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

remove old interpreter from source tree

Browse source
This commit is contained in:
Lobo 2026-02-09 10:48:16 -03:00
parent d279bf1d31
commit e18681b309
91 changed files with 45 additions and 11539 deletions
Download patch file Download diff file Expand all files Collapse all files

31
src/arena.c
View file

@ -1,31 +0,0 @@
#include "arena.h"
#include <assert.h>
#include <stdlib.h>
#include <string.h>
V *_arena_alloc(Ar *ar, I count, I size, I align) {
I pad = -(U)ar->start & (align - 1);
assert(count < (ar->end - ar->start - pad) / size);
V *r = ar->start + pad;
ar->start += pad + count * size;
return memset(r, 0, count * size);
}
V arena_init(Ar *ar, Z size) {
ar->data = malloc(size);
ar->start = ar->data;
ar->end = ar->start + size;
}
V arena_free(Ar *ar) {
free(ar->data);
ar->data = ar->start = ar->end = NULL;
}
char *arena_strdup(Ar *ar, const char *str) {
Z len = strlen(str) + 1;
char *copy = arena_alloc(ar, len, char);
memcpy(copy, str, len);
return copy;
}

18
src/arena.h
View file

@ -1,18 +0,0 @@
#ifndef ARENA_H
#define ARENA_H
#include "common.h"
typedef struct Ar {
U8 *data;
U8 *start, *end;
} Ar;
#define arena_alloc(a, n, t) (t *)_arena_alloc(a, n, sizeof(t), _Alignof(t))
V *_arena_alloc(Ar *, ptrdiff_t, ptrdiff_t, ptrdiff_t);
V arena_init(Ar *, Z);
V arena_free(Ar *);
char *arena_strdup(Ar *, const char *);
#endif

91
src/chunk.c
View file

@ -1,91 +0,0 @@
#include <stdlib.h>
#include "chunk.h"
#include "vendor/yar.h"
#if CHUNK_DEBUG
#include <stdio.h>
#endif
Bc *chunk_new(const char *name) {
Bc *chunk = calloc(1, sizeof(Bc));
chunk->name = name;
chunk->ref = 1;
#if CHUNK_DEBUG
fprintf(stderr, "DEBUG: created chunk %s at %p\n", chunk->name, (V *)chunk);
#endif
return chunk;
}
V chunk_acquire(Bc *chunk) {
#if CHUNK_DEBUG
fprintf(stderr, "DEBUG: acquiring chunk %s at %p\n", chunk->name, (V *)chunk);
#endif
chunk->ref++;
}
V chunk_release(Bc *chunk) {
#if CHUNK_DEBUG
fprintf(stderr, "DEBUG: releasing chunk %s at %p\n", chunk->name, (V *)chunk);
#endif
if (--chunk->ref == 0) {
#if CHUNK_DEBUG
fprintf(stderr, "DEBUG: freeing chunk %s at %p\n", chunk->name, (V *)chunk);
#endif
yar_free(&chunk->constants);
yar_free(&chunk->lines);
yar_free(&chunk->symbols);
yar_free(chunk);
free(chunk);
}
}
V chunk_emit_byte(Bc *chunk, U8 byte) { *yar_append(chunk) = byte; }
V chunk_emit_sleb128(Bc *chunk, I num) {
I more = 1;
while (more) {
U8 byte = num & 0x7f;
num >>= 7;
if ((num == 0 && !(byte & 0x40)) || (num == -1 && (byte & 0x40))) {
more = 0;
} else {
byte |= 0x80;
}
chunk_emit_byte(chunk, byte);
}
}
I chunk_add_constant(Bc *chunk, O value) {
I mark = chunk->constants.count;
*yar_append(&chunk->constants) = value;
return mark;
}
V chunk_emit_byte_with_line(Bc *chunk, U8 byte, I line, I col) {
*yar_append(chunk) = byte;
if (chunk->lines.count == 0 ||
chunk->lines.items[chunk->lines.count - 1].row != line ||
chunk->lines.items[chunk->lines.count - 1].col != col) {
Bl *entry = yar_append(&chunk->lines);
entry->offset = chunk->count - 1;
entry->row = line;
entry->col = col;
}
}
I chunk_get_line(Bc *chunk, Z offset, I *out_col) {
if (chunk->lines.count == 0)
return -1;
Z left = 0, right = chunk->lines.count - 1;
while (left < right) {
Z mid = left + (right - left + 1) / 2;
if (chunk->lines.items[mid].offset <= offset)
left = mid;
else
right = mid - 1;
}
if (out_col)
*out_col = chunk->lines.items[left].col;
return chunk->lines.items[left].row;
}

50
src/chunk.h
View file

@ -1,50 +0,0 @@
#ifndef CHUNK_H
#define CHUNK_H
#define CHUNK_DEBUG 0
#include "common.h"
#include "object.h"
typedef struct Bl {
Z offset;
I row;
I col;
} Bl;
typedef struct Bs {
const char *name;
struct Dt *resolved;
} Bs;
typedef struct Bc {
I ref;
const char *name;
U8 *items;
Z count, capacity;
struct {
O *items;
Z count, capacity;
} constants;
struct {
Bl *items;
Z count, capacity;
} lines;
struct {
Bs *items;
Z count, capacity;
} symbols;
} Bc;
Bc *chunk_new(const char *);
V chunk_acquire(Bc *);
V chunk_release(Bc *);
V chunk_emit_byte(Bc *, U8);
V chunk_emit_sleb128(Bc *, I);
I chunk_add_constant(Bc *, O);
V chunk_emit_byte_with_line(Bc *, U8, I, I);
I chunk_get_line(Bc *, Z, I*);
#endif

16
src/common.h
View file

@ -1,16 +0,0 @@
#ifndef COMMON_H
#define COMMON_H
#include <stdint.h>
#include <stddef.h>
typedef void V;
typedef intptr_t I;
typedef uintptr_t U;
typedef double F;
typedef size_t Z;
typedef uint8_t U8;
typedef uint32_t U32;
typedef uint64_t U64;
#endif

332
src/compile.c
View file

@ -1,332 +0,0 @@
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "chunk.h"
#include "compile.h"
#include "debug.h"
#include "gc.h"
#include "object.h"
#include "parser.h"
#include "src/primitive.h"
#include "string.h"
#include "vendor/yar.h"
#include "vm.h"
// clang-format off
struct {
const char *name;
U8 opcode[8];
} primitives[] = {
{"nil", {OP_NIL, 0}},
{"dup", {OP_DUP, 0}},
{"drop", {OP_DROP, 0}},
{"swap", {OP_SWAP, 0}},
{"2dup", {OP_2DUP, 0}},
{"2drop", {OP_2DROP, 0}},
{"2swap", {OP_2SWAP, 0}},
{"2over", {OP_2TOR, OP_2DUP, OP_2FROMR, 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}},
{"curry", {OP_CURRY, 0}},
{"?", {OP_CHOOSE, 0}},
{"+", {OP_ADD, 0}},
{"-", {OP_SUB, 0}},
{"*", {OP_MUL, 0}},
{"/", {OP_DIV, 0}},
{"%", {OP_MOD, 0}},
{"logand", {OP_LOGAND, 0}},
{"logor", {OP_LOGOR, 0}},
{"logxor", {OP_LOGXOR, 0}},
{"lognot", {OP_LOGNOT, 0}},
{"=", {OP_EQ, 0}},
{"<>", {OP_NEQ, 0}},
{"<", {OP_LT, 0}},
{">", {OP_GT, 0}},
{"<=", {OP_LTE, 0}},
{">=", {OP_GTE, 0}},
{"and", {OP_AND, 0}},
{"or", {OP_OR, 0}},
{"^", {OP_CONCAT, 0}},
{NULL, {0}},
};
// clang-format on
V compiler_init(Cm *cm, Vm *vm, const char *name) {
cm->vm = vm;
cm->arena = &vm->arena;
cm->dictionary = &vm->dictionary;
cm->chunk = chunk_new(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_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_CALL) {
Z ofs = i + 1;
if (ofs < chunk->count && chunk->items[ofs] == OP_RETURN) {
chunk->items[i] = OP_TAIL_CALL;
}
i++;
} else if (opcode == OP_CONST) {
I ofs = peek_sleb128(&chunk->items[i + 1], NULL);
i += 1 + ofs;
} else {
i++;
}
}
}
static I compile_expr(Cm *cm, Ast *node);
static I compile_constant(Cm *cm, O value, I line, I col) {
I idx = chunk_add_constant(cm->chunk, value);
chunk_emit_byte_with_line(cm->chunk, OP_CONST, line, col);
chunk_emit_sleb128(cm->chunk, idx);
return 1;
}
static I add_sym(Bc *chunk, const char *name, Dt *word) {
for (Z i = 0; i < chunk->symbols.count; i++) {
if (strcmp(chunk->symbols.items[i].name, name) == 0)
return i;
}
Z idx = chunk->symbols.count;
Bs *sym = yar_append(&chunk->symbols);
sym->name = name;
sym->resolved = word;
return idx;
}
static I compile_call(Cm *cm, const char *name, I line, I col) {
for (Z i = 0; primitives[i].name != NULL; i++) {
if (strcmp(name, primitives[i].name) == 0) {
for (Z j = 0; primitives[i].opcode[j] != 0; j++)
chunk_emit_byte_with_line(cm->chunk, primitives[i].opcode[j], line,
col);
return 1;
}
}
I prim_idx = prim_find(name);
if (prim_idx != -1) {
chunk_emit_byte_with_line(cm->chunk, OP_PRIM, line, col);
chunk_emit_sleb128(cm->chunk, prim_idx);
return 1;
}
Dt *word = upsert(cm->dictionary, name, NULL);
if (!word) {
fprintf(stderr, "compiler error at %ld:%ld: undefined word '%s'\n",
line + 1, col + 1, name);
return 0;
}
I idx = add_sym(cm->chunk, name, word);
chunk_emit_byte_with_line(cm->chunk, OP_DOWORD, line, col);
chunk_emit_sleb128(cm->chunk, idx);
return 1;
}
static I compile_command(Cm *cm, Ast *node) {
for (size_t i = 0; i < node->children.count; i++) {
if (!compile_expr(cm, node->children.items[i]))
return 0;
}
return compile_call(cm, node->name, node->line, node->col);
}
static I compile_definition(Cm *cm, Ast *node) {
const char *name = arena_strdup(cm->arena, node->name);
Dt *entry = upsert(cm->dictionary, name, cm->arena);
Cm inner = {0};
inner.arena = cm->arena;
inner.chunk = chunk_new(name);
inner.vm = cm->vm;
inner.dictionary = cm->dictionary;
for (size_t i = 0; i < node->children.count; i++) {
if (!compile_expr(&inner, node->children.items[i])) {
chunk_release(inner.chunk);
return 0;
}
}
chunk_emit_byte_with_line(inner.chunk, OP_RETURN, node->line, node->col);
optim_tailcall(inner.chunk);
entry->chunk = inner.chunk;
#if COMPILER_DEBUG
disassemble(inner.chunk, name, cm->dictionary);
#endif
return 1;
}
static O compile_quotation_obj(Cm *cm, Ast *node) {
Cm inner = {0};
inner.arena = cm->arena;
inner.chunk = chunk_new("<quotation>");
inner.vm = cm->vm;
inner.dictionary = cm->dictionary;
for (size_t i = 0; i < node->children.count; i++) {
if (!compile_expr(&inner, node->children.items[i])) {
chunk_release(inner.chunk);
return NIL;
}
}
chunk_emit_byte_with_line(inner.chunk, OP_RETURN, node->line, node->col);
optim_tailcall(inner.chunk);
Hd *hd = gc_alloc(cm->vm, sizeof(Hd) + sizeof(Bc *));
hd->type = OBJ_QUOT;
Bc **chunk_ptr = (Bc **)(hd + 1);
*chunk_ptr = inner.chunk;
return BOX(hd);
}
static I compile_quotation(Cm *cm, Ast *node) {
O obj = compile_quotation_obj(cm, node);
if (obj == NIL)
return 0;
return compile_constant(cm, obj, node->line, node->col);
}
static I compile_pragma(Cm *cm, Ast *node) {
if (strcmp(node->name, "#load") == 0) {
if (node->children.count == 0) {
fprintf(stderr, "compiler error: #load requires argument\n");
return 0;
}
Ast *arg = node->children.items[0];
if (arg->type != AST_STR) {
fprintf(stderr, "compiler error: #load requires string\n");
return 0;
}
char *fname = arg->name;
FILE *f = fopen(fname, "rb");
if (!f) {
fprintf(stderr, "compiler error: cannot open file '%s'\n", fname);
return 0;
}
Stream s = {filestream_vtable, f};
Lx *lx = lexer_make(&s);
Ast *root = parser_parse(lx);
I success = 1;
for (size_t i = 0; i < root->children.count; i++) {
if (!compile_expr(cm, root->children.items[i])) {
success = 0;
break;
}
}
ast_free(root);
lexer_free(lx);
fclose(f);
return success;
}
fprintf(stderr, "compiler warning: unknown pragma \"%s\"\n", node->name);
return 1;
}
static I compile_expr(Cm *cm, Ast *node) {
if (!node)
return 0;
switch (node->type) {
case AST_INT: {
O num = NUM(node->int_val);
return compile_constant(cm, num, node->line, node->col);
}
case AST_STR: {
O obj = string_make(cm->vm, node->name, -1);
return compile_constant(cm, obj, node->line, node->col);
}
case AST_WORD:
return compile_call(cm, node->name, node->line, node->col);
case AST_QUOTE:
return compile_quotation(cm, node);
case AST_DEF:
return compile_definition(cm, node);
case AST_CMD:
return compile_command(cm, node);
case AST_PRAGMA:
return compile_pragma(cm, node);
case AST_PROGRAM:
for (size_t i = 0; i < node->children.count; i++) {
if (!compile_expr(cm, node->children.items[i]))
return 0;
}
return 1;
default:
fprintf(stderr, "compiler error: nyi ast type %d\n", (int)node->type);
return 0;
}
}
Bc *compile_program(Cm *cm, Ast *ast) {
if (ast->type == AST_PROGRAM) {
for (size_t i = 0; i < ast->children.count; i++) {
if (!compile_expr(cm, ast->children.items[i])) {
chunk_release(cm->chunk);
return NULL;
}
}
} else {
if (!compile_expr(cm, ast)) {
chunk_release(cm->chunk);
return NULL;
}
}
chunk_emit_byte(cm->chunk, OP_RETURN);
optim_tailcall(cm->chunk);
return cm->chunk;
}

21
src/compile.h
View file

@ -1,21 +0,0 @@
#include "common.h"
#include "arena.h"
#include "chunk.h"
#include "gc.h"
#include "vm.h"
#include "parser.h"
#define COMPILER_DEBUG 0
/** Compiler context */
typedef struct Cm {
Vm *vm; // Parent context
Ar *arena;
Bc *chunk;
Dt **dictionary;
} Cm;
V compiler_init(Cm *, Vm *, const char *);
V compiler_deinit(Cm *);
Bc *compile_program(Cm *, Ast *);

33
src/core/alien.c Normal file
View file

@ -0,0 +1,33 @@
#include <growl.h>
Growl growl_make_alien(GrowlVM *vm, GrowlAlienType *type, void *data) {
size_t size = sizeof(GrowlObjectHeader) + sizeof(GrowlAlien);
GrowlObjectHeader *hdr = growl_gc_alloc(vm, size);
hdr->type = GROWL_TYPE_ALIEN;
GrowlAlien *alien = (GrowlAlien *)(hdr + 1);
alien->type = type;
alien->data = data;
return GROWL_BOX(hdr);
}
Growl growl_make_alien_tenured(GrowlVM *vm, GrowlAlienType *type, void *data) {
size_t size = sizeof(GrowlObjectHeader) + sizeof(GrowlAlien);
GrowlObjectHeader *hdr = growl_gc_alloc_tenured(vm, size);
hdr->type = GROWL_TYPE_ALIEN;
GrowlAlien *alien = (GrowlAlien *)(hdr + 1);
alien->type = type;
alien->data = data;
return GROWL_BOX(hdr);
}
GrowlAlien *growl_unwrap_alien(Growl obj, GrowlAlienType *type) {
if (obj == GROWL_NIL || GROWL_IMM(obj))
return NULL;
GrowlObjectHeader *hdr = GROWL_UNBOX(obj);
if (hdr->type != GROWL_TYPE_ALIEN)
return NULL;
GrowlAlien *alien = (GrowlAlien *)(hdr + 1);
if (alien->type != type)
return NULL;
return alien;
}

35
src/core/arena.c Normal file
View file

@ -0,0 +1,35 @@
#include <growl.h>
#include <stdlib.h>
#include <string.h>
void growl_arena_init(GrowlArena *arena, size_t size) {
arena->start = arena->free = malloc(size);
if (arena->start == NULL)
abort();
arena->end = arena->start + size;
}
void growl_arena_free(GrowlArena *arena) {
free(arena->start);
arena->start = arena->end = arena->free = NULL;
}
void *growl_arena_alloc(GrowlArena *arena, size_t size, size_t align,
size_t count) {
ptrdiff_t padding = -(uintptr_t)arena->free & (align - 1);
ptrdiff_t available = arena->end - arena->free - padding;
if (available < 0 || count > available / size) {
fprintf(stderr, "arena: out of memory :(");
abort();
}
void *p = arena->free + padding;
arena->free += padding + count * size;
return memset(p, 0, count * size);
}
char *growl_arena_strdup(GrowlArena *ar, const char *str) {
size_t len = strlen(str) + 1;
char *copy = growl_arena_new(ar, char, len);
memcpy(copy, str, len);
return copy;
}

112
src/core/callable.c Normal file
View file

@ -0,0 +1,112 @@
#include <growl.h>
#include <string.h>
int growl_callable(Growl obj) {
if (obj == GROWL_NIL || GROWL_IMM(obj))
return 0;
GrowlObjectHeader *hdr = GROWL_UNBOX(obj);
switch (hdr->type) {
case GROWL_TYPE_QUOTATION:
case GROWL_TYPE_COMPOSE:
case GROWL_TYPE_CURRY:
return 1;
default:
return 0;
}
}
Growl growl_make_quotation(GrowlVM *vm, const uint8_t *code, size_t code_size,
const Growl *constants, size_t constants_size) {
Growl constants_obj;
if (constants_size == 0) {
constants_obj = GROWL_NIL;
} else {
size_t constants_obj_size = sizeof(GrowlObjectHeader) + sizeof(GrowlTuple) +
constants_size * sizeof(Growl);
GrowlObjectHeader *constants_hdr =
growl_gc_alloc_tenured(vm, constants_obj_size);
constants_hdr->type = GROWL_TYPE_TUPLE;
GrowlTuple *constants_tuple = (GrowlTuple *)(constants_hdr + 1);
constants_tuple->count = constants_size;
for (size_t i = 0; i < constants_size; ++i) {
constants_tuple->data[i] = constants[i];
}
constants_obj = GROWL_BOX(constants_hdr);
}
size_t quotation_obj_size =
sizeof(GrowlObjectHeader) + sizeof(GrowlQuotation) + code_size;
GrowlObjectHeader *quotation_hdr =
growl_gc_alloc_tenured(vm, quotation_obj_size);
quotation_hdr->type = GROWL_TYPE_QUOTATION;
GrowlQuotation *quotation = (GrowlQuotation *)(quotation_hdr + 1);
quotation->constants = constants_obj;
quotation->count = code_size;
memcpy(quotation->data, code, code_size);
return GROWL_BOX(quotation_hdr);
}
GrowlQuotation *growl_unwrap_quotation(Growl obj) {
if (obj == GROWL_NIL || GROWL_IMM(obj))
return NULL;
GrowlObjectHeader *hdr = GROWL_UNBOX(obj);
if (hdr->type != GROWL_TYPE_QUOTATION)
return NULL;
return (GrowlQuotation *)(hdr + 1);
}
Growl growl_compose(GrowlVM *vm, Growl first, Growl second) {
if (!growl_callable(first))
return GROWL_NIL;
if (!growl_callable(second))
return GROWL_NIL;
size_t mark = growl_gc_mark(vm);
growl_gc_root(vm, &first);
growl_gc_root(vm, &second);
size_t size = sizeof(GrowlObjectHeader) + sizeof(GrowlCompose);
GrowlObjectHeader *hdr = growl_gc_alloc(vm, size);
hdr->type = GROWL_TYPE_COMPOSE;
GrowlCompose *comp = (GrowlCompose *)(hdr + 1);
comp->first = first;
comp->second = second;
growl_gc_reset(vm, mark);
return GROWL_BOX(hdr);
}
GrowlCompose *growl_unwrap_compose(Growl obj) {
if (obj == GROWL_NIL || GROWL_IMM(obj))
return NULL;
GrowlObjectHeader *hdr = GROWL_UNBOX(obj);
if (hdr->type != GROWL_TYPE_COMPOSE)
return NULL;
return (GrowlCompose *)(hdr + 1);
}
Growl growl_curry(GrowlVM *vm, Growl value, Growl callable) {
if (!growl_callable(callable))
return GROWL_NIL;
size_t mark = growl_gc_mark(vm);
growl_gc_root(vm, &value);
growl_gc_root(vm, &callable);
size_t size = sizeof(GrowlObjectHeader) + sizeof(GrowlCurry);
GrowlObjectHeader *hdr = growl_gc_alloc(vm, size);
hdr->type = GROWL_TYPE_CURRY;
GrowlCurry *comp = (GrowlCurry *)(hdr + 1);
comp->value = value;
comp->callable = callable;
growl_gc_reset(vm, mark);
return GROWL_BOX(hdr);
}
GrowlCurry *growl_unwrap_curry(Growl obj) {
if (obj == GROWL_NIL || GROWL_IMM(obj))
return NULL;
GrowlObjectHeader *hdr = GROWL_UNBOX(obj);
if (hdr->type != GROWL_TYPE_CURRY)
return NULL;
return (GrowlCurry *)(hdr + 1);
}

