summaryrefslogtreecommitdiff
path: root/com.c
diff options
context:
space:
mode:
Diffstat (limited to 'com.c')
-rw-r--r--com.c341
1 files changed, 167 insertions, 174 deletions
diff --git a/com.c b/com.c
index 38a4196..000ad63 100644
--- a/com.c
+++ b/com.c
@@ -33,6 +33,8 @@ Compiler compiler_new(Compiler *outer, Chunk *ch) {
};
}
+static void cpl_expr(Compiler *C, Val v, int flags);
+
static int stack_effect_of(Op opcode) {
switch (opcode) {
case OP_LOADK:
@@ -73,7 +75,7 @@ static int stack_effect_of(Op opcode) {
break;
default:
- ERROR("unknown stack effect of opcode %d",opcode);
+ ERROR("unknown opcode %d",opcode);
break;
}
}
@@ -94,7 +96,7 @@ static uint8_t cpl_const(Compiler *C, Val v) {
Chunk *ch = C->ch;
for (int i = 0; i < ch->consts.len; i++) {
- if (val_equal(v, ch-consts.d[i])) {
+ if (val_equal(v, ch->consts.d[i])) {
return i;
}
}
@@ -130,8 +132,8 @@ static void cpl_endscope(Compiler *C, uint8_t nlocals) {
// jump offsets and things
static size_t placeholder(Compiler *C) {
size_t old_ix = BYTECODE(C).len;
- compile_byte(C, 0x00);
- compile_byte(C, 0x00);
+ cpl_byte(C, 0x00);
+ cpl_byte(C, 0x00);
return old_ix;
}
static void patch(Compiler *C, size_t addr, uint16_t val) {
@@ -156,13 +158,14 @@ static void end_scope(Compiler *C) {
// printf("\t%3d %s\n",loc.slot, loc.name);
// }
- compile_endscope_instr(C, sc->nlocals);
+ cpl_endscope(C, sc->nlocals);
free(sc);
}
// returns slot of declared local
static uint8_t declare_local(Compiler *C, char *name) {
Scope *sc = C->scope;
CHECK(sc != NULL, "can't declare local outside of scope");
+ CHECK(sc->nlocals < MAX_LOCALS, "maximum number of locals per function exceeded");
Local *l = &sc->locals[sc->nlocals++];
l->name = name;
// -1 because local is expected to be already on the stack
@@ -185,54 +188,54 @@ static Local *locate_local(Compiler *C, char *name) {
// compiles a body, ie sequence of "toplevel" expressions in which
// declarations are allowed
-static void compile_body(Compiler *C, AstVec l, int startat, int flags) {
+static void cpl_body(Compiler *C, ObjArr *a, int startat, int flags) {
+ CHECK(a->len > 0, "tried to compile empty body");
+ CHECK(startat < a->len, "tried to startat past end of body");
begin_scope(C);
- for (int i = startat; i < l.len - 1; i++) {
- compile_node(C, l.vals[i], F_toplevel);
- compile_opcode(C, OP_DROP);
+ for (int i = startat; i < a->len - 1; i++) {
+ cpl_expr(C, a->d[i], F_toplevel);
+ cpl_op(C, OP_DROP);
}
- compile_node(C, l.vals[l.len - 1], F_toplevel | (flags & F_tail));
+ cpl_expr(C, a->d[a->len - 1], F_toplevel | (flags & F_tail));
end_scope(C);
}
+// the forms!
-
-static void set_form(Compiler *C, AstVec l, Op _, int flags) {
- AstNode target = l.vals[1];
- if (target.ty == AST_IDENT) {
- // set variable, local or global
- char *name = target.as.str;
-
+static void set_form(Compiler *C, ObjArr *a, Op _, int flags) {
+ Val target = a->d[1];
+ if (IS_STRING(target)) {
+ // set variable: local or global
+ char *name = AS_CSTRING(target);
Local *loc = locate_local(C, name);
- if (loc != NULL) {
- compile_node(C, l.vals[2], 0);
- compile_opcode(C, OP_SETLOCAL);
- compile_byte(C, loc->slot);
+ if (loc) {
+ // write local
+ cpl_expr(C, a->d[2], 0);
+ cpl_op(C, OP_SETLOCAL);
+ cpl_byte(C, loc->slot);
} else {
// write global
- ObjString *o = objstring_copy_cstr(C->S, name);
- compile_node(C, l.vals[2], 0);
- compile_opcode(C, OP_SETGLOBAL);
- compile_byte(C, compile_constant(C, VAL_OBJ(o)));
+ cpl_expr(C, a->d[2], 0);
+ cpl_constop(C, OP_SETGLOBAL, target);
}
- } else if (target.ty == AST_LIST) {
- AstVec pair = target.as.list;
- CHECK(pair.len == 2, "can only set to (arr, ix) 2-pair");
+ } else if (IS_ARR(target)) {
+ ObjArr *pair = AS_ARR(target);
+ CHECK(pair->len == 2, "can only set to (arr, ix) 2-pair");
// (value arr ix) <- TOS
- compile_node(C, l.vals[2], 0);
- compile_node(C, pair.vals[0], 0);
- compile_node(C, pair.vals[1], 0);
- compile_opcode(C, OP_SETIDX);
+ cpl_expr(C, a->d[2], 0);
+ cpl_expr(C, pair->d[0], 0);
+ cpl_expr(C, pair->d[1], 0);
+ cpl_op(C, OP_SETIDX);
}
}
-static void do_form(Compiler *C, AstVec l, Op _, int flags) {
- compile_body(C, l, 1, flags);
+static void do_form(Compiler *C, ObjArr *a, Op _, int flags) {
+ cpl_body(C, a, 1, flags);
}
-static void if_form(Compiler *C, AstVec l, Op _, int flags) {
+static void if_form(Compiler *C, ObjArr *a, Op _, int flags) {
// (if cond if-true if-false)
// cond
// 0branch ->A
@@ -243,21 +246,20 @@ static void if_form(Compiler *C, AstVec l, Op _, int flags) {
// never toplevel
int downflags = flags & ~F_toplevel;
-
int orig_stack_cur = C->stack_cur;
- compile_node(C, l.vals[1], 0);
- compile_opcode(C, OP_0BRANCH);
+ cpl_expr(C, a->d[1], 0);
+ cpl_op(C, OP_0BRANCH);
size_t ph_a = placeholder(C);
- compile_node(C, l.vals[2], downflags);
- compile_opcode(C, OP_SKIP);
+ cpl_expr(C, a->d[2], downflags);
+ cpl_op(C, OP_SKIP);
size_t ph_b = placeholder(C);
size_t dest_a = BYTECODE(C).len;
int stack_cur_a = C->stack_cur;
C->stack_cur = orig_stack_cur;
- compile_node(C, l.vals[3], downflags);
+ cpl_expr(C, a->d[3], downflags);
size_t dest_b = BYTECODE(C).len;
int stack_cur_b = C->stack_cur;
@@ -269,7 +271,7 @@ static void if_form(Compiler *C, AstVec l, Op _, int flags) {
CHECK(stack_cur_a == orig_stack_cur + 1, "this should never happen");
}
-static void while_form(Compiler *C, AstVec l, Op _, int flags) {
+static void while_form(Compiler *C, ObjArr *a, Op _, int flags) {
// (while cond body ...)
// A:
// cond
@@ -279,67 +281,62 @@ static void while_form(Compiler *C, AstVec l, Op _, int flags) {
// B:
// nil (while loop always returns nil)
size_t dest_a = BYTECODE(C).len;
- compile_node(C, l.vals[1], 0);
- compile_opcode(C, OP_0BRANCH);
+ cpl_expr(C, a->d[1], 0);
+ cpl_op(C, OP_0BRANCH);
size_t ph_b = placeholder(C);
- compile_body(C, l, 2, flags & ~F_tail);
- compile_opcode(C, OP_DROP);
- compile_opcode(C, OP_REDO);
+ cpl_body(C, a, 2, flags & ~F_tail);
+ cpl_op(C, OP_DROP);
+ cpl_op(C, OP_REDO);
size_t ph_a = placeholder(C);
size_t dest_b = BYTECODE(C).len;
- compile_opcode(C, OP_NIL);
+ cpl_op(C, OP_NIL);
patch(C, ph_a, ph_a - dest_a + 2);
patch(C, ph_b, dest_b - ph_b - 2);
}
-
-
-static void arith_form(Compiler *C, AstVec l, Op op, int flags) {
- compile_node(C, l.vals[1], 0);
- compile_node(C, l.vals[2], 0);
- compile_opcode(C, op);
+static void arith_form(Compiler *C, ObjArr *a, Op op, int flags) {
+ cpl_expr(C, a->d[1], 0);
+ cpl_expr(C, a->d[2], 0);
+ cpl_op(C, op);
}
-
-
-static void let_form(Compiler *C, AstVec l, Op _, int flags) {
- CHECK(l.vals[1].ty == AST_LIST, "let's first argument must be list");
- AstVec bindlist = l.vals[1].as.list;
- CHECK(bindlist.len % 2 == 0, "unmatched binding in let");
- int nbinds = bindlist.len / 2;
+static void let_form(Compiler *C, ObjArr *a, Op _, int flags) {
+ CHECK(IS_ARR(a->d[1]), "let's first argument must be list");
+ ObjArr *bindlist = AS_ARR(a->d[1]);
+ CHECK(bindlist->len % 2 == 0, "unmatched binding in let");
+ int nbinds = bindlist->len / 2;
begin_scope(C);
for (int i = 0; i < nbinds; i++) {
int ix = i * 2;
- AstNode name = bindlist.vals[ix];
- AstNode expr = bindlist.vals[ix+1];
- CHECK(name.ty == AST_IDENT, "binding name must be identifier");
- compile_node(C, expr, 0);
- declare_local(C, name.as.str);
+ Val name = bindlist->d[ix];
+ Val expr = bindlist->d[ix+1];
+ CHECK(IS_STRING(name), "binding name must be identifier");
+ cpl_expr(C, expr, 0);
+ declare_local(C, AS_CSTRING(name));
}
- compile_body(C, l, 2, flags);
+ cpl_body(C, a, 2, flags);
end_scope(C);
}
-static void for_form(Compiler *C, AstVec l, Op _, int flags) {
+static void for_form(Compiler *C, ObjArr *a, Op _, int flags) {
// (for (x n) ...)
- CHECK(l.vals[1].ty == AST_LIST, "for needs binding list");
- AstVec blist = l.vals[1].as.list;
- CHECK(blist.len == 2, "for binding list must have length 2");
- CHECK(blist.vals[0].ty == AST_IDENT, "can only bind to ident");
- char *ivar = blist.vals[0].as.str;
+ CHECK(IS_ARR(a->d[1]), "for needs binding list");
+ ObjArr *blist = AS_ARR(a->d[1]);
+ CHECK(blist->len == 2, "for binding list must have length 2");
+ CHECK(IS_STRING(blist->d[0]), "can only bind to ident");
+ char *ivar = AS_CSTRING(blist->d[0]);
begin_scope(C);
- compile_opcode(C, OP_LOADK);
- compile_byte(C, compile_constant(C, VAL_NUM(0)));
+ cpl_constop(C, OP_LOADK, VAL_NUM(0));
uint8_t islot = declare_local(C, ivar);
- compile_node(C, blist.vals[1], 0);
+ cpl_expr(C, blist->d[1], 0);
uint8_t mslot = declare_local(C, "__max__");
// A
@@ -354,26 +351,25 @@ static void for_form(Compiler *C, AstVec l, Op _, int flags) {
// nil
size_t dest_A = BYTECODE(C).len;
- compile_opcode(C, OP_GETLOCAL);
- compile_byte(C, islot);
- compile_opcode(C, OP_GETLOCAL);
- compile_byte(C, mslot);
- compile_opcode(C, OP_CMP);
- compile_opcode(C, OP_0BRANCH);
+ cpl_op(C, OP_GETLOCAL);
+ cpl_byte(C, islot);
+ cpl_op(C, OP_GETLOCAL);
+ cpl_byte(C, mslot);
+ cpl_op(C, OP_CMP);
+ cpl_op(C, OP_0BRANCH);
size_t ph_B = placeholder(C);
- compile_body(C, l, 2, flags & ~F_tail);
- compile_opcode(C, OP_DROP);
- compile_opcode(C, OP_GETLOCAL);
- compile_byte(C, islot);
- compile_opcode(C, OP_LOADK);
- compile_byte(C, compile_constant(C, VAL_NUM(1)));
- compile_opcode(C, OP_ADD);
- compile_opcode(C, OP_SETLOCAL);
- compile_opcode(C, islot);
- compile_opcode(C, OP_REDO);
+ cpl_body(C, a, 2, flags & ~F_tail);
+ cpl_op(C, OP_DROP);
+ cpl_op(C, OP_GETLOCAL);
+ cpl_byte(C, islot);
+ cpl_constop(C, OP_LOADK, VAL_NUM(1));
+ cpl_op(C, OP_ADD);
+ cpl_op(C, OP_SETLOCAL);
+ cpl_op(C, islot);
+ cpl_op(C, OP_REDO);
size_t ph_A = placeholder(C);
size_t dest_B = BYTECODE(C).len;
- compile_opcode(C, OP_NIL);
+ cpl_op(C, OP_NIL);
patch(C, ph_A , ph_A - dest_A + 2);
patch(C, ph_B ,dest_B - ph_B - 2);
@@ -381,30 +377,29 @@ static void for_form(Compiler *C, AstVec l, Op _, int flags) {
end_scope(C);
}
-static void each_form(Compiler *C, AstVec l, Op _, int flags) {
+static void each_form(Compiler *C, ObjArr *a, Op _, int flags) {
// (each (x a) ...)
// returns nil, for now
- CHECK(l.vals[1].ty == AST_LIST, "each needs binding list");
- AstVec blist = l.vals[1].as.list;
- CHECK(blist.len == 2, "each binding list must have length 2");
- CHECK(blist.vals[0].ty == AST_IDENT, "can only bind to ident");
- char *ivar = blist.vals[0].as.str;
+ CHECK(IS_ARR(a->d[1]), "each needs binding list");
+ ObjArr *blist = AS_ARR(a->d[1]);
+ CHECK(blist->len == 2, "each binding list must have length 2");
+ CHECK(IS_STRING(blist->d[0]), "can only bind to ident");
+ char *ivar = AS_CSTRING(blist->d[0]);
begin_scope(C);
- compile_opcode(C, OP_LOADK);
- compile_byte(C, compile_constant(C, VAL_NUM(0)));
+ cpl_constop(C, OP_LOADK, VAL_NUM(0));
uint8_t islot = declare_local(C, "__idx__");
- compile_node(C, blist.vals[1], 0);
+ cpl_expr(C, blist->d[1], 0);
uint8_t aslot = declare_local(C, "__arr__");
- compile_opcode(C, OP_GETLOCAL);
- compile_byte(C, aslot);
- compile_opcode(C, OP_ARRLEN);
+ cpl_op(C, OP_GETLOCAL);
+ cpl_byte(C, aslot);
+ cpl_op(C, OP_ARRLEN);
uint8_t mslot = declare_local(C, "__max__");
- compile_opcode(C, OP_NIL);
+ cpl_op(C, OP_NIL);
uint8_t vslot = declare_local(C, ivar);
@@ -424,40 +419,39 @@ static void each_form(Compiler *C, AstVec l, Op _, int flags) {
// nil
size_t dest_A = BYTECODE(C).len;
- compile_opcode(C, OP_GETLOCAL);
- compile_byte(C, islot);
- compile_opcode(C, OP_GETLOCAL);
- compile_byte(C, mslot);
- compile_opcode(C, OP_CMP);
- compile_opcode(C, OP_0BRANCH);
+ cpl_op(C, OP_GETLOCAL);
+ cpl_byte(C, islot);
+ cpl_op(C, OP_GETLOCAL);
+ cpl_byte(C, mslot);
+ cpl_op(C, OP_CMP);
+ cpl_op(C, OP_0BRANCH);
size_t ph_B = placeholder(C);
- compile_opcode(C, OP_GETLOCAL);
- compile_byte(C, aslot);
- compile_opcode(C, OP_GETLOCAL);
- compile_byte(C, islot);
- compile_call_instr(C, 2);
- compile_opcode(C, OP_SETLOCAL);
- compile_byte(C, vslot);
- compile_opcode(C, OP_DROP);
-
- compile_body(C, l, 2, flags & ~F_tail);
- compile_opcode(C, OP_DROP);
-
- compile_opcode(C, OP_GETLOCAL);
- compile_byte(C, islot);
- compile_opcode(C, OP_LOADK);
- compile_byte(C, compile_constant(C, VAL_NUM(1)));
- compile_opcode(C, OP_ADD);
- compile_opcode(C, OP_SETLOCAL);
- compile_byte(C, islot);
- compile_opcode(C, OP_DROP);
-
- compile_opcode(C, OP_REDO);
+ cpl_op(C, OP_GETLOCAL);
+ cpl_byte(C, aslot);
+ cpl_op(C, OP_GETLOCAL);
+ cpl_byte(C, islot);
+ cpl_call(C, 2);
+ cpl_op(C, OP_SETLOCAL);
+ cpl_byte(C, vslot);
+ cpl_op(C, OP_DROP);
+
+ cpl_body(C, a, 2, flags & ~F_tail);
+ cpl_op(C, OP_DROP);
+
+ cpl_op(C, OP_GETLOCAL);
+ cpl_byte(C, islot);
+ cpl_constop(C, OP_LOADK, VAL_NUM(1));
+ cpl_op(C, OP_ADD);
+ cpl_op(C, OP_SETLOCAL);
+ cpl_byte(C, islot);
+ cpl_op(C, OP_DROP);
+
+ cpl_op(C, OP_REDO);
size_t ph_A = placeholder(C);
size_t dest_B = BYTECODE(C).len;
- compile_opcode(C, OP_NIL);
+ cpl_op(C, OP_NIL);
patch(C, ph_A, ph_A - dest_A + 2);
patch(C, ph_B, dest_B - ph_B - 2);
@@ -466,23 +460,23 @@ static void each_form(Compiler *C, AstVec l, Op _, int flags) {
}
-static void def_form(Compiler *C, AstVec l, Op _, int flags) {
- CHECK(l.vals[1].ty == AST_IDENT, "def's first argument must be ident");
+static void def_form(Compiler *C, ObjArr *a, Op _, int flags) {
+ CHECK(IS_STRING(a->d[1]), "def's first argument must be ident");
CHECK(flags & F_toplevel, "def only allowed at top level");
- compile_node(C, l.vals[2], 0);
- declare_local(C, l.vals[1].as.str);
+ cpl_expr(C, a->d[2], 0);
+ declare_local(C, AS_CSTRING(a->d[1]));
// whatever is calling us will compile an OP_DROP next
// or, well. not if we're in tail position. but i can't see
// any circumstance where you'd want that anyway
- compile_opcode(C, OP_NIL);
+ cpl_op(C, OP_NIL);
}
-static void fn_form(Compiler *C, AstVec l, Op _, int flags) {
+static void fn_form(Compiler *C, ObjArr *a, Op _, int flags) {
// (fn (arg arg arg) body ...)
- CHECK(l.vals[1].ty == AST_LIST, "fn's first argument must be list");
- AstVec arglist = l.vals[1].as.list;
- CHECK(arglist.len <= 255, "maximum 255 args for function");
- uint8_t arity = arglist.len;
+ CHECK(IS_ARR(a->d[1]), "fn's first argument must be list");
+ ObjArr *arglist = AS_ARR(a->d[1]);
+ CHECK(arglist->len <= 255, "maximum 255 args for function");
+ uint8_t arity = arglist->len;
ObjFunc *func = objfunc_new(C->S, arity);
Compiler subcompiler = compiler_new(C, &func->ch);
@@ -494,32 +488,31 @@ static void fn_form(Compiler *C, AstVec l, Op _, int flags) {
SC->stack_cur ++;
declare_local(SC, "__func__");
for (int i = 0; i < arity; i++) {
- AstNode argname = arglist.vals[i];
- CHECK(argname.ty == AST_IDENT, "argument name must be identifier");
+ Val argname = arglist->d[i];
+ CHECK(IS_STRING(argname), "argument name must be identifier");
SC->stack_cur ++;
- declare_local(SC, argname.as.str);
+ declare_local(SC, AS_CSTRING(argname));
}
- compile_body(SC, l, 2, F_tail);
+ cpl_body(SC, a, 2, F_tail);
end_scope(SC);
- compile_opcode(SC, OP_RET);
+ cpl_op(SC, OP_RET);
- compile_opcode(C, OP_LOADK);
- compile_byte(C, compile_constant(C, VAL_OBJ(func)));
+ cpl_constop(C, OP_LOADK, VAL_OBJ(func));
}
-static void defn_form(Compiler *C, AstVec l, Op _, int flags) {
+static void defn_form(Compiler *C, ObjArr *a, Op _, int flags) {
// todo: reduce redundancy
- CHECK(l.vals[1].ty == AST_LIST, "defns first arg must be list");
- AstVec blist = l.vals[1].as.list;
- CHECK(blist.len > 0, "defn needs at least a function name");
- CHECK(blist.len <= 256, "maximum 255 args for function");
+ CHECK(IS_ARR(a->d[1]), "defns first arg must be list");
+ ObjArr *blist = AS_ARR(a->d[1]);
+ CHECK(blist->len > 0, "defn needs at least a function name");
+ CHECK(blist->len <= 256, "maximum 255 args for function");
CHECK(flags & F_toplevel, "defn only allowed at toplevel");
- uint8_t arity = blist.len - 1;
+ uint8_t arity = blist->len - 1;
- CHECK(blist.vals[0].ty == AST_IDENT, "func name must be ident");
- char *fname = blist.vals[0].as.str;
+ CHECK(IS_STRING(blist->d[0]), "func name must be ident");
+ char *fname = AS_CSTRING(blist->d[0]);
ObjFunc *func = objfunc_new(C->S, arity);
Compiler subcompiler = compiler_new(C, &func->ch);
@@ -528,22 +521,21 @@ static void defn_form(Compiler *C, AstVec l, Op _, int flags) {
SC->stack_cur ++;
declare_local(SC, fname);
for (int i = 0; i < arity; i++) {
- AstNode argname = blist.vals[i+1];
- CHECK(argname.ty == AST_IDENT, "arg name must be identifier");
+ Val argname = blist->d[i+1];
+ CHECK(IS_STRING(argname), "arg name must be identifier");
SC->stack_cur ++;
- declare_local(SC, argname.as.str);
+ declare_local(SC, AS_CSTRING(argname));
}
- compile_body(SC, l, 2, F_tail);
+ cpl_body(SC, a, 2, F_tail);
end_scope(SC);
- compile_opcode(SC, OP_RET);
+ cpl_op(SC, OP_RET);
- compile_opcode(C, OP_LOADK);
- compile_byte(C, compile_constant(C, VAL_OBJ(func)));
+ cpl_constop(C, OP_LOADK, VAL_OBJ(func));
declare_local(C, fname);
- compile_opcode(C, OP_NIL);
+ cpl_op(C, OP_NIL);
}
-typedef void (*form_compiler)(Compiler *C, AstVec l, Op op, int flags);
+typedef void (*form_compiler)(Compiler *C, ObjArr *a, Op op, int flags);
typedef struct {
char *name;
int min_params;
@@ -582,7 +574,7 @@ static BuiltinForm *find_builtinform(char *name) {
return NULL;
}
-static void compile_expr(Compiler *C, Val v, int flags) {
+static void cpl_expr(Compiler *C, Val v, int flags) {
switch (val_type(v)) {
case TY_NUM: case TY_NIL: case TY_BOOL:
cpl_constop(C, OP_LOADK, v);
@@ -617,8 +609,8 @@ static void compile_expr(Compiler *C, Val v, int flags) {
} else {
// function call
CHECK(len < 256, "max 255 args in a function call");
- for (int i = 0; i a->len; i++)
- compile_expr(C, a->d[i], 0);
+ for (int i = 0; i < a->len; i++)
+ cpl_expr(C, a->d[i], 0);
if (flags & F_tail)
cpl_tailcall(C, len);
else
@@ -688,8 +680,9 @@ int main(int argc, char **argv) {
fread(buf, 1, 8192, infile);
buf[8192] = '\0';
ObjArr *top = read_exprs(S, buf);
+ cpl_body(&com, top, 0, 0);
- println_val(VAL_OBJ(top));
+ // println_val(VAL_OBJ(top));
// pcc_destroy(parser);
// compile_body(&com, top.as.list, 0, 0);
@@ -698,7 +691,7 @@ int main(int argc, char **argv) {
- compile_opcode(&com, OP_HALT);
+ cpl_op(&com, OP_HALT);
Thread th = thread_new(S);
th.ch = &ch;
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-15 04:53:41 +0000