lobo/growl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

*

Browse source
This commit is contained in:
Lobo 2026-01-20 13:34:19 -03:00
parent 1185690ce6
commit b9a5bc5e63
9 changed files with 203 additions and 30 deletions
Download patch file Download diff file Expand all files Collapse all files

72
src/compile.c
View file

@ -20,6 +20,10 @@ struct {
{"dup", OP_DUP},
{"drop", OP_DROP},
{"swap", OP_SWAP},
{"over", OP_OVER},
{"nip", OP_NIP},
{"bury", OP_BURY},
{"dig", OP_DIG},
{">r", OP_TOR},
{"r>", OP_FROMR},
{"call", OP_APPLY},
@ -48,6 +52,62 @@ V compiler_init(Cm *cm, Vm *vm, const char *name) {
V compiler_deinit(Cm *cm) { cm->dictionary = NULL; }
static I peek_sleb128(U8 *ptr, I *out_value) {
I result = 0;
I shift = 0;
U8 byte;
I bytes = 0;
do {
byte = ptr[bytes];
bytes++;
result |= (I)(byte & 0x7F) << shift;
shift += 7;
} while (byte & 0x80);
if ((shift < 64) && (byte & 0x40)) {
result |= -(1LL << shift);
}
if (out_value)
*out_value = result;
return bytes;
}
static V optim_tailcall(Bc *chunk) {
Z i = 0;
while (i < chunk->count) {
U8 opcode = chunk->items[i];
if (opcode == OP_CALL) {
I ofs = peek_sleb128(&chunk->items[i + 1], NULL);
Z next = i + 1 + ofs;
if (next < chunk->count && chunk->items[next] == OP_RETURN) {
chunk->items[i] = OP_TAIL_CALL;
}
i++;
} else if (opcode == OP_DOWORD) {
I ofs = peek_sleb128(&chunk->items[i + 1], NULL);
Z next = i + 1 + ofs;
if (next < chunk->count && chunk->items[next] == OP_RETURN) {
chunk->items[i] = OP_TAIL_DOWORD;
}
i++;
} else if (opcode == OP_APPLY) {
Z ofs = i + 1;
if (ofs < chunk->count && chunk->items[ofs] == OP_RETURN) {
chunk->items[i] = OP_TAIL_APPLY;
}
i++;
} else if (opcode == OP_CONST || opcode == OP_JUMP ||
opcode == OP_JUMP_IF_NIL) {
I ofs = peek_sleb128(&chunk->items[i + 1], NULL);
i += 1 + ofs;
} else {
i++;
}
}
}
static I compile_expr(Cm *cm, mpc_ast_t *curr, mpc_ast_trav_t **next);
static I compile_ast(Cm *cm, mpc_ast_t *curr, mpc_ast_trav_t **next);
@ -110,8 +170,7 @@ static I compile_definition(Cm *cm, mpc_ast_t *curr, mpc_ast_trav_t **next) {
while (curr != NULL) {
if (strcmp(curr->tag, "char") == 0 && strcmp(curr->contents, "}") == 0)
break;
I res = compile_expr(&inner, curr, next);
if (!res) {
if (!compile_expr(&inner, curr, next)) {
chunk_release(inner.chunk);
return 0;
}
@ -119,8 +178,13 @@ static I compile_definition(Cm *cm, mpc_ast_t *curr, mpc_ast_trav_t **next) {
}
chunk_emit_byte(inner.chunk, OP_RETURN);
optim_tailcall(inner.chunk);
entry->chunk = inner.chunk;
// disassemble(inner.chunk, name, cm->dictionary);
#if COMPILER_DEBUG
disassemble(inner.chunk, name, cm->dictionary);
#endif
return 1;
}
@ -145,6 +209,7 @@ static O compile_quotation_obj(Cm *cm, mpc_ast_t *curr, mpc_ast_trav_t **next) {
curr = mpc_ast_traverse_next(next);
}
chunk_emit_byte(inner.chunk, OP_RETURN);
optim_tailcall(inner.chunk);
Hd *hd = gc_alloc(cm->vm, sizeof(Hd) + sizeof(Bc *));
hd->type = OBJ_QUOT;
@ -206,5 +271,6 @@ Bc *compile_program(Cm *cm, mpc_ast_t *ast) {
Bc *chunk = cm->chunk;
chunk_emit_byte(chunk, OP_RETURN);
optim_tailcall(chunk);
return chunk;
}

3
src/compile.h
View file

@ -7,7 +7,8 @@
#include "vendor/mpc.h"
// Forward declaration
#define COMPILER_DEBUG 1
/** Compiler context */
typedef struct Cm {
Vm *vm; // Parent context

27
src/debug.c
View file

@ -124,6 +124,33 @@ Z disassemble_instruction(Bc *chunk, Z offset, Dt **dictionary) {
case OP_APPLY:
printf("APPLY\n");
return offset;
case OP_TAIL_CALL: {
Z bytes_read;
I ofs = decode_sleb128(&chunk->items[offset], &bytes_read);
printf("TAIL_CALL %ld\n", ofs);
return offset + bytes_read;
}
case OP_TAIL_DOWORD: {
Z bytes_read;
I hash = decode_sleb128(&chunk->items[offset], &bytes_read);
printf("TAIL_DOWORD");
if (dictionary && *dictionary) {
Dt *entry = lookup_hash(dictionary, hash);
if (entry != NULL) {
printf(" %s", entry->name);
} else {
printf(" ???");
}
} else {
printf(" 0x%lx", hash);
}
printf("\n");
return offset + bytes_read;
}
case OP_TAIL_APPLY:
printf("TAIL_APPLY\n");
return offset;
case OP_RETURN:
printf("RETURN\n");
return offset;

5
src/gc.c
View file

@ -6,8 +6,7 @@
#include "chunk.h"
#include "gc.h"
#include "object.h"
#include "src/print.h"
#include "src/vm.h"
#include "vm.h"
#include "vendor/yar.h"
#define ALIGN(n) (((n) + 7) & ~7)
@ -83,7 +82,7 @@ V gc_collect(Vm *vm) {
Dt *node = *--dsp;
if (!node)
continue;
if (node->name != NULL) {
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]);

3
src/main.c
View file

@ -1,8 +1,6 @@
#include <stdio.h>
#include <stdlib.h>
#include "common.h"
#include "chunk.h"
#include "compile.h"
#include "debug.h"
@ -75,7 +73,6 @@ I loadfile(const char *fname) {
mpc_ast_delete(res.output);
if (chunk != NULL) {
// disassemble(chunk, fname, &vm.dictionary);
I res = vm_run(&vm, chunk, 0);
chunk_release(chunk);
vm_deinit(&vm);

80
src/vm.c
View file

@ -31,7 +31,7 @@ static I decode_sleb128(U8 **ptr) {
V vm_init(Vm *vm) {
vm->sp = vm->stack;
vm->rsp = vm->rstack;
vm->rtsp = vm->rtstack;
vm->tsp = vm->tstack;
vm->chunk = NULL;
vm->dictionary = NULL;
@ -40,9 +40,9 @@ V vm_init(Vm *vm) {
for (Z i = 0; i < STACK_SIZE; i++) {
vm->stack[i] = NIL;
vm->rtstack[i] = NIL;
vm->tstack[i] = NIL;
gc_addroot(&vm->gc, &vm->stack[i]);
gc_addroot(&vm->gc, &vm->rtstack[i]);
gc_addroot(&vm->gc, &vm->tstack[i]);
}
}
@ -61,10 +61,10 @@ O vm_pop(Vm *vm) {
}
O vm_peek(Vm *vm) { return *(vm->sp - 1); }
V vm_rtpush(Vm *vm, O o) { *vm->rtsp++ = o; }
V vm_rtpush(Vm *vm, O o) { *vm->tsp++ = o; }
O vm_rtpop(Vm *vm) {
O o = *--vm->rtsp;
*vm->rtsp = NIL;
O o = *--vm->tsp;
*vm->tsp = NIL;
return o;
}
@ -137,6 +137,42 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
vm_push(vm, a);
break;
}
case OP_NIP: {
/* a b -> b */
O b = vm_pop(vm);
(void)vm_pop(vm);
vm_push(vm, b);
break;
}
case OP_OVER: {
/* a b -> a b a */
O b = vm_pop(vm);
O a = vm_pop(vm);
vm_push(vm, a);
vm_push(vm, b);
vm_push(vm, a);
break;
}
case OP_BURY: {
/* a b c - c a b */
O c = vm_pop(vm);
O b = vm_pop(vm);
O a = vm_pop(vm);
vm_push(vm, c);
vm_push(vm, a);
vm_push(vm, b);
break;
}
case OP_DIG: {
/* a b c - b c a */
O c = vm_pop(vm);
O b = vm_pop(vm);
O a = vm_pop(vm);
vm_push(vm, b);
vm_push(vm, c);
vm_push(vm, a);
break;
}
case OP_TOR: {
vm_rtpush(vm, vm_pop(vm));
break;
@ -188,6 +224,38 @@ I vm_run(Vm *vm, Bc *chunk, I offset) {
}
break;
}
case OP_TAIL_CALL: {
I ofs = decode_sleb128(&vm->ip);
// Tail call: reuse current frame, just jump
vm->ip = chunk->items + ofs;
break;
}
case OP_TAIL_DOWORD: {
I hash = decode_sleb128(&vm->ip);
Dt *word = lookup_hash(&vm->dictionary, hash);
if (!word) {
fprintf(stderr, "vm: word not found (hash = %lx)\n", hash);
return 0;
}
// Tail call: reuse current frame
vm->chunk = word->chunk;
vm->ip = word->chunk->items;
break;
}
case OP_TAIL_APPLY: {
O quot = vm_pop(vm);
if (type(quot) == TYPE_QUOT) {
Bc **ptr = (Bc **)(UNBOX(quot) + 1);
Bc *chunk = *ptr;
// Tail call: reuse current frame
vm->chunk = chunk;
vm->ip = chunk->items;
} else {
fprintf(stderr, "vm: attempt to apply non-quotation object\n");
return 0;
}
break;
}
case OP_RETURN:
if (vm->rsp != vm->rstack) {
Fr frame = vm_rpop(vm);

11
src/vm.h
View file

@ -16,6 +16,10 @@ enum {
OP_DROP,
OP_DUP,
OP_SWAP,
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_JUMP, // Relative jump
@ -23,6 +27,9 @@ enum {
OP_CALL,
OP_DOWORD, // Call word from dictionary by name hash
OP_APPLY,
OP_TAIL_CALL, // Tail call within chunk (reuses current frame)
OP_TAIL_DOWORD, // Tail call to dictionary word (reuses current frame)
OP_TAIL_APPLY, // Tail call to quotation (reuses current frame)
OP_RETURN,
OP_CHOOSE,
OP_ADD,
@ -49,8 +56,8 @@ typedef struct Fr {
typedef struct Vm {
Gc gc;
O stack[STACK_SIZE], *sp;
O rtstack[STACK_SIZE], *rtsp;
Fr rstack[STACK_SIZE], *rsp; // Return stack
O tstack[STACK_SIZE], *tsp;
Fr rstack[STACK_SIZE], *rsp;
U8 *ip;
Bc *chunk;
Dt *dictionary;