344
src/core/compiler.c Normal file
View file

@ -0,0 +1,344 @@
#include <growl.h>
#include <stdarg.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "opcodes.h"
#include "sleb128.h"
#include "dynarray.h"
#define COMPILER_DEBUG 0
typedef struct {
Growl *data;
size_t count;
size_t capacity;
} ConstantTable;
typedef struct {
uint8_t *data;
size_t count;
size_t capacity;
ConstantTable constants;
} Chunk;
typedef struct {
const char *name;
uint8_t opcodes[8];
} Primitive;
// clang-format off
Primitive primitives[] = {
{"nil", {GOP_PUSH_NIL, 0}},
{"drop", {GOP_DROP, 0}},
{"dup", {GOP_DUP, 0}},
{"swap", {GOP_SWAP, 0}},
{"2drop", {GOP_2DROP, 0}},
{"2dup", {GOP_2DUP, 0}},
{"2swap", {GOP_2SWAP, 0}},
{"nip", {GOP_NIP, 0}},
{"over", {GOP_OVER, 0}},
{"bury", {GOP_BURY, 0}},
{"dig", {GOP_DIG, 0}},
{">r", {GOP_TO_RETAIN, 0}},
{"r>", {GOP_FROM_RETAIN, 0}},
{"?", {GOP_CHOOSE, 0}},
{"if", {GOP_CHOOSE, GOP_CALL, 0}},
{"call", {GOP_CALL, 0}},
{"compose", {GOP_COMPOSE, 0}},
{"curry", {GOP_CURRY, 0}},
{"dip", {GOP_DIP, 0}},
{".", {GOP_PPRINT, 0}},
{"+", {GOP_ADD, 0}},
{"*", {GOP_MUL, 0}},
{"-", {GOP_SUB, 0}},
{"/", {GOP_DIV, 0}},
{"%", {GOP_MOD, 0}},
{"and", {GOP_AND, 0}},
{"or", {GOP_OR, 0}},
{"=", {GOP_EQ, 0}},
{"!=", {GOP_NEQ, 0}},
{"<", {GOP_LT, 0}},
{"<=", {GOP_LTE, 0}},
{">", {GOP_GT, 0}},
{">=", {GOP_GTE, 0}},
{"&", {GOP_BAND, 0}},
{"|", {GOP_BOR, 0}},
{"^", {GOP_BXOR, 0}},
{"~", {GOP_BNOT, 0}},
{NULL, {0}}
};
// clang-format on
static void emit_byte(GrowlVM *vm, Chunk *chunk, uint8_t byte) {
*push(chunk, &vm->scratch) = byte;
}
static void emit_sleb128(GrowlVM *vm, Chunk *chunk, intptr_t num) {
int more = 1;
while (more) {
uint8_t byte = num & 0x7f;
num >>= 7;
if ((num == 0 && !(byte & 0x40)) || (num == -1 && (byte & 0x40))) {
more = 0;
} else {
byte |= 0x80;
}
emit_byte(vm, chunk, byte);
}
}
static size_t add_constant(GrowlVM *vm, Chunk *chunk, Growl value) {
for (size_t i = 0; i < chunk->constants.count; ++i) {
if (chunk->constants.data[i] == value)
return i;
}
*push(&chunk->constants, &vm->scratch) = value;
return chunk->constants.count - 1;
}
static int is_integer(const char *str, long *out) {
char *end;
long val = strtol(str, &end, 0);
if (*end == '\0' && end != str) {
*out = val;
return 1;
}
return 0;
}
__attribute__((format(printf, 2, 3))) static void
compile_error(GrowlLexer *lexer, const char *fmt, ...) {
fprintf(stderr, "%d:%d: compile error: ", lexer->start_row + 1,
lexer->start_col + 1);
va_list args;
va_start(args, fmt);
vfprintf(stderr, fmt, args);
va_end(args);
fprintf(stderr, "\n");
}
static void optimize_tail_calls(Chunk *chunk) {
size_t i = 0;
while (i < chunk->count) {
uint8_t opcode = chunk->data[i];
size_t start = i++;
if (opcode == GOP_PUSH_CONSTANT || opcode == GOP_WORD ||
opcode == GOP_TAIL_WORD) {
if (i < chunk->count)
i += growl_sleb128_peek(&chunk->data[i], NULL);
}
if (i < chunk->count && chunk->data[i] == GOP_RETURN) {
if (opcode == GOP_CALL) {
chunk->data[start] = GOP_TAIL_CALL;
} else if (opcode == GOP_WORD) {
chunk->data[start] = GOP_TAIL_WORD;
}
}
}
}
static int compile_token(GrowlVM *vm, GrowlLexer *lexer, Chunk *chunk);
static int compile_quotation(GrowlVM *vm, GrowlLexer *lexer, Chunk *chunk) {
growl_lexer_next(lexer); // skip '['
Chunk quot_chunk = {0};
while (lexer->kind != ']' && lexer->kind != GTOK_EOF &&
lexer->kind != GTOK_INVALID) {
if (compile_token(vm, lexer, &quot_chunk)) {
return 1;
}
}
if (lexer->kind != ']') {
compile_error(lexer, "expected ']' to close quotation");
return 1;
}
emit_byte(vm, &quot_chunk, GOP_RETURN);
optimize_tail_calls(&quot_chunk);
Growl quot = growl_make_quotation(vm, quot_chunk.data, quot_chunk.count,
quot_chunk.constants.data,
quot_chunk.constants.count);
size_t idx = add_constant(vm, chunk, quot);
emit_byte(vm, chunk, GOP_PUSH_CONSTANT);
emit_sleb128(vm, chunk, (intptr_t)idx);
growl_lexer_next(lexer);
return 0;
}
static int compile_string(GrowlVM *vm, GrowlLexer *lexer, Chunk *chunk) {
Growl str = growl_wrap_string_tenured(vm, lexer->buffer);
size_t const_idx = add_constant(vm, chunk, str);
emit_byte(vm, chunk, GOP_PUSH_CONSTANT);
emit_sleb128(vm, chunk, (intptr_t)const_idx);
growl_lexer_next(lexer);
return 0;
}
static int compile_def(GrowlVM *vm, GrowlLexer *lexer) {
growl_lexer_next(lexer);
if (lexer->kind != GTOK_WORD) {
compile_error(lexer, "expected name after 'def'");
return 1;
}
char *name = growl_arena_strdup(&vm->scratch, lexer->buffer);
growl_lexer_next(lexer);
if (lexer->kind != GTOK_LBRACE) {
compile_error(lexer, "expected '{' after def name '%s'", name);
return 1;
}
// Add a forward declaration to the dictionary so the word can reference itself
GrowlDictionary *entry =
growl_dictionary_upsert(&vm->dictionary, name, &vm->arena);
GrowlDefinition *def = push(&vm->defs, &vm->arena);
def->name = growl_arena_strdup(&vm->arena, name);
def->callable = GROWL_NIL; // Placeholder, will be filled in after compilation
entry->callable = GROWL_NIL;
entry->index = vm->defs.count - 1;
growl_lexer_next(lexer);
Chunk fn_chunk = {0};
while (lexer->kind != GTOK_RBRACE && lexer->kind != GTOK_EOF &&
lexer->kind != GTOK_INVALID) {
if (compile_token(vm, lexer, &fn_chunk)) {
return 1;
}
}
if (lexer->kind != GTOK_RBRACE) {
compile_error(lexer, "expected '}' to close def '%s'", name);
return 1;
}
emit_byte(vm, &fn_chunk, GOP_RETURN);
optimize_tail_calls(&fn_chunk);
Growl fn =
growl_make_quotation(vm, fn_chunk.data, fn_chunk.count,
fn_chunk.constants.data, fn_chunk.constants.count);
#if COMPILER_DEBUG
GrowlQuotation *quot = growl_unwrap_quotation(fn);
fprintf(stderr, "=== %s ===\n", def->name);
growl_disassemble(vm, quot);
#endif
// Now update the definition with the compiled quotation
def->callable = fn;
entry->callable = fn;
growl_lexer_next(lexer);
return 0;
}
static int compile_call(GrowlVM *vm, GrowlLexer *lexer, const char *name,
Chunk *chunk) {
for (size_t i = 0; primitives[i].name != NULL; i++) {
if (strcmp(name, primitives[i].name) == 0) {
for (size_t j = 0; primitives[i].opcodes[j] != 0; j++)
emit_byte(vm, chunk, primitives[i].opcodes[j]);
growl_lexer_next(lexer);
return 0;
}
}
GrowlDictionary *entry = growl_dictionary_upsert(&vm->dictionary, name, NULL);
if (entry == NULL) {
compile_error(lexer, "undefined word '%s'", name);
return 1;
}
emit_byte(vm, chunk, GOP_WORD);
emit_sleb128(vm, chunk, entry->index);
growl_lexer_next(lexer);
return 0;
}
static int compile_command(GrowlVM *vm, GrowlLexer *lexer, Chunk *chunk) {
char *name = growl_arena_strdup(&vm->scratch, lexer->buffer);
name[strlen(name) - 1] = '\0';
growl_lexer_next(lexer);
while (lexer->kind != GTOK_SEMICOLON && lexer->kind != GTOK_EOF &&
lexer->kind != GTOK_INVALID) {
if (compile_token(vm, lexer, chunk)) {
return 1;
}
}
if (lexer->kind != GTOK_SEMICOLON) {
compile_error(lexer, "expected ';' to close command '%s:'", name);
return 1;
}
return compile_call(vm, lexer, name, chunk);
}
static int compile_word(GrowlVM *vm, GrowlLexer *lexer, Chunk *chunk) {
char *text = lexer->buffer;
size_t len = strlen(text);
if (strcmp(text, "load") == 0) {
// TODO: loading source files
compile_error(lexer, "'load' nyi");
return 1;
}
// Compile a definition
if (strcmp(text, "def") == 0) {
return compile_def(vm, lexer);
}
// Compile a command: word: args... ;
if (len > 1 && text[len - 1] == ':') {
return compile_command(vm, lexer, chunk);
}
// Compile an integer value
long value;
if (is_integer(text, &value)) {
size_t idx = add_constant(vm, chunk, GROWL_NUM(value));
emit_byte(vm, chunk, GOP_PUSH_CONSTANT);
emit_sleb128(vm, chunk, (intptr_t)idx);
growl_lexer_next(lexer);
return 0;
}
return compile_call(vm, lexer, text, chunk);
}
static int compile_token(GrowlVM *vm, GrowlLexer *lexer, Chunk *chunk) {
switch (lexer->kind) {
case GTOK_WORD:
return compile_word(vm, lexer, chunk);
case GTOK_STRING:
return compile_string(vm, lexer, chunk);
case GTOK_LBRACKET:
return compile_quotation(vm, lexer, chunk);
case GTOK_SEMICOLON:
case GTOK_RPAREN:
case GTOK_RBRACKET:
case GTOK_RBRACE:
compile_error(lexer, "unexpected token '%c'", lexer->kind);
return 1;
case GTOK_INVALID:
compile_error(lexer, "invalid token");
return 1;
default:
compile_error(lexer, "unhandled token type '%c'", lexer->kind);
return 1;
}
}
Growl growl_compile(GrowlVM *vm, GrowlLexer *lexer) {
Chunk chunk = {0};
growl_lexer_next(lexer);
while (lexer->kind != GTOK_EOF) {
if (compile_token(vm, lexer, &chunk))
return GROWL_NIL;
}
emit_byte(vm, &chunk, GOP_RETURN);
optimize_tail_calls(&chunk);
return growl_make_quotation(vm, chunk.data, chunk.count, chunk.constants.data,
chunk.constants.count);
}

21
src/core/dictionary.c Normal file
View file

@ -0,0 +1,21 @@
#include <growl.h>
#include <string.h>
GrowlDictionary *growl_dictionary_upsert(GrowlDictionary **dict,
const char *name, GrowlArena *perm) {
size_t len = strlen(name);
for (uint64_t h = growl_hash_bytes((uint8_t *)name, len); *dict; h <<= 2) {
if (strcmp(name, (*dict)->name) == 0) {
return *dict;
}
dict = &(*dict)->child[h >> 62];
}
if (!perm) {
return NULL;
}
*dict = growl_arena_new(perm, GrowlDictionary, 1);
(*dict)->name = name;
return *dict;
}

112
src/core/disasm.c Normal file
View file

@ -0,0 +1,112 @@
#include "opcodes.h"
#include "sleb128.h"
#include <growl.h>
static void disassemble(GrowlVM *vm, GrowlQuotation *quot, int indent);
static size_t disassemble_instr(GrowlVM *vm, GrowlQuotation *quot,
size_t offset, int indent) {
for (int i = 0; i < indent; i++) {
fprintf(stderr, " ");
}
fprintf(stderr, "%04zu ", offset);
uint8_t opcode = quot->data[offset++];
// clang-format off
#define OPCODE(name) case GOP_## name:
#define OPCODE1(name) case GOP_## name: fprintf(stderr, #name "\n"); return offset;
// clang-format on
switch (opcode) {
OPCODE1(NOP);
OPCODE1(PUSH_NIL);
OPCODE(PUSH_CONSTANT) {
intptr_t idx;
size_t bytes_read = growl_sleb128_peek(&quot->data[offset], &idx);
fprintf(stderr, "PUSH_CONSTANT %ld", idx);
if (quot->constants != GROWL_NIL &&
growl_type(quot->constants) == GROWL_TYPE_TUPLE) {
GrowlTuple *constants = growl_unwrap_tuple(quot->constants);
if (idx >= 0 && (size_t)idx < constants->count) {
Growl constant = constants->data[idx];
fprintf(stderr, " (");
growl_print_to(stderr, constant);
fprintf(stderr, ")");
if (!GROWL_IMM(constant) && constant != GROWL_NIL &&
growl_type(constant) == GROWL_TYPE_QUOTATION) {
putc('\n', stderr);
GrowlQuotation *inner = growl_unwrap_quotation(constant);
disassemble(vm, inner, indent + 1);
return offset + bytes_read;
}
}
}
putc('\n', stderr);
return offset + bytes_read;
}
OPCODE1(DROP);
OPCODE1(DUP);
OPCODE1(SWAP);
OPCODE1(2DROP);
OPCODE1(2DUP);
OPCODE1(2SWAP);
OPCODE1(NIP);
OPCODE1(OVER);
OPCODE1(BURY);
OPCODE1(DIG);
OPCODE1(TO_RETAIN);
OPCODE1(FROM_RETAIN);
OPCODE1(CHOOSE);
OPCODE1(CALL);
OPCODE1(CALL_NEXT);
OPCODE1(PUSH_NEXT);
OPCODE1(TAIL_CALL);
OPCODE(WORD) {
intptr_t idx;
size_t bytes_read = growl_sleb128_peek(&quot->data[offset], &idx);
fprintf(stderr, "WORD %s\n", vm->defs.data[idx].name);
return offset + bytes_read;
}
OPCODE(TAIL_WORD) {
intptr_t idx;
size_t bytes_read = growl_sleb128_peek(&quot->data[offset], &idx);
fprintf(stderr, "TAIL_WORD %s\n", vm->defs.data[idx].name);
return offset + bytes_read;
}
OPCODE1(RETURN);
OPCODE1(COMPOSE);
OPCODE1(CURRY);
OPCODE1(DIP);
OPCODE1(PPRINT);
OPCODE1(ADD);
OPCODE1(MUL);
OPCODE1(SUB);
OPCODE1(DIV);
OPCODE1(MOD);
OPCODE1(BAND);
OPCODE1(BOR);
OPCODE1(BXOR);
OPCODE1(BNOT);
OPCODE1(EQ);
OPCODE1(NEQ);
OPCODE1(LT);
OPCODE1(LTE);
OPCODE1(GT);
OPCODE1(GTE);
default:
printf("%d\n", opcode);
return offset;
}
}
static void disassemble(GrowlVM *vm, GrowlQuotation *quot, int indent) {
size_t offset = 0;
while (offset < quot->count)
offset = disassemble_instr(vm, quot, offset, indent);
}
void growl_disassemble(GrowlVM *vm, GrowlQuotation *quot) {
disassemble(vm, quot, 0);
}

42
src/core/dynarray.h Normal file
View file

@ -0,0 +1,42 @@
#ifndef GROWL_DYNARRAY_H
#define GROWL_DYNARRAY_H
// See https://nullprogram.com/blog/2023/10/05/
#include <growl.h>
#include <stddef.h>
#include <stdint.h>
#include <string.h>
#define push(s, a) \
({ \
typeof(s) s_ = (s); \
typeof(a) a_ = (a); \
if (s_->count >= s_->capacity) { \
__grow(s_, sizeof(*s_->data), _Alignof(*s_->data), a_); \
} \
s_->data + s_->count++; \
})
static void __grow(void *slice, ptrdiff_t size, ptrdiff_t align, GrowlArena *a) {
struct {
uint8_t *data;
ptrdiff_t len;
ptrdiff_t cap;
} replica;
memcpy(&replica, slice, sizeof(replica));
if (!replica.data) {
replica.cap = 1;
replica.data = growl_arena_alloc(a, 2 * size, align, replica.cap);
} else if (a->free == replica.data + size * replica.cap) {
growl_arena_alloc(a, size, 1, replica.cap);
} else {
void *data = growl_arena_alloc(a, 2 * size, align, replica.cap);
memcpy(data, replica.data, size * replica.len);
replica.data = data;
}
replica.cap *= 2;
memcpy(slice, &replica, sizeof(replica));
}
#endif // GROWL_DYNARRAY_H

49
src/core/file.c Normal file
View file

@ -0,0 +1,49 @@
#include <growl.h>
static void file_finalize(void *data) {
FILE *f = data;
if (f && f != stdin && f != stdout && f != stderr)
fclose(f);
}
// clang-format off
static GrowlAlienType alien_file_type = {
.name = "file",
.finalizer = file_finalize,
.call = NULL,
};
// clang-format on
static Growl stdout_obj = GROWL_NIL;
static void native_file_stdout(GrowlVM *vm) {
if (stdout_obj == GROWL_NIL) {
GrowlObjectHeader *hdr = growl_gc_alloc_tenured(
vm, sizeof(GrowlObjectHeader) + sizeof(GrowlAlien));
hdr->type = GROWL_TYPE_ALIEN;
GrowlAlien *stdout_alien = (GrowlAlien *)(hdr + 1);
stdout_alien->data = stdout;
stdout_alien->type = &alien_file_type;
stdout_obj = GROWL_BOX(hdr);
}
growl_push(vm, stdout_obj);
}
static void native_file_write(GrowlVM *vm) {
Growl file_obj = growl_pop(vm);
Growl string_obj = growl_pop(vm);
GrowlAlien *file_alien = growl_unwrap_alien(file_obj, &alien_file_type);
if (file_alien == NULL)
growl_vm_error(vm, "expected file object");
GrowlString *str = growl_unwrap_string(string_obj);
if (str == NULL)
growl_vm_error(vm, "expected string");
fwrite(str->data, sizeof(char), str->len, file_alien->data);
}
void growl_register_file_library(GrowlVM *vm) {
growl_register_native(vm, "file/stdout", native_file_stdout);
growl_register_native(vm, "file/write", native_file_write);
}

223
src/core/gc.c Normal file
View file

