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

ooh okay diva

Browse source
This commit is contained in:
Lobo 2026-02-08 10:03:56 -03:00
parent 90175b7e26
commit 58ba150c93
17 changed files with 1122 additions and 94 deletions
Download patch file Download diff file Expand all files Collapse all files

17
next/core/arena.c
View file

@ -2,25 +2,34 @@
#include <stdlib.h>
#include <string.h>
void growl_arena_init(GrowlGCArena *arena, size_t size) {
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(GrowlGCArena *arena) {
void growl_arena_free(GrowlArena *arena) {
free(arena->start);
arena->start = arena->end = arena->free = NULL;
}
void *growl_arena_alloc(GrowlGCArena *arena, size_t size, size_t align,
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)
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;
}

35
next/core/callable.c
View file

@ -17,16 +17,23 @@ 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) {
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);
Growl constants_obj;
constants_tuple->count = constants_size;
for (size_t i = 0; i < constants_size; ++i) {
constants_tuple->data[i] = constants[i];
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 =
@ -36,7 +43,7 @@ Growl growl_make_quotation(GrowlVM *vm, const uint8_t *code, size_t code_size,
quotation_hdr->type = GROWL_TYPE_QUOTATION;
GrowlQuotation *quotation = (GrowlQuotation *)(quotation_hdr + 1);
quotation->constants = GROWL_BOX(constants_hdr);
quotation->constants = constants_obj;
quotation->count = code_size;
memcpy(quotation->data, code, code_size);
@ -57,12 +64,16 @@ Growl growl_compose(GrowlVM *vm, Growl first, Growl second) {
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);
}
@ -78,12 +89,16 @@ GrowlCompose *growl_unwrap_compose(Growl obj) {
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);
}

342
next/core/compiler.c
View file

@ -1,2 +1,344 @@
#include <growl.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "opcodes.h"
#include "sleb128.h"
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}},
{"call", {GOP_CALL, 0}},
{"compose", {GOP_COMPOSE, 0}},
{"curry", {GOP_CURRY, 0}},
{".", {GOP_PPRINT, 0}},
{"+", {GOP_ADD, 0}},
{"*", {GOP_MUL, 0}},
{"-", {GOP_SUB, 0}},
{"/", {GOP_DIV, 0}},
{"%", {GOP_MOD, 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
// See https://nullprogram.com/blog/2023/10/05/
#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 {
char *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 == (uint8_t *)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));
}
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;
}
static int compile_token(GrowlVM *vm, GrowlLexer *lexer, Chunk *chunk);
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[i] = GOP_NOP;
chunk->data[start] = GOP_TAIL_CALL;
} else if (opcode == GOP_WORD) {
chunk->data[i] = GOP_NOP;
chunk->data[start] = GOP_TAIL_WORD;
}
}
}
}
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 != ']') {
fprintf(stderr, "error: expected ']' to close quotation\n");
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(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) {
fprintf(stderr, "compiler: expected name after 'def'\n");
return 1;
}
char *name = growl_arena_strdup(&vm->scratch, lexer->buffer);
growl_lexer_next(lexer);
if (lexer->kind != GTOK_LBRACE) {
fprintf(stderr, "compiler: expected '{' after def name\n");
return 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) {
fprintf(stderr, "error: expected '}' to close def\n");
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);
GrowlQuotation *quot = (GrowlQuotation *)(GROWL_UNBOX(fn) + 1);
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->quotation = quot;
entry->quotation = quot;
entry->index = vm->defs.count - 1;
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) {
fprintf(stderr, "compiler: undefined word '%s'\n", 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) {
fprintf(stderr, "compiler: expected ';' to close command\n");
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);
// 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:
fprintf(stderr, "compiler: unexpected token '%c'\n", lexer->kind);
return 1;
case GTOK_INVALID:
fprintf(stderr, "compiler: lexing error at line %d, column %d\n",
lexer->current_row, lexer->current_col + 1);
return 1;
default:
fprintf(stderr, "compiler: unhandled token type '%c'\n", 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
next/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;
}

94
next/core/disasm.c Normal file
View file

@ -0,0 +1,94 @@
#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++) {
printf(" ");
}
printf("%04zu ", offset);
uint8_t opcode = quot->data[offset++];
// clang-format off
#define OPCODE(name) case GOP_## name:
#define OPCODE1(name) case GOP_## name: printf(#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);
printf("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];
printf(" (");
growl_print(constant);
printf(")");
if (!GROWL_IMM(constant) && constant != GROWL_NIL &&
growl_type(constant) == GROWL_TYPE_QUOTATION) {
putchar('\n');
GrowlQuotation *inner = growl_unwrap_quotation(constant);
disassemble(vm, inner, indent + 1);
return offset + bytes_read;
}
}
}
putchar('\n');
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(CALL);
OPCODE1(CALL_NEXT);
OPCODE1(TAIL_CALL);
OPCODE(WORD) {
intptr_t idx;
size_t bytes_read = growl_sleb128_peek(&quot->data[offset], &idx);
printf("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);
printf("TAIL_WORD %s\n", vm->defs.data[idx].name);
return offset + bytes_read;
}
OPCODE1(RETURN);
OPCODE1(COMPOSE);
OPCODE1(CURRY);
OPCODE1(PPRINT);
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);
}

