diff options
| -rw-r--r-- | com.c | 341 | ||||
| -rw-r--r-- | mem.c | 7 | ||||
| -rw-r--r-- | mem.h | 8 | ||||
| -rw-r--r-- | val.c | 7 | ||||
| -rw-r--r-- | val.h | 4 |
5 files changed, 186 insertions, 181 deletions
@@ -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; @@ -22,3 +22,10 @@ Obj *alloc_obj(State *S, size_t sz, ObjTy oty) { o->oty = oty; return o; } + + +size_t next_pwrof2(size_t x) { + size_t p = 1; + while (p < x) p <<= 1; + return p; +} @@ -17,16 +17,12 @@ void *M(State *S, void *ptr, size_t old, size_t new); #define ENSURE_CAP(S, darr, type, needed) \ if (darr.cap < needed) { \ size_t __newsz = next_pwrof2(needed); \ - if (__newsz < 8) __newsz = 8; + if (__newsz < 8) __newsz = 8; \ darr.d = RENEW_ARR(S, darr.d, type, darr.cap, __newsz); \ darr.cap = __newsz; \ } -inline size_t next_pwrof2(size_t x) { - size_t p = 1; - while (p < x) p <<= 1; - return p; -} +size_t next_pwrof2(size_t x); #define FREE(S,p,ty) M(S, p, sizeof(ty), 0) #define FREE_ARR(S,p,ty,old) M(S, p, (old)*sizeof(ty), 0) @@ -184,3 +184,10 @@ const char *typename_str(Val v) { } return "???"; } + +int val_type(Val v) { + if (IS_OBJ(v)) + return AS_OBJ(v)->oty; + else + return v.ty; +} @@ -36,10 +36,12 @@ const char *typename_str(Val v); bool is_truthy(Val v); bool val_equal(Val a, Val b); +// ValTy or ObjTy +int val_type(Val v); typedef enum { - OTY_STRING, + OTY_STRING = 100, OTY_FUNC, OTY_ARR, } ObjTy; |