@ -0,0 +1,223 @@
//
// Created by lobo on 2/5/26.
//
#include <assert.h>
#include <growl.h>
#include <inttypes.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#define GC_DEBUG 0
#define ALIGN(n) (((n) + 7) & ~7)
static int in_from(GrowlVM *vm, void *ptr) {
const uint8_t *x = ptr;
return (x >= vm->from.start && x < vm->from.end);
}
static Growl copy(GrowlVM *vm, GrowlObjectHeader *hdr) {
assert(in_from(vm, hdr));
assert(hdr->type != UINT32_MAX);
size_t size = ALIGN(hdr->size);
GrowlObjectHeader *new = (GrowlObjectHeader *)vm->to.free;
vm->to.free += size;
memcpy(new, hdr, size);
hdr->type = UINT32_MAX;
Growl *obj = (Growl *)(hdr + 1);
*obj = (Growl)(new);
return *obj;
}
static Growl forward(GrowlVM *vm, Growl obj) {
if (obj == 0)
return 0;
if (!in_from(vm, (void *)obj))
return obj;
GrowlObjectHeader *hdr = (GrowlObjectHeader *)obj;
if (hdr->type == UINT32_MAX) {
Growl *fwd = (Growl *)(hdr + 1);
return *fwd;
}
return copy(vm, hdr);
}
GrowlObjectHeader *growl_gc_alloc(GrowlVM *vm, size_t size) {
size = ALIGN(size);
if (vm->from.free + size > vm->from.end) {
growl_gc_collect(vm);
if (vm->from.free + size > vm->from.end) {
fprintf(stderr, "gc: oom (requested %" PRIdPTR " bytes)\n", size);
abort();
}
}
GrowlObjectHeader *hdr = (GrowlObjectHeader *)vm->from.free;
vm->from.free += size;
memset(hdr, 0, size);
hdr->size = size;
return hdr;
}
GrowlObjectHeader *growl_gc_alloc_tenured(GrowlVM *vm, size_t size) {
size = ALIGN(size);
GrowlObjectHeader *hdr = growl_arena_alloc(&vm->tenured, size, 8, 1);
hdr->size = size;
return hdr;
}
static void scan(GrowlVM *vm, GrowlObjectHeader *hdr) {
switch (hdr->type) {
case GROWL_TYPE_STRING:
break;
case GROWL_TYPE_LIST: {
GrowlList *list = (GrowlList *)(hdr + 1);
list->head = forward(vm, list->head);
list->tail = forward(vm, list->tail);
break;
}
case GROWL_TYPE_TUPLE: {
GrowlTuple *tuple = (GrowlTuple *)(hdr + 1);
for (size_t i = 0; i < tuple->count; ++i) {
tuple->data[i] = forward(vm, tuple->data[i]);
}
break;
}
case GROWL_TYPE_QUOTATION: {
GrowlQuotation *quot = (GrowlQuotation *)(hdr + 1);
quot->constants = forward(vm, quot->constants);
break;
}
case GROWL_TYPE_COMPOSE: {
GrowlCompose *comp = (GrowlCompose *)(hdr + 1);
comp->first = forward(vm, comp->first);
comp->second = forward(vm, comp->second);
break;
}
case GROWL_TYPE_CURRY: {
GrowlCurry *comp = (GrowlCurry *)(hdr + 1);
comp->value = forward(vm, comp->value);
comp->callable = forward(vm, comp->callable);
break;
}
case GROWL_TYPE_ALIEN:
break;
case UINT32_MAX:
fprintf(stderr, "gc: fwd pointer during scan\n");
abort();
default:
fprintf(stderr, "gc: junk object type %" PRIu32 "\n", hdr->type);
abort();
}
}
#if GC_DEBUG
static void gc_print_stats(GrowlVM *vm, const char *label) {
size_t nursery_used = vm->from.free - vm->from.start;
size_t nursery_total = vm->from.end - vm->from.start;
size_t tenured_used = vm->tenured.free - vm->tenured.start;
size_t tenured_total = vm->tenured.end - vm->tenured.start;
size_t arena_used = vm->arena.free - vm->arena.start;
size_t arena_total = vm->arena.end - vm->arena.start;
fprintf(stderr, "%s:\n", label);
fprintf(stderr, " arena: %zu/%zu bytes (%.1f%%)\n", arena_used,
arena_total, (double)arena_used / (double)arena_total * 100.0);
fprintf(stderr, " tenured: %zu/%zu bytes (%.1f%%)\n", tenured_used,
tenured_total, (double)tenured_used / (double)tenured_total * 100.0);
fprintf(stderr, " nursery: %zu/%zu bytes (%.1f%%)\n", nursery_used,
nursery_total, (double)nursery_used / (double)nursery_total * 100.0);
}
#endif
void growl_gc_collect(GrowlVM *vm) {
uint8_t *gc_scan = vm->to.free;
#if GC_DEBUG
fprintf(stderr, ">>> starting garbage collection\n");
gc_print_stats(vm, "before GC");
#endif
// Forward work stack
for (size_t i = 0; i < GROWL_STACK_SIZE; ++i) {
vm->wst[i] = forward(vm, vm->wst[i]);
}
// Forward retain stack
for (size_t i = 0; i < GROWL_STACK_SIZE; ++i) {
vm->rst[i] = forward(vm, vm->rst[i]);
}
// Forward GC roots
for (size_t i = 0; i < vm->root_count; ++i) {
*vm->roots[i] = forward(vm, *vm->roots[i]);
}
// Forward word definitions
for (size_t i = 0; i < vm->defs.count; ++i) {
vm->defs.data[i].callable = forward(vm, vm->defs.data[i].callable);
}
uint8_t *tenured_scan = vm->tenured.start;
while (tenured_scan < vm->tenured.free) {
GrowlObjectHeader *hdr = (GrowlObjectHeader *)tenured_scan;
scan(vm, hdr);
tenured_scan += ALIGN(hdr->size);
}
while (gc_scan < vm->to.free) {
GrowlObjectHeader *hdr = (GrowlObjectHeader *)gc_scan;
scan(vm, hdr);
gc_scan += ALIGN(hdr->size);
}
gc_scan = vm->from.start;
while (gc_scan < vm->from.free) {
GrowlObjectHeader *hdr = (GrowlObjectHeader *)gc_scan;
if (hdr->type != UINT32_MAX) {
switch (hdr->type) {
case GROWL_TYPE_ALIEN: {
GrowlAlien *alien = (GrowlAlien *)(hdr + 1);
if (alien->type->finalizer != NULL) {
alien->type->finalizer(alien->data);
alien->data = NULL;
}
break;
}
default:
break;
}
}
gc_scan += ALIGN(hdr->size);
}
GrowlArena tmp = vm->from;
vm->from = vm->to;
vm->to = tmp;
vm->to.free = vm->to.start;
vm->scratch.free = vm->scratch.start;
#if GC_DEBUG
gc_print_stats(vm, "after GC");
fprintf(stderr, ">>> garbage collection done\n");
#endif
}
void growl_gc_root(GrowlVM *vm, Growl *ptr) {
if (vm->root_count >= vm->root_capacity) {
size_t cap = vm->root_capacity == 0 ? 16 : vm->root_capacity * 2;
Growl **data = realloc(vm->roots, cap * sizeof(Growl *));
if (!data) {
fprintf(stderr, "roots: oom\n");
abort();
}
vm->root_capacity = cap;
vm->roots = data;
}
vm->roots[vm->root_count++] = ptr;
}
size_t growl_gc_mark(GrowlVM *vm) { return vm->root_count; }
void growl_gc_reset(GrowlVM *vm, size_t mark) { vm->root_count = mark; }

71
src/core/hash.c Normal file
View file

@ -0,0 +1,71 @@
#include <growl.h>
#define FNV_OFFSET_BASIS 14695981039346656037ULL
#define FNV_PRIME 1099511628211ULL
uint64_t growl_hash_combine(uint64_t a, uint64_t b) {
return a ^ (b + 0x9e3779b97f4a7c15ULL + (a << 6) + (a >> 2));
}
uint64_t growl_hash_bytes(const uint8_t *data, size_t len) {
uint64_t hash = FNV_OFFSET_BASIS;
for (size_t i = 0; i < len; i++) {
hash ^= (uint64_t)data[i];
hash *= FNV_PRIME;
}
return hash;
}
static uint64_t hash_list(Growl obj) {
uint64_t hash = FNV_OFFSET_BASIS;
while (obj != GROWL_NIL) {
GrowlList *list = (GrowlList *)(GROWL_UNBOX(obj) + 1);
uint64_t head = growl_hash(list->head);
hash = growl_hash_combine(hash, head);
obj = list->tail;
}
return hash;
}
uint64_t growl_hash(Growl obj) {
if (obj == GROWL_NIL)
return 0;
if (GROWL_IMM(obj))
return obj;
GrowlObjectHeader *hdr = GROWL_UNBOX(obj);
switch (hdr->type) {
case GROWL_TYPE_STRING: {
GrowlString *str = (GrowlString *)(hdr + 1);
return growl_hash_bytes((uint8_t *)str->data, str->len);
}
case GROWL_TYPE_LIST: {
return hash_list(obj);
}
case GROWL_TYPE_TUPLE: {
GrowlTuple *tuple = (GrowlTuple *)(hdr + 1);
uint64_t hash = FNV_OFFSET_BASIS;
for (size_t i = 0; i < tuple->count; i++)
hash = growl_hash_combine(hash, growl_hash(tuple->data[i]));
return hash;
}
case GROWL_TYPE_QUOTATION: {
GrowlQuotation *quot = (GrowlQuotation *)(hdr + 1);
uint64_t hash = growl_hash_bytes(quot->data, quot->count);
if (quot->constants != GROWL_NIL)
hash = growl_hash_combine(hash, growl_hash(quot->constants));
return hash;
}
case GROWL_TYPE_COMPOSE: {
GrowlCompose *comp = (GrowlCompose *)(hdr + 1);
return growl_hash_combine(growl_hash(comp->first), growl_hash(comp->second));
}
case GROWL_TYPE_CURRY: {
GrowlCurry *curry = (GrowlCurry *)(hdr + 1);
return growl_hash_combine(growl_hash(curry->value), growl_hash(curry->callable));
}
default:
return obj;
}
}

155
src/core/lexer.c Normal file
View file

@ -0,0 +1,155 @@
#include <ctype.h>
#include <growl.h>
#include <stdlib.h>
static int lexer_getc(GrowlLexer *lx) {
int c = getc(lx->file);
if (c == '\n') {
lx->current_row++;
lx->current_col = 0;
} else if (c != EOF) {
lx->current_col++;
}
return c;
}
static void lexer_ungetc(GrowlLexer *lx, int c) {
ungetc(c, lx->file);
if (c == '\n') {
lx->current_row--;
} else if (c != EOF) {
lx->current_col--;
}
}
static int getc_ws(GrowlLexer *lx) {
if (feof(lx->file))
return EOF;
for (;;) {
int ch = lexer_getc(lx);
if (isspace(ch))
continue;
return ch;
}
}
static int is_delimiter(int i) {
return i == '(' || i == ')' || i == '[' || i == ']' || i == '{' || i == '}' ||
i == ';' || i == '\\' || i == '"';
}
static void append(GrowlLexer *lexer, int ch) {
if (lexer->cursor >= GROWL_LEXER_BUFSIZE) {
fprintf(stderr, "lexer: buffer overflow\n");
abort();
}
lexer->buffer[lexer->cursor++] = (char)(ch & 0xff);
}
static int scan_word(GrowlLexer *lx) {
int next = lexer_getc(lx);
for (;;) {
if (next == -1) {
if (lx->cursor == 0)
lx->kind = GTOK_EOF;
append(lx, 0);
return lx->kind;
}
if (is_delimiter(next) || isspace(next)) {
lexer_ungetc(lx, next);
append(lx, 0);
return lx->kind;
}
append(lx, next);
next = lexer_getc(lx);
}
}
static int scan_string(GrowlLexer *lexer) {
int next;
for (;;) {
next = lexer_getc(lexer);
switch (next) {
case EOF:
goto eof;
case '\\':
// TODO: \x escape sequences
next = lexer_getc(lexer);
if (next == -1)
goto eof;
switch (next) {
case 't':
append(lexer, '\t');
break;
case 'n':
append(lexer, '\n');
break;
case 'r':
append(lexer, '\r');
break;
case 'b':
append(lexer, '\b');
break;
case 'v':
append(lexer, '\v');
break;
case 'f':
append(lexer, '\f');
break;
case '0':
append(lexer, '\0');
break;
case 'e':
append(lexer, '\x1b');
break;
case '\\':
case '"':
append(lexer, next);
break;
default:
return lexer->kind = GTOK_INVALID;
}
break;
case '"':
append(lexer, 0);
return lexer->kind = GTOK_STRING;
default:
append(lexer, next);
}
}
eof:
return lexer->kind = GTOK_INVALID;
}
int growl_lexer_next(GrowlLexer *lexer) {
lexer->cursor = 0;
if (feof(lexer->file)) {
return lexer->kind = GTOK_EOF;
}
int next = getc_ws(lexer);
lexer->start_row = lexer->current_row;
lexer->start_col = lexer->current_col ? lexer->current_col - 1 : 0;
switch (next) {
case '\\':
for (; next != '\n'; next = lexer_getc(lexer))
;
return growl_lexer_next(lexer);
case '(':
case ')':
case '[':
case ']':
case '{':
case '}':
case ';':
return lexer->kind = next;
case '"':
return scan_string(lexer);
default:
lexer_ungetc(lexer, next);
lexer->kind = GTOK_WORD;
return scan_word(lexer);
}
}

2
src/core/list.c Normal file
View file

@ -0,0 +1,2 @@
#include <growl.h>

29
src/core/native.c Normal file
View file

@ -0,0 +1,29 @@
#include <growl.h>
#include <string.h>
#include "dynarray.h"
static void call_native(GrowlVM *vm, void *data) {
void (*fn)(GrowlVM *) = data;
fn(vm);
}
// clang-format off
static GrowlAlienType native_type = {
.name = "native",
.finalizer = NULL,
.call = call_native,
};
// clang-format on
void growl_register_native(GrowlVM *vm, const char *name,
void (*fn)(GrowlVM *)) {
Growl alien = growl_make_alien_tenured(vm, &native_type, (void *)fn);
GrowlDictionary *entry =
growl_dictionary_upsert(&vm->dictionary, name, &vm->arena);
GrowlDefinition *def = push(&vm->defs, &vm->arena);
def->name = growl_arena_strdup(&vm->arena, name);
def->callable = alien;
entry->callable = alien;
entry->index = vm->defs.count - 1;
}

51
src/core/opcodes.h Normal file
View file

@ -0,0 +1,51 @@
#ifndef GROWL_OPCODES_H
#define GROWL_OPCODES_H
enum GrowlOpcode {
GOP_NOP = 0,
GOP_PUSH_NIL,
GOP_PUSH_CONSTANT,
GOP_PUSH_NEXT,
GOP_DROP,
GOP_DUP,
GOP_SWAP,
GOP_2DROP,
GOP_2DUP,
GOP_2SWAP,
GOP_NIP,
GOP_OVER,
GOP_BURY,
GOP_DIG,
GOP_TO_RETAIN,
GOP_FROM_RETAIN,
GOP_CHOOSE,
GOP_CALL,
GOP_CALL_NEXT,
GOP_TAIL_CALL,
GOP_WORD,
GOP_TAIL_WORD,
GOP_RETURN,
GOP_COMPOSE,
GOP_CURRY,
GOP_DIP,
GOP_PPRINT,
GOP_ADD,
GOP_MUL,
GOP_SUB,
GOP_DIV,
GOP_MOD,
GOP_BAND,
GOP_BOR,
GOP_BXOR,
GOP_BNOT,
GOP_AND,
GOP_OR,
GOP_EQ,
GOP_NEQ,
GOP_LT,
GOP_LTE,
GOP_GT,
GOP_GTE,
};
#endif // GROWL_OPCODES_H

81
src/core/print.c Normal file
View file

@ -0,0 +1,81 @@
#include <growl.h>
#include <inttypes.h>
void growl_print(Growl value) { growl_print_to(stdout, value); }
void growl_println(Growl value) {
growl_print_to(stdout, value);
putchar('\n');
}
static void print_escaped(FILE *file, const char *data, size_t len) {
putc('"', file);
for (size_t i = 0; i < len; ++i) {
switch (data[i]) {
case '\0':
putc('\\', file);
putc('0', file);
break;
case '\t':
putc('\\', file);
putc('t', file);
break;
case '\n':
putc('\\', file);
putc('n', file);
break;
case '\r':
putc('\\', file);
putc('r', file);
break;
case '\b':
putc('\\', file);
putc('b', file);
break;
case '\v':
putc('\\', file);
putc('v', file);
break;
case '\f':
putc('\\', file);
putc('f', file);
break;
case '\x1b':
putc('\\', file);
putc('e', file);
break;
case '\\':
putc('\\', file);
putc('\\', file);
break;
case '"':
putc('\\', file);
putc('"', file);
break;
default:
putc(data[i], file);
break;
}
}
putc('"', file);
}
void growl_print_to(FILE *file, Growl value) {
if (value == GROWL_NIL) {
fprintf(file, "nil");
} else if (GROWL_IMM(value)) {
fprintf(file, "%" PRIdPTR, GROWL_ORD(value));
} else {
GrowlObjectHeader *hdr = GROWL_UNBOX(value);
switch (hdr->type) {
case GROWL_TYPE_STRING: {
GrowlString *str = (GrowlString *)(hdr + 1);
print_escaped(file, str->data, str->len);
break;
}
default:
fprintf(file, "<object type=%" PRIu32 " @ %p>", hdr->type, hdr);
break;
}
}
}

45
src/core/sleb128.c Normal file
View file

@ -0,0 +1,45 @@
//
// Created by lobo on 2/5/26.
//
#include "sleb128.h"
intptr_t growl_sleb128_decode(uint8_t **ptr) {
intptr_t result = 0;
intptr_t shift = 0;
uint8_t byte;
do {
byte = **ptr;
(*ptr)++;
result |= (intptr_t)(byte & 0x7F) << shift;
shift += 7;
} while (byte & 0x80);
if (shift < 64 && byte & 0x40) {
result |= -(1LL << shift);
}
return result;
}
size_t growl_sleb128_peek(const uint8_t *ptr, intptr_t *out) {
intptr_t result = 0, shift = 0;
size_t bytes = 0;
uint8_t byte;
do {
byte = ptr[bytes];
bytes++;
result |= (intptr_t)(byte & 0x7f) << shift;
shift += 7;
} while (byte & 0x80);
if (shift < 64 && byte & 0x40) {
result |= -(1LL << shift);
}
if (out)
*out = result;
return bytes;
}

10
src/core/sleb128.h Normal file
View file

@ -0,0 +1,10 @@
#ifndef GROWL_SLEB128_H
#define GROWL_SLEB128_H
#include <stdint.h>
#include <stddef.h>
intptr_t growl_sleb128_decode(uint8_t **ptr);
size_t growl_sleb128_peek(const uint8_t *ptr, intptr_t *out);
#endif // GROWL_SLEB128_H

45
src/core/string.c Normal file
View file

@ -0,0 +1,45 @@
#include <growl.h>
#include <string.h>
Growl growl_make_string(GrowlVM *vm, size_t len) {
size_t size = sizeof(GrowlObjectHeader) + sizeof(GrowlString) + len;
GrowlObjectHeader *hdr = growl_gc_alloc(vm, size);
hdr->type = GROWL_TYPE_STRING;
GrowlString *str = (GrowlString *)(hdr + 1);
str->len = len;
memset(str->data, 0, len);
return GROWL_BOX(hdr);
}
Growl growl_wrap_string(GrowlVM *vm, const char *cstr) {
size_t len = strlen(cstr);
size_t size = sizeof(GrowlObjectHeader) + sizeof(GrowlString) + len + 1;
GrowlObjectHeader *hdr = growl_gc_alloc(vm, size);
hdr->type = GROWL_TYPE_STRING;
GrowlString *str = (GrowlString *)(hdr + 1);
str->len = len;
memcpy(str->data, cstr, len);
str->data[len] = 0;
return GROWL_BOX(hdr);
}
Growl growl_wrap_string_tenured(GrowlVM *vm, const char *cstr) {
size_t len = strlen(cstr);
size_t size = sizeof(GrowlObjectHeader) + sizeof(GrowlString) + len + 1;
GrowlObjectHeader *hdr = growl_gc_alloc_tenured(vm, size);
hdr->type = GROWL_TYPE_STRING;
GrowlString *str = (GrowlString *)(hdr + 1);
str->len = len;
memcpy(str->data, cstr, len);
str->data[len] = 0;
return GROWL_BOX(hdr);
}
GrowlString *growl_unwrap_string(Growl obj) {
if (obj == 0 || GROWL_IMM(obj))
return NULL;
GrowlObjectHeader *hdr = GROWL_UNBOX(obj);
if (hdr->type != GROWL_TYPE_STRING)
return NULL;
return (GrowlString *)(hdr + 1);
}

11
src/core/table.c Normal file
View file

@ -0,0 +1,11 @@
#include <growl.h>
GrowlTable *growl_unwrap_table(Growl obj) {
if (obj == 0 || GROWL_IMM(obj))
return NULL;
GrowlObjectHeader *hdr = GROWL_UNBOX(obj);
if (hdr->type != GROWL_TYPE_TABLE)
return NULL;
return (GrowlTable *)(hdr + 1);
}

10
src/core/tuple.c Normal file
View file

@ -0,0 +1,10 @@
#include <growl.h>
GrowlTuple *growl_unwrap_tuple(Growl obj) {
if (obj == 0 || GROWL_IMM(obj))
return NULL;
GrowlObjectHeader *hdr = GROWL_UNBOX(obj);
if (hdr->type != GROWL_TYPE_TUPLE)
return NULL;
return (GrowlTuple *)(hdr + 1);
}

75
src/core/value.c Normal file
View file

