diff --git a/compiler/compile.c b/compiler/compile.c index 35e565e..bad22b8 100644 --- a/compiler/compile.c +++ b/compiler/compile.c @@ -94,14 +94,20 @@ void emit(struct function *fn, struct context *ctx, struct node *expr) { size_t index; assert(ctx_lookup_name(ctx, n0->n_ident, &kind, &index) == 0); - assert(kind == NAME_GLOBAL); n1 = caddr(expr); assert(null_q(cdr(cddr(expr)))); // (define ident value) // Emit value for n1 emit(fn, ctx, n1); - emit_insn(fn, OP(OP_STG, index)); + switch (kind) { + case NAME_LOCAL: + emit_insn(fn, OP(OP_STL, index)); + break; + case NAME_GLOBAL: + emit_insn(fn, OP(OP_STG, index)); + break; + } } else if (cons_q(n0)) { struct node *name = car(n0); struct node *args = cdr(n0); @@ -147,7 +153,17 @@ void emit(struct function *fn, struct context *ctx, struct node *expr) { } // Check for macros/builtin operators - if (!strcmp(n0->n_ident, "if")) { + if (!strcmp(n0->n_ident, "begin")) { + n1 = cdr(expr); + assert(!null_q(n1)); + + for (; n1; n1 = cdr(n1)) { + n2 = car(n1); + + emit(fn, ctx, n2); + } + return; + } else if (!strcmp(n0->n_ident, "if")) { n1 = cadr(expr); // condition n2 = caddr(expr); // yes-expr n3 = car(cdr(cddr(expr))); // no-expr @@ -238,7 +254,7 @@ void emit(struct function *fn, struct context *ctx, struct node *expr) { } else if (!strcmp(n0->n_ident, "<=") && c0 == 2) { emit_insn(fn, OP(OP_LE, 0)); } else if (!strcmp(n0->n_ident, "null?") && c0 == 1) { - emit_insn(fn, OP(OP_TEST, 0)); + emit_insn(fn, OP(OP_ISZ, 0)); } else if (!strcmp(n0->n_ident, "not") && c0 == 1) { emit_insn(fn, OP(OP_NOT, 0)); } else if (!strcmp(n0->n_ident, "car") && c0 == 1) { @@ -247,19 +263,29 @@ void emit(struct function *fn, struct context *ctx, struct node *expr) { emit_insn(fn, OP(OP_CDR, 0)); } else { size_t index; + int kind; - // TODO lookup unit-local function - // TODO function signature validation? - - // Lookup external reference in the list, if already present - if (unit_ext_ref(ctx, n0->n_ident, &index) == 0) { - emit_insn(fn, OP(OP_XCALL, index)); - } else { + if (ctx_lookup_name(ctx, n0->n_ident, &kind, &index) != 0) { printf("Undefined reference to function "); vm_print(n0, 0); printf("\n"); abort(); } + + switch (kind) { + case NAME_EXTERNAL: + emit_insn(fn, OP(OP_XCALL, index)); + break; + case NAME_LOCAL: + emit_insn(fn, OP(OP_LCALL, index)); + break; + case NAME_GLOBAL: + emit_insn(fn, OP(OP_GCALL, index)); + break; + default: + printf("Unknown\n"); + abort(); + } } return; case N_INTEGER: @@ -292,6 +318,9 @@ void emit(struct function *fn, struct context *ctx, struct node *expr) { case NAME_ARGUMENT: emit_insn(fn, OP(OP_LDARG, index)); break; + case NAME_LOCAL: + emit_insn(fn, OP(OP_LDL, index)); + break; default: abort(); } diff --git a/compiler/include/unit.h b/compiler/include/unit.h index f453bf1..b3ae5ee 100644 --- a/compiler/include/unit.h +++ b/compiler/include/unit.h @@ -50,7 +50,6 @@ struct unit { void unit_init(struct unit *u); void ctx_init(struct context *c, struct context *p); struct function *unit_lambda(struct unit *u); -int unit_ext_ref(struct context *ctx, const char *name, size_t *index); int unit_ext_load(struct unit *self, const char *unit); int ctx_lookup_name(struct context *ctx, const char *name, int *kind, size_t *index); diff --git a/compiler/main.c b/compiler/main.c index 16db3c4..4325e55 100644 --- a/compiler/main.c +++ b/compiler/main.c @@ -11,10 +11,39 @@ #include "unit.h" #include "node.h" -static struct node *read_program(const char *text) { - struct vm_parser p; +static int file_peek(struct vm_parser *p) { + if (p->ch == -1) { + int ch = fgetc(p->ctx); + p->ch = ch; + } + if (p->ch == -1) { + return 0; + } + return p->ch; +} + +static int file_pop(struct vm_parser *p) { + int ch = file_peek(p); + if (ch == -1) { + return 0; + } + p->ch = fgetc(p->ctx); + return ch; +} + +static struct node *read_program(const char *filename) { + FILE *fp; struct node *head, *tail, *expr; - vm_str_parser(&p, text); + struct vm_parser p; + + fp = fopen(filename, "r"); + assert(fp); + + p.ch = -1; + p.ctx = fp; + p.peek = file_peek; + p.pop = file_pop; + head = NULL; while (vm_parse(&p, &expr) == 0) { expr = cons(expr, NULL); @@ -25,6 +54,8 @@ static struct node *read_program(const char *text) { } tail = expr; } + + fclose(fp); return head; } @@ -92,21 +123,18 @@ static void write_unit(FILE *fp, struct unit *u) { } } -int main(void) { +int main(int argc, char **argv) { + const char *input, *output; + assert(argc == 3); + input = argv[1]; + output = argv[2]; + struct unit unit; struct node *program; FILE *fp; - const char *code = -"(use core)" -"(define in (cons 1 (cons 2 (cons 3 (cons 4 nil)))))" -"(while (not (null? in))" -" (print (car in))" -" (setq in (cdr in))" -")" -; unit_init(&unit); - program = read_program(code); + program = read_program(input); struct function *main = unit_lambda(&unit); main->args = NULL; @@ -114,9 +142,9 @@ int main(void) { unit.global.owner = main; emit_function(&unit.global, main); - fp = fopen("output.vmx", "wb"); + fp = fopen(output, "wb"); if (!fp) { - perror("output.vmx"); + perror(output); return -1; } write_unit(fp, &unit); diff --git a/compiler/parse.c b/compiler/parse.c index b0482d4..b7e9bde 100644 --- a/compiler/parse.c +++ b/compiler/parse.c @@ -30,7 +30,7 @@ static inline int is_digit(int ch) { static inline int is_ident0(int ch) { return (ch >= 'a' && ch <= 'z') || (ch >= 'A' && ch <= 'Z') || - strchr("+-*&^%$@!~<>/.", ch); + strchr("+-*&^%$@!~<>/=.", ch); } static int skip_whitespace(struct vm_parser *in) { diff --git a/compiler/unit.c b/compiler/unit.c index 15d35c2..a00a2fa 100644 --- a/compiler/unit.c +++ b/compiler/unit.c @@ -46,11 +46,48 @@ void emit_insn(struct function *fn, uint32_t insn) { *p = insn; } -int unit_ext_ref(struct context *ctx, const char *name, size_t *index) { - (void) ctx; - (void) name; - (void) index; +// TODO non-builtin units +int unit_ext_load(struct unit *self, const char *name) { + if (!strcmp(name, "core")) { + struct ext_unit *unit = vector_append(&self->ext_units); + unit->entry_count = sizeof(u_core_entries) / sizeof(u_core_entries[0]); + unit->entries = u_core_entries; + strcpy(unit->name, name); + return 0; + } + return -ENOENT; +} +// TODO external references +int ctx_lookup_name(struct context *ctx, const char *name, int *kind, size_t *index) { + // 1. Lookup local + struct hash_pair *p; + p = hash_lookup(&ctx->vars, name); + if (p) { + if (ctx->parent) { + // TODO only look into level-1 local contexts + *kind = NAME_LOCAL; + } else { + *kind = NAME_GLOBAL; + } + *index = (size_t) p->value; + return 0; + } + + // 2. Lookup argument + assert(ctx->owner); + size_t arg_i = 0; + for (struct node *node = ctx->owner->args; node; node = cdr(node), ++arg_i) { + struct node *arg = car(node); + assert(ident_q(arg)); + if (!strcmp(arg->n_ident, name)) { + *kind = NAME_ARGUMENT; + *index = arg_i; + return 0; + } + } + + // 3. Lookup external struct unit *root = ctx->root; // Try looking up an existing reference entry @@ -69,6 +106,7 @@ int unit_ext_ref(struct context *ctx, const char *name, size_t *index) { struct ext_unit_entry *ent = &unit->entries[j]; if (!strcmp(ent->name, name)) { + *kind = NAME_EXTERNAL; *index = root->ext_refs.size; struct ext_ref *ref = vector_append(&root->ext_refs); ref->unit_index = i; @@ -79,48 +117,6 @@ int unit_ext_ref(struct context *ctx, const char *name, size_t *index) { } } - return -ENOENT; -} - -// TODO non-builtin units -int unit_ext_load(struct unit *self, const char *name) { - if (!strcmp(name, "core")) { - struct ext_unit *unit = vector_append(&self->ext_units); - unit->entry_count = sizeof(u_core_entries) / sizeof(u_core_entries[0]); - unit->entries = u_core_entries; - strcpy(unit->name, name); - return 0; - } - return -ENOENT; -} - -// TODO external references -int ctx_lookup_name(struct context *ctx, const char *name, int *kind, size_t *index) { - struct hash_pair *p; - p = hash_lookup(&ctx->vars, name); - if (p) { - if (ctx->parent) { - printf("TODO local contexts\n"); - abort(); - } - *kind = NAME_GLOBAL; - *index = (size_t) p->value; - return 0; - } - - // Lookup argument - assert(ctx->owner); - size_t arg_i = 0; - for (struct node *node = ctx->owner->args; node; node = cdr(node), ++arg_i) { - struct node *arg = car(node); - assert(ident_q(arg)); - if (!strcmp(arg->n_ident, name)) { - *kind = NAME_ARGUMENT; - *index = arg_i; - return 0; - } - } - if (ctx->parent) { return ctx_lookup_name(ctx->parent, name, kind, index); } diff --git a/core/include/op.h b/core/include/op.h index 7e6b101..826064b 100644 --- a/core/include/op.h +++ b/core/include/op.h @@ -26,15 +26,18 @@ #define OP_CDR 0x41 #define OP_CONS 0x45 -#define OP_TEST 0x46 +#define OP_ISZ 0x46 #define OP_LDARG 0x4B #define OP_LDG 0x4E #define OP_STG 0x4F #define OP_LDF 0x50 +#define OP_LDL 0x51 +#define OP_STL 0x52 #define OP_XCALL 0x60 #define OP_LCALL 0x61 -#define OP_JMP 0x62 -#define OP_BT 0x63 -#define OP_BF 0x64 +#define OP_GCALL 0x62 +#define OP_JMP 0x63 +#define OP_BT 0x64 +#define OP_BF 0x65 #define OP_RET 0x6F diff --git a/vm/include/vmstate.h b/vm/include/vmstate.h index 9dbaf7e..2f098e5 100644 --- a/vm/include/vmstate.h +++ b/vm/include/vmstate.h @@ -4,6 +4,8 @@ #include "vector.h" +#define MAXARG 12 + struct vm_value; #define REF_NATIVE (1 << 0) @@ -23,6 +25,10 @@ struct vm_state { // Runtime stack uint64_t *stack; size_t sp, stack_size; + uint64_t *call_stack; + size_t csp, call_stack_size; + + uint64_t arg_regs[MAXARG]; struct vector ref_table; @@ -39,6 +45,9 @@ void vm_state_init(struct vm_state *vm, struct vm_func_entry *vm_add_function(struct vm_state *vm); struct vm_ref_entry *vm_add_ref(struct vm_state *vm); +void vm_call_index(struct vm_state *vm, size_t index); +void vm_call_ref(struct vm_state *vm, struct vm_value *ref); + // Bytecode interpretation int vm_eval_step(struct vm_state *vm); diff --git a/vm/include/vmval.h b/vm/include/vmval.h index 170aae5..eb0a86c 100644 --- a/vm/include/vmval.h +++ b/vm/include/vmval.h @@ -9,6 +9,7 @@ enum vm_type { VT_CONS, VT_STRING, + VT_FUNC, }; struct vm_value { @@ -18,6 +19,9 @@ struct vm_value { struct { uintptr_t fat_ar, fat_dr; } v_cons; + struct { + size_t lib_index, fn_index; + } v_func; struct vm_string v_string; }; }; @@ -43,11 +47,16 @@ static inline int cons_q(uint64_t w) { } } +static inline int func_q(uint64_t w) { + return ref_q(w) && !null_q(w) && getref(w)->type == VT_FUNC; +} + static inline int pair_q(uint64_t w) { return ref_q(w) && (!null_q(w) && getref(w)->type == VT_CONS); } struct vm_value *vm_cons(uint64_t w0, uint64_t w1); struct vm_value *vm_makestr(const char *str); +struct vm_value *vm_func(size_t lib_index, size_t fn_index); void vm_print(uint64_t w); diff --git a/vm/vmstate.c b/vm/vmstate.c index dd20c54..23490ff 100644 --- a/vm/vmstate.c +++ b/vm/vmstate.c @@ -57,6 +57,10 @@ void vm_state_init(struct vm_state *vm, size_t stack_size, size_t global_pool_si vm->sp = stack_size; vm->stack_size = stack_size; + vm->call_stack_size = 1024; + vm->call_stack = calloc(sizeof(uint64_t), vm->call_stack_size); + vm->csp = vm->call_stack_size; + vm->global_pool = calloc(sizeof(uint64_t), global_pool_size); vm->global_pool_size = global_pool_size; @@ -90,6 +94,28 @@ struct vm_func_entry *vm_add_function(struct vm_state *vm) { // } //} +void vm_call_index(struct vm_state *vm, size_t index) { + struct vm_func_entry *func; + assert(index < vm->functions.size); + assert(vm->csp); + + vm->call_stack[--vm->csp] = vm->ip; + vm->fp = index; + vm->ip = 0; + + func = vector_ref(&vm->functions, index); + assert(func->argc <= MAXARG); + for (size_t i = 0; i < func->argc; ++i) { + vm->arg_regs[i] = pop(vm); + } +} + +void vm_call_ref(struct vm_state *vm, struct vm_value *ref) { + assert(ref->type == VT_FUNC); + assert(ref->v_func.lib_index == 0); + vm_call_index(vm, ref->v_func.fn_index); +} + int vm_eval_opcode(struct vm_state *vm, uint32_t opcode) { uint64_t w0, w1; size_t i0; @@ -105,6 +131,18 @@ int vm_eval_opcode(struct vm_state *vm, uint32_t opcode) { push_ref(vm, NULL); } return 0; + case OP_EQ: + w0 = pop(vm); + w1 = pop(vm); + if (ref_q(w0) || ref_q(w1)) { + assert(0 && "Ref cmp not implemented yet"); + } + if (w0 == w1) { + push_integer(vm, 1); + } else { + push_ref(vm, NULL); + } + return 0; // case OP_LDNIL: push_ref(vm, NULL); @@ -128,6 +166,11 @@ int vm_eval_opcode(struct vm_state *vm, uint32_t opcode) { push_ref(vm, vm_cons(w0, w1)); return 0; // + case OP_LDARG: + i0 = opcode & 0xFFFFFF; + assert(i0 < MAXARG); + push(vm, vm->arg_regs[i0]); + return 0; case OP_LDG: i0 = opcode & 0xFFFFFF; assert(i0 < vm->global_pool_size); @@ -139,8 +182,17 @@ int vm_eval_opcode(struct vm_state *vm, uint32_t opcode) { assert(i0 < vm->global_pool_size); vm->global_pool[i0] = w0; return 0; + case OP_LDF: + i0 = opcode & 0xFFFFFF; + assert(i0 < vm->functions.size); + push_ref(vm, vm_func(0, i0)); + return 0; + case OP_STL: + case OP_LDL: + printf("TODO implement local values\n"); + abort(); // - case OP_TEST: + case OP_ISZ: w0 = pop(vm); if (null_q(w0)) { push_integer(vm, 1); @@ -158,6 +210,13 @@ int vm_eval_opcode(struct vm_state *vm, uint32_t opcode) { assert(func); return func(vm); } + case OP_GCALL: + i0 = opcode & 0xFFFFFF; + assert(i0 < vm->global_pool_size); + w0 = vm->global_pool[i0]; + assert(func_q(w0)); + vm_call_ref(vm, getref(w0)); + return 0; case OP_BF: w0 = pop(vm); ii0 = sximm(opcode & 0xFFFFFF); diff --git a/vm/vmval.c b/vm/vmval.c index 11c2570..a71bd7b 100644 --- a/vm/vmval.c +++ b/vm/vmval.c @@ -34,6 +34,9 @@ static void vm_print_ref(struct vm_value *value, int cdepth) { printf(")"); } break; + case VT_FUNC: + printf("", value->v_func.lib_index, value->v_func.fn_index); + break; } } @@ -65,6 +68,15 @@ struct vm_value *vm_makestr(const char *str) { return v; } +struct vm_value *vm_func(size_t lib_index, size_t fn_index) { + struct vm_value *v = malloc(sizeof(struct vm_value)); + v->type = VT_FUNC; + v->refcount = 0; + v->v_func.lib_index = lib_index; + v->v_func.fn_index = fn_index; + return v; +} + void vm_print(uint64_t w) { vm_print2(w, 0); }