From 30ff72b3ae9fcde5f8e659a05813eb74de4aa4a0 Mon Sep 17 00:00:00 2001 From: "Javier B. Torres" Date: Fri, 23 Jan 2026 18:43:16 -0300 Subject: [PATCH] * --- README | 2 +- examples/cat.grr | 7 ------- src/chunk.c | 3 ++- src/compile.c | 7 +++++++ src/compile.h | 2 +- src/gc.c | 51 +++++++++++++++++++++++++----------------------- src/gc.h | 2 +- src/vm.c | 41 +++++++++++++++++++++++++++++++++++++- src/vm.h | 19 +++++++++++------- std.grr | 12 ++++++++++++ 10 files changed, 103 insertions(+), 43 deletions(-) diff --git a/README b/README index d62ed04..b39f6fb 100644 --- a/README +++ b/README @@ -12,5 +12,5 @@ TODO: - [o] "#load" pragma -- [o better dip/keep (avoid using the retain stack for them) +- [o] better dip/keep (avoid using the retain stack for them) - [ ] hand-rolled parser diff --git a/examples/cat.grr b/examples/cat.grr index f475451..663e885 100644 --- a/examples/cat.grr +++ b/examples/cat.grr @@ -1,11 +1,4 @@ #load("std.grr") -def while { - swap dup bury >r >r - if: call dup - [r> dup >r call r> r> swap while] - [drop r> drop r> drop]; -} - while: [stdin fgetline] [print]; diff --git a/src/chunk.c b/src/chunk.c index 675769b..2e5d892 100644 --- a/src/chunk.c +++ b/src/chunk.c @@ -32,8 +32,9 @@ V chunk_release(Bc *chunk) { #if CHUNK_DEBUG fprintf(stderr, "DEBUG: freeing chunk %s at %p\n", chunk->name, (V *)chunk); #endif - yar_free(&chunk->lines); yar_free(&chunk->constants); + yar_free(&chunk->lines); + yar_free(&chunk->symbols); yar_free(chunk); free(chunk); } diff --git a/src/compile.c b/src/compile.c index b0fa3ec..02ca0ee 100644 --- a/src/compile.c +++ b/src/compile.c @@ -23,12 +23,17 @@ struct { {"dup", {OP_DUP, 0}}, {"drop", {OP_DROP, 0}}, {"swap", {OP_SWAP, 0}}, + {"2dup", {OP_2DUP, 0}}, + {"2drop", {OP_2DROP, 0}}, + {"2swap", {OP_2SWAP, 0}}, {"over", {OP_OVER, 0}}, {"nip", {OP_NIP, 0}}, {"bury", {OP_BURY, 0}}, {"dig", {OP_DIG, 0}}, {">r", {OP_TOR, 0}}, {"r>", {OP_FROMR, 0}}, + {"2>r", {OP_2TOR, 0}}, + {"2r>", {OP_2FROMR, 0}}, {"if", {OP_CHOOSE, OP_CALL, 0}}, {"call", {OP_CALL, 0}}, {"compose", {OP_COMPOSE, 0}}, @@ -395,6 +400,8 @@ static I compile_ast(Cm *cm, mpc_ast_t *curr, mpc_ast_trav_t **next) { } Bc *compile_program(Cm *cm, mpc_ast_t *ast) { + mpc_ast_print_to(ast, stderr); + mpc_ast_trav_t *next = mpc_ast_traverse_start(ast, mpc_ast_trav_order_pre); mpc_ast_t *curr = mpc_ast_traverse_next(&next); // Begin traversal diff --git a/src/compile.h b/src/compile.h index 13542b9..5b234f8 100644 --- a/src/compile.h +++ b/src/compile.h @@ -7,7 +7,7 @@ #include "vendor/mpc.h" -#define COMPILER_DEBUG 0 +#define COMPILER_DEBUG 1 /** Compiler context */ typedef struct Cm { diff --git a/src/gc.c b/src/gc.c index c67ea3c..7802a62 100644 --- a/src/gc.c +++ b/src/gc.c @@ -60,7 +60,7 @@ static V printstats(Gc *gc, const char *label) { } #endif -V gc_collect(Vm *vm) { +V gc_collect(Vm *vm, I final) { Gc *gc = &vm->gc; uint8_t *scan = gc->to.free; @@ -68,29 +68,32 @@ V gc_collect(Vm *vm) { printstats(gc, "before GC"); #endif - for (Z i = 0; i < gc->roots.count; i++) { - O *o = gc->roots.items[i]; - *o = forward(gc, *o); - } - - Dt *dstack[256]; - Dt **dsp = dstack; - *dsp++ = vm->dictionary; - - // Forward constants referenced by dictionary entries - while (dsp > dstack) { - Dt *node = *--dsp; - if (!node) - continue; - if (node->chunk != NULL) { - for (Z i = 0; i < node->chunk->constants.count; i++) { - node->chunk->constants.items[i] = - forward(gc, node->chunk->constants.items[i]); - } + if (!final) { + // Final GC ignores roots. + for (Z i = 0; i < gc->roots.count; i++) { + O *o = gc->roots.items[i]; + *o = forward(gc, *o); } - for (I i = 0; i < 4; i++) { - if (node->child[i] != NULL) - *dsp++ = node->child[i]; + + Dt *dstack[256]; + Dt **dsp = dstack; + *dsp++ = vm->dictionary; + + // Forward constants referenced by dictionary entries + while (dsp > dstack) { + Dt *node = *--dsp; + if (!node) + continue; + if (node->chunk != NULL) { + for (Z i = 0; i < node->chunk->constants.count; i++) { + node->chunk->constants.items[i] = + forward(gc, node->chunk->constants.items[i]); + } + } + for (I i = 0; i < 4; i++) { + if (node->child[i] != NULL) + *dsp++ = node->child[i]; + } } } @@ -170,7 +173,7 @@ Hd *gc_alloc(Vm *vm, Z sz) { Gc *gc = &vm->gc; sz = ALIGN(sz); if (gc->from.free + sz > gc->from.end) { - gc_collect(vm); + gc_collect(vm, 0); if (gc->from.free + sz > gc->from.end) { fprintf(stderr, "out of memory (requested %" PRIdPTR "bytes\n", sz); abort(); diff --git a/src/gc.h b/src/gc.h index c5fa7af..2f28ba5 100644 --- a/src/gc.h +++ b/src/gc.h @@ -32,7 +32,7 @@ V gc_deinit(Gc *); typedef struct Vm Vm; -V gc_collect(Vm *); +V gc_collect(Vm *, I); Hd *gc_alloc(Vm *, Z); #endif diff --git a/src/vm.c b/src/vm.c index 0211d59..8394e6c 100644 --- a/src/vm.c +++ b/src/vm.c @@ -90,7 +90,7 @@ V vm_deinit(Vm *vm) { vm->dictionary = NULL; // Run final GC pass - gc_collect(vm); + gc_collect(vm, 1); gc_deinit(&vm->gc); } @@ -191,12 +191,26 @@ I vm_run(Vm *vm, Bc *chunk, I offset) { (void)vm_pop(vm); break; } + case OP_2DROP: { + (void)vm_pop(vm); + (void)vm_pop(vm); + break; + } case OP_DUP: { O obj = vm_pop(vm); vm_push(vm, obj); vm_push(vm, obj); break; } + case OP_2DUP: { + O obj2 = vm_pop(vm); + O obj1 = vm_pop(vm); + vm_push(vm, obj1); + vm_push(vm, obj1); + vm_push(vm, obj2); + vm_push(vm, obj2); + break; + } case OP_SWAP: { O b = vm_pop(vm); O a = vm_pop(vm); @@ -204,6 +218,17 @@ I vm_run(Vm *vm, Bc *chunk, I offset) { vm_push(vm, a); break; } + case OP_2SWAP: { + O d = vm_pop(vm); + O c = vm_pop(vm); + O b = vm_pop(vm); + O a = vm_pop(vm); + vm_push(vm, d); + vm_push(vm, c); + vm_push(vm, b); + vm_push(vm, a); + break; + } case OP_NIP: { /* a b -> b */ O b = vm_pop(vm); @@ -244,10 +269,24 @@ I vm_run(Vm *vm, Bc *chunk, I offset) { vm_tpush(vm, vm_pop(vm)); break; } + case OP_2TOR: { + O obj2 = vm_pop(vm); + O obj1 = vm_pop(vm); + vm_tpush(vm, obj1); + vm_tpush(vm, obj2); + break; + } case OP_FROMR: { vm_push(vm, vm_tpop(vm)); break; } + case OP_2FROMR: { + O obj2 = vm_tpop(vm); + O obj1 = vm_tpop(vm); + vm_push(vm, obj1); + vm_push(vm, obj2); + break; + } case OP_DOWORD: { I idx = decode_sleb128(&vm->ip); Dt *word = vm->chunk->symbols.items[idx].resolved; diff --git a/src/vm.h b/src/vm.h index 168fc09..b4e3c6a 100644 --- a/src/vm.h +++ b/src/vm.h @@ -13,21 +13,26 @@ enum { OP_NOP = 0, - OP_CONST, // Push constant to stack - OP_NIL, // Push constant to stack + OP_CONST, + OP_NIL, OP_DROP, + OP_2DROP, OP_DUP, + OP_2DUP, OP_SWAP, + OP_2SWAP, OP_NIP, OP_OVER, OP_BURY, OP_DIG, - OP_TOR, // Push from stack to retain stack - OP_FROMR, // Push from retain stack to stack - OP_DOWORD, // Call word from dictionary by name hash + OP_TOR, + OP_2TOR, + OP_FROMR, + OP_2FROMR, + OP_DOWORD, OP_CALL, - OP_TAIL_DOWORD, // Tail call to dictionary word (reuses current frame) - OP_TAIL_CALL, // Tail call to quotation (reuses current frame) + OP_TAIL_DOWORD, + OP_TAIL_CALL, OP_PRIM, OP_COMPOSE, OP_CURRY, diff --git a/std.grr b/std.grr index 779b125..805ccc7 100644 --- a/std.grr +++ b/std.grr @@ -9,7 +9,12 @@ def when { [] if } def unless { swap when } def dip { swap [] curry compose call } +def 2dip { swap [dip] dip } +def 3dip { swap [2dip] dip } + def keep { over [call] dip } +def 2keep { [2dup] dip 2dip } + def bi { [keep] dip call } def tri { [[keep] dip keep] dip call } @@ -18,3 +23,10 @@ def times { [drop drop] [swap over >r >r call r> 1 - r> times]; } + +def while { + swap dup bury >r >r + if: call dup + [r> dup >r call r> r> swap while] + [drop r> drop r> drop]; +}