@ -0,0 +1,75 @@
#include <growl.h>
#include <string.h>
uint32_t growl_type(Growl obj) {
if (obj == GROWL_NIL)
return GROWL_TYPE_NIL;
if (GROWL_IMM(obj))
return GROWL_TYPE_NUMBER;
GrowlObjectHeader *hdr = GROWL_UNBOX(obj);
return hdr->type;
}
int growl_equals(Growl a, Growl b) {
if (a == b)
return 1;
uint32_t type_a = growl_type(a);
uint32_t type_b = growl_type(b);
if (type_a != type_b)
return 0;
switch (type_a) {
case GROWL_TYPE_NIL:
case GROWL_TYPE_NUMBER:
// Already checked by pointer equality
return 0;
case GROWL_TYPE_STRING: {
GrowlString *str_a = growl_unwrap_string(a);
GrowlString *str_b = growl_unwrap_string(b);
if (str_a->len != str_b->len)
return 0;
return memcmp(str_a->data, str_b->data, str_a->len) == 0;
}
case GROWL_TYPE_LIST: {
GrowlList *list_a = (GrowlList *)(GROWL_UNBOX(a) + 1);
GrowlList *list_b = (GrowlList *)(GROWL_UNBOX(b) + 1);
return growl_equals(list_a->head, list_b->head) &&
growl_equals(list_a->tail, list_b->tail);
}
case GROWL_TYPE_TUPLE: {
GrowlTuple *tuple_a = growl_unwrap_tuple(a);
GrowlTuple *tuple_b = growl_unwrap_tuple(b);
if (tuple_a->count != tuple_b->count)
return 0;
for (size_t i = 0; i < tuple_a->count; i++) {
if (!growl_equals(tuple_a->data[i], tuple_b->data[i]))
return 0;
}
return 1;
}
case GROWL_TYPE_QUOTATION: {
GrowlQuotation *quot_a = (GrowlQuotation *)(GROWL_UNBOX(a) + 1);
GrowlQuotation *quot_b = (GrowlQuotation *)(GROWL_UNBOX(b) + 1);
if (quot_a->count != quot_b->count)
return 0;
if (memcmp(quot_a->data, quot_b->data, quot_a->count) != 0)
return 0;
return growl_equals(quot_a->constants, quot_b->constants);
}
case GROWL_TYPE_COMPOSE: {
GrowlCompose *comp_a = (GrowlCompose *)(GROWL_UNBOX(a) + 1);
GrowlCompose *comp_b = (GrowlCompose *)(GROWL_UNBOX(b) + 1);
return growl_equals(comp_a->first, comp_b->first) &&
growl_equals(comp_a->second, comp_b->second);
}
case GROWL_TYPE_CURRY: {
GrowlCurry *curry_a = (GrowlCurry *)(GROWL_UNBOX(a) + 1);
GrowlCurry *curry_b = (GrowlCurry *)(GROWL_UNBOX(b) + 1);
return growl_equals(curry_a->value, curry_b->value) &&
growl_equals(curry_a->callable, curry_b->callable);
}
case GROWL_TYPE_TABLE:
return 0;
default:
return 0;
}
}

494
src/core/vm.c Normal file
View file

@ -0,0 +1,494 @@
#include <growl.h>
#include <stdarg.h>
#include <stdlib.h>
#include <stdnoreturn.h>
#include "opcodes.h"
#include "sleb128.h"
#include <inttypes.h>
#include <stdio.h>
GrowlVM *growl_vm_init(void) {
GrowlVM *vm = calloc(1, sizeof(GrowlVM));
if (vm == NULL) {
abort();
}
growl_arena_init(&vm->from, GROWL_HEAP_SIZE);
growl_arena_init(&vm->to, GROWL_HEAP_SIZE);
growl_arena_init(&vm->tenured, GROWL_HEAP_SIZE);
growl_arena_init(&vm->scratch, GROWL_SCRATCH_SIZE);
growl_arena_init(&vm->arena, GROWL_SCRATCH_SIZE);
vm->dictionary = NULL;
vm->sp = vm->wst;
vm->rsp = vm->rst;
vm->csp = vm->cst;
vm->roots = NULL;
vm->root_count = 0;
vm->root_capacity = 0;
static uint8_t compose_code[] = {GOP_CALL_NEXT};
Growl compose_tramp = growl_make_quotation(vm, compose_code, 1, NULL, 0);
vm->compose_trampoline = (GrowlQuotation *)(GROWL_UNBOX(compose_tramp) + 1);
static uint8_t return_code[] = {GOP_RETURN};
Growl return_tramp = growl_make_quotation(vm, return_code, 1, NULL, 0);
vm->return_trampoline = (GrowlQuotation *)(GROWL_UNBOX(return_tramp) + 1);
static uint8_t dip_code[] = {GOP_PUSH_NEXT, GOP_RETURN};
Growl dip_tramp = growl_make_quotation(vm, dip_code, 2, NULL, 0);
vm->dip_trampoline = (GrowlQuotation *)(GROWL_UNBOX(dip_tramp) + 1);
return vm;
}
void growl_vm_free(GrowlVM *vm) {
growl_arena_free(&vm->from);
growl_arena_free(&vm->to);
growl_arena_free(&vm->tenured);
growl_arena_free(&vm->scratch);
growl_arena_free(&vm->arena);
if (vm->roots != NULL)
free(vm->roots);
free(vm);
}
__attribute__((format(printf, 2, 3))) noreturn void
growl_vm_error(GrowlVM *vm, const char *fmt, ...) {
va_list args;
va_start(args, fmt);
fprintf(stderr, "vm: ");
vfprintf(stderr, fmt, args);
fprintf(stderr, "\n");
va_end(args);
longjmp(vm->error, -1);
}
void growl_push(GrowlVM *vm, Growl obj) {
if (vm->sp >= vm->wst + GROWL_STACK_SIZE)
growl_vm_error(vm, "work stack overflow");
*vm->sp++ = obj;
}
Growl growl_peek(GrowlVM *vm, size_t depth) {
if (vm->sp <= vm->wst + depth)
growl_vm_error(vm, "work stack underflow");
return vm->sp[-(depth + 1)];
}
Growl growl_pop(GrowlVM *vm) {
if (vm->sp <= vm->wst)
growl_vm_error(vm, "work stack underflow");
Growl obj = *--vm->sp;
*vm->sp = GROWL_NIL;
return obj;
}
void growl_rpush(GrowlVM *vm, Growl obj) {
if (vm->rsp >= vm->rst + GROWL_STACK_SIZE)
growl_vm_error(vm, "work stack overflow");
*vm->rsp++ = obj;
}
Growl growl_rpop(GrowlVM *vm) {
if (vm->rsp <= vm->rst)
growl_vm_error(vm, "work stack underflow");
Growl obj = *--vm->rsp;
*vm->rsp = GROWL_NIL;
return obj;
}
static void callstack_push(GrowlVM *vm, GrowlQuotation *q, uint8_t *ip) {
if (vm->csp >= vm->cst + GROWL_CALL_STACK_SIZE)
growl_vm_error(vm, "call stack overflow");
vm->csp->quot = q;
vm->csp->ip = ip;
vm->csp->next = GROWL_NIL;
vm->csp++;
}
static GrowlFrame callstack_pop(GrowlVM *vm) {
if (vm->csp <= vm->cst)
growl_vm_error(vm, "call stack underflow");
return *--vm->csp;
}
static inline void dispatch(GrowlVM *vm, Growl obj,
int tail __attribute__((unused))) {
for (;;) {
switch (growl_type(obj)) {
case GROWL_TYPE_QUOTATION: {
GrowlQuotation *q = (GrowlQuotation *)(GROWL_UNBOX(obj) + 1);
vm->current_quotation = q;
vm->ip = q->data;
return;
}
case GROWL_TYPE_COMPOSE: {
GrowlCompose *c = (GrowlCompose *)(GROWL_UNBOX(obj) + 1);
callstack_push(vm, vm->compose_trampoline, vm->compose_trampoline->data);
vm->csp[-1].next = c->second;
obj = c->first;
continue;
}
case GROWL_TYPE_CURRY: {
GrowlCurry *c = (GrowlCurry *)(GROWL_UNBOX(obj) + 1);
growl_push(vm, c->value);
obj = c->callable;
continue;
}
case GROWL_TYPE_ALIEN: {
GrowlAlien *alien = (GrowlAlien *)(GROWL_UNBOX(obj) + 1);
if (alien->type && alien->type->call) {
alien->type->call(vm, alien->data);
// After calling a native function, we need to return to the caller
if (vm->csp != vm->cst) {
GrowlFrame frame = callstack_pop(vm);
vm->current_quotation = frame.quot;
vm->ip = frame.ip;
vm->next = frame.next;
} else {
// No frames on call stack, use return trampoline to exit
vm->current_quotation = vm->return_trampoline;
vm->ip = vm->return_trampoline->data;
}
return;
}
growl_vm_error(vm, "attempt to call non-callable alien");
}
default:
growl_vm_error(vm, "attempt to call non-callable (type=%d)",
growl_type(obj));
}
}
}
int growl_vm_execute(GrowlVM *vm, GrowlQuotation *quot) {
size_t gc_mark = growl_gc_mark(vm);
int result = setjmp(vm->error);
if (result != 0) {
growl_gc_reset(vm, gc_mark);
return result;
}
vm->ip = quot->data;
vm->current_quotation = quot;
// clang-format off
#define VM_START() for (;;) { uint8_t opcode; switch(opcode = *vm->ip++) {
#define VM_END() }}
#define VM_DEFAULT() default:
#define VM_OP(op) case GOP_## op:
#define VM_NEXT() break
// clang-format on
VM_START()
VM_OP(NOP) VM_NEXT();
VM_OP(PUSH_NIL) {
growl_push(vm, GROWL_NIL);
VM_NEXT();
}
VM_OP(PUSH_CONSTANT) {
intptr_t idx = growl_sleb128_decode(&vm->ip);
GrowlTuple *constants =
growl_unwrap_tuple(vm->current_quotation->constants);
if (constants != NULL) {
if (idx >= 0 && (size_t)idx < constants->count) {
growl_push(vm, constants->data[idx]);
} else {
growl_vm_error(vm, "constant index %" PRIdPTR " out of bounds", idx);
}
} else {
growl_vm_error(vm, "attempt to index nil constant table");
}
VM_NEXT();
}
VM_OP(PUSH_NEXT) {
growl_push(vm, vm->next);
vm->next = GROWL_NIL;
VM_NEXT();
}
VM_OP(DROP) {
(void)growl_pop(vm);
VM_NEXT();
}
VM_OP(DUP) {
growl_push(vm, growl_peek(vm, 0));
VM_NEXT();
}
VM_OP(SWAP) {
Growl b = growl_pop(vm);
Growl a = growl_pop(vm);
growl_push(vm, b);
growl_push(vm, a);
VM_NEXT();
}
VM_OP(2DROP) {
(void)growl_pop(vm);
(void)growl_pop(vm);
VM_NEXT();
}
VM_OP(2DUP) {
growl_push(vm, growl_peek(vm, 1));
growl_push(vm, growl_peek(vm, 1));
VM_NEXT();
}
VM_OP(2SWAP) {
Growl d = growl_pop(vm);
Growl c = growl_pop(vm);
Growl b = growl_pop(vm);
Growl a = growl_pop(vm);
growl_push(vm, c);
growl_push(vm, d);
growl_push(vm, a);
growl_push(vm, b);
VM_NEXT();
}
VM_OP(NIP) {
Growl b = growl_pop(vm);
(void)growl_pop(vm);
growl_push(vm, b);
VM_NEXT();
}
VM_OP(OVER) {
growl_push(vm, growl_peek(vm, 1));
VM_NEXT();
}
VM_OP(BURY) {
Growl c = growl_pop(vm);
Growl b = growl_pop(vm);
Growl a = growl_pop(vm);
growl_push(vm, c);
growl_push(vm, a);
growl_push(vm, b);
VM_NEXT();
}
VM_OP(DIG) {
Growl c = growl_pop(vm);
Growl b = growl_pop(vm);
Growl a = growl_pop(vm);
growl_push(vm, b);
growl_push(vm, c);
growl_push(vm, a);
VM_NEXT();
}
VM_OP(TO_RETAIN) {
growl_rpush(vm, growl_pop(vm));
VM_NEXT();
}
VM_OP(FROM_RETAIN) {
growl_push(vm, growl_rpop(vm));
VM_NEXT();
}
VM_OP(CHOOSE) {
Growl f = growl_pop(vm);
Growl t = growl_pop(vm);
Growl cond = growl_pop(vm);
if (cond != GROWL_NIL) {
growl_push(vm, t);
} else {
growl_push(vm, f);
}
VM_NEXT();
}
VM_OP(CALL) {
Growl obj = growl_pop(vm);
callstack_push(vm, vm->current_quotation, vm->ip);
dispatch(vm, obj, 0);
VM_NEXT();
}
VM_OP(CALL_NEXT) {
Growl callable = vm->next;
vm->next = GROWL_NIL;
dispatch(vm, callable, 1);
VM_NEXT();
}
VM_OP(TAIL_CALL) {
Growl obj = growl_pop(vm);
dispatch(vm, obj, 1);
VM_NEXT();
}
VM_OP(WORD) {
intptr_t idx = growl_sleb128_decode(&vm->ip);
GrowlDefinition *def = &vm->defs.data[idx];
Growl word = def->callable;
callstack_push(vm, vm->current_quotation, vm->ip);
dispatch(vm, word, 0);
VM_NEXT();
}
VM_OP(TAIL_WORD) {
intptr_t idx = growl_sleb128_decode(&vm->ip);
GrowlDefinition *def = &vm->defs.data[idx];
Growl word = def->callable;
dispatch(vm, word, 1);
VM_NEXT();
}
VM_OP(RETURN) {
if (vm->csp != vm->cst) {
GrowlFrame frame = callstack_pop(vm);
vm->current_quotation = frame.quot;
vm->ip = frame.ip;
vm->next = frame.next;
} else {
goto done;
}
VM_NEXT();
}
VM_OP(COMPOSE) {
Growl second = growl_pop(vm);
Growl first = growl_pop(vm);
Growl composed = growl_compose(vm, first, second);
if (composed == GROWL_NIL)
growl_vm_error(vm, "attempt to compose with a non-callable");
growl_push(vm, composed);
VM_NEXT();
}
VM_OP(CURRY) {
Growl callable = growl_pop(vm);
Growl value = growl_pop(vm);
Growl curried = growl_curry(vm, value, callable);
if (curried == GROWL_NIL)
growl_vm_error(vm, "attempt to curry with a non-callable");
growl_push(vm, curried);
VM_NEXT();
}
VM_OP(DIP) {
Growl callable = growl_pop(vm);
Growl x = growl_pop(vm);
callstack_push(vm, vm->current_quotation, vm->ip);
callstack_push(vm, vm->dip_trampoline, vm->dip_trampoline->data);
vm->csp[-1].next = x;
dispatch(vm, callable, 0);
VM_NEXT();
}
VM_OP(PPRINT) {
growl_println(growl_pop(vm));
VM_NEXT();
}
#define VM_BINOP(name, op) \
case GOP_##name: { \
Growl b = growl_pop(vm); \
Growl a = growl_pop(vm); \
if (GROWL_IMM(b) && GROWL_IMM(a)) { \
growl_push(vm, GROWL_NUM(GROWL_ORD(a) op GROWL_ORD(b))); \
} else { \
growl_vm_error(vm, "numeric op on non-numbers"); \
} \
VM_NEXT(); \
}
VM_BINOP(ADD, +);
VM_BINOP(MUL, *);
VM_BINOP(SUB, -);
VM_OP(DIV) {
Growl b = growl_pop(vm);
Growl a = growl_pop(vm);
if (GROWL_IMM(b) && GROWL_IMM(a)) {
if (GROWL_ORD(b) == 0)
growl_vm_error(vm, "division by zero");
growl_push(vm, GROWL_NUM(GROWL_ORD(a) / GROWL_ORD(b)));
} else {
growl_vm_error(vm, "numeric op on non-numbers");
};
VM_NEXT();
}
VM_OP(MOD) {
Growl b = growl_pop(vm);
Growl a = growl_pop(vm);
if (GROWL_IMM(b) && GROWL_IMM(a)) {
if (GROWL_ORD(b) == 0)
growl_vm_error(vm, "division by zero");
growl_push(vm, GROWL_NUM(GROWL_ORD(a) % GROWL_ORD(b)));
} else {
growl_vm_error(vm, "numeric op on non-numbers");
};
VM_NEXT();
}
VM_BINOP(BAND, &);
VM_BINOP(BOR, |);
VM_BINOP(BXOR, ^);
VM_OP(BNOT) {
Growl a = growl_pop(vm);
if (GROWL_IMM(a)) {
growl_push(vm, GROWL_NUM(~GROWL_ORD(a)));
} else {
growl_vm_error(vm, "arithmetic on non-numbers");
}
VM_NEXT();
}
VM_OP(AND) {
Growl b = growl_pop(vm);
Growl a = growl_pop(vm);
if (a == GROWL_NIL) {
growl_push(vm, a);
} else {
growl_push(vm, b);
}
VM_NEXT();
}
VM_OP(OR) {
Growl b = growl_pop(vm);
Growl a = growl_pop(vm);
if (a == GROWL_NIL) {
growl_push(vm, b);
} else {
growl_push(vm, a);
}
VM_NEXT();
}
VM_OP(EQ) {
Growl b = growl_pop(vm);
Growl a = growl_pop(vm);
int equals = growl_equals(a, b);
if (equals) {
growl_push(vm, GROWL_NUM(1));
} else {
growl_push(vm, GROWL_NIL);
}
VM_NEXT();
}
VM_OP(NEQ) {
Growl b = growl_pop(vm);
Growl a = growl_pop(vm);
int equals = growl_equals(a, b);
if (!equals) {
growl_push(vm, GROWL_NUM(1));
} else {
growl_push(vm, GROWL_NIL);
}
VM_NEXT();
}
#define VM_CMPOP(name, op) \
case GOP_##name: { \
Growl b = growl_pop(vm); \
Growl a = growl_pop(vm); \
if (GROWL_IMM(b) && GROWL_IMM(a)) { \
if (GROWL_ORD(a) op GROWL_ORD(b)) { \
growl_push(vm, GROWL_NUM(1)); \
} else { \
growl_push(vm, GROWL_NIL); \
} \
} else { \
growl_vm_error(vm, "comparison on non-numbers"); \
} \
VM_NEXT(); \
}
VM_CMPOP(LT, <);
VM_CMPOP(LTE, <=);
VM_CMPOP(GT, >);
VM_CMPOP(GTE, >=);
VM_DEFAULT() { growl_vm_error(vm, "unknown opcode %d", opcode); }
VM_END()
done:
growl_gc_reset(vm, gc_mark);
return 0;
}

146
src/debug.c
View file