34
next/core/gc.c
View file

@ -9,6 +9,7 @@
#include <stdlib.h>
#include <string.h>
#define GC_DEBUG 0
#define ALIGN(n) (((n) + 7) & ~7)
static int in_from(GrowlVM *vm, void *ptr) {
@ -54,13 +55,14 @@ GrowlObjectHeader *growl_gc_alloc(GrowlVM *vm, size_t size) {
}
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->arena, size, 8, 1);
GrowlObjectHeader *hdr = growl_arena_alloc(&vm->tenured, size, 8, 1);
hdr->size = size;
return hdr;
}
@ -110,24 +112,32 @@ static void scan(GrowlVM *vm, GrowlObjectHeader *hdr) {
}
}
#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->arena.free - vm->arena.start;
size_t tenured_total = vm->arena.end - vm->arena.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,
nursery_total, (double)tenured_used / (double)tenured_total * 100.0);
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
for (size_t i = 0; i < GROWL_STACK_SIZE; ++i) {
vm->wst[i] = forward(vm, vm->wst[i]);
@ -137,11 +147,11 @@ void growl_gc_collect(GrowlVM *vm) {
*vm->roots[i] = forward(vm, *vm->roots[i]);
}
uint8_t *arena_scan = vm->arena.start;
while (arena_scan < vm->arena.free) {
GrowlObjectHeader *hdr = (GrowlObjectHeader *)arena_scan;
uint8_t *tenured_scan = vm->tenured.start;
while (tenured_scan < vm->tenured.free) {
GrowlObjectHeader *hdr = (GrowlObjectHeader *)tenured_scan;
scan(vm, hdr);
arena_scan += ALIGN(hdr->size);
tenured_scan += ALIGN(hdr->size);
}
while (gc_scan < vm->to.free) {
@ -170,14 +180,16 @@ void growl_gc_collect(GrowlVM *vm) {
gc_scan += ALIGN(hdr->size);
}
GrowlGCArena tmp = vm->from;
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 finished\n");
fprintf(stderr, ">>> garbage collection done\n");
#endif
}
void growl_gc_root(GrowlVM *vm, Growl *ptr) {
@ -185,7 +197,7 @@ void growl_gc_root(GrowlVM *vm, Growl *ptr) {
size_t cap = vm->root_capacity == 0 ? 16 : vm->root_capacity * 2;
Growl **data = realloc(vm->roots, cap * sizeof(Growl *));
if (!data) {
fprintf(stderr, "expanding roots array: oom\n");
fprintf(stderr, "roots: oom\n");
abort();
}
vm->root_capacity = cap;

71
next/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
next/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 = getc_ws(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);
}
}

20
next/core/opcodes.h
View file

@ -20,7 +20,27 @@ enum GrowlOpcode {
GOP_CALL,
GOP_CALL_NEXT,
GOP_TAIL_CALL,
GOP_WORD,
GOP_TAIL_WORD,
GOP_RETURN,
GOP_COMPOSE,
GOP_CURRY,
GOP_PPRINT,
GOP_ADD,
GOP_MUL,
GOP_SUB,
GOP_DIV,
GOP_MOD,
GOP_BAND,
GOP_BOR,
GOP_BXOR,
GOP_BNOT,
GOP_EQ,
GOP_NEQ,
GOP_LT,
GOP_LTE,
GOP_GT,
GOP_GTE,
};
#endif // GROWL_OPCODES_H

82
next/core/print.c Normal file
View file

@ -0,0 +1,82 @@
#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(const char *data, size_t len) {
putchar('"');
for (size_t i = 0; i < len; ++i) {
switch (data[i]) {
case '\0':
putchar('\\');
putchar('0');
break;
case '\t':
putchar('\\');
putchar('t');
break;
case '\n':
putchar('\\');
putchar('n');
break;
case '\r':
putchar('\\');
putchar('r');
break;
case '\b':
putchar('\\');
putchar('b');
break;
case '\v':
putchar('\\');
putchar('v');
break;
case '\f':
putchar('\\');
putchar('f');
break;
case '\x1b':
putchar('\\');
putchar('e');
break;
case '\\':
putchar('\\');
putchar('\\');
break;
case '"':
putchar('\\');
putchar('"');
break;
default:
putchar(data[i]);
break;
}
}
putchar('"');
}
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(str->data, str->len);
break;
}
default:
fprintf(file, "<object type=%" PRIu32 " @ %p>", hdr->type, hdr);
break;
}
}
}