@ -1,146 +0,0 @@
#include <stdio.h>
#include "chunk.h"
#include "debug.h"
#include "dictionary.h"
#include "primitive.h"
#include "print.h"
#include "vm.h"
static I decode_sleb128(U8 *ptr, Z *bytes_read) {
I result = 0;
I shift = 0;
U8 byte;
Z count = 0;
do {
byte = ptr[count++];
result |= (I)(byte & 0x7F) << shift;
shift += 7;
} while (byte & 0x80);
if ((shift < 64) && (byte & 0x40))
result |= -(1LL << shift);
*bytes_read = count;
return result;
}
static Z dis_instr(Bc *chunk, Z offset, Dt **dictionary, I indent);
static V dis(Bc *chunk, Dt **dictionary, I indent) {
Z offset = 0;
while (offset < chunk->count)
offset = dis_instr(chunk, offset, dictionary, indent);
}
V disassemble(Bc *chunk, const char *name, Dt **dictionary) {
printf("=== %s ===\n", name);
dis(chunk, dictionary, 0);
}
static Z dis_instr(Bc *chunk, Z offset, Dt **dictionary, I indent) {
for (I i = 0; i < indent; i++)
printf(" ");
printf("%04zu ", offset);
I col = -1;
I line = chunk_get_line(chunk, offset, &col);
if (line >= 0) {
printf("%4ld:%-3ld ", line + 1, col + 1);
} else {
printf(" ");
}
U8 opcode = chunk->items[offset++];
#define CASE(name) case OP_##name:
#define SIMPLE(name) \
case OP_##name: \
printf(#name "\n"); \
return offset;
switch (opcode) {
SIMPLE(NOP);
SIMPLE(NIL);
CASE(CONST) {
Z bytes_read;
I idx = decode_sleb128(&chunk->items[offset], &bytes_read);
printf("CONST %ld", idx);
if (idx >= 0 && idx < (I)chunk->constants.count) {
O obj = chunk->constants.items[idx];
printf(" (");
print(obj);
printf(")");
if (!IMM(obj) && obj != NIL && type(obj) == OBJ_QUOT) {
putchar('\n');
Hd *hdr = UNBOX(obj);
Bc **chunk_ptr = (Bc **)(hdr + 1);
Bc *quot_chunk = *chunk_ptr;
dis(quot_chunk, dictionary, indent + 1);
return offset + bytes_read;
}
}
printf("\n");
return offset + bytes_read;
}
SIMPLE(DROP);
SIMPLE(DUP);
SIMPLE(SWAP);
SIMPLE(NIP);
SIMPLE(OVER);
SIMPLE(BURY);
SIMPLE(DIG);
SIMPLE(TOR);
SIMPLE(FROMR);
CASE(DOWORD) {
Z bytes_read;
I idx = decode_sleb128(&chunk->items[offset], &bytes_read);
Dt *word = chunk->symbols.items[idx].resolved;
printf("DOWORD \"%s\"\n", word->name);
return offset + bytes_read;
}
SIMPLE(CALL);
CASE(TAIL_DOWORD) {
Z bytes_read;
I idx = decode_sleb128(&chunk->items[offset], &bytes_read);
Dt *word = chunk->symbols.items[idx].resolved;
printf("TAIL_DOWORD \"%s\"\n", word->name);
return offset + bytes_read;
}
SIMPLE(TAIL_CALL);
CASE(PRIM) {
Z bytes_read;
I idx = decode_sleb128(&chunk->items[offset], &bytes_read);
Pr prim = primitives_table[idx];
printf("PRIM \"%s\"\n", prim.name);
return offset + bytes_read;
}
SIMPLE(COMPOSE);
SIMPLE(CURRY);
SIMPLE(RETURN);
SIMPLE(CHOOSE);
SIMPLE(ADD);
SIMPLE(SUB);
SIMPLE(MUL);
SIMPLE(DIV);
SIMPLE(MOD);
SIMPLE(LOGAND);
SIMPLE(LOGOR);
SIMPLE(LOGXOR);
SIMPLE(LOGNOT);
SIMPLE(EQ);
SIMPLE(NEQ);
SIMPLE(LT);
SIMPLE(GT);
SIMPLE(LTE);
SIMPLE(GTE);
SIMPLE(AND);
SIMPLE(OR);
SIMPLE(CONCAT);
default:
printf("??? (%d)\n", opcode);
return offset;
}
#undef SIMPLE
#undef CASE
}

5
src/debug.h
View file

@ -1,5 +0,0 @@
#include "chunk.h"
#include "common.h"
#include "dictionary.h"
V disassemble(Bc *, const char*, Dt **);

39
src/dictionary.c
View file

@ -1,39 +0,0 @@
#include <string.h>
#include "arena.h"
#include "common.h"
#include "dictionary.h"
U64 hash64(const char *str) {
I len = strlen(str);
U64 h = 0x100;
for (I i = 0; i < len; i++) {
h ^= str[i] & 255;
h *= 1111111111111111111;
}
return h;
}
Dt *upsert(Dt **env, const char *key, Ar *a) {
U64 hash = hash64(key);
for (U64 h = hash; *env; h <<= 2) {
if (hash == (*env)->hash)
return *env;
env = &(*env)->child[h >> 62];
}
if (!a)
return 0;
*env = arena_alloc(a, 1, Dt);
(*env)->name = key;
(*env)->hash = hash;
return *env;
}
Dt *lookup_hash(Dt **env, U64 hash) {
for (U64 h = hash; *env; h <<= 2) {
if ((*env)->hash == hash)
return *env;
env = &(*env)->child[h >> 62];
}
return NULL;
}

19
src/dictionary.h
View file

@ -1,19 +0,0 @@
#ifndef DICTIONARY_H
#define DICTIONARY_H
#include "arena.h"
#include "chunk.h"
typedef struct Dt Dt;
struct Dt {
Dt *child[4];
const char *name;
U64 hash;
Bc *chunk;
};
U64 hash64(const char *);
Dt *upsert(Dt **, const char *, Ar *);
Dt *lookup_hash(Dt **, U64);
#endif

83
src/file.c
View file

@ -1,83 +0,0 @@
#include <stdio.h>
#include <stdlib.h>
#include "src/gc.h"
#include "src/object.h"
#include "string.h"
#include "userdata.h"
#include "vm.h"
static V finalizer(V *data);
// clang-format off
Ut userdata_file = {
.name = "file",
.finalizer = finalizer
};
// clang-format on
I prim_file_stdin(Vm *vm) {
vm_push(vm, vm->stdin);
return 0;
}
I prim_file_stdout(Vm *vm) {
vm_push(vm, vm->stdout);
return 0;
}
I prim_file_stderr(Vm *vm) {
vm_push(vm, vm->stderr);
return 0;
}
I prim_file_fprint(Vm *vm) {
O file_obj = vm_pop(vm);
O string_obj = vm_pop(vm);
Ud *file_ud = userdata_unwrap(file_obj, &userdata_file);
if (file_ud == NULL) {
fprintf(stderr, "expected file object\n");
return VM_ERR_TYPE;
};
Str *str = string_unwrap(string_obj);
if (str == NULL) {
fprintf(stderr, "expected string\n");
return VM_ERR_TYPE;
}
fwrite(str->data, sizeof(char), str->len, (FILE *)file_ud->data);
return 0;
}
I prim_file_fgetline(Vm *vm) {
O file_obj = vm_pop(vm);
I mark = gc_mark(&vm->gc);
gc_addroot(&vm->gc, &file_obj);
Ud *file_ud = userdata_unwrap(file_obj, &userdata_file);
if (file_ud == NULL) {
fprintf(stderr, "expected file object\n");
return VM_ERR_TYPE;
}
char *lineptr = NULL;
size_t size;
I len = getline(&lineptr, &size, (FILE *)file_ud->data);
if (len == -1) {
vm_push(vm, NIL);
} else {
vm_push(vm, string_make(vm, lineptr, len));
}
free(lineptr);
gc_reset(&vm->gc, mark);
return 0;
}
static V finalizer(V *data) {
FILE *f = (FILE *)data;
if (f && f != stdin && f != stdout && f != stderr)
fclose(f);
}

9
src/file.h
View file

@ -1,9 +0,0 @@
#include "userdata.h"
extern Ut userdata_file;
I prim_file_stdin(Vm *);
I prim_file_stdout(Vm *);
I prim_file_stderr(Vm *);
I prim_file_fprint(Vm *);
I prim_file_fgetline(Vm *vm);

215
src/gc.c
View file

@ -1,215 +0,0 @@
#include <assert.h>
#include <inttypes.h>
#include <stdio.h>
#include <stdlib.h>
#include "chunk.h"
#include "gc.h"
#include "object.h"
#include "userdata.h"
#include "vendor/yar.h"
#include "vm.h"
#define ALIGN(n) (((n) + 7) & ~7)
static inline int infrom(Gc *gc, V *ptr) {
const U8 *x = (const U8 *)ptr;
return (x >= gc->from.start && x < gc->from.end);
}
V gc_addroot(Gc *gc, O *ptr) { *yar_append(&gc->roots) = ptr; }
I gc_mark(Gc *gc) { return gc->roots.count; }
V gc_reset(Gc *gc, I mark) { gc->roots.count = mark; }
static O copy(Gc *gc, Hd *hdr) {
assert(infrom(gc, hdr));
assert(hdr->type != OBJ_FWD);
Z sz = ALIGN(hdr->size);
Hd *new = (Hd *)gc->to.free;
gc->to.free += sz;
memcpy(new, hdr, sz);
hdr->type = OBJ_FWD;
O *obj = (O *)(hdr + 1);
*obj = BOX(new);
return *obj;
}
static O forward(Gc *gc, O obj) {
if (obj == 0)
return 0;
if (IMM(obj))
return obj;
if (!infrom(gc, (V *)obj))
return obj;
Hd *hdr = UNBOX(obj);
if (hdr->type == OBJ_FWD) {
O *o = (O *)(hdr + 1);
return *o;
} else {
return copy(gc, hdr);
}
}
#if GC_DEBUG
static V printstats(Gc *gc, const char *label) {
Z used = (Z)(gc->from.free - gc->from.start);
fprintf(stderr, "[%s] used=%zu/%zu bytes (%.1f%%)\n", label, used,
(Z)HEAP_BYTES, (F)used / (F)HEAP_BYTES * 100.0);
}
#endif
V gc_collect(Vm *vm, I final) {
Gc *gc = &vm->gc;
uint8_t *scan = gc->to.free;
#if GC_DEBUG
printstats(gc, "before GC");
#endif
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);
}
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];
}
}
}
while (scan < gc->to.free) {
if (scan >= gc->to.end) {
fprintf(stderr, "fatal GC error: out of memory\n");
abort();
}
Hd *hdr = (Hd *)scan;
switch (hdr->type) {
case OBJ_STR:
break;
case OBJ_QUOT: {
Bc **chunk_ptr = (Bc **)(hdr + 1);
Bc *chunk = *chunk_ptr;
for (Z i = 0; i < chunk->constants.count; i++)
chunk->constants.items[i] = forward(gc, chunk->constants.items[i]);
break;
}
case OBJ_COMPOSE: {
Qo *comp = (Qo *)(hdr + 1);
comp->first = forward(gc, comp->first);
comp->second = forward(gc, comp->second);
break;
};
case OBJ_CURRY: {
Qc *curry = (Qc *)(hdr + 1);
curry->value = forward(gc, curry->value);
curry->callable = forward(gc, curry->callable);
break;
};
case OBJ_USERDATA:
break;
case OBJ_FWD:
fprintf(stderr, "fatal GC error: forwarding pointer in to-space\n");
abort();
default:
fprintf(stderr, "GC warning: junk object type %" PRId32 "\n", hdr->type);
}
scan += ALIGN(hdr->size);
}
scan = gc->from.start;
while (scan < gc->from.free) {
Hd *hdr = (Hd *)scan;
if (hdr->type != OBJ_FWD) {
switch (hdr->type) {
case OBJ_QUOT: {
Bc **chunk_ptr = (Bc **)(hdr + 1);
chunk_release(*chunk_ptr);
break;
}
case OBJ_USERDATA: {
Ud *ud = (Ud *)(hdr + 1);
if (ud->kind->finalizer != NULL)
ud->kind->finalizer(ud->data);
break;
}
default:
break;
}
}
scan += ALIGN(hdr->size);
}
Gs tmp = gc->from;
gc->from = gc->to;
gc->to = tmp;
gc->to.free = gc->to.start;
#if GC_DEBUG
printstats(gc, "after GC");
#endif
}
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, 0);
if (gc->from.free + sz > gc->from.end) {
fprintf(stderr, "out of memory (requested %" PRIdPTR "bytes\n", sz);
abort();
}
}
Hd *hdr = (Hd *)gc->from.free;
gc->from.free += sz;
hdr->size = sz;
return hdr;
}
V gc_init(Gc *gc) {
gc->from.start = malloc(HEAP_BYTES);
if (!gc->from.start)
goto fatal;
gc->from.end = gc->from.start + HEAP_BYTES;
gc->from.free = gc->from.start;
gc->to.start = malloc(HEAP_BYTES);
if (!gc->to.start)
goto fatal;
gc->to.end = gc->to.start + HEAP_BYTES;
gc->to.free = gc->to.start;
gc->roots.capacity = 0;
gc->roots.count = 0;
gc->roots.items = NULL;
return;
fatal:
fprintf(stderr, "failed to allocate heap space\n");
abort();
}
V gc_deinit(Gc *gc) {
free(gc->from.start);
free(gc->to.start);
yar_free(&gc->roots);
}

38
src/gc.h
View file

@ -1,38 +0,0 @@
#ifndef GC_H
#define GC_H
#include "common.h"
#include "object.h"
#define GC_DEBUG 1
#if GC_DEBUG
#define HEAP_BYTES (8 * 1024)
#else
#define HEAP_BYTES (4 * 1024 * 1024)
#endif
typedef struct Gs {
U8 *start, *end;
U8 *free;
} Gs;
typedef struct Gc {
Gs from, to;
struct {
O **items;
Z count, capacity;
} roots;
} Gc;
V gc_addroot(Gc *, O *);
I gc_mark(Gc *);
V gc_reset(Gc *, I);
V gc_init(Gc *);
V gc_deinit(Gc *);
typedef struct Vm Vm;
V gc_collect(Vm *, I);
Hd *gc_alloc(Vm *, Z);
#endif

266
src/include/growl.h Normal file
View file

@ -0,0 +1,266 @@
#ifndef GROWL_H
#define GROWL_H
#include <setjmp.h>
#include <stddef.h>
#include <stdint.h>
#include <stdio.h>
#include <stdnoreturn.h>
typedef uintptr_t Growl;
#define GROWL_NIL ((Growl)(0))
#define GROWL_BOX(x) ((Growl)(x))
#define GROWL_UNBOX(x) ((GrowlObjectHeader *)(x))
#define GROWL_IMM(x) ((Growl)(x) & (Growl)1)
#define GROWL_NUM(x) (((Growl)((intptr_t)(x) << 1)) | (Growl)1)
#define GROWL_ORD(x) ((intptr_t)(x) >> 1)
typedef struct GrowlObjectHeader GrowlObjectHeader;
typedef struct GrowlString GrowlString;
typedef struct GrowlList GrowlList;
typedef struct GrowlTuple GrowlTuple;
typedef struct GrowlTable GrowlTable;
typedef struct GrowlQuotation GrowlQuotation;
typedef struct GrowlCompose GrowlCompose;
typedef struct GrowlCurry GrowlCurry;
typedef struct GrowlAlienType GrowlAlienType;
typedef struct GrowlAlien GrowlAlien;
typedef struct GrowlLexer GrowlLexer;
typedef struct GrowlArena GrowlArena;
typedef struct GrowlFrame GrowlFrame;
typedef struct GrowlModule GrowlModule;
typedef struct GrowlCompileContext GrowlCompileContext;
typedef struct GrowlDictionary GrowlDictionary;
typedef struct GrowlDefinition GrowlDefinition;
typedef struct GrowlDefinitionTable GrowlDefinitionTable;
typedef struct GrowlVM GrowlVM;
enum {
GROWL_TYPE_NIL,
GROWL_TYPE_NUMBER,
GROWL_TYPE_STRING,
GROWL_TYPE_LIST,
GROWL_TYPE_TUPLE,
GROWL_TYPE_TABLE,
GROWL_TYPE_QUOTATION,
GROWL_TYPE_COMPOSE,
GROWL_TYPE_CURRY,
GROWL_TYPE_ALIEN,
};
struct GrowlObjectHeader {
size_t size;
uint32_t type;
};
uint32_t growl_type(Growl obj);
int growl_equals(Growl a, Growl b);
uint64_t growl_hash_combine(uint64_t a, uint64_t b);
uint64_t growl_hash_bytes(const uint8_t *data, size_t len);
uint64_t growl_hash(Growl obj);
void growl_print_to(FILE *file, Growl value);
void growl_print(Growl value);
void growl_println(Growl value);
struct GrowlString {
size_t len;
char data[];
};
Growl growl_make_string(GrowlVM *vm, size_t len);
Growl growl_wrap_string(GrowlVM *vm, const char *cstr);
Growl growl_wrap_string_tenured(GrowlVM *vm, const char *cstr);
GrowlString *growl_unwrap_string(Growl obj);
struct GrowlList {
Growl head, tail;
};
struct GrowlTuple {
size_t count;
Growl data[];
};
GrowlTuple *growl_unwrap_tuple(Growl obj);
struct GrowlTable {};
GrowlTable *growl_unwrap_table(Growl obj);
struct GrowlQuotation {
size_t count;
Growl constants;
uint8_t data[];
};
struct GrowlCompose {
Growl first, second;
};
struct GrowlCurry {
Growl value, callable;
};
int growl_callable(Growl obj);
Growl growl_make_quotation(GrowlVM *vm, const uint8_t *code, size_t code_size,
const Growl *constants, size_t constants_size);
GrowlQuotation *growl_unwrap_quotation(Growl obj);
Growl growl_compose(GrowlVM *vm, Growl first, Growl second);
GrowlCompose *growl_unwrap_compose(Growl obj);
Growl growl_curry(GrowlVM *vm, Growl value, Growl callable);
GrowlCurry *growl_unwrap_curry(Growl obj);
struct GrowlAlienType {
const char *name;
void (*call)(GrowlVM *, void *);
void (*finalizer)(void *);
};
struct GrowlAlien {
GrowlAlienType *type;
void *data;
};
Growl growl_make_alien(GrowlVM *vm, GrowlAlienType *type, void *data);
Growl growl_make_alien_tenured(GrowlVM *vm, GrowlAlienType *type, void *data);
GrowlAlien *growl_unwrap_alien(Growl obj, GrowlAlienType *type);
void growl_register_native(GrowlVM *vm, const char *name,
void (*fn)(GrowlVM *));
/** Lexer */
enum {
GTOK_INVALID = -1,
GTOK_EOF = 0,
GTOK_WORD = 'a',
GTOK_STRING = '"',
GTOK_SEMICOLON = ';',
GTOK_LPAREN = '(',
GTOK_RPAREN = ')',
GTOK_LBRACKET = '[',
GTOK_RBRACKET = ']',
GTOK_LBRACE = '{',
GTOK_RBRACE = '}',
};
#define GROWL_LEXER_BUFSIZE 256
struct GrowlLexer {
int kind;
int cursor;
int current_row, current_col;
int start_row, start_col;
FILE *file;
char buffer[GROWL_LEXER_BUFSIZE];
};
int growl_lexer_next(GrowlLexer *lexer);
struct GrowlArena {
uint8_t *start, *end;
uint8_t *free;
};
void growl_arena_init(GrowlArena *arena, size_t size);
void growl_arena_free(GrowlArena *arena);
void *growl_arena_alloc(GrowlArena *arena, size_t size, size_t align,
size_t count);
char *growl_arena_strdup(GrowlArena *ar, const char *str);
#define growl_arena_new(a, t, n) \
(t *)growl_arena_alloc(a, sizeof(t), _Alignof(t), n)
#define GROWL_STACK_SIZE 128
#define GROWL_CALL_STACK_SIZE 64
#define GROWL_HEAP_SIZE (4 * 1024 * 1024)
#define GROWL_ARENA_SIZE (2 * 1024 * 1024)
#define GROWL_SCRATCH_SIZE (1024 * 1024)
struct GrowlFrame {
GrowlQuotation *quot;
uint8_t *ip;
Growl next;
};
struct GrowlDefinition {
const char *name;
Growl callable;
};
struct GrowlDefinitionTable {
GrowlDefinition *data;
size_t count, capacity;
};
struct GrowlDictionary {
GrowlDictionary *child[4];
const char *name;
Growl callable;
size_t index;
};
struct GrowlModule {
char *resolved_path;
GrowlModule *next;
};
struct GrowlCompileContext {
GrowlCompileContext *parent;
const char *file_path, *file_dir;
};
GrowlDictionary *growl_dictionary_upsert(GrowlDictionary **dict,
const char *name, GrowlArena *perm);
struct GrowlVM {
GrowlArena from, to;
GrowlArena tenured;
GrowlArena scratch;
GrowlArena arena;
GrowlDictionary *dictionary;
GrowlDefinitionTable defs;
GrowlQuotation *current_quotation;
uint8_t *ip;
Growl wst[GROWL_STACK_SIZE], *sp;
Growl rst[GROWL_STACK_SIZE], *rsp;
GrowlFrame cst[GROWL_CALL_STACK_SIZE], *csp;
GrowlQuotation *compose_trampoline;
GrowlQuotation *return_trampoline;
GrowlQuotation *dip_trampoline;
Growl next;
Growl **roots;
size_t root_count, root_capacity;
jmp_buf error;
};
GrowlVM *growl_vm_init(void);
void growl_vm_free(GrowlVM *vm);
GrowlObjectHeader *growl_gc_alloc(GrowlVM *vm, size_t size);
GrowlObjectHeader *growl_gc_alloc_tenured(GrowlVM *vm, size_t size);
void growl_gc_collect(GrowlVM *vm);
void growl_gc_root(GrowlVM *vm, Growl *ptr);
size_t growl_gc_mark(GrowlVM *vm);
void growl_gc_reset(GrowlVM *vm, size_t mark);
void growl_push(GrowlVM *vm, Growl obj);
Growl growl_peek(GrowlVM *vm, size_t depth);
Growl growl_pop(GrowlVM *vm);
void growl_rpush(GrowlVM *vm, Growl obj);
Growl growl_rpop(GrowlVM *vm);
noreturn void growl_vm_error(GrowlVM *vm, const char *fmt, ...);
int growl_vm_execute(GrowlVM *vm, GrowlQuotation *quot);
/** Compiler */
Growl growl_compile(GrowlVM *vm, GrowlLexer *lexer);
void growl_disassemble(GrowlVM *vm, GrowlQuotation *quot);
/** Extra libraries */
void growl_register_file_library(GrowlVM *vm);
#endif // GROWL_H

217
src/lexer.c
View file

@ -1,217 +0,0 @@
#include <ctype.h>
#include <err.h>
#include <stdlib.h>
#include <utf.h>
#include "lexer.h"
#include "vendor/yar.h"
Lx *lexer_make(Stream *s) {
Lx *lx = calloc(1, sizeof(Lx));
lx->stream = s;
return lx;
}
V lexer_free(Lx *lx) {
yar_free(lx);
free(lx);
}
static int lx_getc(Lx *lx) {
int c = ST_GETC(lx->stream);
if (c == '\n') {
lx->curr_line++;
lx->curr_col = 0;
} else if (c != -1) {
lx->curr_col++;
}
return c;
}
static void lx_ungetc(Lx *lx, int c) {
ST_UNGETC(c, lx->stream);
if (c == '\n') {
lx->curr_line--;
} else if (c != -1) {
lx->curr_col--;
}
}
static inline int is_delimiter(int i) {
return i == '(' || i == ')' || i == '[' || i == ']' || i == '{' || i == '}' ||
i == ';' || i == '\\' || i == '"';
}
static inline void appendrune(Lx *lx, Rune rn) {
char data[5];
I len = runetochar(data, &rn);
yar_append_many(lx, data, len);
}
static inline void appendbyte(Lx *lx, char byte) { *yar_append(lx) = byte; }
static int getc_ws(Lx *lx) {
if (ST_EOF(lx->stream))
return -1;
for (;;) {
int ch = lx_getc(lx);
if (isspace(ch))
continue;
return ch;
}
}
static int scanword(Lx *lx) {
int next = lx_getc(lx);
for (;;) {
if (next == -1) {
if (lx->count == 0)
lx->kind = TOK_EOF;
appendbyte(lx, 0);
return lx->kind;
} else if (is_delimiter(next) || isspace(next)) {
lx_ungetc(lx, next);
appendbyte(lx, 0);
return lx->kind;
} else {
appendbyte(lx, next);
next = lx_getc(lx);
continue;
}
}
}
static void scanescape(Lx *lx) {
char escbuf[7], *escptr = escbuf;
int next;
Rune tmp;
for (;;) {
next = lx_getc(lx);
if (next == -1) {
errx(1, "unterminated hex sequence '%s'", escbuf);
} else if (next == ';') {
*escptr = 0;
break;
} else if (!isxdigit(next)) {
errx(1, "invalid hex digit '%c'", next);
}
if (escptr - escbuf >= 6) {
errx(1, "hex sequence too long (6 chars max.)");
} else {
*(escptr++) = next;
}
}
tmp = strtol(escbuf, &escptr, 16);
if (*escptr == '\0') {
if (tmp < 256) {
appendbyte(lx, (U8)(tmp & 255));
} else {
appendrune(lx, tmp);
}
} else {
errx(1, "invalid hex sequence '%s'", escbuf);
}
}
static int scanstring(Lx *lx) {
int next;
for (;;) {
next = lx_getc(lx);
switch (next) {
case -1:
goto eof;
case '\\':
next = lx_getc(lx);
if (next == -1)
goto eof;
switch (next) {
case 't':
appendbyte(lx, '\t');
break;
case 'n':
appendbyte(lx, '\n');
break;
case 'r':
appendbyte(lx, '\r');
break;
case 'b':
appendbyte(lx, '\b');
break;
case 'v':
appendbyte(lx, '\v');
break;
case 'f':
appendbyte(lx, '\f');
break;
case '0':
appendbyte(lx, '\0');
break;
case 'e':
appendbyte(lx, '\x1b');
break;
case '\\':
case '"':
appendbyte(lx, next);
break;
case 'x':
scanescape(lx);
break;
default:
return (lx->kind = TOK_INVALID);
}
break;
case '"':
appendbyte(lx, 0);
return (lx->kind = TOK_STRING);
default:
appendbyte(lx, next);
}
}
eof:
return (lx->kind = TOK_INVALID);
}
I lexer_next(Lx *lx) {
int next;
lx->cursor = 0;
lx->count = 0;
if (ST_EOF(lx->stream)) {
lx->kind = TOK_EOF;
return 0;
}
next = getc_ws(lx);
lx->start_line = lx->curr_line;
lx->start_col = (lx->curr_col > 0) ? lx->curr_col - 1 : 0;
switch (next) {
case '\\':
for (; next != '\n'; next = lx_getc(lx))
;
return lexer_next(lx);
case '(':
case ')':
case '[':
case ']':
case '{':
case '}':
case ';':
return (lx->kind = next);
case '"':
return scanstring(lx);
default:
lx_ungetc(lx, next);
lx->kind = TOK_WORD;
return scanword(lx);
};
}

36
src/lexer.h
View file

@ -1,36 +0,0 @@
#ifndef LEXER_H
#define LEXER_H
#include "common.h"
#include "stream.h"
enum {
TOK_INVALID = -1,
TOK_EOF = 0,
TOK_WORD = 'a',
TOK_STRING = '"',
TOK_SEMICOLON = ';',
TOK_LPAREN = '(',
TOK_RPAREN = ')',
TOK_LBRACKET = '[',
TOK_RBRACKET = ']',
TOK_LBRACE = '{',
TOK_RBRACE = '}',
TOK_COMMENT = '\\',
};
typedef struct Lx {
I kind;
I cursor;
I curr_line, curr_col;
I start_line, start_col;
Stream *stream;
char *items;
Z count, capacity;
} Lx;
Lx *lexer_make(Stream *);
V lexer_free(Lx *lx);
I lexer_next(Lx *);
#endif

107
src/main.c
View file