11
next/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);
}

7
next/core/value.c
View file

@ -9,3 +9,10 @@ uint32_t growl_type(Growl obj) {
return hdr->type;
}
int growl_equals(Growl a, Growl b) {
if (a != b)
return 0;
if (growl_type(a) != growl_type(b))
return 0;
return 1;
}

190
next/core/vm.c
View file

@ -10,39 +10,40 @@
#include <stdio.h>
GrowlVM *growl_vm_init(void) {
GrowlVM *mem = malloc(sizeof(GrowlVM));
if (mem == NULL) {
GrowlVM *vm = calloc(1, sizeof(GrowlVM));
if (vm == NULL) {
abort();
}
growl_arena_init(&mem->from, GROWL_HEAP_SIZE);
growl_arena_init(&mem->to, GROWL_HEAP_SIZE);
growl_arena_init(&mem->arena, GROWL_ARENA_SIZE);
growl_arena_init(&mem->scratch, GROWL_SCRATCH_SIZE);
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);
mem->sp = mem->wst;
mem->rsp = mem->rst;
mem->csp = mem->cst;
vm->dictionary = NULL;
for (size_t i = 0; i < GROWL_STACK_SIZE; ++i) {
mem->wst[i] = 0;
mem->rst[i] = 0;
}
vm->sp = vm->wst;
vm->rsp = vm->rst;
vm->csp = vm->cst;
mem->roots = NULL;
mem->root_count = 0;
mem->root_capacity = 0;
vm->roots = NULL;
vm->root_count = 0;
vm->root_capacity = 0;
// TODO: initialize compose trampoline
static uint8_t trampoline_code[] = {GOP_CALL_NEXT};
Growl trampoline = growl_make_quotation(vm, trampoline_code, 1, NULL, 0);
vm->compose_trampoline = (GrowlQuotation *)(GROWL_UNBOX(trampoline) + 1);
return mem;
return vm;
}
void growl_vm_free(GrowlVM *vm) {
growl_arena_free(&vm->from);
growl_arena_free(&vm->to);
growl_arena_free(&vm->arena);
growl_arena_free(&vm->tenured);
growl_arena_free(&vm->scratch);
growl_arena_free(&vm->arena);
if (vm->roots != NULL)
free(vm->roots);
free(vm);
@ -98,6 +99,7 @@ static void callstack_push(GrowlVM *vm, GrowlQuotation *q, uint8_t *ip) {
vm_error(vm, "call stack overflow");
vm->csp->quot = q;
vm->csp->ip = ip;
vm->csp->next = GROWL_NIL;
vm->csp++;
}
@ -107,12 +109,22 @@ static GrowlFrame callstack_pop(GrowlVM *vm) {
return *--vm->csp;
}
static void root_constants(GrowlVM *vm, GrowlQuotation *quot) {
GrowlTuple *constants = growl_unwrap_tuple(quot->constants);
if (constants != NULL) {
for (size_t i = 0; i < constants->count; ++i) {
growl_gc_root(vm, &constants->data[i]);
}
}
}
static inline void dispatch(GrowlVM *vm, Growl obj) {
for (;;) {
switch (growl_type(obj)) {
case GROWL_TYPE_QUOTATION: {
GrowlQuotation *q = (GrowlQuotation *)(GROWL_UNBOX(obj) + 1);
vm->quotation = q;
root_constants(vm, q);
vm->current_quotation = q;
vm->ip = q->data;
return;
}
@ -134,7 +146,8 @@ static inline void dispatch(GrowlVM *vm, Growl obj) {
}
}
}
int vm_doquot(GrowlVM *vm, GrowlQuotation *quot) {
int growl_vm_execute(GrowlVM *vm, GrowlQuotation *quot) {
size_t gc_mark = growl_gc_mark(vm);
int result = setjmp(vm->error);
@ -143,15 +156,10 @@ int vm_doquot(GrowlVM *vm, GrowlQuotation *quot) {
return result;
}
GrowlTuple *constants = growl_unwrap_tuple(quot->constants);
if (constants != NULL) {
for (size_t i = 0; i < constants->count; ++i) {
growl_gc_root(vm, &constants->data[i]);
}
}
root_constants(vm, quot);
vm->ip = quot->data;
vm->quotation = quot;
vm->current_quotation = quot;
// clang-format off
#define VM_START() for (;;) { uint8_t opcode; switch(opcode = *vm->ip++) {
@ -169,10 +177,16 @@ int vm_doquot(GrowlVM *vm, GrowlQuotation *quot) {
}
VM_OP(PUSH_CONSTANT) {
intptr_t idx = growl_sleb128_decode(&vm->ip);
GrowlTuple *constants =
growl_unwrap_tuple(vm->current_quotation->constants);
if (constants != NULL) {
growl_push(vm, constants->data[idx]);
if (idx >= 0 && (size_t)idx < constants->count) {
growl_push(vm, constants->data[idx]);
} else {
vm_error(vm, "constant index %" PRIdPTR " out of bounds", idx);
}
} else {
vm_error(vm, "constant index %" PRIdPTR " out of bounds", idx);
vm_error(vm, "attempt to index nil constant table");
}
VM_NEXT();
}
@ -231,14 +245,6 @@ int vm_doquot(GrowlVM *vm, GrowlQuotation *quot) {
growl_push(vm, b);
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(DIG) {
Growl c = growl_pop(vm);
Growl b = growl_pop(vm);
@ -248,15 +254,23 @@ int vm_doquot(GrowlVM *vm, GrowlQuotation *quot) {
growl_push(vm, a);
VM_NEXT();
}
VM_OP(CALL) { // TODO: compose and curry
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(CALL) {
Growl obj = growl_pop(vm);
callstack_push(vm, vm->quotation, vm->ip);
callstack_push(vm, vm->current_quotation, vm->ip);
dispatch(vm, obj);
VM_NEXT();
}
VM_OP(CALL_NEXT) {
growl_push(vm, vm->next);
vm->next = GROWL_NIL;
growl_push(vm, vm->compose_next);
vm->compose_next = GROWL_NIL;
__attribute__((__fallthrough__));
}
VM_OP(TAIL_CALL) {
@ -264,16 +278,106 @@ int vm_doquot(GrowlVM *vm, GrowlQuotation *quot) {
dispatch(vm, obj);
VM_NEXT();
}
VM_OP(WORD) {
intptr_t idx = growl_sleb128_decode(&vm->ip);
GrowlDefinition *def = &vm->defs.data[idx];
Growl word = GROWL_BOX((GrowlObjectHeader *)(def->quotation) - 1);
callstack_push(vm, vm->current_quotation, vm->ip);
dispatch(vm, word);
VM_NEXT();
}
VM_OP(TAIL_WORD) {
intptr_t idx = growl_sleb128_decode(&vm->ip);
GrowlDefinition *def = &vm->defs.data[idx];
Growl word = GROWL_BOX((GrowlObjectHeader *)(def->quotation) - 1);
dispatch(vm, word);
VM_NEXT();
}
VM_OP(RETURN) {
if (vm->csp != vm->cst) {
GrowlFrame frame = callstack_pop(vm);
vm->quotation = frame.quot;
vm->current_quotation = frame.quot;
vm->ip = frame.ip;
vm->compose_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)
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)
vm_error(vm, "attempt to curry with a non-callable");
growl_push(vm, curried);
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 { \
vm_error(vm, "arithmetic 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)
vm_error(vm, "division by zero");
growl_push(vm, GROWL_NUM(GROWL_ORD(a) / GROWL_ORD(b)));
} else {
vm_error(vm, "arithmetic 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)
vm_error(vm, "division by zero");
growl_push(vm, GROWL_NUM(GROWL_ORD(a) % GROWL_ORD(b)));
} else {
vm_error(vm, "arithmetic 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 {
vm_error(vm, "arithmetic on non-numbers");
}
VM_NEXT();
}
VM_DEFAULT() { vm_error(vm, "unknown opcode %d", opcode); }
VM_END()