@ -1,91 +1,28 @@
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <growl.h>
#include <math.h>
#include "chunk.h"
#include "compile.h"
#include "debug.h"
#include "parser.h"
#include "vm.h"
int main(void) {
GrowlVM *vm = growl_vm_init();
growl_register_file_library(vm);
GrowlLexer lexer = {0};
lexer.file = stdin;
#include "vendor/linenoise.h"
#define REPL_BUFFER_SIZE 4096
I repl(void) {
Vm vm = {0};
vm_init(&vm);
char *line;
while ((line = linenoise("growl> ")) != NULL) {
Buf b = { line, (int)strlen(line), 0, -1 };
Stream s = { bufstream_vtable, &b };
Lx *lx = lexer_make(&s);
Ast *root = parser_parse(lx);
Cm cm = {0};
compiler_init(&cm, &vm, "<repl>");
Bc *chunk = compile_program(&cm, root);
ast_free(root);
lexer_free(lx);
if (chunk != NULL) {
vm_run(&vm, chunk, 0);
chunk_release(chunk);
linenoiseHistoryAdd(line);
Growl obj = growl_compile(vm, &lexer);
if (obj != GROWL_NIL) {
GrowlQuotation *quot = growl_unwrap_quotation(obj);
if (!growl_vm_execute(vm, quot)) {
if (vm->sp != vm->wst) {
fprintf(stderr, "Stack:");
for (Growl *p = vm->wst; p < vm->sp; p++) {
putc(' ', stderr);
growl_print_to(stderr, *p);
}
putchar('\n');
}
}
compiler_deinit(&cm);
linenoiseFree(line);
}
vm_deinit(&vm);
growl_gc_collect(vm);
growl_vm_free(vm);
return 0;
}
I loadfile(const char *fname) {
Vm vm = {0};
vm_init(&vm);
FILE *f = fopen(fname, "rb");
if (!f) {
fprintf(stderr, "error: cannot open file '%s'\n", fname);
return 1;
}
Stream s = { filestream_vtable, f };
Lx *lx = lexer_make(&s);
Ast *root = parser_parse(lx);
Cm cm = {0};
compiler_init(&cm, &vm, fname);
Bc *chunk = compile_program(&cm, root);
ast_free(root);
lexer_free(lx);
fclose(f);
if (chunk != NULL) {
#if COMPILER_DEBUG
disassemble(chunk, fname, &vm.dictionary);
#endif
I res = vm_run(&vm, chunk, 0);
chunk_release(chunk);
vm_deinit(&vm);
return !res;
} else {
vm_deinit(&vm);
return 1;
}
}
int main(int argc, const char *argv[]) {
switch (argc) {
case 1:
return repl();
case 2:
return loadfile(argv[1]);
default:
fprintf(stderr, "usage: growl [file]\n");
return 64;
}
}

10
src/object.c
View file

@ -1,10 +0,0 @@
#include "object.h"
I type(O o) {
if (o == NIL)
return OBJ_NIL;
if (IMM(o))
return OBJ_NUM;
Hd *h = UNBOX(o);
return h->type;
}

48
src/object.h
View file

@ -1,48 +0,0 @@
#ifndef OBJECT_H
#define OBJECT_H
#include "common.h"
#define NIL ((O)0)
#define BOX(x) ((O)(x))
#define UNBOX(x) ((Hd *)(x))
#define IMM(x) ((O)(x) & (O)1)
#define NUM(x) (((O)((intptr_t)(x) << 1)) | (O)1)
#define ORD(x) ((intptr_t)(x) >> 1)
enum {
OBJ_NIL = 0,
OBJ_NUM = 1,
OBJ_FWD = 2,
OBJ_QUOT,
OBJ_COMPOSE,
OBJ_CURRY,
OBJ_STR,
OBJ_ARRAY,
OBJ_USERDATA,
};
typedef uintptr_t O;
/** Object header */
typedef struct Hd {
U32 size, type;
} Hd;
/** Composition */
typedef struct Qo {
O first, second;
} Qo;
/** Curry */
typedef struct Qc {
O value, callable;
} Qc; //
I type(O);
static inline I callable(O o) {
I t = type(o);
return t == OBJ_QUOT || t == OBJ_COMPOSE || t == OBJ_CURRY;
}
#endif

156
src/parser.c
View file

@ -1,156 +0,0 @@
#include "parser.h"
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
static Ast *ast_new(I type, I line, I col) {
Ast *node = calloc(1, sizeof(Ast));
node->type = type;
node->line = line;
node->col = col;
return node;
}
void ast_free(Ast *ast) {
if (!ast)
return;
if (ast->name)
free(ast->name);
for (size_t i = 0; i < ast->children.count; i++) {
ast_free(ast->children.items[i]);
}
yar_free(&ast->children);
free(ast);
}
static Ast *parse_expr_at(Lx *lx);
static void parse_block(Lx *lx, Ast *parent, int close_token) {
while (1) {
if (lx->kind == TOK_EOF) {
if (close_token != TOK_EOF)
fprintf(stderr, "syntax error: unexpected EOF, expected '%c'\n",
close_token);
break;
}
if (lx->kind == close_token) {
lexer_next(lx);
break;
}
Ast *expr = parse_expr_at(lx);
*yar_append(&parent->children) = expr;
}
}
static Ast *parse_expr_at(Lx *lx) {
int kind = lx->kind;
I line = lx->start_line;
I col = lx->start_col;
if (kind == TOK_WORD) {
char *text = lx->items;
if (strcmp(text, "def") == 0) {
Ast *node = ast_new(AST_DEF, line, col);
lexer_next(lx);
if (lx->kind != TOK_WORD) {
fprintf(stderr, "syntax error: expected word after 'def' at %ld:%ld\n",
(long)line + 1, (long)col + 1);
return node;
}
node->name = strdup(lx->items);
lexer_next(lx);
if (lx->kind != '{') {
fprintf(stderr,
"syntax error: expected '{' after def name at %ld:%ld\n",
(long)lx->start_line + 1, (long)lx->start_col + 1);
return node;
}
lexer_next(lx);
parse_block(lx, node, '}');
return node;
}
size_t len = strlen(text);
if (len > 0 && text[len - 1] == ':') {
Ast *node = ast_new(AST_CMD, line, col);
node->name = strndup(text, len - 1);
lexer_next(lx);
parse_block(lx, node, ';');
return node;
}
if (text[0] == '#') {
Ast *node = ast_new(AST_PRAGMA, line, col);
node->name = strdup(text);
lexer_next(lx);
if (lx->kind == '(') {
lexer_next(lx);
parse_block(lx, node, ')');
}
return node;
}
char *end;
long val = strtol(text, &end, 0);
if (*end == '\0') {
Ast *node = ast_new(AST_INT, line, col);
node->int_val = val;
lexer_next(lx);
return node;
}
Ast *node = ast_new(AST_WORD, line, col);
node->name = strdup(text);
lexer_next(lx);
return node;
}
if (kind == TOK_STRING) {
Ast *node = ast_new(AST_STR, line, col);
node->name = strdup(lx->items);
lexer_next(lx);
return node;
}
if (kind == '[') {
Ast *node = ast_new(AST_QUOTE, line, col);
lexer_next(lx);
parse_block(lx, node, ']');
return node;
}
if (kind == '{') {
Ast *node = ast_new(AST_TABLE, line, col);
lexer_next(lx);
parse_block(lx, node, '}');
return node;
}
if (kind == '(') {
Ast *node = ast_new(AST_LIST, line, col);
lexer_next(lx);
parse_block(lx, node, ')');
return node;
}
if (kind == TOK_INVALID) {
fprintf(stderr, "syntax error: invalid token at %ld:%ld\n", (long)line + 1,
(long)col + 1);
} else {
fprintf(stderr, "syntax error: unexpected token '%c' (%d) at %ld:%ld\n",
kind, kind, (long)line + 1, (long)col + 1);
}
lexer_next(lx);
return NULL;
}
Ast *parser_parse(Lx *lx) {
Ast *root = ast_new(AST_PROGRAM, 0, 0);
lexer_next(lx);
parse_block(lx, root, TOK_EOF);
return root;
}

35
src/parser.h
View file

@ -1,35 +0,0 @@
#ifndef PARSER_H
#define PARSER_H
#include "common.h"
#include "lexer.h"
#include "vendor/yar.h"
enum {
AST_PROGRAM,
AST_INT,
AST_STR,
AST_WORD,
AST_LIST,
AST_TABLE,
AST_QUOTE,
AST_DEF,
AST_CMD,
AST_PRAGMA,
};
typedef struct Ast {
I type;
char *name;
I int_val;
struct {
struct Ast **items;
Z count, capacity;
} children;
I line, col;
} Ast;
Ast *parser_parse(Lx *lx);
void ast_free(Ast *ast);
#endif

46
src/primitive.c
View file

@ -1,46 +0,0 @@
#include <stdio.h>
#include <string.h>
#include "primitive.h"
#include "print.h"
#include "string.h"
#include "vm.h"
#include "file.h"
// Pretty-printing primitives
static I prim_pprint(Vm *vm) {
println(vm_pop(vm));
return 0;
}
static I prim_printstack(Vm *vm) {
printf("Stk:");
for (O *p = vm->stack; p < vm->sp; p++) {
putchar(' ');
print(*p);
}
putchar('\n');
return 0;
}
// clang-format off
Pr primitives_table[] = {
{".", prim_pprint},
{".s", prim_printstack},
{"stdin", prim_file_stdin},
{"stdout", prim_file_stdout},
{"stderr", prim_file_stderr},
{"fprint", prim_file_fprint},
{"fgetline", prim_file_fgetline},
{NULL, NULL},
};
// clang-format on
I prim_find(const char *name) {
for (Z i = 0; primitives_table[i].name != NULL; i++) {
if (strcmp(primitives_table[i].name, name) == 0)
return i;
}
return -1;
}

14
src/primitive.h
View file

@ -1,14 +0,0 @@
#ifndef PRIMITIVE_H
#define PRIMITIVE_H
#include "vm.h"
typedef struct Pr {
const char *name;
I (*fn)(Vm *);
} Pr;
extern Pr primitives_table[];
I prim_find(const char *name);
#endif

91
src/print.c
View file

@ -1,91 +0,0 @@
#include <inttypes.h>
#include <stdio.h>
#include "object.h"
#include "print.h"
#include "string.h"
#include "userdata.h"
static V print_string(Str *s) {
putchar('"');
for (Z i = 0; i < s->len; i++) {
unsigned char c = s->data[i];
switch (c) {
case '\t':
printf("\\t");
break;
case '\n':
printf("\\n");
break;
case '\r':
printf("\\r");
break;
case '\b':
printf("\\b");
break;
case '\v':
printf("\\v");
break;
case '\f':
printf("\\f");
break;
case '\0':
printf("\\0");
break;
case '\x1b':
printf("\\e");
break;
case '\\':
printf("\\\\");
break;
case '\"':
printf("\\\"");
break;
default:
if (c < 32 || c > 126) {
printf("\\x%02x;", c);
} else {
putchar(c);
}
}
}
putchar('"');
}
V print(O o) {
if (o == NIL) {
printf("nil");
} else if (IMM(o)) {
printf("%" PRIdPTR, ORD(o));
} else {
Hd *hdr = UNBOX(o);
switch (hdr->type) {
case OBJ_QUOT:
printf("<quotation>");
break;
case OBJ_COMPOSE:
printf("<composed>");
break;
case OBJ_CURRY:
printf("<curried>");
break;
case OBJ_STR: {
Str *s = string_unwrap(o);
print_string(s);
break;
}
case OBJ_USERDATA: {
Ud *ud = (Ud *)(hdr + 1);
printf("<#userdata %s@%p>", ud->kind->name, ud->data);
break;
}
default:
printf("<#obj type=%ld ptr=%p>", type(o), (void *)o);
}
}
}
V println(O o) {
print(o);
putchar('\n');
}

10
src/print.h
View file

@ -1,10 +0,0 @@
#ifndef PRINT_H
#define PRINT_H
#include "common.h"
#include "object.h"
V print(O);
V println(O);
#endif

39
src/stream.c
View file

@ -1,39 +0,0 @@
#include "stream.h"
#include <stdio.h>
static int filestream_getc(void *f) { return fgetc((FILE *)f); }
static int filestream_ungetc(int c, void *f) { return ungetc(c, (FILE *)f); }
static int filestream_eof(void *f) { return feof((FILE *)f); }
static int bufstream_getc(void *f) {
Buf *b = f;
if (b->unread != -1) {
int c = b->unread;
b->unread = -1;
return c;
} else if (b->pos >= b->len) {
return -1;
}
return b->data[b->pos++];
}
static int bufstream_ungetc(int c, void *f) { return ((Buf *)f)->unread = c; }
static int bufstream_eof(void *f) {
Buf *b = f;
if (b->unread != -1)
return 0;
return b->pos >= b->len;
}
// clang-format off
static const StreamVtable _filestream_vtable = {
filestream_getc, filestream_ungetc, filestream_eof
};
const StreamVtable *filestream_vtable = &_filestream_vtable;
static const StreamVtable _bufstream_vtable = {
bufstream_getc, bufstream_ungetc, bufstream_eof
};
const StreamVtable *bufstream_vtable = &_bufstream_vtable;
// clang-format on

30
src/stream.h
View file

@ -1,30 +0,0 @@
#ifndef STREAM_H
#define STREAM_H
typedef struct StreamVtable {
int (*__sgetc)(void *);
int (*__sungetc)(int, void *);
int (*__seof)(void *);
} StreamVtable;
typedef struct Stream {
const StreamVtable *vtable;
void *data;
} Stream;
typedef struct Buf {
const char *data;
int len, pos;
int unread;
} Buf;
#define ST_GETC(R) ((R)->vtable->__sgetc((R)->data))
#define ST_UNGETC(C, R) ((R)->vtable->__sungetc(C, (R)->data))
#define ST_EOF(R) ((R)->vtable->__seof((R)->data))
#define BUF(s) ((Buf){s, sizeof(s)-1, 0, -1})
extern const StreamVtable *filestream_vtable;
extern const StreamVtable *bufstream_vtable;
#endif

51
src/string.c
View file

@ -1,51 +0,0 @@
#include <string.h>
#include "string.h"
#include "src/gc.h"
O string_make(Vm *vm, const char *str, I len) {
if (len < 0)
len = strlen(str);
Z size = sizeof(Hd) + sizeof(Str) + len + 1;
Hd *hdr = gc_alloc(vm, size);
hdr->type = OBJ_STR;
Str *s = (Str *)(hdr + 1);
s->len = len;
memcpy(s->data, str, len);
s->data[len] = 0;
return BOX(hdr);
}
Str *string_unwrap(O o) {
if (o == NIL || IMM(o))
return NULL;
Hd *hdr = UNBOX(o);
if (hdr->type != OBJ_STR)
return NULL;
return (Str *)(hdr + 1);
}
O string_concat(Vm *vm, O a_obj, O b_obj) {
I mark = gc_mark(&vm->gc);
gc_addroot(&vm->gc, &a_obj);
gc_addroot(&vm->gc, &b_obj);
Str *as = string_unwrap(a_obj);
Str *bs = string_unwrap(b_obj);
I a_len = as->len;
I b_len = bs->len;
O new = string_make(vm, "", a_len + b_len);
as = string_unwrap(a_obj);
bs = string_unwrap(b_obj);
Str *news = (Str *)(UNBOX(new) + 1);
memcpy(news->data, as->data, a_len);
memcpy(news->data + a_len, bs->data, b_len);
news->data[a_len + b_len] = 0;
gc_reset(&vm->gc, mark);
return new;
}

13
src/string.h
View file

@ -1,13 +0,0 @@
#include "common.h"
#include "object.h"
#include "vm.h"
/** String */
typedef struct Str {
Z len;
char data[];
} Str;
O string_make(Vm *, const char *, I);
Str *string_unwrap(O);
O string_concat(Vm *, O, O);

24
src/userdata.c
View file

@ -1,24 +0,0 @@
#include "userdata.h"
#include "gc.h"
O userdata_make(Vm *vm, V *data, Ut *kind) {
Z size = sizeof(Hd) + sizeof(Ud);
Hd *hdr = gc_alloc(vm, size);
hdr->type = OBJ_USERDATA;
Ud *ud = (Ud *)(hdr + 1);
ud->kind = kind;
ud->data = data;
return BOX(hdr);
}
Ud *userdata_unwrap(O o, Ut *kind) {
if (o == NIL || IMM(o))
return NULL;
Hd *hdr = UNBOX(o);
if (hdr->type != OBJ_USERDATA)
return NULL;
Ud *ud = (Ud *)(hdr + 1);
if (ud->kind != kind)
return NULL;
return ud;
}

21
src/userdata.h
View file

@ -1,21 +0,0 @@
#ifndef USERDATA_H
#define USERDATA_H
#include "common.h"
#include "object.h"
#include "vm.h"
typedef struct Ut {
const char *name;
V (*finalizer)(V *);
} Ut;
typedef struct Ud {
Ut *kind;
V *data;
} Ud;
O userdata_make(Vm *, V *, Ut *);
Ud *userdata_unwrap(O, Ut *);
#endif

1763
src/vendor/linenoise.c vendored
View file

File diff suppressed because it is too large Load diff

114
src/vendor/linenoise.h vendored
View file

@ -1,114 +0,0 @@
/* linenoise.h -- VERSION 1.0
*
* Guerrilla line editing library against the idea that a line editing lib
* needs to be 20,000 lines of C code.
*
* See linenoise.c for more information.
*
* ------------------------------------------------------------------------
*
* Copyright (c) 2010-2023, Salvatore Sanfilippo <antirez at gmail dot com>
* Copyright (c) 2010-2013, Pieter Noordhuis <pcnoordhuis at gmail dot com>
*
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions are
* met:
*
* * Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
*
* * Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
*
* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
* "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
* LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
* A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
* HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
* LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
* DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
* THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
* (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
#ifndef __LINENOISE_H
#define __LINENOISE_H
#ifdef __cplusplus
extern "C" {
#endif
#include <stddef.h> /* For size_t. */
extern char *linenoiseEditMore;
/* The linenoiseState structure represents the state during line editing.
* We pass this state to functions implementing specific editing
* functionalities. */
struct linenoiseState {
int in_completion; /* The user pressed TAB and we are now in completion
* mode, so input is handled by completeLine(). */
size_t completion_idx; /* Index of next completion to propose. */
int ifd; /* Terminal stdin file descriptor. */
int ofd; /* Terminal stdout file descriptor. */
char *buf; /* Edited line buffer. */
size_t buflen; /* Edited line buffer size. */
const char *prompt; /* Prompt to display. */
size_t plen; /* Prompt length. */
size_t pos; /* Current cursor position. */
size_t oldpos; /* Previous refresh cursor position. */
size_t len; /* Current edited line length. */
size_t cols; /* Number of columns in terminal. */
size_t oldrows; /* Rows used by last refrehsed line (multiline mode) */
int oldrpos; /* Cursor row from last refresh (for multiline clearing). */
int history_index; /* The history index we are currently editing. */
};
typedef struct linenoiseCompletions {
size_t len;
char **cvec;
} linenoiseCompletions;
/* Non blocking API. */
int linenoiseEditStart(struct linenoiseState *l, int stdin_fd, int stdout_fd, char *buf, size_t buflen, const char *prompt);
char *linenoiseEditFeed(struct linenoiseState *l);
void linenoiseEditStop(struct linenoiseState *l);
void linenoiseHide(struct linenoiseState *l);
void linenoiseShow(struct linenoiseState *l);
/* Blocking API. */
char *linenoise(const char *prompt);
void linenoiseFree(void *ptr);
/* Completion API. */
typedef void(linenoiseCompletionCallback)(const char *, linenoiseCompletions *);
typedef char*(linenoiseHintsCallback)(const char *, int *color, int *bold);
typedef void(linenoiseFreeHintsCallback)(void *);
void linenoiseSetCompletionCallback(linenoiseCompletionCallback *);
void linenoiseSetHintsCallback(linenoiseHintsCallback *);
void linenoiseSetFreeHintsCallback(linenoiseFreeHintsCallback *);
void linenoiseAddCompletion(linenoiseCompletions *, const char *);
/* History API. */
int linenoiseHistoryAdd(const char *line);
int linenoiseHistorySetMaxLen(int len);
int linenoiseHistorySave(const char *filename);
int linenoiseHistoryLoad(const char *filename);
/* Other utilities. */
void linenoiseClearScreen(void);
void linenoiseSetMultiLine(int ml);
void linenoisePrintKeyCodes(void);
void linenoiseMaskModeEnable(void);
void linenoiseMaskModeDisable(void);
#ifdef __cplusplus
}
#endif
#endif /* __LINENOISE_H */

4128
src/vendor/mpc.c vendored
View file

File diff suppressed because it is too large Load diff

391
src/vendor/mpc.h vendored
View file

@ -1,391 +0,0 @@
/*
** mpc - Micro Parser Combinator library for C
**
** https://github.com/orangeduck/mpc
**
** Daniel Holden - contact@daniel-holden.com
** Licensed under BSD3
*/
#ifndef mpc_h
#define mpc_h
#ifdef __cplusplus
extern "C" {
#endif
#include <stdlib.h>
#include <stdio.h>
#include <stdarg.h>
#include <string.h>
#include <math.h>
#include <errno.h>
#include <ctype.h>
/*
** State Type
*/
typedef struct {
long pos;
long row;
long col;
int term;
} mpc_state_t;
/*
** Error Type
*/
typedef struct {
mpc_state_t state;
int expected_num;
char *filename;
char *failure;
char **expected;
char received;
} mpc_err_t;
void mpc_err_delete(mpc_err_t *e);
char *mpc_err_string(mpc_err_t *e);
void mpc_err_print(mpc_err_t *e);
void mpc_err_print_to(mpc_err_t *e, FILE *f);
/*
** Parsing
*/
typedef void mpc_val_t;
typedef union {
mpc_err_t *error;
mpc_val_t *output;
} mpc_result_t;
struct mpc_parser_t;
typedef struct mpc_parser_t mpc_parser_t;
int mpc_parse(const char *filename, const char *string, mpc_parser_t *p, mpc_result_t *r);
int mpc_nparse(const char *filename, const char *string, size_t length, mpc_parser_t *p, mpc_result_t *r);
int mpc_parse_file(const char *filename, FILE *file, mpc_parser_t *p, mpc_result_t *r);
int mpc_parse_pipe(const char *filename, FILE *pipe, mpc_parser_t *p, mpc_result_t *r);
int mpc_parse_contents(const char *filename, mpc_parser_t *p, mpc_result_t *r);
/*
** Function Types
*/
typedef void(*mpc_dtor_t)(mpc_val_t*);
typedef mpc_val_t*(*mpc_ctor_t)(void);
typedef mpc_val_t*(*mpc_apply_t)(mpc_val_t*);
typedef mpc_val_t*(*mpc_apply_to_t)(mpc_val_t*,void*);
typedef mpc_val_t*(*mpc_fold_t)(int,mpc_val_t**);
typedef int(*mpc_check_t)(mpc_val_t**);
typedef int(*mpc_check_with_t)(mpc_val_t**,void*);
/*
** Building a Parser
*/
mpc_parser_t *mpc_new(const char *name);
mpc_parser_t *mpc_copy(mpc_parser_t *a);
mpc_parser_t *mpc_define(mpc_parser_t *p, mpc_parser_t *a);
mpc_parser_t *mpc_undefine(mpc_parser_t *p);
void mpc_delete(mpc_parser_t *p);
void mpc_cleanup(int n, ...);
/*
** Basic Parsers
*/
mpc_parser_t *mpc_any(void);
mpc_parser_t *mpc_char(char c);
mpc_parser_t *mpc_range(char s, char e);
mpc_parser_t *mpc_oneof(const char *s);
mpc_parser_t *mpc_noneof(const char *s);
mpc_parser_t *mpc_satisfy(int(*f)(char));
mpc_parser_t *mpc_string(const char *s);
/*
** Other Parsers
*/
mpc_parser_t *mpc_pass(void);
mpc_parser_t *mpc_fail(const char *m);
mpc_parser_t *mpc_failf(const char *fmt, ...);
mpc_parser_t *mpc_lift(mpc_ctor_t f);
mpc_parser_t *mpc_lift_val(mpc_val_t *x);
mpc_parser_t *mpc_anchor(int(*f)(char,char));
mpc_parser_t *mpc_state(void);
/*
** Combinator Parsers
*/
mpc_parser_t *mpc_expect(mpc_parser_t *a, const char *e);
mpc_parser_t *mpc_expectf(mpc_parser_t *a, const char *fmt, ...);
mpc_parser_t *mpc_apply(mpc_parser_t *a, mpc_apply_t f);
mpc_parser_t *mpc_apply_to(mpc_parser_t *a, mpc_apply_to_t f, void *x);
mpc_parser_t *mpc_check(mpc_parser_t *a, mpc_dtor_t da, mpc_check_t f, const char *e);
mpc_parser_t *mpc_check_with(mpc_parser_t *a, mpc_dtor_t da, mpc_check_with_t f, void *x, const char *e);
mpc_parser_t *mpc_checkf(mpc_parser_t *a, mpc_dtor_t da, mpc_check_t f, const char *fmt, ...);
mpc_parser_t *mpc_check_withf(mpc_parser_t *a, mpc_dtor_t da, mpc_check_with_t f, void *x, const char *fmt, ...);
mpc_parser_t *mpc_not(mpc_parser_t *a, mpc_dtor_t da);
mpc_parser_t *mpc_not_lift(mpc_parser_t *a, mpc_dtor_t da, mpc_ctor_t lf);
mpc_parser_t *mpc_maybe(mpc_parser_t *a);
mpc_parser_t *mpc_maybe_lift(mpc_parser_t *a, mpc_ctor_t lf);
mpc_parser_t *mpc_many(mpc_fold_t f, mpc_parser_t *a);
mpc_parser_t *mpc_many1(mpc_fold_t f, mpc_parser_t *a);
mpc_parser_t *mpc_count(int n, mpc_fold_t f, mpc_parser_t *a, mpc_dtor_t da);
mpc_parser_t *mpc_or(int n, ...);
mpc_parser_t *mpc_and(int n, mpc_fold_t f, ...);
mpc_parser_t *mpc_predictive(mpc_parser_t *a);
/*
** Common Parsers
*/
mpc_parser_t *mpc_eoi(void);
mpc_parser_t *mpc_soi(void);
mpc_parser_t *mpc_boundary(void);
mpc_parser_t *mpc_boundary_newline(void);
mpc_parser_t *mpc_whitespace(void);
mpc_parser_t *mpc_whitespaces(void);
mpc_parser_t *mpc_blank(void);
mpc_parser_t *mpc_newline(void);
mpc_parser_t *mpc_tab(void);
mpc_parser_t *mpc_escape(void);
mpc_parser_t *mpc_digit(void);
mpc_parser_t *mpc_hexdigit(void);
mpc_parser_t *mpc_octdigit(void);
mpc_parser_t *mpc_digits(void);
mpc_parser_t *mpc_hexdigits(void);
mpc_parser_t *mpc_octdigits(void);
mpc_parser_t *mpc_lower(void);
mpc_parser_t *mpc_upper(void);
mpc_parser_t *mpc_alpha(void);
mpc_parser_t *mpc_underscore(void);
mpc_parser_t *mpc_alphanum(void);
mpc_parser_t *mpc_int(void);
mpc_parser_t *mpc_hex(void);
mpc_parser_t *mpc_oct(void);
mpc_parser_t *mpc_number(void);
mpc_parser_t *mpc_real(void);
mpc_parser_t *mpc_float(void);
mpc_parser_t *mpc_char_lit(void);
mpc_parser_t *mpc_string_lit(void);
mpc_parser_t *mpc_regex_lit(void);
mpc_parser_t *mpc_ident(void);
/*
** Useful Parsers
*/
mpc_parser_t *mpc_startwith(mpc_parser_t *a);
mpc_parser_t *mpc_endwith(mpc_parser_t *a, mpc_dtor_t da);
mpc_parser_t *mpc_whole(mpc_parser_t *a, mpc_dtor_t da);
mpc_parser_t *mpc_stripl(mpc_parser_t *a);
mpc_parser_t *mpc_stripr(mpc_parser_t *a);
mpc_parser_t *mpc_strip(mpc_parser_t *a);
mpc_parser_t *mpc_tok(mpc_parser_t *a);
mpc_parser_t *mpc_sym(const char *s);
mpc_parser_t *mpc_total(mpc_parser_t *a, mpc_dtor_t da);
mpc_parser_t *mpc_between(mpc_parser_t *a, mpc_dtor_t ad, const char *o, const char *c);
mpc_parser_t *mpc_parens(mpc_parser_t *a, mpc_dtor_t ad);
mpc_parser_t *mpc_braces(mpc_parser_t *a, mpc_dtor_t ad);
mpc_parser_t *mpc_brackets(mpc_parser_t *a, mpc_dtor_t ad);
mpc_parser_t *mpc_squares(mpc_parser_t *a, mpc_dtor_t ad);
mpc_parser_t *mpc_tok_between(mpc_parser_t *a, mpc_dtor_t ad, const char *o, const char *c);
mpc_parser_t *mpc_tok_parens(mpc_parser_t *a, mpc_dtor_t ad);
mpc_parser_t *mpc_tok_braces(mpc_parser_t *a, mpc_dtor_t ad);
mpc_parser_t *mpc_tok_brackets(mpc_parser_t *a, mpc_dtor_t ad);
mpc_parser_t *mpc_tok_squares(mpc_parser_t *a, mpc_dtor_t ad);
mpc_parser_t *mpc_sepby1(mpc_fold_t f, mpc_parser_t *sep, mpc_parser_t *a);
/*
** Common Function Parameters
*/
void mpcf_dtor_null(mpc_val_t *x);
mpc_val_t *mpcf_ctor_null(void);
mpc_val_t *mpcf_ctor_str(void);
mpc_val_t *mpcf_free(mpc_val_t *x);
mpc_val_t *mpcf_int(mpc_val_t *x);
mpc_val_t *mpcf_hex(mpc_val_t *x);
mpc_val_t *mpcf_oct(mpc_val_t *x);
mpc_val_t *mpcf_float(mpc_val_t *x);
mpc_val_t *mpcf_strtriml(mpc_val_t *x);
mpc_val_t *mpcf_strtrimr(mpc_val_t *x);
mpc_val_t *mpcf_strtrim(mpc_val_t *x);
mpc_val_t *mpcf_escape(mpc_val_t *x);
mpc_val_t *mpcf_escape_regex(mpc_val_t *x);
mpc_val_t *mpcf_escape_string_raw(mpc_val_t *x);
mpc_val_t *mpcf_escape_char_raw(mpc_val_t *x);
mpc_val_t *mpcf_unescape(mpc_val_t *x);
mpc_val_t *mpcf_unescape_regex(mpc_val_t *x);
mpc_val_t *mpcf_unescape_string_raw(mpc_val_t *x);
mpc_val_t *mpcf_unescape_char_raw(mpc_val_t *x);
mpc_val_t *mpcf_null(int n, mpc_val_t** xs);
mpc_val_t *mpcf_fst(int n, mpc_val_t** xs);
mpc_val_t *mpcf_snd(int n, mpc_val_t** xs);
mpc_val_t *mpcf_trd(int n, mpc_val_t** xs);
mpc_val_t *mpcf_fst_free(int n, mpc_val_t** xs);
mpc_val_t *mpcf_snd_free(int n, mpc_val_t** xs);
mpc_val_t *mpcf_trd_free(int n, mpc_val_t** xs);
mpc_val_t *mpcf_all_free(int n, mpc_val_t** xs);
mpc_val_t *mpcf_freefold(int n, mpc_val_t** xs);
mpc_val_t *mpcf_strfold(int n, mpc_val_t** xs);
/*
** Regular Expression Parsers
*/
enum {
MPC_RE_DEFAULT = 0,
MPC_RE_M = 1,
MPC_RE_S = 2,
MPC_RE_MULTILINE = 1,
MPC_RE_DOTALL = 2
};
mpc_parser_t *mpc_re(const char *re);
mpc_parser_t *mpc_re_mode(const char *re, int mode);
/*
** AST
*/
typedef struct mpc_ast_t {
char *tag;
char *contents;
mpc_state_t state;
int children_num;
struct mpc_ast_t** children;
} mpc_ast_t;
mpc_ast_t *mpc_ast_new(const char *tag, const char *contents);
mpc_ast_t *mpc_ast_build(int n, const char *tag, ...);
mpc_ast_t *mpc_ast_add_root(mpc_ast_t *a);
mpc_ast_t *mpc_ast_add_child(mpc_ast_t *r, mpc_ast_t *a);
mpc_ast_t *mpc_ast_add_tag(mpc_ast_t *a, const char *t);
mpc_ast_t *mpc_ast_add_root_tag(mpc_ast_t *a, const char *t);
mpc_ast_t *mpc_ast_tag(mpc_ast_t *a, const char *t);
mpc_ast_t *mpc_ast_state(mpc_ast_t *a, mpc_state_t s);
void mpc_ast_delete(mpc_ast_t *a);
void mpc_ast_print(mpc_ast_t *a);
void mpc_ast_print_to(mpc_ast_t *a, FILE *fp);
int mpc_ast_get_index(mpc_ast_t *ast, const char *tag);
int mpc_ast_get_index_lb(mpc_ast_t *ast, const char *tag, int lb);
mpc_ast_t *mpc_ast_get_child(mpc_ast_t *ast, const char *tag);
mpc_ast_t *mpc_ast_get_child_lb(mpc_ast_t *ast, const char *tag, int lb);
typedef enum {
mpc_ast_trav_order_pre,
mpc_ast_trav_order_post
} mpc_ast_trav_order_t;
typedef struct mpc_ast_trav_t {
mpc_ast_t *curr_node;
struct mpc_ast_trav_t *parent;
int curr_child;
mpc_ast_trav_order_t order;
} mpc_ast_trav_t;
mpc_ast_trav_t *mpc_ast_traverse_start(mpc_ast_t *ast,
mpc_ast_trav_order_t order);
mpc_ast_t *mpc_ast_traverse_next(mpc_ast_trav_t **trav);
void mpc_ast_traverse_free(mpc_ast_trav_t **trav);
/*
** Warning: This function currently doesn't test for equality of the `state` member!
*/
int mpc_ast_eq(mpc_ast_t *a, mpc_ast_t *b);
mpc_val_t *mpcf_fold_ast(int n, mpc_val_t **as);
mpc_val_t *mpcf_str_ast(mpc_val_t *c);
mpc_val_t *mpcf_state_ast(int n, mpc_val_t **xs);
mpc_parser_t *mpca_tag(mpc_parser_t *a, const char *t);
mpc_parser_t *mpca_add_tag(mpc_parser_t *a, const char *t);
mpc_parser_t *mpca_root(mpc_parser_t *a);
mpc_parser_t *mpca_state(mpc_parser_t *a);
mpc_parser_t *mpca_total(mpc_parser_t *a);
mpc_parser_t *mpca_not(mpc_parser_t *a);
mpc_parser_t *mpca_maybe(mpc_parser_t *a);
mpc_parser_t *mpca_many(mpc_parser_t *a);
mpc_parser_t *mpca_many1(mpc_parser_t *a);
mpc_parser_t *mpca_count(int n, mpc_parser_t *a);
mpc_parser_t *mpca_or(int n, ...);
mpc_parser_t *mpca_and(int n, ...);
enum {
MPCA_LANG_DEFAULT = 0,
MPCA_LANG_PREDICTIVE = 1,
MPCA_LANG_WHITESPACE_SENSITIVE = 2
};
mpc_parser_t *mpca_grammar(int flags, const char *grammar, ...);
mpc_err_t *mpca_lang(int flags, const char *language, ...);
mpc_err_t *mpca_lang_file(int flags, FILE *f, ...);
mpc_err_t *mpca_lang_pipe(int flags, FILE *f, ...);
mpc_err_t *mpca_lang_contents(int flags, const char *filename, ...);
/*
** Misc
*/
void mpc_print(mpc_parser_t *p);
void mpc_optimise(mpc_parser_t *p);
void mpc_stats(mpc_parser_t *p);
int mpc_test_pass(mpc_parser_t *p, const char *s, const void *d,
int(*tester)(const void*, const void*),
mpc_dtor_t destructor,
void(*printer)(const void*));
int mpc_test_fail(mpc_parser_t *p, const char *s, const void *d,
int(*tester)(const void*, const void*),
mpc_dtor_t destructor,
void(*printer)(const void*));
#ifdef __cplusplus
}
#endif
#endif

2
src/vendor/yar.c vendored
View file

@ -1,2 +0,0 @@
#define YAR_IMPLEMENTATION
#include "yar.h"

229
src/vendor/yar.h vendored
View file

@ -1,229 +0,0 @@
/* yar - dynamic arrays in C - public domain Nicholas Rixson 2025
*
* https://github.com/segcore/yar
*
* Licence: see end of file
Sample usage:
#define YAR_IMPLEMENTATION
#include "yar.h"
int main() {
// struct { double *items; size_t count; size_t capacity; } numbers = {0};
yar(double) numbers = {0};
*yar_append(&numbers) = 3.14159;
*yar_append(&numbers) = 2.71828;
*yar_append(&numbers) = 1.61803;
for(size_t i = 0; i < numbers.count; i++) {
printf("%f\n", numbers.items[i]);
}
yar_free(&numbers);
}
*/
#ifndef YAR_H
#define YAR_H
#include <stddef.h> // size_t
#include <string.h> // strlen
/*
* yar(type) - Declare a new basic dynamic array
*
* yar_append(array) - Add a new item at the end of the array, and return a pointer to it
*
* yar_reserve(array, extra) - Reserve space for `extra` count of items
*
* yar_append_many(array, data, num) - Append a copy of existing data
*
* yar_append_cstr(array, data) - Append a C string (nul-terminated char array)
*
* yar_insert(array, index, num) - Insert items somewhere within the array. Moves items to higher indexes as required. Returns &array[index]
*
* yar_remove(array, index, num) - Remove items from somewhere within the array. Moves items to lower indexes as required.
*
* yar_reset(array) - Reset the count of elements to 0, to re-use the memory. Does not free the memory.
*
* yar_init(array) - Set items, count, and capacity to 0. Can usually be avoided with <declaration> = {0};
*
* yar_free(array) - Free items memory, and set the items, count, and capacity to 0.
*/
#define yar(type) struct { type *items; size_t count; size_t capacity; }
#define yar_append(array) ((_yar_append((void**)&(array)->items, &(array)->count, &(array)->capacity, sizeof((array)->items[0])) ? \
&(array)->items[(array)->count - 1] : NULL))
#define yar_reserve(array, extra) ((_yar_reserve((void**)&(array)->items, &(array)->count, &(array)->capacity, sizeof((array)->items[0]), (extra)) ? \
&(array)->items[(array)->count] : NULL))
#define yar_append_many(array, data, num) ((_yar_append_many((void**)&(array)->items, &(array)->count, &(array)->capacity, sizeof((array)->items[0]), 1 ? (data) : ((array)->items), (num)) ))
#define yar_append_cstr(array, data) yar_append_many(array, data, strlen(data))
#define yar_insert(array, index, num) ((_yar_insert((void**)&(array)->items, &(array)->count, &(array)->capacity, sizeof((array)->items[0]), index, num) ))
#define yar_remove(array, index, num) ((_yar_remove((void**)&(array)->items, &(array)->count, sizeof((array)->items[0]), index, num) ))
#define yar_reset(array) (((array)->count = 0))
#define yar_init(array) ((array)->items = NULL, (array)->count = 0, (array)->capacity = 0)
#define yar_free(array) ((_yar_free((array)->items)), (array)->items = NULL, (array)->count = 0, (array)->capacity = 0)
#ifndef YARAPI
#define YARAPI // nothing; overridable if needed.
#endif
#ifdef __cplusplus
extern "C" {
#endif
// Implementation functions
YARAPI void* _yar_append(void** items_pointer, size_t* count, size_t* capacity, size_t item_size);
YARAPI void* _yar_append_many(void** items_pointer, size_t* count, size_t* capacity, size_t item_size, void* data, size_t extra);
YARAPI void* _yar_reserve(void** items_pointer, size_t* count, size_t* capacity, size_t item_size, size_t extra);
YARAPI void* _yar_insert(void** items_pointer, size_t* count, size_t* capacity, size_t item_size, size_t index, size_t extra);
YARAPI void* _yar_remove(void** items_pointer, size_t* count, size_t item_size, size_t index, size_t remove);
YARAPI void* _yar_realloc(void* p, size_t new_size);
YARAPI void _yar_free(void* p);
#ifdef __cplusplus
}
#endif
#endif // YAR_H
#if defined(YAR_IMPLEMENTATION)
#ifndef YAR_MIN_CAP
#define YAR_MIN_CAP 16
#endif
#ifndef YAR_REALLOC
#define YAR_REALLOC realloc
#endif
#ifndef YAR_FREE
#define YAR_FREE free
#endif
#include <string.h> // mem* functions
YARAPI void* _yar_append(void** items_pointer, size_t* count, size_t* capacity, size_t item_size)
{
void* result = _yar_reserve(items_pointer, count, capacity, item_size, 1);
if (result != NULL) *count += 1;
return result;
}
YARAPI void* _yar_append_many(void** items_pointer, size_t* count, size_t* capacity, size_t item_size, void* data, size_t extra)
{
void* result = _yar_reserve(items_pointer, count, capacity, item_size, extra);
if (result != NULL) {
memcpy(result, data, item_size * extra);
*count += extra;
}
return result;
}
YARAPI void* _yar_reserve(void** items_pointer, size_t* count, size_t* capacity, size_t item_size, size_t extra)
{
char* items = *items_pointer;
size_t newcount = *count + extra;
if (newcount > *capacity) {
size_t newcap = (*capacity < YAR_MIN_CAP) ? YAR_MIN_CAP : *capacity * 8 / 5;
if (newcap < newcount) newcap = newcount;
void* next = _yar_realloc(items, newcap * item_size);
if (next == NULL) return NULL;
items = next;
*items_pointer = next;
*capacity = newcap;
}
void* result = items + (*count * item_size);
if (extra && result) memset(result, 0, item_size * extra);
return result;
}
YARAPI void* _yar_insert(void** items_pointer, size_t* count, size_t* capacity, size_t item_size, size_t index, size_t extra)
{
void* next = _yar_reserve(items_pointer, count, capacity, item_size, extra);
if(next == NULL) return NULL;
char* items = *items_pointer;
if (index < *count)
{
memmove(&items[item_size * (index + extra)], &items[item_size * index], (*count - index) * item_size);
memset(&items[item_size * index], 0, extra * item_size);
}
*count += extra;
return items + index * item_size;
}
YARAPI void* _yar_remove(void** items_pointer, size_t* count, size_t item_size, size_t index, size_t remove)
{
if(remove >= *count) {
*count = 0;
return *items_pointer;
}
if (index >= *count) {
return *items_pointer;
}
char* items = *items_pointer;
memmove(&items[item_size * index], &items[item_size * (index + remove)], item_size * (*count - (index + remove)));
*count -= remove;
return items + item_size * index;
}
YARAPI void* _yar_realloc(void* p, size_t new_size)
{
// Declaration, so we can call it if the definition is overridden
extern void* YAR_REALLOC(void *ptr, size_t size);
return YAR_REALLOC(p, new_size);
}
YARAPI void _yar_free(void* p)
{
extern void YAR_FREE(void *ptr);
YAR_FREE(p);
}
#endif // YAR_IMPLEMENTATION
/*
------------------------------------------------------------------------------
This software is available under 2 licenses -- choose whichever you prefer.
------------------------------------------------------------------------------
ALTERNATIVE A - MIT License
Copyright (c) 2025 Nicholas Rixson
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
SOFTWARE.
------------------------------------------------------------------------------
ALTERNATIVE B - Public Domain (www.unlicense.org)
This is free and unencumbered software released into the public domain.
Anyone is free to copy, modify, publish, use, compile, sell, or distribute this
software, either in source code form or as a compiled binary, for any purpose,
commercial or non-commercial, and by any means.
In jurisdictions that recognize copyright laws, the author or authors of this
software dedicate any and all copyright interest in the software to the public
domain. We make this dedication for the benefit of the public at large and to
the detriment of our heirs and successors. We intend this dedication to be an
overt act of relinquishment in perpetuity of all present and future rights to
this software under copyright law.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
------------------------------------------------------------------------------
*/

509
src/vm.c
View file

@ -1,509 +0,0 @@
#include <setjmp.h>
#include <stdio.h>
#include "arena.h"
#include "chunk.h"
#include "compile.h"
#include "dictionary.h"
#include "file.h"
#include "gc.h"
#include "object.h"
#include "primitive.h"
#include "string.h"
#include "userdata.h"
#include "vm.h"
static I decode_sleb128(U8 **ptr) {
I result = 0;
I shift = 0;
U8 byte;
do {
byte = **ptr;
(*ptr)++;
result |= (I)(byte & 0x7F) << shift;
shift += 7;
} while (byte & 0x80);
if ((shift < 64) && (byte & 0x40)) {
result |= -(1LL << shift);
}
return result;
}
V vm_init(Vm *vm) {
vm->sp = vm->stack;
vm->rsp = vm->rstack;
vm->tsp = vm->tstack;
vm->chunk = NULL;
vm->dictionary = NULL;
gc_init(&vm->gc);
arena_init(&vm->arena, 1024 * 1024);
for (Z i = 0; i < STACK_SIZE; i++) {
vm->stack[i] = NIL;
vm->tstack[i] = NIL;
vm->rstack[i].obj = NIL;
gc_addroot(&vm->gc, &vm->stack[i]);
gc_addroot(&vm->gc, &vm->tstack[i]);
gc_addroot(&vm->gc, &vm->rstack[i].obj);
}
vm->next_call = NIL;
gc_addroot(&vm->gc, &vm->next_call);
vm->trampoline = chunk_new("<trampoline>");
chunk_emit_byte(vm->trampoline, OP_CALL_NEXT);
vm->stdin = userdata_make(vm, (void *)stdin, &userdata_file);
vm->stdout = userdata_make(vm, (void *)stdout, &userdata_file);
vm->stderr = userdata_make(vm, (void *)stderr, &userdata_file);
gc_addroot(&vm->gc, &vm->stdin);
gc_addroot(&vm->gc, &vm->stdout);
gc_addroot(&vm->gc, &vm->stderr);
}
V vm_deinit(Vm *vm) {
chunk_release(vm->trampoline);
// Free all definitions
Dt *dstack[256];
Dt **dsp = dstack;
*dsp++ = vm->dictionary;
while (dsp > dstack) {
Dt *node = *--dsp;
if (!node)
continue;
if (node->chunk != NULL)
chunk_release(node->chunk);
for (I i = 0; i < 4; i++) {
if (node->child[i] != NULL)
*dsp++ = node->child[i];
}
}
arena_free(&vm->arena);
vm->dictionary = NULL;
// Run final GC pass
gc_collect(vm, 1);
gc_deinit(&vm->gc);
}
static V vm_error(Vm *vm, I error, const char *message) {
I col = -1;
I line = chunk_get_line(vm->chunk, vm->ip - vm->chunk->items, &col);
fprintf(stderr, "error at %ld:%ld: %s\n", line + 1, col + 1, message);
longjmp(vm->error, error);
}
V vm_push(Vm *vm, O o) {
if (vm->sp >= vm->stack + STACK_SIZE)
vm_error(vm, VM_ERR_STACK_OVERFLOW, "data stack overflow");
*vm->sp++ = o;
}
O vm_pop(Vm *vm) {
if (vm->sp <= vm->stack)
vm_error(vm, VM_ERR_STACK_UNDERFLOW, "data stack underflow");
O o = *--vm->sp;
*vm->sp = NIL;
return o;
}
V vm_tpush(Vm *vm, O o) {
if (vm->tsp >= vm->tstack + STACK_SIZE)
vm_error(vm, VM_ERR_STACK_OVERFLOW, "retain stack overflow");
*vm->tsp++ = o;
}
O vm_tpop(Vm *vm) {
if (vm->tsp <= vm->tstack)
vm_error(vm, VM_ERR_STACK_UNDERFLOW, "retain stack underflow");
O o = *--vm->tsp;
*vm->tsp = NIL;
return o;
}
V vm_rpush(Vm *vm, Bc *chunk, U8 *ip) {
if (vm->rsp >= vm->rstack + STACK_SIZE)
vm_error(vm, VM_ERR_STACK_OVERFLOW, "return stack overflow");
vm->rsp->chunk = chunk;
vm->rsp->ip = ip;
vm->rsp->obj = NIL;
vm->rsp++;
}
Fr vm_rpop(Vm *vm) {
if (vm->rsp <= vm->rstack)
vm_error(vm, VM_ERR_STACK_UNDERFLOW, "return stack underflow");
return *--vm->rsp;
}
I vm_run(Vm *vm, Bc *chunk, I offset) {
I mark = gc_mark(&vm->gc);
if (setjmp(vm->error) != 0) {
gc_reset(&vm->gc, mark);
return 0;
}
for (Z i = 0; i < chunk->constants.count; i++)
gc_addroot(&vm->gc, &chunk->constants.items[i]);
#define BINOP(op) \
{ \
O b = vm_pop(vm); \
O a = vm_pop(vm); \
if (!IMM(a) || !IMM(b)) \
vm_error(vm, VM_ERR_TYPE, "numop on non-numeric objects"); \
vm_push(vm, NUM(ORD(a) op ORD(b))); \
break; \
}
#define CMPOP(op) \
{ \
O b = vm_pop(vm); \
O a = vm_pop(vm); \
if (!IMM(a) || !IMM(b)) \
vm_error(vm, VM_ERR_TYPE, "comparison on non-numeric objects"); \
vm_push(vm, (ORD(a) op ORD(b)) ? NUM(1) : NIL); \
break; \
}
vm->ip = chunk->items + offset;
vm->chunk = chunk;
for (;;) {
U8 opcode;
switch (opcode = *vm->ip++) {
case OP_NOP:
continue;
case OP_NIL:
vm_push(vm, NIL);
break;
case OP_CONST: {
I idx = decode_sleb128(&vm->ip);
vm_push(vm, vm->chunk->constants.items[idx]);
break;
}
case OP_DROP: {
(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, obj2);
vm_push(vm, obj1);
vm_push(vm, obj2);
break;
}
case OP_SWAP: {
O b = vm_pop(vm);
O a = vm_pop(vm);
vm_push(vm, b);
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, c);
vm_push(vm, d);
vm_push(vm, a);
vm_push(vm, b);
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_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;
if (!word)
vm_error(vm, VM_ERR_RUNTIME, "word not found");
vm_rpush(vm, vm->chunk, vm->ip);
vm->chunk = word->chunk;
vm->ip = word->chunk->items;
break;
}
case OP_CALL: {
O quot = vm_pop(vm);
vm_rpush(vm, vm->chunk, vm->ip);
do_call:
switch (type(quot)) {
case OBJ_QUOT: {
Bc **ptr = (Bc **)(UNBOX(quot) + 1);
Bc *chunk = *ptr;
vm->chunk = chunk;
vm->ip = chunk->items;
break;
}
case OBJ_COMPOSE: {
Qo *comp = (Qo *)(UNBOX(quot) + 1);
vm_rpush(vm, vm->trampoline, vm->trampoline->items);
vm->rsp[-1].obj = comp->second;
quot = comp->first;
goto do_call;
}
case OBJ_CURRY: {
Qc *curry = (Qc *)(UNBOX(quot) + 1);
vm_push(vm, curry->value);
quot = curry->callable;
goto do_call;
break;
}
default:
vm_error(vm, VM_ERR_TYPE, "attempt to call non-quotation object");
}
break;
}
case OP_TAIL_DOWORD: {
I idx = decode_sleb128(&vm->ip);
Dt *word = vm->chunk->symbols.items[idx].resolved;
if (!word)
vm_error(vm, VM_ERR_RUNTIME, "word not found");
vm->chunk = word->chunk;
vm->ip = word->chunk->items;
break;
}
case OP_CALL_NEXT:
vm_push(vm, vm->next_call);
vm->next_call = NIL;
// fallthrough
case OP_TAIL_CALL: {
O quot = vm_pop(vm);
do_tail_call:
switch (type(quot)) {
case OBJ_QUOT: {
Bc **ptr = (Bc **)(UNBOX(quot) + 1);
Bc *chunk = *ptr;
vm->chunk = chunk;
vm->ip = chunk->items;
break;
}
case OBJ_COMPOSE: {
Qo *comp = (Qo *)(UNBOX(quot) + 1);
vm_rpush(vm, vm->trampoline, vm->trampoline->items);
vm->rsp[-1].obj = comp->second;
quot = comp->first;
goto do_tail_call;
}
case OBJ_CURRY: {
Qc *curry = (Qc *)(UNBOX(quot) + 1);
vm_push(vm, curry->value);
quot = curry->callable;
goto do_tail_call;
break;
}
default:
vm_error(vm, VM_ERR_TYPE, "attempt to call non-quotation object");
}
break;
}
case OP_PRIM: {
I idx = decode_sleb128(&vm->ip);
Pr prim = primitives_table[idx];
I err = prim.fn(vm);
if (err != 0)
vm_error(vm, err, "primitive call failed");
break;
}
case OP_COMPOSE: {
I mark = gc_mark(&vm->gc);
O c1 = vm_pop(vm);
O c2 = vm_pop(vm);
gc_addroot(&vm->gc, &c2);
gc_addroot(&vm->gc, &c1);
if (!callable(c2) || !callable(c1))
vm_error(vm, VM_ERR_TYPE, "non-callable arguments to compose");
Hd *hd = gc_alloc(vm, sizeof(Hd) + sizeof(Qo));
hd->type = OBJ_COMPOSE;
Qo *comp = (Qo *)(hd + 1);
comp->first = c2;
comp->second = c1;
vm_push(vm, BOX(hd));
gc_reset(&vm->gc, mark);
break;
}
case OP_CURRY: {
I mark = gc_mark(&vm->gc);
O cble = vm_pop(vm);
O value = vm_pop(vm);
gc_addroot(&vm->gc, &cble);
gc_addroot(&vm->gc, &value);
if (!callable(cble))
vm_error(vm, VM_ERR_TYPE, "non-callable argument to curry");
Hd *hd = gc_alloc(vm, sizeof(Hd) + sizeof(Qc));
hd->type = OBJ_CURRY;
Qc *curry = (Qc *)(hd + 1);
curry->value = value;
curry->callable = cble;
vm_push(vm, BOX(hd));
gc_reset(&vm->gc, mark);
break;
}
case OP_RETURN:
if (vm->rsp != vm->rstack) {
Fr frame = vm_rpop(vm);
vm->next_call = frame.obj;
vm->chunk = frame.chunk;
vm->ip = frame.ip;
} else {
goto done;
}
break;
case OP_CHOOSE: {
O fals = vm_pop(vm);
O tru = vm_pop(vm);
O cond = vm_pop(vm);
if (cond == NIL) {
vm_push(vm, fals);
} else {
vm_push(vm, tru);
}
break;
}
case OP_ADD:
BINOP(+);
case OP_SUB:
BINOP(-);
case OP_MUL:
BINOP(*);
case OP_DIV:
BINOP(/);
case OP_MOD:
BINOP(%);
case OP_LOGAND:
BINOP(&);
case OP_LOGOR:
BINOP(|);
case OP_LOGXOR:
BINOP(^);
case OP_LOGNOT: {
O o = vm_pop(vm);
if (!IMM(o))
vm_error(vm, VM_ERR_TYPE, "numop on non-number");
vm_push(vm, NUM(~ORD(o)));
break;
}
case OP_EQ:
CMPOP(==);
case OP_NEQ:
CMPOP(!=);
case OP_LT:
CMPOP(<);
case OP_GT:
CMPOP(>);
case OP_LTE:
CMPOP(<=);
case OP_GTE:
CMPOP(>=);
case OP_AND: {
O b = vm_pop(vm);
O a = vm_pop(vm);
if (a == NIL) {
vm_push(vm, NIL);
} else {
vm_push(vm, b);
}
break;
}
case OP_OR: {
O b = vm_pop(vm);
O a = vm_pop(vm);
if (a == NIL) {
vm_push(vm, b);
} else {
vm_push(vm, a);
}
break;
}
case OP_CONCAT: {
O b = vm_pop(vm);
if (type(b) != OBJ_STR)
vm_error(vm, VM_ERR_TYPE, "expected string");
O a = vm_pop(vm);
if (type(a) != OBJ_STR)
vm_error(vm, VM_ERR_TYPE, "expected string");
vm_push(vm, string_concat(vm, a, b));
break;
}
default:
vm_error(vm, VM_ERR_RUNTIME, "unknown opcode");
}
}
done:
gc_reset(&vm->gc, mark);
return 1;
}

103
src/vm.h
View file

@ -1,103 +0,0 @@
#ifndef VM_H
#define VM_H
#include <setjmp.h>
#include "common.h"
#include "arena.h"
#include "chunk.h"
#include "dictionary.h"
#include "gc.h"
#include "object.h"
enum {
OP_NOP = 0,
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,
OP_2TOR,
OP_FROMR,
OP_2FROMR,
OP_DOWORD,
OP_CALL,
OP_TAIL_DOWORD,
OP_TAIL_CALL,
OP_PRIM,
OP_COMPOSE,
OP_CURRY,
OP_RETURN,
OP_CHOOSE,
OP_ADD,
OP_SUB,
OP_MUL,
OP_DIV,
OP_MOD,
OP_EQ,
OP_NEQ,
OP_LOGAND,
OP_LOGOR,
OP_LOGXOR,
OP_LOGNOT,
OP_LT,
OP_GT,
OP_LTE,
OP_GTE,
OP_AND,
OP_OR,
OP_CONCAT,
OP_CALL_NEXT,
};
#define STACK_SIZE 256
typedef struct Fr {
Bc *chunk;
U8 *ip;
O obj;
} Fr;
typedef struct Vm {
Gc gc;
O stack[STACK_SIZE], *sp;
O tstack[STACK_SIZE], *tsp;
Fr rstack[STACK_SIZE], *rsp;
U8 *ip;
Bc *chunk;
Dt *dictionary;
Ar arena;
jmp_buf error;
Bc *trampoline;
O next_call;
// These objects need to stay as roots!
O stdin, stdout, stderr;
} Vm;
enum {
VM_ERR_STACK_OVERFLOW = 1,
VM_ERR_STACK_UNDERFLOW,
VM_ERR_TYPE,
VM_ERR_RUNTIME
};
V vm_init(Vm *);
V vm_deinit(Vm *);
I vm_run(Vm *, Bc *, I);
V vm_push(Vm *, O);
O vm_pop(Vm *);
V vm_tpush(Vm *, O);
O vm_tpop(Vm *);
#endif