diff --git a/Makefile b/Makefile index d98eb580..03e06ab5 100644 --- a/Makefile +++ b/Makefile @@ -26,12 +26,12 @@ PREFIX?=/usr/local BINDIR=$(PREFIX)/bin VERSION=\"0.0.0-beta\" -CFLAGS=-std=c99 -Wall -Wextra -I./include -I./libs -g -fsanitize=address -DDST_VERSION=$(VERSION) +CFLAGS=-std=c99 -Wall -Wextra -I./include -I./libs -g -fsanitize=address -DDST_VERSION=$(VERSION) PREFIX=/usr/local DST_TARGET=dst DST_XXD=xxd DEBUGGER=lldb -DST_INTERNAL_HEADERS=$(addprefix core/,symcache.h opcodes.h strtod.h compile.h gc.h sourcemap.h) +DST_INTERNAL_HEADERS=$(addprefix core/,symcache.h opcodes.h strtod.h compile.h gc.h sourcemap.h vector.h) DST_HEADERS=$(addprefix include/dst/,dst.h dstconfig.h dsttypes.h dststate.h dststl.h) ############################# @@ -48,9 +48,9 @@ all: $(DST_TARGET) DST_CORE_SOURCES=$(addprefix core/,\ abstract.c array.c asm.c buffer.c compile.c\ - fiber.c func.c gc.c math.c parse.c sourcemap.c string.c\ + fiber.c gc.c math.c parse.c sourcemap.c string.c\ stl.c strtod.c struct.c symcache.c table.c tuple.c util.c\ - value.c vm.c wrap.c) + value.c vector.c vm.c wrap.c) DST_CLIENT_SOURCES=$(addprefix client/,\ main.c) @@ -58,29 +58,6 @@ DST_CLIENT_SOURCES=$(addprefix client/,\ $(DST_TARGET): $(DST_CORE_SOURCES) $(DST_CLIENT_SOURCES) $(DST_ALL_HEADERS) $(CC) $(CFLAGS) $(DST_CORE_SOURCES) $(DST_CLIENT_SOURCES) -o $(DST_TARGET) -###################### -##### Unit Tests ##### -###################### - -CCU_FLAGS = $(CFLAGS) -DDST_UNIT_TEST - -DST_UNIT_BINARIES=$(addprefix unittests/,\ - asm_test.out array_test.out buffer_test.out compile_test.out fiber_test.out \ - parse_test.out strtod_test.out table_test.out) - -%.out: %.c $(DST_CORE_OBJECTS) $(DST_ALL_HEADERS) unittests/unit.h - $(CC) $(CCU_FLAGS) $(DST_CORE_OBJECTS) $< -o $@ - -unit: $(DST_UNIT_BINARIES) - unittests/array_test.out - unittests/asm_test.out - unittests/buffer_test.out - unittests/compile_test.out - unittests/fiber_test.out - unittests/parse_test.out - unittests/strtod_test.out - unittests/table_test.out - ################### ##### Testing ##### ################### @@ -95,7 +72,7 @@ valgrind: $(DST_TARGET) @ valgrind --leak-check=full -v ./$(DST_TARGET) test: $(DST_TARGET) - @ ./$(DST_TARGET) dsttests/basic.dst + @ ./$(DST_TARGET) dsttest/suite0.dst valtest: $(DST_TARGET) valgrind --leak-check=full -v ./$(DST_TARGET) dsttests/basic.dst diff --git a/core/array.c b/core/array.c index 8b7d8b40..befe16d5 100644 --- a/core/array.c +++ b/core/array.c @@ -66,8 +66,11 @@ void dst_array_setcount(DstArray *array, int32_t count) { if (count < 0) return; if (count > array->count) { + int32_t i; dst_array_ensure(array, count + 1); - dst_memempty(array->data + array->count, count - array->count); + for (i = array->count; i < count; i++) { + array->data[i] = dst_wrap_nil(); + } } array->count = count; } diff --git a/core/asm.c b/core/asm.c index f0510d92..f0a13dbc 100644 --- a/core/asm.c +++ b/core/asm.c @@ -90,11 +90,12 @@ struct DstAssembler { DstFuncDef *def; jmp_buf on_error; const uint8_t *errmessage; - const uint8_t *name; int32_t environments_capacity; + int32_t defs_capacity; int32_t bytecode_count; /* Used for calculating labels */ + DstValue name; DstTable labels; /* symbol -> bytecode index */ DstTable constants; /* symbol -> constant index */ DstTable slots; /* symbol -> slot index */ @@ -166,39 +167,6 @@ static const DstInstructionDef dst_ops[] = { {"typecheck", DIT_ST, DOP_TYPECHECK}, }; -/* Compare a DST string to a native 0 terminated c string. Used in the - * binary search for the instruction definition. */ -static int dst_strcompare(const uint8_t *str, const char *other) { - int32_t len = dst_string_length(str); - int32_t index; - for (index = 0; index < len; index++) { - uint8_t c = str[index]; - uint8_t k = ((const uint8_t *)other)[index]; - if (c < k) return -1; - if (c > k) return 1; - if (k == '\0') break; - } - return (other[index] == '\0') ? 0 : -1; -} - -/* Find an instruction definition given its name */ -static const DstInstructionDef *dst_findi(const uint8_t *key) { - const DstInstructionDef *low = dst_ops; - const DstInstructionDef *hi = dst_ops + (sizeof(dst_ops) / sizeof(DstInstructionDef)); - while (low < hi) { - const DstInstructionDef *mid = low + ((hi - low) / 2); - int comp = dst_strcompare(key, mid->name); - if (comp < 0) { - hi = mid; - } else if (comp > 0) { - low = mid + 1; - } else { - return mid; - } - } - return NULL; -} - /* Check a dst string against a bunch of test_strings. Return the * index of the matching test_string, or -1 if not found. */ static int32_t strsearch(const uint8_t *str, const char **test_strings) { @@ -246,31 +214,36 @@ static void dst_asm_errorv(DstAssembler *a, const uint8_t *m) { * to reference outer function environments, and may change the outer environment. * Returns the index of the environment in the assembler's environments, or -1 * if not found. */ -/*static int32_t dst_asm_addenv(DstAssembler *a, DstValue envname) {*/ - /*DstValue check;*/ - /*DstFuncDef *def = a->def;*/ - /*int32_t oldlen;*/ - /*int64_t res;*/ - /*[> Check for memoized value <]*/ - /*check = dst_table_get(&a->envs, envname);*/ - /*if (!dst_checktype(check, DST_NIL)) return dst_unwrap_integer(check);*/ - /*if (NULL == a->parent) return -1;*/ - /*res = dst_asm_addenv(a->parent, envname);*/ - /*if (res < 0)*/ - /*return res;*/ - /*oldlen = def->environments_length;*/ - /*dst_table_put(&a->envs, envname, dst_wrap_integer(def->environments_length));*/ - /*if (oldlen >= a->environments_capacity) {*/ - /*int32_t newcap = 2 + 2 * oldlen;*/ - /*def->environments = realloc(def->environments, newcap * sizeof(int32_t));*/ - /*if (NULL == def->environments) {*/ - /*DST_OUT_OF_MEMORY;*/ - /*}*/ - /*a->environments_capacity = newcap;*/ - /*}*/ - /*def->environments[def->environments_length++] = (int32_t) res;*/ - /*return (int32_t) oldlen;*/ -/*}*/ +static int32_t dst_asm_addenv(DstAssembler *a, DstValue envname) { + DstValue check; + DstFuncDef *def = a->def; + int32_t envindex; + int32_t res; + if (dst_equals(a->name, envname)) { + return 0; + } + /* Check for memoized value */ + check = dst_table_get(&a->envs, envname); + if (dst_checktype(check, DST_INTEGER)) return dst_unwrap_integer(check); + if (NULL == a->parent) return -1; + res = dst_asm_addenv(a->parent, envname); + if (res < 0) + return res; + envindex = def->environments_length; + if (envindex == 0) envindex = 1; + dst_table_put(&a->envs, envname, dst_wrap_integer(envindex)); + if (envindex >= a->environments_capacity) { + int32_t newcap = 2 * envindex; + def->environments = realloc(def->environments, newcap * sizeof(int32_t)); + if (NULL == def->environments) { + DST_OUT_OF_MEMORY; + } + a->environments_capacity = newcap; + } + def->environments[envindex] = (int32_t) res; + def->environments_length = envindex + 1; + return envindex; +} /* Parse an argument to an assembly instruction, and return the result as an * integer. This integer will need to be bounds checked. */ @@ -348,6 +321,13 @@ static int32_t doarg_1( } else { goto error; } + if (argtype == DST_OAT_ENVIRONMENT && ret == -1) { + /* Add a new env */ + ret = dst_asm_addenv(a, x); + if (ret < 0) { + dst_asm_errorv(a, dst_formatc("unknown environment %q", x)); + } + } break; } } @@ -530,14 +510,15 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts) a.def = def; a.parent = parent; a.errmessage = NULL; - a.name = NULL; a.environments_capacity = 0; a.bytecode_count = 0; - dst_table_init(&a.labels, 10); - dst_table_init(&a.constants, 10); - dst_table_init(&a.slots, 10); - dst_table_init(&a.envs, 10); - dst_table_init(&a.defs, 10); + a.defs_capacity = 0; + a.name = dst_wrap_nil(); + dst_table_init(&a.labels, 0); + dst_table_init(&a.constants, 0); + dst_table_init(&a.slots, 0); + dst_table_init(&a.envs, 0); + dst_table_init(&a.defs, 0); /* Set error jump */ if (setjmp(a.on_error)) { @@ -557,8 +538,7 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts) "expected struct or table for assembly source"); /* Check for function name */ - x = dst_get(s, dst_csymbolv("name")); - if (dst_checktype(x, DST_SYMBOL)) a.name = dst_unwrap_symbol(x); + a.name = dst_get(s, dst_csymbolv("name")); /* Set function arity */ x = dst_get(s, dst_csymbolv("arity")); @@ -613,11 +593,11 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts) const DstValue *t = dst_unwrap_tuple(ct); int32_t tcount = dst_tuple_length(t); const uint8_t *macro = dst_unwrap_symbol(t[0]); - if (0 == dst_strcompare(macro, "quote")) { + if (0 == dst_cstrcmp(macro, "quote")) { def->constants[i] = t[1]; } else if (tcount == 3 && dst_checktype(t[1], DST_SYMBOL) && - 0 == dst_strcompare(macro, "def")) { + 0 == dst_cstrcmp(macro, "def")) { def->constants[i] = t[2]; dst_table_put(&a.constants, t[1], dst_wrap_integer(i)); } else { @@ -633,10 +613,37 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts) } /* Parse sub funcdefs */ - /*x = dst_get(s, dst_csymbolv("closures"));*/ - /*if (dst_seq_view(x, &arr, &count)) {*/ - - /*}*/ + x = dst_get(s, dst_csymbolv("closures")); + if (dst_seq_view(x, &arr, &count)) { + int32_t i; + for (i = 0; i < count; i++) { + DstAssembleResult subres; + DstAssembleOptions subopts; + DstValue subname; + int32_t newlen; + subopts.source = arr[i]; + subopts.flags = opts.flags; + subres = dst_asm1(&a, subopts); + if (subres.status != DST_ASSEMBLE_OK) { + dst_asm_errorv(&a, subres.error); + } + subname = dst_get(arr[i], dst_csymbolv("name")); + if (!dst_checktype(subname, DST_NIL)) { + dst_table_put(&a.defs, subname, dst_wrap_integer(def->defs_length)); + } + newlen = def->defs_length + 1; + if (a.defs_capacity < newlen) { + int32_t newcap = newlen; + def->defs = realloc(def->defs, newcap * sizeof(DstFuncDef *)); + if (NULL == def->defs) { + DST_OUT_OF_MEMORY; + } + a.defs_capacity = newcap; + } + def->defs[def->defs_length] = subres.funcdef; + def->defs_length = newlen; + } + } /* Parse bytecode and labels */ x = dst_get(s, dst_csymbolv("bytecode")); @@ -675,7 +682,11 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts) } else { dst_asm_assert(&a, dst_checktype(t[0], DST_SYMBOL), "expected symbol in assembly instruction"); - idef = dst_findi(dst_unwrap_symbol(t[0])); + idef = dst_strbinsearch( + &dst_ops, + sizeof(dst_ops)/sizeof(DstInstructionDef), + sizeof(DstInstructionDef), + dst_unwrap_symbol(t[0])); if (NULL == idef) dst_asm_errorv(&a, dst_formatc("unknown instruction %v", instr)); op = read_instruction(&a, idef, t); diff --git a/core/compile.c b/core/compile.c index 459d6ca8..8bf534aa 100644 --- a/core/compile.c +++ b/core/compile.c @@ -25,9 +25,14 @@ #include "compile.h" #include "gc.h" #include "sourcemap.h" +#include "vector.h" -/* Throw an error with a dst string */ -void dst_compile_error(DstCompiler *c, const DstValue *sourcemap, const uint8_t *m) { +/* Throw an error with a dst string. */ +void dstc_error(DstCompiler *c, const DstValue *sourcemap, const uint8_t *m) { + /* Don't override first error */ + if (c->result.status == DST_COMPILE_ERROR) { + return; + } if (NULL != sourcemap) { c->result.error_start = dst_unwrap_integer(sourcemap[0]); c->result.error_end = dst_unwrap_integer(sourcemap[1]); @@ -35,18 +40,18 @@ void dst_compile_error(DstCompiler *c, const DstValue *sourcemap, const uint8_t c->result.error_start = -1; c->result.error_end = -1; } + c->result.status = DST_COMPILE_ERROR; c->result.error = m; - longjmp(c->on_error, 1); } /* Throw an error with a message in a cstring */ -void dst_compile_cerror(DstCompiler *c, const DstValue *sourcemap, const char *m) { - dst_compile_error(c, sourcemap, dst_cstring(m)); +void dstc_cerror(DstCompiler *c, const DstValue *sourcemap, const char *m) { + dstc_error(c, sourcemap, dst_cstring(m)); } /* Use these to get sub options. They will traverse the source map so * compiler errors make sense. Then modify the returned options. */ -DstFormOptions dst_compile_getopts_index(DstFormOptions opts, int32_t index) { +DstFormOptions dstc_getindex(DstFormOptions opts, int32_t index) { const DstValue *sourcemap = dst_sourcemap_index(opts.sourcemap, index); DstValue nextval = dst_getindex(opts.x, index); opts.x = nextval; @@ -56,7 +61,7 @@ DstFormOptions dst_compile_getopts_index(DstFormOptions opts, int32_t index) { } /* Index into the key of a table or struct */ -DstFormOptions dst_compile_getopts_key(DstFormOptions opts, DstValue key) { +DstFormOptions dstc_getkey(DstFormOptions opts, DstValue key) { const DstValue *sourcemap = dst_sourcemap_key(opts.sourcemap, key); opts.x = key; opts.sourcemap = sourcemap; @@ -65,7 +70,7 @@ DstFormOptions dst_compile_getopts_key(DstFormOptions opts, DstValue key) { } /* Index into the value of a table or struct */ -DstFormOptions dst_compile_getopts_value(DstFormOptions opts, DstValue key) { +DstFormOptions dstc_getvalue(DstFormOptions opts, DstValue key) { const DstValue *sourcemap = dst_sourcemap_value(opts.sourcemap, key); DstValue nextval = dst_get(opts.x, key); opts.x = nextval; @@ -74,36 +79,31 @@ DstFormOptions dst_compile_getopts_value(DstFormOptions opts, DstValue key) { return opts; } +/* Check error */ +static int dstc_iserr(DstFormOptions *opts) { + return (opts->compiler->result.status == DST_COMPILE_ERROR); +} + /* Allocate a slot index */ -static int32_t slotalloc_index(DstCompiler *c) { - DstScope *scope = dst_compile_topscope(c); +static int32_t dstc_lsloti(DstCompiler *c) { + DstScope *scope = &dst_v_last(c->scopes); /* Get the nth bit in the array */ - int32_t i, biti; + int32_t i, biti, len; biti = -1; - for (i = 0; i < scope->scap; i++) { + len = dst_v_count(scope->slots); + for (i = 0; i < len; i++) { uint32_t block = scope->slots[i]; - if (block != 0xFFFFFFFF) { - biti = i << 5; /* + clz(block) */ - while (block & 1) { - biti++; - block >>= 1; - } - break; + if (block == 0xFFFFFFFF) continue; + biti = i << 5; /* + clz(block) */ + while (block & 1) { + biti++; + block >>= 1; } + break; } if (biti == -1) { - int32_t j; - int32_t newcap = scope->scap * 2 + 1; - scope->slots = realloc(scope->slots, sizeof(int32_t) * newcap); - if (NULL == scope->slots) { - DST_OUT_OF_MEMORY; - } - for (j = scope->scap; j < newcap; j++) { - /* Preallocate slots 0xF0 through 0xFF. */ - scope->slots[j] = j == 7 ? 0xFFFF0000 : 0x00000000; - } - biti = scope->scap << 5; - scope->scap = newcap; + dst_v_push(scope->slots, len == 7 ? 0xFFFF0000 : 0); + biti = len << 5; } /* set the bit at index biti */ scope->slots[biti >> 5] |= 1 << (biti & 0x1F); @@ -113,171 +113,114 @@ static int32_t slotalloc_index(DstCompiler *c) { } /* Free a slot index */ -static void slotfree_index(DstCompiler *c, int32_t index) { - DstScope *scope = dst_compile_topscope(c); +static void dstc_sfreei(DstCompiler *c, int32_t index) { + DstScope *scope = &dst_v_last(c->scopes); /* Don't free the pre allocated slots */ - if (index >= 0 && (index < 0xF0 || index > 0xFF) && index < (scope->scap << 5)) + if (index >= 0 && (index < 0xF0 || index > 0xFF) && + index < (dst_v_count(scope->slots) << 5)) scope->slots[index >> 5] &= ~(1 << (index & 0x1F)); } -/* Helper */ -static int32_t slotalloc_temp(DstCompiler *c, int32_t max, int32_t nth) { - int32_t ret = slotalloc_index(c); +/* Allocate a local near (n) slot and return its index. Slot + * has maximum index max. Common value for max would be 0xFF, + * the highest slot index representable with one byte. */ +static int32_t dstc_lslotn(DstCompiler *c, int32_t max, int32_t nth) { + int32_t ret = dstc_lsloti(c); if (ret > max) { - slotfree_index(c, ret); + dstc_sfreei(c, ret); ret = 0xF0 + nth; } return ret; } /* Free a slot */ -void dst_compile_freeslot(DstCompiler *c, DstSlot s) { +void dstc_freeslot(DstCompiler *c, DstSlot s) { if (s.flags & (DST_SLOT_CONSTANT | DST_SLOT_NAMED)) return; if (s.envindex > 0) return; - slotfree_index(c, s.index); -} - -/* Find a slot given a symbol. Return 1 if found, otherwise 0. */ -static int slotsymfind(DstScope *scope, const uint8_t *sym, DstSlot *out) { - int32_t i; - for (i = 0; i < scope->symcount; i++) { - if (scope->syms[i].sym == sym) { - *out = scope->syms[i].slot; - out->flags |= DST_SLOT_NAMED; - return 1; - } - } - return 0; + dstc_sfreei(c, s.index); } /* Add a slot to a scope with a symbol associated with it (def or var). */ -static void slotsym(DstCompiler *c, const uint8_t *sym, DstSlot s) { - DstScope *scope = dst_compile_topscope(c); - int32_t index = scope->symcount; - int32_t newcount = index + 1; - if (newcount > scope->symcap) { - int32_t newcap = 2 * newcount; - scope->syms = realloc(scope->syms, newcap * sizeof(scope->syms[0])); - if (NULL == scope->syms) { - DST_OUT_OF_MEMORY; - } - scope->symcap = newcap; - } - scope->symcount = newcount; - scope->syms[index].sym = sym; - scope->syms[index].slot = s; +static void dstc_nameslot(DstCompiler *c, const uint8_t *sym, DstSlot s) { + DstScope *scope = &dst_v_last(c->scopes); + SymPair sp; + sp.sym = sym; + sp.slot = s; + sp.slot.flags |= DST_SLOT_NAMED; + dst_v_push(scope->syms, sp); } /* Add a constant to the current scope. Return the index of the constant. */ -static int32_t addconst(DstCompiler *c, const DstValue *sourcemap, DstValue x) { - DstScope *scope = dst_compile_topscope(c); - int32_t i, index, newcount; +static int32_t dstc_const(DstCompiler *c, const DstValue *sourcemap, DstValue x) { + DstScope *scope = &dst_v_last(c->scopes); + int32_t i, len; /* Get the topmost function scope */ while (scope > c->scopes) { if (scope->flags & DST_SCOPE_FUNCTION) break; scope--; } - for (i = 0; i < scope->ccount; i++) { + /* Check if already added */ + len = dst_v_count(scope->consts); + for (i = 0; i < len; i++) { if (dst_equals(x, scope->consts[i])) return i; } - if (scope->ccount >= 0xFFFF) - dst_compile_cerror(c, sourcemap, "too many constants"); - index = scope->ccount; - newcount = index + 1; - if (newcount > scope->ccap) { - int32_t newcap = 2 * newcount; - scope->consts = realloc(scope->consts, newcap * sizeof(DstValue)); - if (NULL == scope->consts) { - DST_OUT_OF_MEMORY; - } - scope->ccap = newcap; + /* Ensure not too many constsants. */ + if (len >= 0xFFFF) { + dstc_cerror(c, sourcemap, "too many constants"); + return 0; } - scope->consts[index] = x; - scope->ccount = newcount; - return index; + dst_v_push(scope->consts, x); + return len; } /* Enter a new scope */ -void dst_compile_scope(DstCompiler *c, int flags) { - int32_t newcount, oldcount; - DstScope *scope; - oldcount = c->scopecount; - newcount = oldcount + 1; - if (newcount > c->scopecap) { - int32_t newcap = 2 * newcount; - c->scopes = realloc(c->scopes, newcap * sizeof(DstScope)); - if (NULL == c->scopes) { - DST_OUT_OF_MEMORY; - } - c->scopecap = newcap; - } - scope = c->scopes + oldcount; - c->scopecount = newcount; - - /* Initialize the scope */ - - scope->consts = NULL; - scope->ccap = 0; - scope->ccount = 0; - - scope->syms = NULL; - scope->symcount = 0; - scope->symcap = 0; - - scope->envs = NULL; - scope->envcount = 0; - scope->envcap = 0; - - scope->defs = NULL; - scope->dcount = 0; - scope->dcap = 0; - - scope->bytecode_start = c->buffercount; - - /* Initialize slots */ - scope->slots = NULL; - scope->scap = 0; - scope->smax = -1; +void dstc_scope(DstCompiler *c, int flags) { + DstScope scope; + scope.consts = NULL; + scope.syms = NULL; + scope.envs = NULL; + scope.defs = NULL; + scope.slots = NULL; + scope.smax = -1; + scope.bytecode_start = dst_v_count(c->buffer); + scope.flags = flags; /* Inherit slots */ - if ((!(flags & DST_SCOPE_FUNCTION)) && oldcount) { - DstScope *oldscope = c->scopes + oldcount - 1; - size_t size = sizeof(int32_t) * oldscope->scap; - scope->smax = oldscope->smax; - scope->scap = oldscope->scap; - if (size) { - scope->slots = malloc(size); - if (NULL == scope->slots) { - DST_OUT_OF_MEMORY; - } - } + if ((!(flags & DST_SCOPE_FUNCTION)) && dst_v_count(c->scopes)) { + DstScope *oldscope = &dst_v_last(c->scopes); + scope.smax = oldscope->smax; + scope.slots = dst_v_copy(oldscope->slots); } - scope->flags = flags; + dst_v_push(c->scopes, scope); } /* Leave a scope. */ -void dst_compile_popscope(DstCompiler *c) { - DstScope *scope; - dst_assert(c->scopecount, "could not pop scope"); - scope = c->scopes + --c->scopecount; +void dstc_popscope(DstCompiler *c) { + DstScope scope; + int32_t oldcount = dst_v_count(c->scopes); + dst_assert(oldcount, "could not pop scope"); + scope = dst_v_last(c->scopes); /* Move free slots to parent scope if not a new function. * We need to know the total number of slots used when compiling the function. */ - if (!(scope->flags & (DST_SCOPE_FUNCTION | DST_SCOPE_UNUSED)) && c->scopecount) { - DstScope *newscope = dst_compile_topscope(c); - if (newscope->smax < scope->smax) - newscope->smax = scope->smax; + if (!(scope.flags & (DST_SCOPE_FUNCTION | DST_SCOPE_UNUSED)) && oldcount > 1) { + DstScope *newscope = &dst_v_last(c->scopes); + if (newscope->smax < scope.smax) + newscope->smax = scope.smax; } - free(scope->consts); - free(scope->slots); - free(scope->syms); - free(scope->envs); - free(scope->defs); + /* Free the scope */ + dst_v_free(scope.consts); + dst_v_free(scope.syms); + dst_v_free(scope.envs); + dst_v_free(scope.defs); + dst_v_free(scope.slots); + dst_v_pop(c->scopes); } -DstSlot dst_compile_constantslot(DstValue x) { +/* Create a slot with a constant */ +DstSlot dstc_cslot(DstValue x) { DstSlot ret; ret.flags = (1 << dst_type(x)) | DST_SLOT_CONSTANT; ret.index = -1; @@ -286,100 +229,56 @@ DstSlot dst_compile_constantslot(DstValue x) { return ret; } -/* Free a single slot */ - -/* - * The mechanism for passing environments to closures is a bit complicated, - * but ensures a few properties. - * * Environments are on the stack unless they need to be closurized - * * Environments can be shared between closures - * * A single closure can access any of multiple parent environments in constant time (no linked lists) - * - * FuncDefs all have a list of a environment indices that are inherited from the - * parent function, as well as a flag indicating if the closures own stack variables - * are needed in a nested closure. The list of indices says which of the parent environments - * go into which environment slot for the new closure. This allows closures to use whatever environments - * they need to, as well as pass these environments to sub closures. To access the direct parent's environment, - * the FuncDef must copy the 0th parent environment. If a closure does not need to export it's own stack - * variables for creating closures, it must keep the 0th entry in the env table to NULL. - * - * TODO - check if this code is bottle neck and search for better data structures. - */ -static DstSlot checkglobal(DstCompiler *c, const DstValue *sourcemap, const uint8_t *sym) { - DstValue check = dst_get(c->env, dst_wrap_symbol(sym)); - DstValue ref; - if (!(dst_checktype(check, DST_STRUCT) || dst_checktype(check, DST_TABLE))) { - dst_compile_error(c, sourcemap, dst_formatc("unknown symbol %q", sym)); - } - ref = dst_get(check, dst_csymbolv("ref")); - if (dst_checktype(ref, DST_ARRAY)) { - DstSlot ret = dst_compile_constantslot(ref); - /* TODO save type info */ - ret.flags |= DST_SLOT_REF | DST_SLOT_NAMED | DST_SLOT_MUTABLE | DST_SLOTTYPE_ANY; - ret.flags &= ~DST_SLOT_CONSTANT; - return ret; - } else { - DstValue value = dst_get(check, dst_csymbolv("value")); - return dst_compile_constantslot(value); - } -} - -static void envinitscope(DstScope *scope) { - if (scope->envcount < 1) { - scope->envcount = 1; - scope->envs = malloc(sizeof(int32_t) * 10); - if (NULL == scope->envs) { - DST_OUT_OF_MEMORY; - } - scope->envcap = 10; - scope->envs[0] = 0; - } -} - -/* Add an env index to a scope */ -static int32_t addenvindex(DstScope *scope, int32_t env) { - int32_t newcount, index; - envinitscope(scope); - index = scope->envcount; - newcount = index + 1; - /* Ensure capacity for adding scope */ - if (newcount > scope->envcap) { - int32_t newcap = 2 * newcount; - scope->envs = realloc(scope->envs, sizeof(int32_t) * newcap); - if (NULL == scope->envs) { - DST_OUT_OF_MEMORY; - } - scope->envcap = newcap; - } - scope->envs[index] = env; - scope->envcount = newcount; - return index; -} - /* Allow searching for symbols. Return information about the symbol */ -DstSlot dst_compile_resolve( +DstSlot dstc_resolve( DstCompiler *c, const DstValue *sourcemap, const uint8_t *sym) { - DstSlot ret = dst_compile_constantslot(dst_wrap_nil()); - DstScope *scope = dst_compile_topscope(c); + DstSlot ret = dstc_cslot(dst_wrap_nil()); + DstScope *top = &dst_v_last(c->scopes); + DstScope *scope = top; int foundlocal = 1; int unused = 0; /* Search scopes for symbol, starting from top */ while (scope >= c->scopes) { + int32_t i, len; if (scope->flags & DST_SCOPE_UNUSED) unused = 1; - if (slotsymfind(scope, sym, &ret)) - goto found; + len = dst_v_count(scope->syms); + for (i = 0; i < len; i++) { + if (scope->syms[i].sym == sym) { + ret = scope->syms[i].slot; + ret.flags |= DST_SLOT_NAMED; + goto found; + } + } if (scope->flags & DST_SCOPE_FUNCTION) foundlocal = 0; scope--; } /* Symbol not found - check for global */ - return checkglobal(c, sourcemap, sym); + { + DstValue check = dst_get(c->env, dst_wrap_symbol(sym)); + DstValue ref; + if (!(dst_checktype(check, DST_STRUCT) || dst_checktype(check, DST_TABLE))) { + dstc_error(c, sourcemap, dst_formatc("unknown symbol %q", sym)); + return dstc_cslot(dst_wrap_nil()); + } + ref = dst_get(check, dst_csymbolv("ref")); + if (dst_checktype(ref, DST_ARRAY)) { + DstSlot ret = dstc_cslot(ref); + /* TODO save type info */ + ret.flags |= DST_SLOT_REF | DST_SLOT_NAMED | DST_SLOT_MUTABLE | DST_SLOTTYPE_ANY; + ret.flags &= ~DST_SLOT_CONSTANT; + return ret; + } else { + DstValue value = dst_get(check, dst_csymbolv("value")); + return dstc_cslot(value); + } + } /* Symbol was found */ found: @@ -400,18 +299,19 @@ DstSlot dst_compile_resolve( while (scope >= c->scopes && !(scope->flags & DST_SCOPE_FUNCTION)) scope--; dst_assert(scope >= c->scopes, "invalid scopes"); scope->flags |= DST_SCOPE_ENV; - envinitscope(scope); + if (!dst_v_count(scope->envs)) dst_v_push(scope->envs, 0); scope++; } /* Propogate env up to current scope */ int32_t envindex = 0; - while (scope <= dst_compile_topscope(c)) { + while (scope <= top) { if (scope->flags & DST_SCOPE_FUNCTION) { - int32_t j; + int32_t j, len; int scopefound = 0; /* Check if scope already has env. If so, break */ - for (j = 1; j < scope->envcount; j++) { + len = dst_v_count(scope->envs); + for (j = 1; j < len; j++) { if (scope->envs[j] == envindex) { scopefound = 1; envindex = j; @@ -419,7 +319,11 @@ DstSlot dst_compile_resolve( } } /* Add the environment if it is not already referenced */ - if (!scopefound) envindex = addenvindex(scope, envindex); + if (!scopefound) { + if (!dst_v_count(scope->envs)) dst_v_push(scope->envs, 0); + dst_v_push(scope->envs, envindex); + envindex = len; + } } scope++; } @@ -429,29 +333,56 @@ DstSlot dst_compile_resolve( } /* Emit a raw instruction with source mapping. */ -void dst_compile_emit(DstCompiler *c, const DstValue *sourcemap, uint32_t instr) { - int32_t index = c->buffercount; - int32_t newcount = index + 1; - if (newcount > c->buffercap) { - int32_t newcap = 2 * newcount; - c->buffer = realloc(c->buffer, newcap * sizeof(uint32_t)); - c->mapbuffer = realloc(c->mapbuffer, newcap * sizeof(int32_t) * 2); - if (NULL == c->buffer || NULL == c->mapbuffer) { - DST_OUT_OF_MEMORY; - } - c->buffercap = newcap; - } - c->buffercount = newcount; +void dstc_emit(DstCompiler *c, const DstValue *sourcemap, uint32_t instr) { + dst_v_push(c->buffer, instr); if (NULL != sourcemap) { - c->mapbuffer[index * 2] = dst_unwrap_integer(sourcemap[0]); - c->mapbuffer[index * 2 + 1] = dst_unwrap_integer(sourcemap[1]); + dst_v_push(c->mapbuffer, dst_unwrap_integer(sourcemap[0])); + dst_v_push(c->mapbuffer, dst_unwrap_integer(sourcemap[1])); + } else { + dst_v_push(c->mapbuffer, -1); + dst_v_push(c->mapbuffer, -1); + } +} + +/* Load a constant into a local slot */ +static void dstc_loadconst(DstCompiler *c, const DstValue *sourcemap, DstValue k, int32_t dest) { + switch (dst_type(k)) { + case DST_NIL: + dstc_emit(c, sourcemap, (dest << 8) | DOP_LOAD_NIL); + break; + case DST_TRUE: + dstc_emit(c, sourcemap, (dest << 8) | DOP_LOAD_TRUE); + break; + case DST_FALSE: + dstc_emit(c, sourcemap, (dest << 8) | DOP_LOAD_FALSE); + break; + case DST_INTEGER: + { + int32_t i = dst_unwrap_integer(k); + if (i <= INT16_MAX && i >= INT16_MIN) { + dstc_emit(c, sourcemap, + (i << 16) | + (dest << 8) | + DOP_LOAD_INTEGER); + break; + } + /* fallthrough */ + } + default: + { + int32_t cindex = dstc_const(c, sourcemap, k); + dstc_emit(c, sourcemap, + (cindex << 16) | + (dest << 8) | + DOP_LOAD_CONSTANT); + break; + } } - c->buffer[index] = instr; } /* Realize any slot to a local slot. Call this to get a slot index * that can be used in an instruction. */ -static int32_t dst_compile_preread( +static int32_t dstc_preread( DstCompiler *c, const DstValue *sourcemap, int32_t max, @@ -464,56 +395,25 @@ static int32_t dst_compile_preread( max = 0xFF; if (s.flags & (DST_SLOT_CONSTANT | DST_SLOT_REF)) { - int32_t cindex; - ret = slotalloc_temp(c, 0xFF, nth); - /* Use instructions for loading certain constants */ - switch (dst_type(s.constant)) { - case DST_NIL: - dst_compile_emit(c, sourcemap, (ret << 8) | DOP_LOAD_NIL); - break; - case DST_TRUE: - dst_compile_emit(c, sourcemap, (ret << 8) | DOP_LOAD_TRUE); - break; - case DST_FALSE: - dst_compile_emit(c, sourcemap, (ret << 8) | DOP_LOAD_FALSE); - break; - case DST_INTEGER: - { - int32_t i = dst_unwrap_integer(s.constant); - if (i <= INT16_MAX && i >= INT16_MIN) { - dst_compile_emit(c, sourcemap, - (i << 16) | - (ret << 8) | - DOP_LOAD_INTEGER); - break; - } - /* fallthrough */ - } - default: - cindex = addconst(c, sourcemap, s.constant); - dst_compile_emit(c, sourcemap, - (cindex << 16) | - (ret << 8) | - DOP_LOAD_CONSTANT); - break; - } + ret = dstc_lslotn(c, 0xFF, nth); + dstc_loadconst(c, sourcemap, s.constant, ret); /* If we also are a reference, deref the one element array */ if (s.flags & DST_SLOT_REF) { - dst_compile_emit(c, sourcemap, + dstc_emit(c, sourcemap, (ret << 16) | (ret << 8) | DOP_GET_INDEX); } } else if (s.envindex > 0 || s.index > max) { - ret = slotalloc_temp(c, max, nth); - dst_compile_emit(c, sourcemap, + ret = dstc_lslotn(c, max, nth); + dstc_emit(c, sourcemap, ((uint32_t)(s.index) << 24) | ((uint32_t)(s.envindex) << 16) | ((uint32_t)(ret) << 8) | DOP_LOAD_UPVALUE); } else if (s.index > max) { - ret = slotalloc_temp(c, max, nth); - dst_compile_emit(c, sourcemap, + ret = dstc_lslotn(c, max, nth); + dstc_emit(c, sourcemap, ((uint32_t)(s.index) << 16) | ((uint32_t)(ret) << 8) | DOP_MOVE_NEAR); @@ -525,15 +425,16 @@ static int32_t dst_compile_preread( } /* Call this to release a read handle after emitting the instruction. */ -static void dst_compile_postread(DstCompiler *c, DstSlot s, int32_t index) { +static void dstc_postread(DstCompiler *c, DstSlot s, int32_t index) { if (index != s.index || s.envindex > 0 || s.flags & DST_SLOT_CONSTANT) { /* We need to free the temporary slot */ - slotfree_index(c, index); + dstc_sfreei(c, index); } } -/* Move values from one slot to another. The destination must be mutable. */ -static void dst_compile_copy( +/* Move values from one slot to another. The destination must + * be writeable (not a literal). */ +static void dstc_copy( DstCompiler *c, const DstValue *sourcemap, DstSlot dest, @@ -545,7 +446,8 @@ static void dst_compile_copy( /* Can't write to constants */ if (dest.flags & DST_SLOT_CONSTANT) { - dst_compile_cerror(c, sourcemap, "cannot write to constant"); + dstc_cerror(c, sourcemap, "cannot write to constant"); + return; } /* Short circuit if dest and source are equal */ @@ -560,18 +462,56 @@ static void dst_compile_copy( } } - /* Process: src -> srclocal -> destlocal -> dest */ + /* Types of slots - src */ + /* constants */ + /* upvalues */ + /* refs */ + /* near index */ + /* far index */ + + /* Types of slots - dest */ + /* upvalues */ + /* refs */ + /* near index */ + /* far index */ + + /* If dest is a near index, do some optimization */ + if (dest.envindex == 0 && dest.index >= 0 && dest.index <= 0xFF) { + if (src.flags & DST_SLOT_CONSTANT) { + dstc_loadconst(c, sourcemap, src.constant, dest.index); + } else if (src.flags & DST_SLOT_REF) { + dstc_loadconst(c, sourcemap, src.constant, dest.index); + dstc_emit(c, sourcemap, + (dest.index << 16) | + (dest.index << 8) | + DOP_GET_INDEX); + } else if (src.envindex > 0) { + dstc_emit(c, sourcemap, + (src.index << 24) | + (src.envindex << 16) | + (dest.index << 8) | + DOP_LOAD_UPVALUE); + } else { + dstc_emit(c, sourcemap, + (src.index << 16) | + (dest.index << 8) | + DOP_MOVE_NEAR); + } + return; + } + /* Process: src -> srclocal -> destlocal -> dest */ + /* src -> srclocal */ - srclocal = dst_compile_preread(c, sourcemap, 0xFF, 1, src); + srclocal = dstc_preread(c, sourcemap, 0xFF, 1, src); /* Pull down dest (find destlocal) */ if (dest.flags & DST_SLOT_REF) { writeback = 1; destlocal = srclocal; - reflocal = slotalloc_temp(c, 0xFF, 2); - dst_compile_emit(c, sourcemap, - (addconst(c, sourcemap, dest.constant) << 16) | + reflocal = dstc_lslotn(c, 0xFF, 2); + dstc_emit(c, sourcemap, + (dstc_const(c, sourcemap, dest.constant) << 16) | (reflocal << 8) | DOP_LOAD_CONSTANT); } else if (dest.envindex > 0) { @@ -586,7 +526,7 @@ static void dst_compile_copy( /* srclocal -> destlocal */ if (srclocal != destlocal) { - dst_compile_emit(c, sourcemap, + dstc_emit(c, sourcemap, ((uint32_t)(srclocal) << 16) | ((uint32_t)(destlocal) << 8) | DOP_MOVE_NEAR); @@ -594,18 +534,18 @@ static void dst_compile_copy( /* destlocal -> dest */ if (writeback == 1) { - dst_compile_emit(c, sourcemap, + dstc_emit(c, sourcemap, (destlocal << 16) | (reflocal << 8) | DOP_PUT_INDEX); } else if (writeback == 2) { - dst_compile_emit(c, sourcemap, + dstc_emit(c, sourcemap, ((uint32_t)(dest.index) << 24) | ((uint32_t)(dest.envindex) << 16) | ((uint32_t)(destlocal) << 8) | DOP_SET_UPVALUE); } else if (writeback == 3) { - dst_compile_emit(c, sourcemap, + dstc_emit(c, sourcemap, ((uint32_t)(dest.index) << 16) | ((uint32_t)(destlocal) << 8) | DOP_MOVE_FAR); @@ -613,20 +553,20 @@ static void dst_compile_copy( /* Cleanup */ if (reflocal >= 0) { - slotfree_index(c, reflocal); + dstc_sfreei(c, reflocal); } - dst_compile_postread(c, src, srclocal); + dstc_postread(c, src, srclocal); } /* Generate the return instruction for a slot. */ -static DstSlot dst_compile_return(DstCompiler *c, const DstValue *sourcemap, DstSlot s) { +static DstSlot dstc_return(DstCompiler *c, const DstValue *sourcemap, DstSlot s) { if (!(s.flags & DST_SLOT_RETURNED)) { if (s.flags & DST_SLOT_CONSTANT && dst_checktype(s.constant, DST_NIL)) { - dst_compile_emit(c, sourcemap, DOP_RETURN_NIL); + dstc_emit(c, sourcemap, DOP_RETURN_NIL); } else { - int32_t ls = dst_compile_preread(c, sourcemap, 0xFFFF, 1, s); - dst_compile_emit(c, sourcemap, DOP_RETURN | (ls << 8)); - dst_compile_postread(c, s, ls); + int32_t ls = dstc_preread(c, sourcemap, 0xFFFF, 1, s); + dstc_emit(c, sourcemap, DOP_RETURN | (ls << 8)); + dstc_postread(c, s, ls); } s.flags |= DST_SLOT_RETURNED; } @@ -635,7 +575,7 @@ static DstSlot dst_compile_return(DstCompiler *c, const DstValue *sourcemap, Dst /* Get a target slot for emitting an instruction. Will always return * a local slot. */ -static DstSlot dst_compile_gettarget(DstFormOptions opts) { +static DstSlot dstc_gettarget(DstFormOptions opts) { DstSlot slot; if ((opts.flags & DST_FOPTS_HINT) && (opts.hint.envindex == 0) && @@ -645,95 +585,119 @@ static DstSlot dst_compile_gettarget(DstFormOptions opts) { slot.envindex = 0; slot.constant = dst_wrap_nil(); slot.flags = 0; - slot.index = slotalloc_temp(opts.compiler, 0xFF, 4); + slot.index = dstc_lslotn(opts.compiler, 0xFF, 4); } return slot; } -/* Push a series of values */ -static void dst_compile_pushtuple( - DstCompiler *c, - const DstValue *sourcemap, - DstValue x, - int32_t start) { - DstFormOptions opts; +/* Slot and map pairing */ +typedef struct SlotMap { + DstSlot slot; + const DstValue *map; +} SlotMap; + +/* Get a bunch of slots for function arguments */ +SlotMap *toslots(DstFormOptions opts, int32_t start) { int32_t i, len; + SlotMap *ret = NULL; + len = dst_length(opts.x); + for (i = start; i < len; i++) { + SlotMap sm; + DstFormOptions subopts = dstc_getindex(opts, i); + sm.slot = dstc_value(subopts); + sm.map = subopts.sourcemap; + dst_v_push(ret, sm); + } + return ret; +} - /* Set basic opts */ - opts.compiler = c; - opts.hint = dst_compile_constantslot(dst_wrap_nil()); - opts.flags = 0; - opts.x = x; - opts.sourcemap = sourcemap; +/* Get a bunch of slots for function arguments */ +static SlotMap *toslotskv(DstFormOptions opts) { + SlotMap *ret = NULL; + const DstKV *kv = NULL; + while (NULL != (kv = dst_next(opts.x, kv))) { + SlotMap km, vm; + DstFormOptions kopts = dstc_getkey(opts, kv->key); + DstFormOptions vopts = dstc_getvalue(opts, kv->key); + km.slot = dstc_value(kopts); + km.map = kopts.sourcemap; + vm.slot = dstc_value(vopts); + vm.map = vopts.sourcemap; + dst_v_push(ret, km); + dst_v_push(ret, vm); + } + return ret; +} - len = dst_length(x); - for (i = start; i < len - 2; i += 3) { - DstFormOptions o1 = dst_compile_getopts_index(opts, i); - DstFormOptions o2 = dst_compile_getopts_index(opts, i + 1); - DstFormOptions o3 = dst_compile_getopts_index(opts, i + 2); - DstSlot s1 = dst_compile_value(o1); - DstSlot s2 = dst_compile_value(o2); - DstSlot s3 = dst_compile_value(o3); - int32_t ls1 = dst_compile_preread(c, o1.sourcemap, 0xFF, 1, s1); - int32_t ls2 = dst_compile_preread(c, o2.sourcemap, 0xFF, 2, s2); - int32_t ls3 = dst_compile_preread(c, o3.sourcemap, 0xFF, 3, s3); - dst_compile_emit(c, o1.sourcemap, +/* Push slots load via toslots. */ +static void pushslots(DstFormOptions opts, SlotMap *sms) { + DstCompiler *c = opts.compiler; + const DstValue *sm = opts.sourcemap; + int32_t i; + for (i = 0; i < dst_v_count(sms) - 2; i += 3) { + int32_t ls1 = dstc_preread(c, sms[i].map, 0xFF, 1, sms[i].slot); + int32_t ls2 = dstc_preread(c, sms[i + 1].map, 0xFF, 2, sms[i + 1].slot); + int32_t ls3 = dstc_preread(c, sms[i + 2].map, 0xFF, 3, sms[i + 2].slot); + dstc_emit(c, sm, (ls3 << 24) | (ls2 << 16) | (ls1 << 8) | DOP_PUSH_3); - dst_compile_postread(c, s1, ls1); - dst_compile_postread(c, s2, ls2); - dst_compile_postread(c, s3, ls3); - dst_compile_freeslot(c, s1); - dst_compile_freeslot(c, s2); - dst_compile_freeslot(c, s3); + dstc_postread(c, sms[i].slot, ls1); + dstc_postread(c, sms[i + 1].slot, ls2); + dstc_postread(c, sms[i + 2].slot, ls3); } - if (i == len - 2) { - DstFormOptions o1 = dst_compile_getopts_index(opts, i); - DstFormOptions o2 = dst_compile_getopts_index(opts, i + 1); - DstSlot s1 = dst_compile_value(o1); - DstSlot s2 = dst_compile_value(o2); - int32_t ls1 = dst_compile_preread(c, o1.sourcemap, 0xFF, 1, s1); - int32_t ls2 = dst_compile_preread(c, o2.sourcemap, 0xFFFF, 2, s2); - dst_compile_emit(c, o1.sourcemap, + if (i == dst_v_count(sms) - 2) { + int32_t ls1 = dstc_preread(c, sms[i].map, 0xFF, 1, sms[i].slot); + int32_t ls2 = dstc_preread(c, sms[i + 1].map, 0xFFFF, 2, sms[i + 1].slot); + dstc_emit(c, sm, (ls2 << 16) | (ls1 << 8) | DOP_PUSH_2); - dst_compile_postread(c, s1, ls1); - dst_compile_postread(c, s2, ls2); - dst_compile_freeslot(c, s1); - dst_compile_freeslot(c, s2); - } else if (i == len - 1) { - DstFormOptions o1 = dst_compile_getopts_index(opts, i); - DstSlot s1 = dst_compile_value(o1); - int32_t ls1 = dst_compile_preread(c, o1.sourcemap, 0xFFFFFF, 1, s1); - dst_compile_emit(c, o1.sourcemap, + dstc_postread(c, sms[i].slot, ls1); + dstc_postread(c, sms[i + 1].slot, ls2); + } else if (i == dst_v_count(sms) - 1) { + int32_t ls1 = dstc_preread(c, sms[i].map, 0xFFFFFF, 1, sms[i].slot); + dstc_emit(c, sm, (ls1 << 8) | DOP_PUSH); - dst_compile_postread(c, s1, ls1); - dst_compile_freeslot(c, s1); + dstc_postread(c, sms[i].slot, ls1); } } -DstSlot dst_compile_quote(DstFormOptions opts, int32_t argn, const DstValue *argv) { - if (argn != 1) - dst_compile_cerror(opts.compiler, opts.sourcemap, "expected 1 argument"); - return dst_compile_constantslot(argv[0]); +/* Free slots loaded via toslots */ +static void freeslots(DstFormOptions opts, SlotMap *sms) { + int32_t i; + for (i = 0; i < dst_v_count(sms); i++) { + dstc_freeslot(opts.compiler, sms[i].slot); + } + dst_v_free(sms); } -DstSlot dst_compile_var(DstFormOptions opts, int32_t argn, const DstValue *argv) { +DstSlot dstc_quote(DstFormOptions opts, int32_t argn, const DstValue *argv) { + if (argn != 1) { + dstc_cerror(opts.compiler, opts.sourcemap, "expected 1 argument"); + return dstc_cslot(dst_wrap_nil()); + } + return dstc_cslot(argv[0]); +} + +DstSlot dstc_var(DstFormOptions opts, int32_t argn, const DstValue *argv) { DstCompiler *c = opts.compiler; DstFormOptions subopts; DstSlot ret; - if (argn != 2) - dst_compile_cerror(opts.compiler, opts.sourcemap, "expected 2 arguments"); - if (!dst_checktype(argv[0], DST_SYMBOL)) - dst_compile_cerror(opts.compiler, opts.sourcemap, "expected symbol"); - subopts = dst_compile_getopts_index(opts, 2); + if (argn != 2) { + dstc_cerror(opts.compiler, opts.sourcemap, "expected 2 arguments"); + return dstc_cslot(dst_wrap_nil()); + } + if (!dst_checktype(argv[0], DST_SYMBOL)) { + dstc_cerror(opts.compiler, opts.sourcemap, "expected symbol"); + return dstc_cslot(dst_wrap_nil()); + } + subopts = dstc_getindex(opts, 2); subopts.flags = opts.flags & ~DST_FOPTS_TAIL; - ret = dst_compile_value(subopts); - if (dst_compile_topscope(c)->flags & DST_SCOPE_TOP) { + ret = dstc_value(subopts); + if (dst_v_last(c->scopes).flags & DST_SCOPE_TOP) { DstCompiler *c = opts.compiler; const DstValue *sm = opts.sourcemap; DstSlot refslot, refarrayslot; @@ -743,107 +707,122 @@ DstSlot dst_compile_var(DstFormOptions opts, int32_t argn, const DstValue *argv) dst_array_push(ref, dst_wrap_nil()); dst_table_put(reftab, dst_csymbolv("ref"), dst_wrap_array(ref)); dst_put(opts.compiler->env, argv[0], dst_wrap_table(reftab)); - refslot = dst_compile_constantslot(dst_wrap_array(ref)); + refslot = dstc_cslot(dst_wrap_array(ref)); refarrayslot = refslot; refslot.flags |= DST_SLOT_REF | DST_SLOT_NAMED | DST_SLOT_MUTABLE; /* Generate code to set ref */ - int32_t refarrayindex = dst_compile_preread(c, sm, 0xFF, 1, refarrayslot); - int32_t retindex = dst_compile_preread(c, sm, 0xFF, 2, ret); - dst_compile_emit(c, sm, + int32_t refarrayindex = dstc_preread(c, sm, 0xFF, 1, refarrayslot); + int32_t retindex = dstc_preread(c, sm, 0xFF, 2, ret); + dstc_emit(c, sm, (retindex << 16) | (refarrayindex << 8) | DOP_PUT_INDEX); - dst_compile_postread(c, refarrayslot, refarrayindex); - dst_compile_postread(c, ret, retindex); - /*dst_compile_freeslot(c, refarrayslot);*/ + dstc_postread(c, refarrayslot, refarrayindex); + dstc_postread(c, ret, retindex); + /*dstc_freeslot(c, refarrayslot);*/ ret = refslot; } else { /* Non root scope, bring to local slot */ - DstSlot localslot; - localslot.index = slotalloc_index(c); - /* infer type? */ - localslot.flags = DST_SLOT_NAMED | DST_SLOT_MUTABLE; - localslot.envindex = 0; - localslot.constant = dst_wrap_nil(); - dst_compile_copy(opts.compiler, opts.sourcemap, localslot, ret); - slotsym(c, dst_unwrap_symbol(argv[0]), localslot); - ret = localslot; + if (ret.flags & DST_SLOT_NAMED || + ret.envindex != 0 || + ret.index < 0 || + ret.index > 0xFF) { + /* Slot is not able to be named */ + DstSlot localslot; + localslot.index = dstc_lsloti(c); + /* infer type? */ + localslot.flags = DST_SLOT_NAMED | DST_SLOT_MUTABLE; + localslot.envindex = 0; + localslot.constant = dst_wrap_nil(); + dstc_copy(opts.compiler, opts.sourcemap, localslot, ret); + ret = localslot; + } + dstc_nameslot(c, dst_unwrap_symbol(argv[0]), ret); } return ret; } -DstSlot dst_compile_varset(DstFormOptions opts, int32_t argn, const DstValue *argv) { +DstSlot dstc_varset(DstFormOptions opts, int32_t argn, const DstValue *argv) { DstFormOptions subopts; DstSlot ret, dest; - if (argn != 2) - dst_compile_cerror(opts.compiler, opts.sourcemap, "expected 2 arguments"); - if (!dst_checktype(argv[0], DST_SYMBOL)) - dst_compile_cerror(opts.compiler, opts.sourcemap, "expected symbol"); - dest = dst_compile_resolve(opts.compiler, opts.sourcemap, dst_unwrap_symbol(argv[0])); - if (!(dest.flags & DST_SLOT_MUTABLE)) { - dst_compile_cerror(opts.compiler, opts.sourcemap, "cannot set constant"); + if (argn != 2) { + dstc_cerror(opts.compiler, opts.sourcemap, "expected 2 arguments"); + return dstc_cslot(dst_wrap_nil()); } - subopts = dst_compile_getopts_index(opts, 2); + if (!dst_checktype(argv[0], DST_SYMBOL)) { + dstc_cerror(opts.compiler, opts.sourcemap, "expected symbol"); + return dstc_cslot(dst_wrap_nil()); + } + dest = dstc_resolve(opts.compiler, opts.sourcemap, dst_unwrap_symbol(argv[0])); + if (!(dest.flags & DST_SLOT_MUTABLE)) { + dstc_cerror(opts.compiler, opts.sourcemap, "cannot set constant"); + return dstc_cslot(dst_wrap_nil()); + } + subopts = dstc_getindex(opts, 2); subopts.flags = DST_FOPTS_HINT; subopts.hint = dest; - ret = dst_compile_value(subopts); - dst_compile_copy(opts.compiler, subopts.sourcemap, dest, ret); + ret = dstc_value(subopts); + dstc_copy(opts.compiler, subopts.sourcemap, dest, ret); return ret; } -DstSlot dst_compile_def(DstFormOptions opts, int32_t argn, const DstValue *argv) { +DstSlot dstc_def(DstFormOptions opts, int32_t argn, const DstValue *argv) { DstCompiler *c = opts.compiler; DstFormOptions subopts; DstSlot ret; - if (argn != 2) - dst_compile_cerror(opts.compiler, opts.sourcemap, "expected 2 arguments"); - if (!dst_checktype(argv[0], DST_SYMBOL)) - dst_compile_cerror(opts.compiler, opts.sourcemap, "expected symbol"); - subopts = dst_compile_getopts_index(opts, 2); + if (argn != 2) { + dstc_cerror(opts.compiler, opts.sourcemap, "expected 2 arguments"); + return dstc_cslot(dst_wrap_nil()); + } + if (!dst_checktype(argv[0], DST_SYMBOL)) { + dstc_cerror(opts.compiler, opts.sourcemap, "expected symbol"); + return dstc_cslot(dst_wrap_nil()); + } + subopts = dstc_getindex(opts, 2); subopts.flags &= ~DST_FOPTS_TAIL; - ret = dst_compile_value(subopts); + ret = dstc_value(subopts); ret.flags |= DST_SLOT_NAMED; - if (dst_compile_topscope(c)->flags & DST_SCOPE_TOP) { + if (dst_v_last(c->scopes).flags & DST_SCOPE_TOP) { /* Global def, generate code to store in env when executed */ DstCompiler *c = opts.compiler; const DstValue *sm = opts.sourcemap; /* Root scope, add to def table */ - DstSlot envslot = dst_compile_constantslot(c->env); - DstSlot nameslot = dst_compile_constantslot(argv[0]); - DstSlot valsymslot = dst_compile_constantslot(dst_csymbolv("value")); - DstSlot tableslot = dst_compile_constantslot(dst_wrap_cfunction(dst_stl_table)); + DstSlot envslot = dstc_cslot(c->env); + DstSlot nameslot = dstc_cslot(argv[0]); + DstSlot valsymslot = dstc_cslot(dst_csymbolv("value")); + DstSlot tableslot = dstc_cslot(dst_wrap_cfunction(dst_stl_table)); /* Create env entry */ - int32_t valsymindex = dst_compile_preread(c, sm, 0xFF, 1, valsymslot); - int32_t retindex = dst_compile_preread(c, sm, 0xFFFF, 2, ret); - dst_compile_emit(c, sm, + int32_t valsymindex = dstc_preread(c, sm, 0xFF, 1, valsymslot); + int32_t retindex = dstc_preread(c, sm, 0xFFFF, 2, ret); + dstc_emit(c, sm, (retindex << 16) | (valsymindex << 8) | DOP_PUSH_2); - dst_compile_postread(c, ret, retindex); - dst_compile_postread(c, valsymslot, valsymindex); - dst_compile_freeslot(c, valsymslot); - int32_t tableindex = dst_compile_preread(opts.compiler, opts.sourcemap, 0xFF, 1, tableslot); - dst_compile_emit(c, sm, + dstc_postread(c, ret, retindex); + dstc_postread(c, valsymslot, valsymindex); + dstc_freeslot(c, valsymslot); + int32_t tableindex = dstc_preread(opts.compiler, opts.sourcemap, 0xFF, 1, tableslot); + dstc_emit(c, sm, (tableindex << 16) | (tableindex << 8) | DOP_CALL); /* Add env entry to env */ - int32_t nameindex = dst_compile_preread(opts.compiler, opts.sourcemap, 0xFF, 2, nameslot); - int32_t envindex = dst_compile_preread(opts.compiler, opts.sourcemap, 0xFF, 3, envslot); - dst_compile_emit(opts.compiler, opts.sourcemap, + int32_t nameindex = dstc_preread(opts.compiler, opts.sourcemap, 0xFF, 2, nameslot); + int32_t envindex = dstc_preread(opts.compiler, opts.sourcemap, 0xFF, 3, envslot); + dstc_emit(opts.compiler, opts.sourcemap, (tableindex << 24) | (nameindex << 16) | (envindex << 8) | DOP_PUT); - dst_compile_postread(opts.compiler, envslot, envindex); - dst_compile_postread(opts.compiler, nameslot, nameindex); - dst_compile_postread(c, tableslot, tableindex); - dst_compile_freeslot(c, tableslot); - dst_compile_freeslot(c, envslot); - dst_compile_freeslot(c, tableslot); + dstc_postread(opts.compiler, envslot, envindex); + dstc_postread(opts.compiler, nameslot, nameindex); + dstc_postread(c, tableslot, tableindex); + dstc_freeslot(c, tableslot); + dstc_freeslot(c, envslot); + dstc_freeslot(c, tableslot); } else { /* Non root scope, simple slot alias */ - slotsym(c, dst_unwrap_symbol(argv[0]), ret); + dstc_nameslot(c, dst_unwrap_symbol(argv[0]), ret); } return ret; } @@ -851,13 +830,17 @@ DstSlot dst_compile_def(DstFormOptions opts, int32_t argn, const DstValue *argv) /* Compile some code that will be thrown away. Used to ensure * that dead code is well formed without including it in the final * bytecode. */ -static void dst_compile_throwaway(DstFormOptions opts) { +static void dstc_throwaway(DstFormOptions opts) { DstCompiler *c = opts.compiler; - int32_t bufstart = c->buffercount; - dst_compile_scope(c, DST_SCOPE_UNUSED); - dst_compile_value(opts); - dst_compile_popscope(c); - c->buffercount = bufstart; + int32_t bufstart = dst_v_count(c->buffer); + dstc_scope(c, DST_SCOPE_UNUSED); + dstc_value(opts); + dstc_popscope(c); + if (NULL != c->buffer) { + dst_v__cnt(c->buffer) = bufstart; + if (NULL != c->mapbuffer) + dst_v__cnt(c->mapbuffer) = bufstart; + } } /* @@ -871,7 +854,7 @@ static void dst_compile_throwaway(DstFormOptions opts) { * ... * :done */ -DstSlot dst_compile_if(DstFormOptions opts, int32_t argn, const DstValue *argv) { +DstSlot dstc_if(DstFormOptions opts, int32_t argn, const DstValue *argv) { DstCompiler *c = opts.compiler; const DstValue *sm = opts.sourcemap; int32_t labelr, labeljr, labeld, labeljd, condlocal; @@ -881,13 +864,15 @@ DstSlot dst_compile_if(DstFormOptions opts, int32_t argn, const DstValue *argv) const int drop = opts.flags & DST_FOPTS_DROP; (void) argv; - if (argn < 2 || argn > 3) - dst_compile_cerror(c, sm, "expected 2 or 3 arguments to if"); + if (argn < 2 || argn > 3) { + dstc_cerror(c, sm, "expected 2 or 3 arguments to if"); + return dstc_cslot(dst_wrap_nil()); + } /* Get options */ - condopts = dst_compile_getopts_index(opts, 1); - leftopts = dst_compile_getopts_index(opts, 2); - rightopts = dst_compile_getopts_index(opts, 3); + condopts = dstc_getindex(opts, 1); + leftopts = dstc_getindex(opts, 2); + rightopts = dstc_getindex(opts, 3); if (argn == 2) rightopts.sourcemap = opts.sourcemap; if (opts.flags & DST_FOPTS_HINT) { leftopts.flags |= DST_FOPTS_HINT; @@ -903,7 +888,7 @@ DstSlot dst_compile_if(DstFormOptions opts, int32_t argn, const DstValue *argv) } /* Compile condition */ - cond = dst_compile_value(condopts); + cond = dstc_value(condopts); /* Check constant condition. */ /* TODO: Use type info for more short circuits */ @@ -916,44 +901,44 @@ DstSlot dst_compile_if(DstFormOptions opts, int32_t argn, const DstValue *argv) goodopts = rightopts; badopts = leftopts; } - dst_compile_scope(c, 0); - target = dst_compile_value(goodopts); - dst_compile_popscope(c); - dst_compile_throwaway(badopts); + dstc_scope(c, 0); + target = dstc_value(goodopts); + dstc_popscope(c); + dstc_throwaway(badopts); return target; } /* Set target for compilation */ target = (!drop && !tail) - ? dst_compile_gettarget(opts) - : dst_compile_constantslot(dst_wrap_nil()); + ? dstc_gettarget(opts) + : dstc_cslot(dst_wrap_nil()); /* Compile jump to right */ - condlocal = dst_compile_preread(c, sm, 0xFF, 1, cond); - labeljr = c->buffercount; - dst_compile_emit(c, sm, DOP_JUMP_IF_NOT | (condlocal << 8)); - dst_compile_postread(c, cond, condlocal); - dst_compile_freeslot(c, cond); + condlocal = dstc_preread(c, sm, 0xFF, 1, cond); + labeljr = dst_v_count(c->buffer); + dstc_emit(c, sm, DOP_JUMP_IF_NOT | (condlocal << 8)); + dstc_postread(c, cond, condlocal); + dstc_freeslot(c, cond); /* Condition left body */ - dst_compile_scope(c, 0); - left = dst_compile_value(leftopts); - if (!drop && !tail) dst_compile_copy(c, sm, target, left); - dst_compile_popscope(c); + dstc_scope(c, 0); + left = dstc_value(leftopts); + if (!drop && !tail) dstc_copy(c, sm, target, left); + dstc_popscope(c); /* Compile jump to done */ - labeljd = c->buffercount; - if (!tail) dst_compile_emit(c, sm, DOP_JUMP); + labeljd = dst_v_count(c->buffer); + if (!tail) dstc_emit(c, sm, DOP_JUMP); /* Compile right body */ - labelr = c->buffercount; - dst_compile_scope(c, 0); - right = dst_compile_value(rightopts); - if (!drop && !tail) dst_compile_copy(c, sm, target, right); - dst_compile_popscope(c); + labelr = dst_v_count(c->buffer); + dstc_scope(c, 0); + right = dstc_value(rightopts); + if (!drop && !tail) dstc_copy(c, sm, target, right); + dstc_popscope(c); /* Write jumps - only add jump lengths if jump actually emitted */ - labeld = c->buffercount; + labeld = dst_v_count(c->buffer); c->buffer[labeljr] |= (labelr - labeljr) << 16; if (!tail) c->buffer[labeljd] |= (labeld - labeljd) << 8; @@ -961,24 +946,24 @@ DstSlot dst_compile_if(DstFormOptions opts, int32_t argn, const DstValue *argv) return target; } -DstSlot dst_compile_do(DstFormOptions opts, int32_t argn, const DstValue *argv) { +DstSlot dstc_do(DstFormOptions opts, int32_t argn, const DstValue *argv) { int32_t i; DstSlot ret; - dst_compile_scope(opts.compiler, 0); + dstc_scope(opts.compiler, 0); (void) argv; for (i = 0; i < argn; i++) { - DstFormOptions subopts = dst_compile_getopts_index(opts, i + 1); + DstFormOptions subopts = dstc_getindex(opts, i + 1); if (i != argn - 1) { subopts.flags = DST_FOPTS_DROP; } else if (opts.flags & DST_FOPTS_TAIL) { subopts.flags = DST_FOPTS_TAIL; } - ret = dst_compile_value(subopts); + ret = dstc_value(subopts); if (i != argn - 1) { - dst_compile_freeslot(opts.compiler, ret); + dstc_freeslot(opts.compiler, ret); } } - dst_compile_popscope(opts.compiler); + dstc_popscope(opts.compiler); return ret; } @@ -991,7 +976,7 @@ DstSlot dst_compile_do(DstFormOptions opts, int32_t argn, const DstValue *argv) * jump :whiletop * :done */ -DstSlot dst_compile_while(DstFormOptions opts, int32_t argn, const DstValue *argv) { +DstSlot dstc_while(DstFormOptions opts, int32_t argn, const DstValue *argv) { DstCompiler *c = opts.compiler; const DstValue *sm = opts.sourcemap; DstSlot cond; @@ -999,180 +984,124 @@ DstSlot dst_compile_while(DstFormOptions opts, int32_t argn, const DstValue *arg int infinite = 0; (void) argv; - if (argn < 2) dst_compile_cerror(c, sm, "expected at least 2 arguments"); - dst_compile_scope(opts.compiler, 0); - labelwt = c->buffercount; + if (argn < 2) { + dstc_cerror(c, sm, "expected at least 2 arguments"); + return dstc_cslot(dst_wrap_nil()); + } + + labelwt = dst_v_count(c->buffer); /* Compile condition */ - cond = dst_compile_value(dst_compile_getopts_index(opts, 1)); + cond = dstc_value(dstc_getindex(opts, 1)); /* Check for constant condition */ if (cond.flags & DST_SLOT_CONSTANT) { /* Loop never executes */ if (!dst_truthy(cond.constant)) { - dst_compile_popscope(c); - return dst_compile_constantslot(dst_wrap_nil()); + return dstc_cslot(dst_wrap_nil()); } /* Infinite loop */ infinite = 1; } + dstc_scope(c, 0); + + /* Infinite loop does not need to check condition */ if (!infinite) { - condlocal = dst_compile_preread(c, sm, 0xFF, 1, cond); - labelc = c->buffercount; - dst_compile_emit(c, sm, DOP_JUMP_IF_NOT | (condlocal << 8)); - dst_compile_postread(c, cond, condlocal); + condlocal = dstc_preread(c, sm, 0xFF, 1, cond); + labelc = dst_v_count(c->buffer); + dstc_emit(c, sm, DOP_JUMP_IF_NOT | (condlocal << 8)); + dstc_postread(c, cond, condlocal); } /* Compile body */ for (i = 1; i < argn; i++) { - DstFormOptions subopts = dst_compile_getopts_index(opts, i + 1); + DstFormOptions subopts = dstc_getindex(opts, i + 1); subopts.flags = DST_FOPTS_DROP; - dst_compile_freeslot(c, dst_compile_value(subopts)); + dstc_freeslot(c, dstc_value(subopts)); } /* Compile jump to whiletop */ - labeljt = c->buffercount; - dst_compile_emit(c, sm, DOP_JUMP); + labeljt = dst_v_count(c->buffer); + dstc_emit(c, sm, DOP_JUMP); /* Calculate jumps */ - labeld = c->buffercount; + labeld = dst_v_count(c->buffer); if (!infinite) c->buffer[labelc] |= (labeld - labelc) << 16; c->buffer[labeljt] |= (labelwt - labeljt) << 8; - dst_compile_popscope(opts.compiler); - return dst_compile_constantslot(dst_wrap_nil()); + /* Pop scope and return nil slot */ + dstc_popscope(opts.compiler); + + return dstc_cslot(dst_wrap_nil()); } /* Compile a funcdef */ -static DstFuncDef *dst_compile_pop_funcdef(DstCompiler *c) { - DstScope *scope = dst_compile_topscope(c); - DstFuncDef *def; - - /* Initialize funcdef */ - def = dst_gcalloc(DST_MEMORY_FUNCDEF, sizeof(DstFuncDef)); - def->environments = NULL; - def->constants = NULL; +static DstFuncDef *dstc_pop_funcdef(DstCompiler *c) { + DstScope scope = dst_v_last(c->scopes); + DstFuncDef *def = dst_gcalloc(DST_MEMORY_FUNCDEF, sizeof(DstFuncDef)); def->source = NULL; def->sourcepath = NULL; - def->defs = NULL; - def->bytecode = NULL; - def->slotcount = scope->smax + 1; + def->sourcemap = NULL; + def->slotcount = scope.smax + 1; /* Copy envs */ - def->environments_length = scope->envcount; - if (def->environments_length > 1) { - def->environments = malloc(sizeof(int32_t) * def->environments_length); - if (def->environments == NULL) { - DST_OUT_OF_MEMORY; - } - memcpy(def->environments, scope->envs, def->environments_length * sizeof(int32_t)); - } + def->environments_length = dst_v_count(scope.envs); + def->environments = NULL; + if (def->environments_length > 1) def->environments = dst_v_flatten(scope.envs); - /* Copy constants */ - def->constants_length = scope->ccount; - if (def->constants_length) { - def->constants = malloc(sizeof(DstValue) * def->constants_length); - if (NULL == def->constants) { - DST_OUT_OF_MEMORY; - } - memcpy(def->constants, - scope->consts, - def->constants_length * sizeof(DstValue)); - } + def->constants_length = dst_v_count(scope.consts); + def->constants = dst_v_flatten(scope.consts); - /* Copy funcdefs */ - def->defs_length = scope->dcount; - if (def->defs_length) { - def->defs = malloc(sizeof(DstFuncDef *) * def->defs_length); - if (NULL == def->defs) { - DST_OUT_OF_MEMORY; - } - memcpy(def->defs, - scope->defs, - def->defs_length * sizeof(DstFuncDef *)); - } + def->defs_length = dst_v_count(scope.defs); + def->defs = dst_v_flatten(scope.defs); /* Copy bytecode */ - def->bytecode_length = c->buffercount - scope->bytecode_start; + def->bytecode_length = dst_v_count(c->buffer) - scope.bytecode_start; if (def->bytecode_length) { - def->bytecode = malloc(sizeof(uint32_t) * def->bytecode_length); + size_t s = sizeof(int32_t) * def->bytecode_length; + def->bytecode = malloc(s); if (NULL == def->bytecode) { DST_OUT_OF_MEMORY; } - memcpy(def->bytecode, - c->buffer + scope->bytecode_start, - def->bytecode_length * sizeof(uint32_t)); - } - - /* Copy source map over */ - if (c->mapbuffer) { - def->sourcemap = malloc(sizeof(int32_t) * 2 * def->bytecode_length); - if (NULL == def->sourcemap) { - DST_OUT_OF_MEMORY; + memcpy(def->bytecode, c->buffer + scope.bytecode_start, s); + dst_v__cnt(c->buffer) = scope.bytecode_start; + if (NULL != c->mapbuffer) { + def->sourcemap = malloc(2 * s); + if (NULL == def->sourcemap) { + DST_OUT_OF_MEMORY; + } + memcpy(def->sourcemap, c->mapbuffer + scope.bytecode_start, 2 * s); + dst_v__cnt(c->mapbuffer) = scope.bytecode_start; } - memcpy(def->sourcemap, - c->mapbuffer + 2 * scope->bytecode_start, - def->bytecode_length * 2 * sizeof(int32_t)); } - /* Reset bytecode gen */ - c->buffercount = scope->bytecode_start; - - /* Manually set arity and flags later */ def->arity = 0; - - /* Set some flags */ def->flags = 0; - if (scope->flags & DST_SCOPE_ENV) { + if (scope.flags & DST_SCOPE_ENV) { def->flags |= DST_FUNCDEF_FLAG_NEEDSENV; } /* Pop the scope */ - dst_compile_popscope(c); + dstc_popscope(c); return def; } /* Add a funcdef to the top most function scope */ -static int32_t dst_compile_addfuncdef(DstCompiler *c, DstFuncDef *def) { - DstScope *scope = dst_compile_topscope(c); +static int32_t dstc_addfuncdef(DstCompiler *c, DstFuncDef *def) { + DstScope *scope = &dst_v_last(c->scopes); while (scope >= c->scopes) { if (scope->flags & DST_SCOPE_FUNCTION) break; scope--; } dst_assert(scope >= c->scopes, "could not add funcdef"); - int32_t defindex = scope->dcount; - int32_t newcount = defindex + 1; - if (newcount >= scope->dcap) { - int32_t newcap = 2 * newcount; - DstFuncDef **defs = realloc(scope->defs, sizeof(DstFuncDef **) * newcap); - if (NULL == defs) { - DST_OUT_OF_MEMORY; - } - scope->defs = defs; - scope->dcap = newcap; - } - scope->dcount = newcount; - scope->defs[defindex] = def; - return defindex; + dst_v_push(scope->defs, def); + return dst_v_count(scope->defs) - 1; } -static int dst_strcompare(const uint8_t *str, const char *other) { - int32_t len = dst_string_length(str); - int32_t index; - for (index = 0; index < len; index++) { - uint8_t c = str[index]; - uint8_t k = ((const uint8_t *)other)[index]; - if (c < k) return -1; - if (c > k) return 1; - if (k == '\0') break; - } - return (other[index] == '\0') ? 0 : -1; -} - -DstSlot dst_compile_fn(DstFormOptions opts, int32_t argn, const DstValue *argv) { +DstSlot dstc_fn(DstFormOptions opts, int32_t argn, const DstValue *argv) { DstCompiler *c = opts.compiler; const DstValue *sm = opts.sourcemap; DstFuncDef *def; @@ -1182,16 +1111,22 @@ DstSlot dst_compile_fn(DstFormOptions opts, int32_t argn, const DstValue *argv) const DstValue *psm; int varargs = 0; - if (argn < 2) dst_compile_cerror(c, sm, "expected at least 2 arguments to function literal"); + if (argn < 2) { + dstc_cerror(c, sm, "expected at least 2 arguments to function literal"); + return dstc_cslot(dst_wrap_nil()); + } /* Begin function */ - dst_compile_scope(c, DST_SCOPE_FUNCTION); + dstc_scope(c, DST_SCOPE_FUNCTION); /* Read function parameters */ parami = 0; arity = 0; if (dst_checktype(argv[0], DST_SYMBOL)) parami = 1; - if (parami >= argn) dst_compile_cerror(c, sm, "expected function parameters"); + if (parami >= argn) { + dstc_cerror(c, sm, "expected function parameters"); + return dstc_cslot(dst_wrap_nil()); + } if (dst_seq_view(argv[parami], ¶ms, ¶mcount)) { psm = dst_sourcemap_index(sm, parami + 1); int32_t i; @@ -1200,9 +1135,10 @@ DstSlot dst_compile_fn(DstFormOptions opts, int32_t argn, const DstValue *argv) if (dst_checktype(params[i], DST_SYMBOL)) { DstSlot slot; /* Check for varargs */ - if (0 == dst_strcompare(dst_unwrap_symbol(params[i]), "&")) { + if (0 == dst_cstrcmp(dst_unwrap_symbol(params[i]), "&")) { if (i != paramcount - 2) { - dst_compile_cerror(c, psmi, "variable argument symbol in unexpected location"); + dstc_cerror(c, psmi, "variable argument symbol in unexpected location"); + return dstc_cslot(dst_wrap_nil()); } varargs = 1; arity--; @@ -1211,46 +1147,48 @@ DstSlot dst_compile_fn(DstFormOptions opts, int32_t argn, const DstValue *argv) slot.flags = DST_SLOT_NAMED; slot.envindex = 0; slot.constant = dst_wrap_nil(); - slot.index = slotalloc_index(c); - slotsym(c, dst_unwrap_symbol(params[i]), slot); + slot.index = dstc_lsloti(c); + dstc_nameslot(c, dst_unwrap_symbol(params[i]), slot); arity++; } else { - dst_compile_cerror(c, psmi, "expected symbol as function parameter"); + dstc_cerror(c, psmi, "expected symbol as function parameter"); + return dstc_cslot(dst_wrap_nil()); } } } else { - dst_compile_cerror(c, sm, "expected function parameters"); + dstc_cerror(c, sm, "expected function parameters"); + return dstc_cslot(dst_wrap_nil()); } /* Compile function body */ for (argi = parami + 1; argi < argn; argi++) { DstSlot s; - DstFormOptions subopts = dst_compile_getopts_index(opts, argi + 1); + DstFormOptions subopts = dstc_getindex(opts, argi + 1); subopts.flags = argi == (argn - 1) ? DST_FOPTS_TAIL : DST_FOPTS_DROP; - s = dst_compile_value(subopts); - dst_compile_freeslot(c, s); + s = dstc_value(subopts); + dstc_freeslot(c, s); } /* Build function */ - def = dst_compile_pop_funcdef(c); + def = dstc_pop_funcdef(c); def->arity = arity; if (varargs) def->flags |= DST_FUNCDEF_FLAG_VARARG; - defindex = dst_compile_addfuncdef(c, def); + defindex = dstc_addfuncdef(c, def); /* Instantiate closure */ ret.flags = 0; ret.envindex = 0; ret.constant = dst_wrap_nil(); - ret.index = slotalloc_index(c); + ret.index = dstc_lsloti(c); localslot = ret.index > 0xF0 ? 0xF1 : ret.index; - dst_compile_emit(c, sm, + dstc_emit(c, sm, (defindex << 16) | (localslot << 8) | DOP_CLOSURE); if (ret.index != localslot) { - dst_compile_emit(c, sm, + dstc_emit(c, sm, (ret.index << 16) | (localslot << 8) | DOP_MOVE_FAR); @@ -1260,56 +1198,41 @@ DstSlot dst_compile_fn(DstFormOptions opts, int32_t argn, const DstValue *argv) } /* Keep in lexographic order */ -static const DstSpecial dst_compiler_specials[] = { - {"def", dst_compile_def}, - {"do", dst_compile_do}, - {"fn", dst_compile_fn}, - {"if", dst_compile_if}, - {"quote", dst_compile_quote}, - {"var", dst_compile_var}, - {"varset!", dst_compile_varset}, - {"while", dst_compile_while} +static const DstSpecial dstc_specials[] = { + {"def", dstc_def}, + {"do", dstc_do}, + {"fn", dstc_fn}, + {"if", dstc_if}, + {"quote", dstc_quote}, + {"var", dstc_var}, + {"varset!", dstc_varset}, + {"while", dstc_while} }; -/* Find an instruction definition given its name */ -static const DstSpecial *dst_finds(const uint8_t *key) { - const DstSpecial *low = dst_compiler_specials; - const DstSpecial *hi = dst_compiler_specials + - (sizeof(dst_compiler_specials) / sizeof(DstSpecial)); - while (low < hi) { - const DstSpecial *mid = low + ((hi - low) / 2); - int comp = dst_strcompare(key, mid->name); - if (comp < 0) { - hi = mid; - } else if (comp > 0) { - low = mid + 1; - } else { - return mid; - } - } - return NULL; -} - /* Compile a tuple */ -DstSlot dst_compile_tuple(DstFormOptions opts) { +DstSlot dstc_tuple(DstFormOptions opts) { DstSlot head; DstFormOptions subopts; DstCompiler *c = opts.compiler; const DstValue *tup = dst_unwrap_tuple(opts.x); int headcompiled = 0; - subopts = dst_compile_getopts_index(opts, 0); + subopts = dstc_getindex(opts, 0); subopts.flags = DST_FUNCTION | DST_CFUNCTION; if (dst_tuple_length(tup) == 0) { - return dst_compile_constantslot(opts.x); + return dstc_cslot(opts.x); } if (dst_checktype(tup[0], DST_SYMBOL)) { - const DstSpecial *s = dst_finds(dst_unwrap_symbol(tup[0])); + const DstSpecial *s = dst_strbinsearch( + &dstc_specials, + sizeof(dstc_specials)/sizeof(DstSpecial), + sizeof(DstSpecial), + dst_unwrap_symbol(tup[0])); if (NULL != s) { return s->compile(opts, dst_tuple_length(tup) - 1, tup + 1); } } if (!headcompiled) { - head = dst_compile_value(subopts); + head = dstc_value(subopts); headcompiled = 1; /* if ((head.flags & DST_SLOT_CONSTANT)) { @@ -1323,194 +1246,167 @@ DstSlot dst_compile_tuple(DstFormOptions opts) { { int32_t headindex; DstSlot retslot; + SlotMap *sms; if (!headcompiled) { - head = dst_compile_value(subopts); + head = dstc_value(subopts); headcompiled = 1; } - headindex = dst_compile_preread(c, subopts.sourcemap, 0xFFFF, 1, head); - dst_compile_pushtuple(opts.compiler, opts.sourcemap, opts.x, 1); + headindex = dstc_preread(c, subopts.sourcemap, 0xFFFF, 1, head); + sms = toslots(opts, 1); + pushslots(opts, sms); + freeslots(opts, sms); if (opts.flags & DST_FOPTS_TAIL) { - dst_compile_emit(c, subopts.sourcemap, (headindex << 8) | DOP_TAILCALL); - retslot = dst_compile_constantslot(dst_wrap_nil()); + dstc_emit(c, subopts.sourcemap, (headindex << 8) | DOP_TAILCALL); + retslot = dstc_cslot(dst_wrap_nil()); retslot.flags = DST_SLOT_RETURNED; } else { - retslot = dst_compile_gettarget(opts); - dst_compile_emit(c, subopts.sourcemap, (headindex << 16) | (retslot.index << 8) | DOP_CALL); + retslot = dstc_gettarget(opts); + dstc_emit(c, subopts.sourcemap, (headindex << 16) | (retslot.index << 8) | DOP_CALL); } - dst_compile_postread(c, head, headindex); + dstc_postread(c, head, headindex); return retslot; } } -static DstSlot dst_compile_array(DstFormOptions opts) { +static DstSlot dstc_array(DstFormOptions opts) { DstCompiler *c = opts.compiler; const DstValue *sm = opts.sourcemap; DstSlot ctor, retslot; + SlotMap *sms; int32_t localindex; - dst_compile_pushtuple(c, sm, opts.x, 0); - ctor = dst_compile_constantslot(dst_wrap_cfunction(dst_stl_array)); - localindex = dst_compile_preread(c, sm, 0xFF, 1, ctor); + sms = toslots(opts, 0); + pushslots(opts, sms); + freeslots(opts, sms); + ctor = dstc_cslot(dst_wrap_cfunction(dst_stl_array)); + localindex = dstc_preread(c, sm, 0xFF, 1, ctor); if (opts.flags & DST_FOPTS_TAIL) { - dst_compile_emit(c, sm, (localindex << 8) | DOP_TAILCALL); - retslot = dst_compile_constantslot(dst_wrap_nil()); + dstc_emit(c, sm, (localindex << 8) | DOP_TAILCALL); + retslot = dstc_cslot(dst_wrap_nil()); retslot.flags = DST_SLOT_RETURNED; } else { - retslot = dst_compile_gettarget(opts); - dst_compile_emit(c, sm, (localindex << 16) | (retslot.index << 8) | DOP_CALL); + retslot = dstc_gettarget(opts); + dstc_emit(c, sm, (localindex << 16) | (retslot.index << 8) | DOP_CALL); } - dst_compile_postread(c, ctor, localindex); + dstc_postread(c, ctor, localindex); return retslot; } -static DstSlot dst_compile_tablector(DstFormOptions opts, DstCFunction cfun) { +static DstSlot dstc_tablector(DstFormOptions opts, DstCFunction cfun) { DstCompiler *c = opts.compiler; const DstValue *sm = opts.sourcemap; - const DstValue *hmap; DstSlot ctor, retslot; - int32_t localindex, i, count, cap; - dst_assert(dst_hashtable_view(opts.x, &hmap, &count, &cap), "expected table or struct"); - for (i = 0; i < cap; i += 2) { - if (!dst_checktype(hmap[i], DST_NIL)) { - DstFormOptions o1 = dst_compile_getopts_key(opts, hmap[i]); - DstFormOptions o2 = dst_compile_getopts_value(opts, hmap[i]); - DstSlot s1 = dst_compile_value(o1); - DstSlot s2 = dst_compile_value(o2); - int32_t ls1 = dst_compile_preread(c, o1.sourcemap, 0xFF, 1, s1); - int32_t ls2 = dst_compile_preread(c, o2.sourcemap, 0xFFFF, 2, s2); - dst_compile_emit(c, o1.sourcemap, - (ls2 << 16) | - (ls1 << 8) | - DOP_PUSH_2); - dst_compile_postread(c, s1, ls1); - dst_compile_postread(c, s2, ls2); - dst_compile_freeslot(c, s1); - dst_compile_freeslot(c, s2); - } - } - ctor = dst_compile_constantslot(dst_wrap_cfunction(cfun)); - localindex = dst_compile_preread(c, sm, 0xFF, 1, ctor); + SlotMap *sms; + int32_t localindex; + sms = toslotskv(opts); + pushslots(opts, sms); + freeslots(opts, sms); + ctor = dstc_cslot(dst_wrap_cfunction(cfun)); + localindex = dstc_preread(c, sm, 0xFF, 1, ctor); if (opts.flags & DST_FOPTS_TAIL) { - dst_compile_emit(c, sm, (localindex << 8) | DOP_TAILCALL); - retslot = dst_compile_constantslot(dst_wrap_nil()); + dstc_emit(c, sm, (localindex << 8) | DOP_TAILCALL); + retslot = dstc_cslot(dst_wrap_nil()); retslot.flags = DST_SLOT_RETURNED; } else { - retslot = dst_compile_gettarget(opts); - dst_compile_emit(c, sm, (localindex << 16) | (retslot.index << 8) | DOP_CALL); + retslot = dstc_gettarget(opts); + dstc_emit(c, sm, (localindex << 16) | (retslot.index << 8) | DOP_CALL); } - dst_compile_postread(c, ctor, localindex); + dstc_postread(c, ctor, localindex); return retslot; } /* Compile a single value */ -DstSlot dst_compile_value(DstFormOptions opts) { +DstSlot dstc_value(DstFormOptions opts) { DstSlot ret; + if (dstc_iserr(&opts)) { + return dstc_cslot(dst_wrap_nil()); + } if (opts.compiler->recursion_guard <= 0) { - dst_compile_cerror(opts.compiler, opts.sourcemap, "recursed too deeply"); + dstc_cerror(opts.compiler, opts.sourcemap, "recursed too deeply"); + return dstc_cslot(dst_wrap_nil()); } opts.compiler->recursion_guard--; switch (dst_type(opts.x)) { default: - ret = dst_compile_constantslot(opts.x); + ret = dstc_cslot(opts.x); break; case DST_SYMBOL: { const uint8_t *sym = dst_unwrap_symbol(opts.x); - ret = dst_compile_resolve(opts.compiler, opts.sourcemap, sym); + ret = dstc_resolve(opts.compiler, opts.sourcemap, sym); break; } case DST_TUPLE: - ret = dst_compile_tuple(opts); + ret = dstc_tuple(opts); break; case DST_ARRAY: - ret = dst_compile_array(opts); + ret = dstc_array(opts); break; case DST_STRUCT: - ret = dst_compile_tablector(opts, dst_stl_struct); + ret = dstc_tablector(opts, dst_stl_struct); break; case DST_TABLE: - ret = dst_compile_tablector(opts, dst_stl_table); + ret = dstc_tablector(opts, dst_stl_table); break; } if (opts.flags & DST_FOPTS_TAIL) { - ret = dst_compile_return(opts.compiler, opts.sourcemap, ret); + ret = dstc_return(opts.compiler, opts.sourcemap, ret); } opts.compiler->recursion_guard++; return ret; } /* Initialize a compiler */ -static void dst_compile_init(DstCompiler *c, DstValue env) { - c->scopecount = 0; - c->scopecap = 0; +static void dstc_init(DstCompiler *c, DstValue env) { c->scopes = NULL; - c->buffercap = 0; - c->buffercount = 0; c->buffer = NULL; c->mapbuffer = NULL; c->recursion_guard = DST_RECURSION_GUARD; c->env = env; + /* Init result */ + c->result.error = NULL; + c->result.status = DST_COMPILE_OK; + c->result.error_start = -1; + c->result.error_end = -1; + c->result.funcdef = NULL; } /* Deinitialize a compiler struct */ -static void dst_compile_deinit(DstCompiler *c) { - while (c->scopecount) - dst_compile_popscope(c); - free(c->scopes); - free(c->buffer); - free(c->mapbuffer); - c->buffer = NULL; - c->mapbuffer = NULL; - c->scopes = NULL; +static void dstc_deinit(DstCompiler *c) { + while (dst_v_count(c->scopes)) dstc_popscope(c); + dst_v_free(c->scopes); + dst_v_free(c->buffer); + dst_v_free(c->mapbuffer); c->env = dst_wrap_nil(); } -/* Compile a single form */ -DstCompileResult dst_compile_one(DstCompiler *c, DstCompileOptions opts) { - DstFormOptions fopts; - DstSlot s; - - /* Ensure only one scope */ - while (c->scopecount) dst_compile_popscope(c); - - if (setjmp(c->on_error)) { - c->result.status = DST_COMPILE_ERROR; - c->result.funcdef = NULL; - return c->result; - } - - /* Push a function scope */ - dst_compile_scope(c, DST_SCOPE_FUNCTION | DST_SCOPE_TOP); - - /* Set the global environment */ - c->env = opts.env; - - fopts.compiler = c; - fopts.sourcemap = opts.sourcemap; - fopts.flags = DST_FOPTS_TAIL | DST_SLOTTYPE_ANY; - fopts.hint = dst_compile_constantslot(dst_wrap_nil()); - fopts.x = opts.source; - - /* Compile the value */ - s = dst_compile_value(fopts); - - c->result.funcdef = dst_compile_pop_funcdef(c); - c->result.status = DST_COMPILE_OK; - - return c->result; -} - /* Compile a form. */ DstCompileResult dst_compile(DstCompileOptions opts) { DstCompiler c; - DstCompileResult res; + DstFormOptions fopts; + DstSlot s; - dst_compile_init(&c, opts.env); + dstc_init(&c, opts.env); - res = dst_compile_one(&c, opts); + /* Push a function scope */ + dstc_scope(&c, DST_SCOPE_FUNCTION | DST_SCOPE_TOP); - dst_compile_deinit(&c); + /* Set initial form options */ + fopts.compiler = &c; + fopts.sourcemap = opts.sourcemap; + fopts.flags = DST_FOPTS_TAIL | DST_SLOTTYPE_ANY; + fopts.hint = dstc_cslot(dst_wrap_nil()); + fopts.x = opts.source; - return res; + /* Compile the value */ + s = dstc_value(fopts); + + if (c.result.status == DST_COMPILE_OK) { + c.result.funcdef = dstc_pop_funcdef(&c); + } + + dstc_deinit(&c); + + return c.result; } DstFunction *dst_compile_func(DstCompileResult res) { diff --git a/core/compile.h b/core/compile.h index 05cf9416..84b39a16 100644 --- a/core/compile.h +++ b/core/compile.h @@ -53,8 +53,6 @@ struct DstSlot { DstValue constant; /* If the slot has a constant value */ }; -/* Most forms that return a constant will not generate any bytecode */ - /* Special forms that need support */ /* cond * while (continue, break) @@ -72,55 +70,42 @@ struct DstSlot { #define DST_SCOPE_TOP 4 #define DST_SCOPE_UNUSED 8 +/* A symbol and slot pair */ +typedef struct SymPair { + const uint8_t *sym; + DstSlot slot; +} SymPair; + /* A lexical scope during compilation */ struct DstScope { /* Constants for this funcdef */ - int32_t ccount; - int32_t ccap; DstValue *consts; /* Map of symbols to slots. Use a simple linear scan for symbols. */ - int32_t symcap; - int32_t symcount; - struct { - const uint8_t *sym; - DstSlot slot; - } *syms; + SymPair *syms; /* Bit vector with allocated slot indices. Used to allocate new slots */ uint32_t *slots; - int32_t scap; int32_t smax; /* FuncDefs */ - int32_t dcount; - int32_t dcap; DstFuncDef **defs; /* Referenced closure environents. The values at each index correspond - * to which index to get the environment from in the parent. The enironment + * to which index to get the environment from in the parent. The environment * that corresponds to the direct parent's stack will always have value 0. */ int32_t *envs; - int32_t envcount; - int32_t envcap; int32_t bytecode_start; int flags; }; -#define dst_compile_topscope(c) ((c)->scopes + (c)->scopecount - 1) - /* Compilation state */ struct DstCompiler { - jmp_buf on_error; int recursion_guard; - int32_t scopecount; - int32_t scopecap; DstScope *scopes; - int32_t buffercap; - int32_t buffercount; uint32_t *buffer; int32_t *mapbuffer; @@ -156,32 +141,32 @@ typedef struct DstSpecial { } DstSpecial; /* An array of optimizers sorted by key */ -extern DstCFunctionOptimizer dst_compiler_optimizers[255]; +extern DstCFunctionOptimizer dstcr_optimizers[255]; /* Dispatch to correct form compiler */ -DstSlot dst_compile_value(DstFormOptions opts); +DstSlot dstc_value(DstFormOptions opts); /****************************************************/ -void dst_compile_error(DstCompiler *c, const DstValue *sourcemap, const uint8_t *m); -void dst_compile_cerror(DstCompiler *c, const DstValue *sourcemap, const char *m); +void dstc_error(DstCompiler *c, const DstValue *sourcemap, const uint8_t *m); +void dstc_cerror(DstCompiler *c, const DstValue *sourcemap, const char *m); /* Use these to get sub options. They will traverse the source map so * compiler errors make sense. Then modify the returned options. */ -DstFormOptions dst_compile_getopts_index(DstFormOptions opts, int32_t index); -DstFormOptions dst_compile_getopts_key(DstFormOptions opts, DstValue key); -DstFormOptions dst_compile_getopts_value(DstFormOptions opts, DstValue key); +DstFormOptions dstc_getindex(DstFormOptions opts, int32_t index); +DstFormOptions dstc_getkey(DstFormOptions opts, DstValue key); +DstFormOptions dstc_getvalue(DstFormOptions opts, DstValue key); -void dst_compile_scope(DstCompiler *c, int newfn); -void dst_compile_popscope(DstCompiler *c); +void dstc_scope(DstCompiler *c, int newfn); +void dstc_popscope(DstCompiler *c); -DstSlot dst_compile_constantslot(DstValue x); -void dst_compile_freeslot(DstCompiler *c, DstSlot slot); +DstSlot dstc_cslot(DstValue x); +void dstc_freeslot(DstCompiler *c, DstSlot slot); /* Search for a symbol */ -DstSlot dst_compile_resolve(DstCompiler *c, const DstValue *sourcemap, const uint8_t *sym); +DstSlot dstc_resolve(DstCompiler *c, const DstValue *sourcemap, const uint8_t *sym); /* Emit instructions. */ -void dst_compile_emit(DstCompiler *c, const DstValue *sourcemap, uint32_t instr); +void dstc_emit(DstCompiler *c, const DstValue *sourcemap, uint32_t instr); #endif diff --git a/core/fiber.c b/core/fiber.c index 0cadda45..0c1ac031 100644 --- a/core/fiber.c +++ b/core/fiber.c @@ -101,17 +101,6 @@ void dst_fiber_pushn(DstFiber *fiber, const DstValue *arr, int32_t n) { fiber->stacktop = newtop; } -/* Pop a value off of the stack. Will not destroy a current stack frame. - * If there is nothing to pop of of the stack, return nil. */ -DstValue dst_fiber_popvalue(DstFiber *fiber) { - int32_t newstacktop = fiber->stacktop - 1; - if (newstacktop < fiber->stackstart) { - return dst_wrap_nil(); - } - fiber->stacktop = newstacktop; - return fiber->data[newstacktop]; -} - /* Help set up function */ static void funcframe_helper(DstFiber *fiber, DstFunction *func) { /* Check varargs */ @@ -168,6 +157,23 @@ void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func) { } +/* If a frame has a closure environment, detach it from + * the stack and have it keep its own values */ +static void dst_function_detach(DstFunction *func) { + /* Check for closure environment */ + if (NULL != func->envs && NULL != func->envs[0]) { + DstFuncEnv *env = func->envs[0]; + size_t s = sizeof(DstValue) * env->length; + DstValue *vmem = malloc(s); + if (NULL == vmem) { + DST_OUT_OF_MEMORY; + } + memcpy(vmem, env->as.fiber->data + env->offset, s); + env->offset = 0; + env->as.values = vmem; + } +} + /* Create a tail frame for a function */ void dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func) { int32_t i; diff --git a/core/func.c b/core/func.c deleted file mode 100644 index c15a1e0b..00000000 --- a/core/func.c +++ /dev/null @@ -1,40 +0,0 @@ -/* -* Copyright (c) 2017 Calvin Rose -* -* 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. -*/ - -#include - -/* If a frame has a closure environment, detach it from - * the stack and have it keep its own values */ -void dst_function_detach(DstFunction *func) { - /* Check for closure environment */ - if (NULL != func->envs && NULL != func->envs[0]) { - DstFuncEnv *env = func->envs[0]; - size_t s = sizeof(DstValue) * env->length; - DstValue *vmem = malloc(s); - if (NULL == vmem) { - DST_OUT_OF_MEMORY; - } - memcpy(vmem, env->as.fiber->data + env->offset, s); - env->offset = 0; - env->as.values = vmem; - } -} diff --git a/core/gc.c b/core/gc.c index 374d31a0..672a91d2 100644 --- a/core/gc.c +++ b/core/gc.c @@ -40,7 +40,7 @@ static void dst_mark_funcdef(DstFuncDef *def); static void dst_mark_function(DstFunction *func); static void dst_mark_array(DstArray *array); static void dst_mark_table(DstTable *table); -static void dst_mark_struct(const DstValue *st); +static void dst_mark_struct(const DstKV *st); static void dst_mark_tuple(const DstValue *tuple); static void dst_mark_buffer(DstBuffer *buffer); static void dst_mark_string(const uint8_t *str); @@ -85,6 +85,16 @@ static void dst_mark_many(const DstValue *values, int32_t n) { } } +/* Mark a bunch of key values items in memory */ +static void dst_mark_kvs(const DstKV *kvs, int32_t n) { + const DstKV *end = kvs + n; + while (kvs < end) { + dst_mark(kvs->key); + dst_mark(kvs->value); + kvs++; + } +} + static void dst_mark_array(DstArray *array) { if (dst_gc_reachable(array)) return; @@ -96,14 +106,14 @@ static void dst_mark_table(DstTable *table) { if (dst_gc_reachable(table)) return; dst_gc_mark(table); - dst_mark_many(table->data, table->capacity); + dst_mark_kvs(table->data, table->capacity); } -static void dst_mark_struct(const DstValue *st) { +static void dst_mark_struct(const DstKV *st) { if (dst_gc_reachable(dst_struct_raw(st))) return; dst_gc_mark(dst_struct_raw(st)); - dst_mark_many(st, dst_struct_capacity(st)); + dst_mark_kvs(st, dst_struct_capacity(st)); } static void dst_mark_tuple(const DstValue *tuple) { @@ -197,7 +207,7 @@ static void dst_deinit_block(DstGCMemoryHeader *block) { dst_table_deinit((DstTable*) mem); break; case DST_MEMORY_FIBER: - free(((DstFiber *) mem)->data); + free(((DstFiber *)mem)->data); break; case DST_MEMORY_BUFFER: dst_buffer_deinit((DstBuffer *) mem); @@ -220,6 +230,7 @@ static void dst_deinit_block(DstGCMemoryHeader *block) { { DstFuncDef *def = (DstFuncDef *)mem; /* TODO - get this all with one alloc and one free */ + free(def->defs); free(def->environments); free(def->constants); free(def->bytecode); @@ -241,7 +252,6 @@ void dst_sweep() { previous = current; current->flags &= ~DST_MEM_REACHABLE; } else { - /*printf("freeing block %p\n", current);*/ dst_deinit_block(current); if (NULL != previous) { previous->next = next; @@ -254,22 +264,6 @@ void dst_sweep() { } } -/*static const char *memtypes[] = {*/ - /*"none",*/ - /*"string",*/ - /*"symbol",*/ - /*"array",*/ - /*"tuple",*/ - /*"table",*/ - /*"struct",*/ - /*"fiber",*/ - /*"buffer",*/ - /*"function",*/ - /*"abstract",*/ - /*"funcenv",*/ - /*"funcdef"*/ -/*};*/ - /* Allocate some memory that is tracked for garbage collection */ void *dst_gcalloc(DstMemoryType type, size_t size) { DstGCMemoryHeader *mdata; @@ -294,8 +288,6 @@ void *dst_gcalloc(DstMemoryType type, size_t size) { mdata->next = dst_vm_blocks; dst_vm_blocks = mdata; - /*printf("created block %p of size %lu, type %s\n", mem, size, memtypes[type]);*/ - return mem + sizeof(DstGCMemoryHeader); } @@ -361,7 +353,7 @@ int dst_gcunrootall(DstValue root) { /* Free all allocated memory */ void dst_clear_memory() { DstGCMemoryHeader *current = dst_vm_blocks; - while (current) { + while (NULL != current) { dst_deinit_block(current); DstGCMemoryHeader *next = current->next; free(current); diff --git a/core/parse.c b/core/parse.c index 9b8d42ef..6874ef4a 100644 --- a/core/parse.c +++ b/core/parse.c @@ -237,11 +237,13 @@ static const uint8_t *parse_recur( default: atom: { + int ascii = 1; DstValue numcheck; const uint8_t *tokenend = src; if (!is_symbol_char(*src)) goto unexpected_character; - while (tokenend < end && is_symbol_char(*tokenend)) - tokenend++; + while (tokenend < end && is_symbol_char(*tokenend)) { + if (*tokenend++ > 127) ascii = 0; + } numcheck = dst_scan_number(src, tokenend - src); if (!dst_checktype(numcheck, DST_NIL)) { ret = numcheck; @@ -255,7 +257,9 @@ static const uint8_t *parse_recur( if (*src >= '0' && *src <= '9') { goto sym_nodigits; } else { - if (!valid_utf8(src, tokenend - src)) + /* Don't do full utf8 check unless we have seen non ascii characters. */ + int valid = ascii || valid_utf8(src, tokenend - src); + if (!valid) goto invalid_utf8; if (*src == ':') { ret = dst_stringv(src + 1, tokenend - src - 1); @@ -415,8 +419,8 @@ static const uint8_t *parse_recur( ret = dst_wrap_table(t); submapping = dst_wrap_table(subt); } else { - DstValue *st = dst_struct_begin(n >> 1); - DstValue *subst = dst_struct_begin(n >> 1); + DstKV *st = dst_struct_begin(n >> 1); + DstKV *subst = dst_struct_begin(n >> 1); for (i = n; i > 0; i -= 2) { DstValue val = dst_array_pop(&args->stack); DstValue key = dst_array_pop(&args->stack); diff --git a/core/stl.c b/core/stl.c index 80aed5cc..2c2fdca8 100644 --- a/core/stl.c +++ b/core/stl.c @@ -100,7 +100,7 @@ int dst_stl_array(int32_t argn, DstValue *argv, DstValue *ret) { int dst_stl_table(int32_t argn, DstValue *argv, DstValue *ret) { int32_t i; - DstTable *table = dst_table(argn/2); + DstTable *table = dst_table(argn >> 1); if (argn & 1) { *ret = dst_cstringv("expected even number of arguments"); return 1; @@ -114,7 +114,7 @@ int dst_stl_table(int32_t argn, DstValue *argv, DstValue *ret) { int dst_stl_struct(int32_t argn, DstValue *argv, DstValue *ret) { int32_t i; - DstValue *st = dst_struct_begin(argn >> 1); + DstKV *st = dst_struct_begin(argn >> 1); if (argn & 1) { *ret = dst_cstringv("expected even number of arguments"); return 1; @@ -126,6 +126,49 @@ int dst_stl_struct(int32_t argn, DstValue *argv, DstValue *ret) { return 0; } +int dst_stl_fiber(int32_t argn, DstValue *argv, DstValue *ret) { + DstFiber *fiber; + if (argn < 1) { + *ret = dst_cstringv("expected at least one argument"); + return 1; + } + if (!dst_checktype(argv[0], DST_FUNCTION)) { + *ret = dst_cstringv("expected a function"); + return 1; + } + fiber = dst_fiber(64); + dst_fiber_funcframe(fiber, dst_unwrap_function(argv[0])); + fiber->parent = dst_vm_fiber; + *ret = dst_wrap_fiber(fiber); + return 0; +} + +int dst_stl_buffer(int32_t argn, DstValue *argv, DstValue *ret) { + DstBuffer *buffer = dst_buffer(10); + int32_t i; + for (i = 0; i < argn; ++i) { + const uint8_t *bytes = dst_to_string(argv[i]); + int32_t len = dst_string_length(bytes); + dst_buffer_push_bytes(buffer, bytes, len); + } + *ret = dst_wrap_buffer(buffer); + return 0; +} + +int dst_stl_gensym(int32_t argn, DstValue *argv, DstValue *ret) { + if (argn > 1) { + *ret = dst_cstringv("expected one argument"); + return 1; + } + if (argn == 0) { + *ret = dst_wrap_symbol(dst_symbol_gen(NULL, 0)); + } else { + const uint8_t *s = dst_to_string(argv[0]); + *ret = dst_wrap_symbol(dst_symbol_gen(s, dst_string_length(s))); + } + return 0; +} + int dst_stl_get(int32_t argn, DstValue *argv, DstValue *ret) { int32_t i; DstValue ds; @@ -213,6 +256,9 @@ static DstReg stl[] = { {"array", dst_stl_array}, {"tuple", dst_stl_tuple}, {"struct", dst_stl_struct}, + {"fiber", dst_stl_fiber}, + {"buffer", dst_stl_buffer}, + {"gensym", dst_stl_gensym}, {"asm", dst_stl_asm}, {"disasm", dst_stl_disasm}, {"get", dst_stl_get}, diff --git a/core/string.c b/core/string.c index 25df919d..6616839a 100644 --- a/core/string.c +++ b/core/string.c @@ -410,13 +410,15 @@ static const char *dst_type_colors[16] = { static void dst_description_helper(DstPrinter *p, DstValue x); /* Print a hastable view inline */ -static void dst_print_hashtable_inner(DstPrinter *p, const DstValue *data, int32_t len, int32_t cap) { +static void dst_print_hashtable_inner(DstPrinter *p, const DstKV *data, int32_t len, int32_t cap) { int32_t i; int doindent = 0; if (p->flags & DST_PRINTFLAG_INDENT) { if (len <= p->token_line_limit) { - for (i = 0; i < cap; i += 2) { - if (is_print_ds(data[i]) || is_print_ds(data[i + 1])) { + for (i = 0; i < cap; i++) { + const DstKV *kv = data + i; + if (is_print_ds(kv->key) || + is_print_ds(kv->value)) { doindent = 1; break; } @@ -428,12 +430,13 @@ static void dst_print_hashtable_inner(DstPrinter *p, const DstValue *data, int32 if (doindent) { dst_buffer_push_u8(p->buffer, '\n'); p->indent++; - for (i = 0; i < cap; i += 2) { - if (!dst_checktype(data[i], DST_NIL)) { + for (i = 0; i < cap; i++) { + const DstKV *kv = data + i; + if (!dst_checktype(kv->key, DST_NIL)) { dst_print_indent(p); - dst_description_helper(p, data[i]); + dst_description_helper(p, kv->key); dst_buffer_push_u8(p->buffer, ' '); - dst_description_helper(p, data[i + 1]); + dst_description_helper(p, kv->value); dst_buffer_push_u8(p->buffer, '\n'); } } @@ -441,15 +444,16 @@ static void dst_print_hashtable_inner(DstPrinter *p, const DstValue *data, int32 dst_print_indent(p); } else { int isfirst = 1; - for (i = 0; i < cap; i += 2) { - if (!dst_checktype(data[i], DST_NIL)) { + for (i = 0; i < cap; i++) { + const DstKV *kv = data + i; + if (!dst_checktype(kv->key, DST_NIL)) { if (isfirst) isfirst = 0; else dst_buffer_push_u8(p->buffer, ' '); - dst_description_helper(p, data[i]); + dst_description_helper(p, kv->key); dst_buffer_push_u8(p->buffer, ' '); - dst_description_helper(p, data[i + 1]); + dst_description_helper(p, kv->value); } } } @@ -496,6 +500,7 @@ static void dst_description_helper(DstPrinter *p, DstValue x) { const char *close; int32_t len, cap; const DstValue *data; + const DstKV *kvs; DstValue check; p->depth--; switch (dst_type(x)) { @@ -537,8 +542,8 @@ static void dst_description_helper(DstPrinter *p, DstValue x) { dst_buffer_push_cstring(p->buffer, open); if (p->depth == 0) { dst_buffer_push_cstring(p->buffer, "..."); - } else if (dst_hashtable_view(x, &data, &len, &cap)) { - dst_print_hashtable_inner(p, data, len, cap); + } else if (dst_hashtable_view(x, &kvs, &len, &cap)) { + dst_print_hashtable_inner(p, kvs, len, cap); } else if (dst_seq_view(x, &data, &len)) { dst_print_seq_inner(p, data, len); } diff --git a/core/struct.c b/core/struct.c index 8f57ea48..b6b4165e 100644 --- a/core/struct.c +++ b/core/struct.c @@ -23,40 +23,35 @@ #include #include "gc.h" -#define dst_struct_maphash(cap, hash) (((uint32_t)(hash) % (cap)) & 0xFFFFFFFE); +#define dst_struct_maphash(cap, hash) ((uint32_t)(hash & (cap - 1))); /* Begin creation of a struct */ -DstValue *dst_struct_begin(int32_t count) { - /* This expression determines size of structs. It must be a pure - * function of count, and hold at least enough space for count - * key value pairs. The minimum it could be is - * sizeof(int32_t) * 2 + 2 * count * sizeof(DstValue). Adding more space - * ensures that structs are less likely to have hash collisions. If more space - * is added or s is changed, change the macro dst_struct_capacity in internal.h */ - int32_t capacity = 4 * count; - size_t s = sizeof(int32_t) * 2 + (capacity * sizeof(DstValue)); +DstKV *dst_struct_begin(int32_t count) { + + /* Calculate capacity as power of 2 after 2 * count. */ + int32_t capacity = dst_tablen(2 * count); + if (capacity < 0) capacity = dst_tablen(count); + + size_t s = sizeof(int32_t) * 4 + (capacity * sizeof(DstKV)); char *data = dst_gcalloc(DST_MEMORY_STRUCT, s); - DstValue *st = (DstValue *) (data + 2 * sizeof(int32_t)); + DstKV *st = (DstKV *) (data + 4 * sizeof(int32_t)); dst_memempty(st, capacity); dst_struct_length(st) = count; - /* Use the hash storage space as a counter to see how many items - * were successfully added. If this number is not equal to the - * original number, we will need to remake the struct using - * only the kv pairs in the struct */ + dst_struct_capacity(st) = capacity; dst_struct_hash(st) = 0; return st; } /* Find an item in a struct */ -static const DstValue *dst_struct_find(const DstValue *st, DstValue key) { +static const DstKV *dst_struct_find(const DstKV *st, DstValue key) { int32_t cap = dst_struct_capacity(st); int32_t index = dst_struct_maphash(cap, dst_hash(key)); int32_t i; - for (i = index; i < cap; i += 2) - if (dst_checktype(st[i], DST_NIL) || dst_equals(st[i], key)) + for (i = index; i < cap; i++) + if (dst_checktype(st[i].key, DST_NIL) || dst_equals(st[i].key, key)) return st + i; - for (i = 0; i < index; i += 2) - if (dst_checktype(st[i], DST_NIL) || dst_equals(st[i], key)) + for (i = 0; i < index; i++) + if (dst_checktype(st[i].key, DST_NIL) || dst_equals(st[i].key, key)) return st + i; return NULL; } @@ -64,7 +59,7 @@ static const DstValue *dst_struct_find(const DstValue *st, DstValue key) { /* Put a kv pair into a struct that has not yet been fully constructed. * Nil keys and values are ignored, extra keys are ignore, and duplicate keys are * ignored. */ -void dst_struct_put(DstValue *st, DstValue key, DstValue value) { +void dst_struct_put(DstKV *st, DstValue key, DstValue value) { int32_t cap = dst_struct_capacity(st); int32_t hash = dst_hash(key); int32_t index = dst_struct_maphash(cap, hash); @@ -74,14 +69,15 @@ void dst_struct_put(DstValue *st, DstValue key, DstValue value) { /* Avoid extra items */ if (dst_struct_hash(st) == dst_struct_length(st)) return; for (dist = 0, j = 0; j < 4; j += 2) - for (i = bounds[j]; i < bounds[j + 1]; i += 2, dist += 2) { + for (i = bounds[j]; i < bounds[j + 1]; i++, dist++) { int status; int32_t otherhash; int32_t otherindex, otherdist; + DstKV *kv = st + i; /* We found an empty slot, so just add key and value */ - if (dst_checktype(st[i], DST_NIL)) { - st[i] = key; - st[i + 1] = value; + if (dst_checktype(kv->key, DST_NIL)) { + kv->key = key; + kv->value = value; /* Update the temporary count */ dst_struct_hash(st)++; return; @@ -91,9 +87,9 @@ void dst_struct_put(DstValue *st, DstValue key, DstValue value) { * hashing to ensure that equivalent structs that are contsructed * with different order have the same internal layout, and therefor * will compare properly - i.e., {1 2 3 4} should equal {3 4 1 2}. */ - otherhash = dst_hash(st[i]); + otherhash = dst_hash(kv->key); otherindex = dst_struct_maphash(cap, otherhash); - otherdist = (i + cap - otherindex) % cap; + otherdist = (i + cap - otherindex) & (cap - 1); if (dist < otherdist) status = -1; else if (otherdist < dist) @@ -103,95 +99,89 @@ void dst_struct_put(DstValue *st, DstValue key, DstValue value) { else if (otherhash < hash) status = 1; else - status = dst_compare(key, st[i]); + status = dst_compare(key, kv->key); /* If other is closer to their ideal slot */ if (status == 1) { /* Swap current kv pair with pair in slot */ - DstValue t1, t2; - t1 = st[i]; - t2 = st[i + 1]; - st[i] = key; - st[i + 1] = value; - key = t1; - value = t2; + DstKV temp = *kv; + kv->key = key; + kv->value = value; + key = temp.key; + value = temp.value; /* Save dist and hash of new kv pair */ dist = otherdist; hash = otherhash; } else if (status == 0) { /* This should not happen - it means * than a key was added to the struct more than once */ + dst_exit("struct double put fail"); return; } } } /* Finish building a struct */ -const DstValue *dst_struct_end(DstValue *st) { +const DstKV *dst_struct_end(DstKV *st) { if (dst_struct_hash(st) != dst_struct_length(st)) { /* Error building struct, probably duplicate values. We need to rebuild * the struct using only the values that went in. The second creation should always * succeed. */ int32_t i, realCount; - DstValue *newst; + DstKV *newst; realCount = 0; - for (i = 0; i < dst_struct_capacity(st); i += 2) { - realCount += dst_checktype(st[i], DST_NIL) ? 1 : 0; + for (i = 0; i < dst_struct_capacity(st); i++) { + DstKV *kv = st + i; + realCount += dst_checktype(kv->key, DST_NIL) ? 1 : 0; } newst = dst_struct_begin(realCount); - for (i = 0; i < dst_struct_capacity(st); i += 2) { - if (!dst_checktype(st[i], DST_NIL)) { - dst_struct_put(newst, st[i], st[i + 1]); + for (i = 0; i < dst_struct_capacity(st); i++) { + DstKV *kv = st + i; + if (!dst_checktype(kv->key, DST_NIL)) { + dst_struct_put(newst, kv->key, kv->value); } } st = newst; } - dst_struct_hash(st) = dst_array_calchash(st, dst_struct_capacity(st)); - return (const DstValue *)st; + dst_struct_hash(st) = dst_kv_calchash(st, dst_struct_capacity(st)); + return (const DstKV *)st; } /* Get an item from a struct */ -DstValue dst_struct_get(const DstValue *st, DstValue key) { - const DstValue *bucket = dst_struct_find(st, key); - if (NULL == bucket || dst_checktype(*bucket, DST_NIL)) { +DstValue dst_struct_get(const DstKV *st, DstValue key) { + const DstKV *kv = dst_struct_find(st, key); + if (NULL == kv || dst_checktype(kv->key, DST_NIL)) { return dst_wrap_nil(); } else { - return bucket[1]; + return kv->value; } } /* Get the next key in a struct */ -DstValue dst_struct_next(const DstValue *st, DstValue key) { - const DstValue *bucket, *end; - end = st + dst_struct_capacity(st); - if (dst_checktype(key, DST_NIL)) { - bucket = st; - } else { - bucket = dst_struct_find(st, key); - if (NULL == bucket || dst_checktype(*bucket, DST_NIL)) - return dst_wrap_nil(); - bucket += 2; +const DstKV *dst_struct_next(const DstKV *st, const DstKV *kv) { + const DstKV *end = st + dst_struct_capacity(st); + kv = (kv == NULL) ? st : kv + 1; + while (kv < end) { + if (!dst_checktype(kv->key, DST_NIL)) return kv; + kv++; } - for (; bucket < end; bucket += 2) { - if (!dst_checktype(bucket[0], DST_NIL)) - return bucket[0]; - } - return dst_wrap_nil(); + return NULL; } /* Convert struct to table */ -DstTable *dst_struct_to_table(const DstValue *st) { +DstTable *dst_struct_to_table(const DstKV *st) { DstTable *table = dst_table(dst_struct_capacity(st)); int32_t i; - for (i = 0; i < dst_struct_capacity(st); i += 2) { - if (!dst_checktype(st[i], DST_NIL)) { - dst_table_put(table, st[i], st[i + 1]); + for (i = 0; i < dst_struct_capacity(st); i++) { + const DstKV *kv = st + i; + if (!dst_checktype(kv->key, DST_NIL)) { + dst_table_put(table, kv->key, kv->value); } } return table; } /* Check if two structs are equal */ -int dst_struct_equal(const DstValue *lhs, const DstValue *rhs) { +int dst_struct_equal(const DstKV *lhs, const DstKV *rhs) { int32_t index; int32_t llen = dst_struct_capacity(lhs); int32_t rlen = dst_struct_capacity(rhs); @@ -199,21 +189,21 @@ int dst_struct_equal(const DstValue *lhs, const DstValue *rhs) { int32_t rhash = dst_struct_hash(rhs); if (llen != rlen) return 0; - if (lhash == 0) - lhash = dst_struct_hash(lhs) = dst_array_calchash(lhs, llen); - if (rhash == 0) - rhash = dst_struct_hash(rhs) = dst_array_calchash(rhs, rlen); if (lhash != rhash) return 0; for (index = 0; index < llen; index++) { - if (!dst_equals(lhs[index], rhs[index])) + const DstKV *l = lhs + index; + const DstKV *r = rhs + index; + if (!dst_equals(l->key, r->key)) + return 0; + if (!dst_equals(l->value, r->value)) return 0; } return 1; } /* Compare structs */ -int dst_struct_compare(const DstValue *lhs, const DstValue *rhs) { +int dst_struct_compare(const DstKV *lhs, const DstKV *rhs) { int32_t i; int32_t lhash = dst_struct_hash(lhs); int32_t rhash = dst_struct_hash(rhs); @@ -223,16 +213,16 @@ int dst_struct_compare(const DstValue *lhs, const DstValue *rhs) { return -1; if (llen > rlen) return 1; - if (0 == lhash) - lhash = dst_struct_hash(lhs) = dst_array_calchash(lhs, llen); - if (0 == rhash) - rhash = dst_struct_hash(rhs) = dst_array_calchash(rhs, rlen); if (lhash < rhash) return -1; if (lhash > rhash) return 1; for (i = 0; i < llen; ++i) { - int comp = dst_compare(lhs[i], rhs[i]); + const DstKV *l = lhs + i; + const DstKV *r = rhs + i; + int comp = dst_compare(l->key, r->key); + if (comp != 0) return comp; + comp = dst_compare(l->value, r->value); if (comp != 0) return comp; } return 0; diff --git a/core/table.c b/core/table.c index 5c56bdb3..8a40af28 100644 --- a/core/table.c +++ b/core/table.c @@ -23,18 +23,23 @@ #include #include "gc.h" -#define dst_table_maphash(cap, hash) (((uint32_t)(hash) % (cap)) & 0xFFFFFFFE) +#define dst_table_maphash(cap, hash) ((uint32_t)(hash) & (cap - 1)) /* Initialize a table */ DstTable *dst_table_init(DstTable *table, int32_t capacity) { - DstValue *data; - if (capacity < 2) capacity = 2; - data = (DstValue *) dst_memalloc_empty(capacity); - if (NULL == data) { - DST_OUT_OF_MEMORY; + DstKV *data; + capacity = dst_tablen(capacity); + if (capacity) { + data = (DstKV *) dst_memalloc_empty(capacity); + if (NULL == data) { + DST_OUT_OF_MEMORY; + } + table->data = data; + table->capacity = capacity; + } else { + table->data = NULL; + table->capacity = 0; } - table->data = data; - table->capacity = capacity; table->count = 0; table->deleted = 0; return table; @@ -53,26 +58,34 @@ DstTable *dst_table(int32_t capacity) { /* Find the bucket that contains the given key. Will also return * bucket where key should go if not in the table. */ -static DstValue *dst_table_find(DstTable *t, DstValue key) { +static DstKV *dst_table_find(DstTable *t, DstValue key) { int32_t index = dst_table_maphash(t->capacity, dst_hash(key)); - int32_t i, j; - int32_t start[2], end[2]; - DstValue *first_bucket = NULL; - start[0] = index; end[0] = t->capacity; - start[1] = 0; end[1] = index; - for (j = 0; j < 2; ++j) { - for (i = start[j]; i < end[j]; i += 2) { - if (dst_checktype(t->data[i], DST_NIL)) { - if (dst_checktype(t->data[i + 1], DST_NIL)) { - /* Empty */ - return t->data + i; - } else if (NULL == first_bucket) { - /* Marked deleted and not seen free bucket yet. */ - first_bucket = t->data + i; - } - } else if (dst_equals(t->data[i], key)) { - return t->data + i; + int32_t i; + DstKV *first_bucket = NULL; + /* Higher half */ + for (i = index; i < t->capacity; i++) { + DstKV *kv = t->data + i; + if (dst_checktype(kv->key, DST_NIL)) { + if (dst_checktype(kv->value, DST_NIL)) { + return kv; + } else if (NULL == first_bucket) { + first_bucket = kv; } + } else if (dst_equals(kv->key, key)) { + return t->data + i; + } + } + /* Lower half */ + for (i = 0; i < index; i++) { + DstKV *kv = t->data + i; + if (dst_checktype(kv->key, DST_NIL)) { + if (dst_checktype(kv->value, DST_NIL)) { + return kv; + } else if (NULL == first_bucket) { + first_bucket = kv; + } + } else if (dst_equals(kv->key, key)) { + return t->data + i; } } return first_bucket; @@ -80,8 +93,8 @@ static DstValue *dst_table_find(DstTable *t, DstValue key) { /* Resize the dictionary table. */ static void dst_table_rehash(DstTable *t, int32_t size) { - DstValue *olddata = t->data; - DstValue *newdata = (DstValue *) dst_memalloc_empty(size); + DstKV *olddata = t->data; + DstKV *newdata = (DstKV *) dst_memalloc_empty(size); if (NULL == newdata) { DST_OUT_OF_MEMORY; } @@ -90,11 +103,11 @@ static void dst_table_rehash(DstTable *t, int32_t size) { t->data = newdata; t->capacity = size; t->deleted = 0; - for (i = 0; i < oldcapacity; i += 2) { - if (!dst_checktype(olddata[i], DST_NIL)) { - DstValue *bucket = dst_table_find(t, olddata[i]); - bucket[0] = olddata[i]; - bucket[1] = olddata[i + 1]; + for (i = 0; i < oldcapacity; i++) { + DstKV *kv = olddata + i; + if (!dst_checktype(kv->key, DST_NIL)) { + DstKV *newkv = dst_table_find(t, kv->key); + *newkv = *kv; } } free(olddata); @@ -102,9 +115,9 @@ static void dst_table_rehash(DstTable *t, int32_t size) { /* Get a value out of the object */ DstValue dst_table_get(DstTable *t, DstValue key) { - DstValue *bucket = dst_table_find(t, key); - if (NULL != bucket && !dst_checktype(bucket[0], DST_NIL)) - return bucket[1]; + DstKV *bucket = dst_table_find(t, key); + if (NULL != bucket && !dst_checktype(bucket->key, DST_NIL)) + return bucket->value; else return dst_wrap_nil(); } @@ -112,13 +125,13 @@ DstValue dst_table_get(DstTable *t, DstValue key) { /* Remove an entry from the dictionary. Return the value that * was removed. */ DstValue dst_table_remove(DstTable *t, DstValue key) { - DstValue *bucket = dst_table_find(t, key); - if (NULL != bucket && !dst_checktype(bucket[0], DST_NIL)) { - DstValue ret = bucket[1]; + DstKV *bucket = dst_table_find(t, key); + if (NULL != bucket && !dst_checktype(bucket->key, DST_NIL)) { + DstValue ret = bucket->key; t->count--; t->deleted++; - bucket[0] = dst_wrap_nil(); - bucket[1] = dst_wrap_false(); + bucket->key = dst_wrap_nil(); + bucket->value = dst_wrap_false(); return ret; } else { return dst_wrap_nil(); @@ -131,18 +144,18 @@ void dst_table_put(DstTable *t, DstValue key, DstValue value) { if (dst_checktype(value, DST_NIL)) { dst_table_remove(t, key); } else { - DstValue *bucket = dst_table_find(t, key); - if (NULL != bucket && !dst_checktype(bucket[0], DST_NIL)) { - bucket[1] = value; + DstKV *bucket = dst_table_find(t, key); + if (NULL != bucket && !dst_checktype(bucket->key, DST_NIL)) { + bucket->value = value; } else { - if (NULL == bucket || 4 * (t->count + t->deleted) >= t->capacity) { - dst_table_rehash(t, 4 * t->count + 6); + if (NULL == bucket || 2 * (t->count + t->deleted + 1) > t->capacity) { + dst_table_rehash(t, dst_tablen(2 * t->count + 2)); } bucket = dst_table_find(t, key); - if (dst_checktype(bucket[1], DST_FALSE)) + if (dst_checktype(bucket->value, DST_FALSE)) --t->deleted; - bucket[0] = key; - bucket[1] = value; + bucket->key = key; + bucket->value = value; ++t->count; } } @@ -151,54 +164,35 @@ void dst_table_put(DstTable *t, DstValue key, DstValue value) { /* Clear a table */ void dst_table_clear(DstTable *t) { int32_t capacity = t->capacity; - DstValue *data = t->data; + DstKV *data = t->data; dst_memempty(data, capacity); t->count = 0; t->deleted = 0; } -/* Find next key in an object. Returns nil if no next key. */ -DstValue dst_table_next(DstTable *t, DstValue key) { - const DstValue *bucket, *end; - end = t->data + t->capacity; - if (dst_checktype(key, DST_NIL)) { - bucket = t->data; - } else { - bucket = dst_table_find(t, key); - if (NULL == bucket || dst_checktype(bucket[0], DST_NIL)) - return dst_wrap_nil(); - bucket += 2; +/* Find next key in an object. Returns NULL if no next key. */ +const DstKV *dst_table_next(DstTable *t, const DstKV *kv) { + DstKV *end = t->data + t->capacity; + kv = (kv == NULL) ? t->data : kv + 1; + while (kv < end) { + if (!dst_checktype(kv->key, DST_NIL)) + return kv; + kv++; } - for (; bucket < end; bucket += 2) { - if (!dst_checktype(bucket[0], DST_NIL)) - return bucket[0]; - } - return dst_wrap_nil(); + return NULL; } /* Convert table to struct */ -const DstValue *dst_table_to_struct(DstTable *t) { - int32_t i; - DstValue *st = dst_struct_begin(t->count); - for (i = 0; i < t->capacity; i += 2) { - if (!dst_checktype(t->data[i], DST_NIL)) { - dst_struct_put(st, t->data[i], t->data[i + 1]); - } +const DstKV *dst_table_to_struct(DstTable *t) { + DstKV *st = dst_struct_begin(t->count); + DstKV *kv = t->data; + DstKV *end = t->data + t->capacity; + while (kv < end) { + if (!dst_checktype(kv->key, DST_NIL)) + dst_struct_put(st, kv->key, kv->value); + kv++; } return dst_struct_end(st); } -/* Merge a struct or another table into a table. */ -void dst_table_merge(DstTable *t, DstValue other) { - int32_t count, cap, i; - const DstValue *hmap; - if (dst_hashtable_view(other, &hmap, &count, &cap)) { - for (i = 0; i < cap; i += 2) { - if (!dst_checktype(hmap[i], DST_NIL)) { - dst_table_put(t, hmap[i], hmap[i + 1]); - } - } - } -} - #undef dst_table_maphash diff --git a/core/util.c b/core/util.c index 2e535882..b4761a1e 100644 --- a/core/util.c +++ b/core/util.c @@ -59,6 +59,18 @@ int32_t dst_array_calchash(const DstValue *array, int32_t len) { return (int32_t) hash; } +/* Computes hash of an array of values */ +int32_t dst_kv_calchash(const DstKV *kvs, int32_t len) { + const DstKV *end = kvs + len; + uint32_t hash = 5381; + while (kvs < end) { + hash = (hash << 5) + hash + dst_hash(kvs->key); + hash = (hash << 5) + hash + dst_hash(kvs->value); + kvs++; + } + return (int32_t) hash; +} + /* Calculate hash for string */ int32_t dst_string_calchash(const uint8_t *str, int32_t len) { const uint8_t *end = str + len; @@ -68,6 +80,58 @@ int32_t dst_string_calchash(const uint8_t *str, int32_t len) { return (int32_t) hash; } +/* Calculate next power of 2. May overflow. If n is 0, + * will return 0. */ +int32_t dst_tablen(int32_t n) { + n |= n >> 1; + n |= n >> 2; + n |= n >> 4; + n |= n >> 8; + n |= n >> 16; + return n + 1; +} + +/* Compare a dst string with a cstring. more efficient than loading + * c string as a dst string. */ +int dst_cstrcmp(const uint8_t *str, const char *other) { + int32_t len = dst_string_length(str); + int32_t index; + for (index = 0; index < len; index++) { + uint8_t c = str[index]; + uint8_t k = ((const uint8_t *)other)[index]; + if (c < k) return -1; + if (c > k) return 1; + if (k == '\0') break; + } + return (other[index] == '\0') ? 0 : -1; +} + +/* Do a binary search on a static array of structs. Each struct must + * have a string as its first element, and the struct must be sorted + * lexogrpahically by that element. */ +const void *dst_strbinsearch( + const void *tab, + size_t tabcount, + size_t itemsize, + const uint8_t *key) { + size_t low = 0; + size_t hi = tabcount; + while (low < hi) { + size_t mid = low + ((hi - low) / 2); + const char **item = (const char **)(tab + mid * itemsize); + const char *name = *item; + int comp = dst_cstrcmp(key, name); + if (comp < 0) { + hi = mid; + } else if (comp > 0) { + low = mid + 1; + } else { + return (const void *)item; + } + } + return NULL; +} + /* Read both tuples and arrays as c pointers + int32_t length. Return 1 if the * view can be constructed, 0 if an invalid type. */ int dst_seq_view(DstValue seq, const DstValue **data, int32_t *len) { @@ -76,7 +140,7 @@ int dst_seq_view(DstValue seq, const DstValue **data, int32_t *len) { *len = dst_unwrap_array(seq)->count; return 1; } else if (dst_checktype(seq, DST_TUPLE)) { - *data = dst_unwrap_struct(seq); + *data = dst_unwrap_tuple(seq); *len = dst_tuple_length(dst_unwrap_struct(seq)); return 1; } @@ -101,7 +165,7 @@ int dst_chararray_view(DstValue str, const uint8_t **data, int32_t *len) { /* Read both structs and tables as the entries of a hashtable with * identical structure. Returns 1 if the view can be constructed and * 0 if the type is invalid. */ -int dst_hashtable_view(DstValue tab, const DstValue **data, int32_t *len, int32_t *cap) { +int dst_hashtable_view(DstValue tab, const DstKV **data, int32_t *len, int32_t *cap) { if (dst_checktype(tab, DST_TABLE)) { *data = dst_unwrap_table(tab)->data; *cap = dst_unwrap_table(tab)->capacity; diff --git a/core/value.c b/core/value.c index 9f8dea4e..74643dee 100644 --- a/core/value.c +++ b/core/value.c @@ -211,14 +211,14 @@ void dst_put(DstValue ds, DstValue key, DstValue value) { /* Get the next key in an associative data structure. Used for iterating through an * associative data structure. */ -DstValue dst_next(DstValue ds, DstValue key) { +const DstKV *dst_next(DstValue ds, const DstKV *kv) { switch(dst_type(ds)) { default: - return dst_wrap_nil(); + return NULL; case DST_TABLE: - return dst_table_next(dst_unwrap_table(ds), key); + return (const DstKV *) dst_table_next(dst_unwrap_table(ds), kv); case DST_STRUCT: - return dst_struct_next(dst_unwrap_struct(ds), key); + return dst_struct_next(dst_unwrap_struct(ds), kv); } } diff --git a/core/vector.c b/core/vector.c new file mode 100644 index 00000000..5603c144 --- /dev/null +++ b/core/vector.c @@ -0,0 +1,73 @@ +/* +* Copyright (c) 2017 Calvin Rose +* +* 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. +*/ + +#include +#include "vector.h" + +void *dst_v_grow(void *v, int32_t increment, int32_t itemsize) { + int32_t dbl_cur = (NULL != v) ? 2 * dst_v__cap(v) : 0; + int32_t min_needed = dst_v_count(v) + increment; + int32_t m = dbl_cur > min_needed ? dbl_cur : min_needed; + int32_t *p = (int32_t *) realloc(v ? dst_v__raw(v) : 0, itemsize * m + sizeof(int32_t)*2); + if (NULL != p) { + if (!v) p[1] = 0; + p[0] = m; + return p + 2; + } else { + { + DST_OUT_OF_MEMORY; + } + return (void *) (2 * sizeof(int32_t)); // try to force a NULL pointer exception later + } +} + +void *dst_v_copymem(void *v, int32_t itemsize) { + int32_t *p; + if (NULL == v) return NULL; + p = malloc(2 * sizeof(int32_t) + itemsize * dst_v__cap(v)); + if (NULL != p) { + memcpy(p, dst_v__raw(v), 2 * sizeof(int32_t) + itemsize * dst_v__cnt(v)); + return p + 2; + } else { + { + DST_OUT_OF_MEMORY; + } + return (void *) (2 * sizeof(int32_t)); // try to force a NULL pointer exception later + } +} + +void *dst_v_flattenmem(void *v, int32_t itemsize) { + int32_t *p; + int32_t sizen; + if (NULL == v) return NULL; + sizen = itemsize * dst_v__cnt(v); + p = malloc(sizen); + if (NULL != p) { + memcpy(p, v, sizen); + return p; + } else { + { + DST_OUT_OF_MEMORY; + } + return NULL; + } +} diff --git a/core/vector.h b/core/vector.h new file mode 100644 index 00000000..c3a53703 --- /dev/null +++ b/core/vector.h @@ -0,0 +1,58 @@ +/* +* Copyright (c) 2017 Calvin Rose +* +* 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. +*/ + +#ifndef DST_VECTOR_H_defined +#define DST_VECTOR_H_defined + +/* + * Modified from + * https://github.com/nothings/stb/blob/master/stretchy_buffer.h +*/ + +/* This is mainly used code such as the assembler or compiler, which + * need vector like data structures that are not garbage collected + * and used only from C */ + +#include + +#define dst_v_free(v) (((v) != NULL) ? (free(dst_v__raw(v)), 0) : 0) +#define dst_v_push(v, x) (dst_v__maybegrow(v, 1), (v)[dst_v__cnt(v)++] = (x)) +#define dst_v_pop(v) (dst_v_count(v) ? dst_v__cnt(v)-- : 0) +#define dst_v_count(v) (((v) != NULL) ? dst_v__cnt(v) : 0) +#define dst_v_add(v, n) (dst_v__maybegrow(v, n), dst_v_cnt(v) += (n), &(v)[dst_v__cnt(v) - (n)]) +#define dst_v_last(v) ((v)[dst_v__cnt(v) - 1]) +#define dst_v_copy(v) (dst_v_copymem((v), sizeof(*(v)))) +#define dst_v_flatten(v) (dst_v_flattenmem((v), sizeof(*(v)))) + +#define dst_v__raw(v) ((int32_t *)(v) - 2) +#define dst_v__cap(v) dst_v__raw(v)[0] +#define dst_v__cnt(v) dst_v__raw(v)[1] + +#define dst_v__needgrow(v, n) ((v) == NULL || dst_v__cnt(v) + (n) >= dst_v__cap(v)) +#define dst_v__maybegrow(v, n) (dst_v__needgrow((v), (n)) ? dst_v__grow((v), (n)) : 0) +#define dst_v__grow(v, n) ((v) = dst_v_grow((v), (n), sizeof(*(v)))) + +void *dst_v_grow(void *v, int32_t increment, int32_t itemsize); +void *dst_v_copymem(void *v, int32_t itemsize); +void *dst_v_flattenmem(void *v, int32_t itemsize); + +#endif diff --git a/core/vm.c b/core/vm.c index 77bdee5f..c97091e3 100644 --- a/core/vm.c +++ b/core/vm.c @@ -43,7 +43,7 @@ static int dst_update_fiber() { return 1; } } else { - /* The root thread has termiated */ + /* The root thread has terminated */ return 1; } } @@ -68,7 +68,7 @@ static int dst_continue(DstValue *returnreg) { * Pulls out unsigned integers */ #define oparg(shift, mask) (((*pc) >> ((shift) << 3)) & (mask)) -#define vm_throw(e) do { retreg = dst_wrap_string(dst_formatc("%s, %v", (e), dst_asm_decode_instruction(*pc))); goto vm_error; } while (0) +#define vm_throw(e) do { retreg = dst_cstringv(e); goto vm_error; } while (0) #define vm_assert(cond, e) do {if (!(cond)) vm_throw((e)); } while (0) #define vm_binop_integer(op) \ diff --git a/core/wrap.c b/core/wrap.c index bf890973..df0e9788 100644 --- a/core/wrap.c +++ b/core/wrap.c @@ -31,14 +31,21 @@ void *dst_nanbox_to_pointer(DstValue x) { * the high bits, and may make the pointer non-canocial on x86. If we switch * to 47 bit pointers (which is what userspace uses on Windows, we can use * the single mask rather than two shifts. */ +#if defined (DST_NANBOX_47) || defined (DST_32) + x.i64 &= DST_NANBOX_POINTERBITS; +#else x.i64 = (x.i64 << 16) >> 16; +#endif return x.pointer; } DstValue dst_nanbox_from_pointer(void *p, uint64_t tagmask) { DstValue ret; ret.pointer = p; +#if defined (DST_NANBOX_47) || defined (DST_32) +#else ret.u64 &= DST_NANBOX_POINTERBITS; +#endif ret.u64 |= tagmask; return ret; } @@ -46,7 +53,10 @@ DstValue dst_nanbox_from_pointer(void *p, uint64_t tagmask) { DstValue dst_nanbox_from_cpointer(const void *p, uint64_t tagmask) { DstValue ret; ret.cpointer = p; +#if defined (DST_NANBOX_47) || defined (DST_32) +#else ret.u64 &= DST_NANBOX_POINTERBITS; +#endif ret.u64 |= tagmask; return ret; } @@ -68,18 +78,21 @@ DstValue dst_nanbox_from_bits(uint64_t bits) { void *dst_nanbox_memalloc_empty(int32_t count) { int32_t i; - void *mem = malloc(count * sizeof(DstValue)); - DstValue *mmem = (DstValue *)mem; + void *mem = malloc(count * sizeof(DstKV)); + DstKV *mmem = (DstKV *)mem; for (i = 0; i < count; i++) { - mmem[i] = dst_wrap_nil(); + DstKV *kv = mmem + i; + kv->key = dst_wrap_nil(); + kv->value = dst_wrap_nil(); } return mem; } -void dst_nanbox_memempty(DstValue *mem, int32_t count) { +void dst_nanbox_memempty(DstKV *mem, int32_t count) { int32_t i; for (i = 0; i < count; i++) { - mem[i] = dst_wrap_nil(); + mem[i].key = dst_wrap_nil(); + mem[i].value = dst_wrap_nil(); } } @@ -134,8 +147,8 @@ DST_WRAP_DEFINE(string, const uint8_t *, DST_STRING, cpointer) DST_WRAP_DEFINE(symbol, const uint8_t *, DST_SYMBOL, cpointer) DST_WRAP_DEFINE(array, DstArray *, DST_ARRAY, pointer) DST_WRAP_DEFINE(tuple, const DstValue *, DST_TUPLE, cpointer) -DST_WRAP_DEFINE(struct, const DstValue *, DST_STRUCT, cpointer) -DST_WRAP_DEFINE(thread, DstFiber *, DST_FIBER, pointer) +DST_WRAP_DEFINE(struct, const DstKV *, DST_STRUCT, cpointer) +DST_WRAP_DEFINE(fiber, DstFiber *, DST_FIBER, pointer) DST_WRAP_DEFINE(buffer, DstBuffer *, DST_BUFFER, pointer) DST_WRAP_DEFINE(function, DstFunction *, DST_FUNCTION, pointer) DST_WRAP_DEFINE(cfunction, DstCFunction, DST_CFUNCTION, pointer) diff --git a/dsttest/suite0.dst b/dsttest/suite0.dst index a5d28350..5ba67285 100644 --- a/dsttest/suite0.dst +++ b/dsttest/suite0.dst @@ -47,23 +47,49 @@ (assert (>= 6 5 4 4 3 2 1) "greater than or equal to integers") (assert (>= 6.0 5.0 4.0 4.0 3.0 2.0 1.0) "greater than or equal to reals") -(assert (< nil 1.0 1 false true "hi" +(assert (< nil false true + (fiber (fn [x] x)) + 1 1.0 "hi" (quote hello) (array 1 2 3) (tuple 1 2 3) - (table "a" "b" "c" false) - (struct 1 2) - (fiber (fn [x] x)) + (table "a" "b" "c" "d") + (struct 1 2 3 4) (buffer "hi") (fn [x] (+ x x)) +) "type ordering") +(assert (= (get {} 1) nil) "get nil from empty struct") +(assert (= (get @{} 1) nil) "get nil from empty table") +(assert (= (get {:boop :bap} :boop) :bap) "get non nil from struct") +(assert (= (get @{:boop :bap} :boop) :bap) "get non nil from table") +(assert (put @{} :boop :bap) "can add to empty table") +(assert (put @{1 3} :boop :bap) "can add to non-empty table") + (assert (not false) "false literal") (assert true "true literal") (assert (not nil) "nil literal") (assert (= 7 (| 3 4)) "bit or") (assert (= 0 (& 3 4)) "bit and") +# Set global variables to prevent some compiler optimizations that defeat point of the test +(var zero 0) +(var one 1) +(var two 2) +(var three 3) +(var plus +) +(assert (= 22 (plus one (plus 1 2 two) (plus 8 (plus zero 1) 4 three))) "nested function calls") + +# Mcarthy's 91 function +(var f91 nil) +(varset! f91 (fn [n] (if (> n 100) (- n 10) (f91 (f91 (+ n 11)))))) +(assert (= 91 (f91 10)), "f91(10) = 91") +(assert (= 91 (f91 100)), "f91(100) = 91") +(assert (= 91 (f91 101)), "f91(101) = 91") +(assert (= 92 (f91 102)), "f91(102) = 92") +(assert (= 93 (f91 103)), "f91(103) = 93") +(assert (= 94 (f91 104)), "f91(104) = 94") + (assert (= "hello" :hello) "keyword syntax for strings") (assert (= '(1 2 3) (quote (1 2 3)) (tuple 1 2 3)) "quote shorthand") diff --git a/include/dst/dst.h b/include/dst/dst.h index 45738ae3..0341d374 100644 --- a/include/dst/dst.h +++ b/include/dst/dst.h @@ -95,18 +95,19 @@ const uint8_t *dst_symbol_gen(const uint8_t *buf, int32_t len); #define dst_csymbolv(cstr) dst_wrap_symbol(dst_csymbol(cstr)) /* Structs */ -#define dst_struct_raw(t) ((int32_t *)(t) - 2) +#define dst_struct_raw(t) ((int32_t *)(t) - 4) #define dst_struct_length(t) (dst_struct_raw(t)[0]) -#define dst_struct_capacity(t) (dst_struct_length(t) * 4) -#define dst_struct_hash(t) ((dst_struct_raw(t)[1])) -DstValue *dst_struct_begin(int32_t count); -void dst_struct_put(DstValue *st, DstValue key, DstValue value); -const DstValue *dst_struct_end(DstValue *st); -DstValue dst_struct_get(const DstValue *st, DstValue key); -DstValue dst_struct_next(const DstValue *st, DstValue key); -DstTable *dst_struct_to_table(const DstValue *st); -int dst_struct_equal(const DstValue *lhs, const DstValue *rhs); -int dst_struct_compare(const DstValue *lhs, const DstValue *rhs); +#define dst_struct_capacity(t) (dst_struct_raw(t)[1]) +#define dst_struct_hash(t) (dst_struct_raw(t)[2]) +/* Do something with the 4th header slot - flags? */ +DstKV *dst_struct_begin(int32_t count); +void dst_struct_put(DstKV *st, DstValue key, DstValue value); +const DstKV *dst_struct_end(DstKV *st); +DstValue dst_struct_get(const DstKV *st, DstValue key); +const DstKV *dst_struct_next(const DstKV *st, const DstKV *kv); +DstTable *dst_struct_to_table(const DstKV *st); +int dst_struct_equal(const DstKV *lhs, const DstKV *rhs); +int dst_struct_compare(const DstKV *lhs, const DstKV *rhs); /* Table functions */ DstTable *dst_table(int32_t capacity); @@ -115,9 +116,9 @@ void dst_table_deinit(DstTable *table); DstValue dst_table_get(DstTable *t, DstValue key); DstValue dst_table_remove(DstTable *t, DstValue key); void dst_table_put(DstTable *t, DstValue key, DstValue value); -DstValue dst_table_next(DstTable *t, DstValue key); -const DstValue *dst_table_to_struct(DstTable *t); -void dst_table_merge(DstTable *t, DstValue other); +const DstKV *dst_table_next(DstTable *t, const DstKV *kv); +const DstKV *dst_table_to_struct(DstTable *t); +void dst_table_merge(DstTable *t, DstValue other); /* Fiber */ DstFiber *dst_fiber(int32_t capacity); @@ -129,15 +130,11 @@ void dst_fiber_push(DstFiber *fiber, DstValue x); void dst_fiber_push2(DstFiber *fiber, DstValue x, DstValue y); void dst_fiber_push3(DstFiber *fiber, DstValue x, DstValue y, DstValue z); void dst_fiber_pushn(DstFiber *fiber, const DstValue *arr, int32_t n); -DstValue dst_fiber_popvalue(DstFiber *fiber); void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func); void dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func); void dst_fiber_cframe(DstFiber *fiber); void dst_fiber_popframe(DstFiber *fiber); -/* Functions */ -void dst_function_detach(DstFunction *func); - /* Assembly */ DstAssembleResult dst_asm(DstAssembleOptions opts); DstFunction *dst_asm_func(DstAssembleResult result); @@ -147,7 +144,7 @@ DstValue dst_asm_decode_instruction(uint32_t instr); /* Treat similar types through uniform interfaces for iteration */ int dst_seq_view(DstValue seq, const DstValue **data, int32_t *len); int dst_chararray_view(DstValue str, const uint8_t **data, int32_t *len); -int dst_hashtable_view(DstValue tab, const DstValue **data, int32_t *len, int32_t *cap); +int dst_hashtable_view(DstValue tab, const DstKV **data, int32_t *len, int32_t *cap); /* Abstract */ #define dst_abstract_header(u) ((DstAbstractHeader *)(u) - 1) @@ -160,7 +157,7 @@ int32_t dst_hash(DstValue x); int dst_compare(DstValue x, DstValue y); DstValue dst_get(DstValue ds, DstValue key); void dst_put(DstValue ds, DstValue key, DstValue value); -DstValue dst_next(DstValue ds, DstValue key); +const DstKV *dst_next(DstValue ds, const DstKV *kv); int32_t dst_length(DstValue x); int32_t dst_capacity(DstValue x); DstValue dst_getindex(DstValue ds, int32_t index); @@ -169,11 +166,19 @@ void dst_setindex(DstValue ds, DstValue value, int32_t index); /* Utils */ extern const char dst_base64[65]; int32_t dst_array_calchash(const DstValue *array, int32_t len); +int32_t dst_kv_calchash(const DstKV *kvs, int32_t len); int32_t dst_string_calchash(const uint8_t *str, int32_t len); +int32_t dst_tablen(int32_t n); DstValue dst_loadreg(DstReg *regs, size_t count); DstValue dst_scan_number(const uint8_t *src, int32_t len); int32_t dst_scan_integer(const uint8_t *str, int32_t len, int *err); double dst_scan_real(const uint8_t *str, int32_t len, int *err); +int dst_cstrcmp(const uint8_t *str, const char *other); +const void *dst_strbinsearch( + const void *tab, + size_t tabcount, + size_t itemsize, + const uint8_t *key); /* Parsing */ DstParseResult dst_parse(const uint8_t *src, int32_t len); diff --git a/include/dst/dstconfig.h b/include/dst/dstconfig.h index 4a83a272..88e4e745 100644 --- a/include/dst/dstconfig.h +++ b/include/dst/dstconfig.h @@ -28,7 +28,8 @@ /* * Detect OS and endianess. - * From webkit source. + * From webkit source. There is likely some extreneous + * detection for unsupported platforms */ /* Check Unix */ @@ -116,6 +117,14 @@ #define DST_RECURSION_GUARD 1000 /* Use nanboxed values - uses 8 bytes per value instead of 12 or 16. */ -//#define DST_NANBOX +#define DST_NANBOX +#define DST_NANBOX_47 + +/* Alignment for pointers */ +#ifdef DST_32 +#define DST_WALIGN 4 +#else +#define DST_WALIGN 8 +#endif #endif /* DST_CONFIG_H_defined */ diff --git a/include/dst/dsttypes.h b/include/dst/dsttypes.h index 3f902801..69022130 100644 --- a/include/dst/dsttypes.h +++ b/include/dst/dsttypes.h @@ -44,6 +44,7 @@ typedef struct DstReg DstReg; typedef struct DstAbstractHeader DstAbstractHeader; typedef struct DstFuncDef DstFuncDef; typedef struct DstFuncEnv DstFuncEnv; +typedef struct DstKV DstKV; typedef struct DstStackFrame DstStackFrame; typedef struct DstAbstractType DstAbstractType; typedef int (*DstCFunction)(int32_t argn, DstValue *argv, DstValue *ret); @@ -109,11 +110,13 @@ union DstValue { double real; }; +#define dst_u64(x) ((x).u64) + /* This representation uses 48 bit pointers. The trade off vs. the LuaJIT style * 47 bit payload representaion is that the type bits are no long contiguous. Type * checking can still be fast, but typewise polymorphism takes a bit longer. However, * hopefully we can avoid some annoying problems that occur when trying to use 47 bit pointers - * in a 48 bit address space (Linux on ARM) */ + * in a 48 bit address space (Linux on ARM). If DST_NANBOX_47 is set, use 47 bit tagged pointers. */ /* |.......Tag.......|.......................Payload..................| */ /* Non-double: t|11111111111|1ttt|xxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx */ @@ -121,44 +124,61 @@ union DstValue { /* Double (no NaNs): x xxxxxxxxxxx xxxx xxxxxxxxxxxxxxxx xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx */ -/* A simple scheme for nan boxed values */ -/* normal doubles, denormalized doubles, and infinities are doubles */ -/* Quiet nan is nil. Sign bit should be 0. */ +#if defined (DST_NANBOX_47) || defined (DST_32) + +#define DST_NANBOX_TAGBITS 0xFFFF800000000000lu +#define DST_NANBOX_PAYLOADBITS 0x00007FFFFFFFFFFFlu + + +#define dst_nanbox_lowtag(type) \ + ((uint64_t)(type) | 0x1FFF0) + +#define dst_nanbox_tag(type) \ + (dst_nanbox_lowtag(type) << 47) + +#define dst_type(x) \ + (isnan((x).real) \ + ? (((x).u64 >> 47) & 0xF) \ + : DST_REAL) + +#else /* defined (DST_NANBOX_47) || defined (DST_32) */ -#define DST_NANBOX_TYPEBITS 0x0007000000000000lu #define DST_NANBOX_TAGBITS 0xFFFF000000000000lu #define DST_NANBOX_PAYLOADBITS 0x0000FFFFFFFFFFFFlu -#ifdef DST_64 -#define DST_NANBOX_POINTERBITS 0x0000FFFFFFFFFFFFlu -#else -#define DST_NANBOX_POINTERBITS 0x00000000FFFFFFFFlu -#endif -#define dst_u64(x) ((x).u64) #define dst_nanbox_lowtag(type) \ - ((((uint64_t)(type) & 0x8) << 12) | 0x7FF8 | (type)) + ((((uint64_t)(type) & 0x1) << 15) | 0x7FF8 | ((type) >> 1)) + #define dst_nanbox_tag(type) \ (dst_nanbox_lowtag(type) << 48) +#define dst_type(x) \ + (isnan((x).real) \ + ? (((x).u64 >> 47) & 0xE) | ((x).u64 >> 63) \ + : DST_REAL) + +#endif /* defined (DST_NANBOX_47) || defined (DST_32) */ + +/* 32 bit mode will not use the full payload for pointers. */ +#ifdef DST_32 +#define DST_NANBOX_POINTERBITS 0xFFFFFFFFlu +#else +#define DST_NANBOX_POINTERBITS DST_NANBOX_PAYLOADBITS +#endif + #define dst_nanbox_checkauxtype(x, type) \ (((x).u64 & DST_NANBOX_TAGBITS) == dst_nanbox_tag((type))) -/* Check if number is nan or if number is real double */ #define dst_nanbox_isreal(x) \ (!isnan((x).real) || dst_nanbox_checkauxtype((x), DST_REAL)) -#define dst_type(x) \ - (isnan((x).real) \ - ? (((x).u64 & DST_NANBOX_TYPEBITS) >> 48) | (((x).u64 >> 60) & 0x8) \ - : DST_REAL) - #define dst_checktype(x, t) \ (((t) == DST_REAL) \ ? dst_nanbox_isreal(x) \ : dst_nanbox_checkauxtype((x), (t))) void *dst_nanbox_to_pointer(DstValue x); -void dst_nanbox_memempty(DstValue *mem, int32_t count); +void dst_nanbox_memempty(DstKV *mem, int32_t count); void *dst_nanbox_memalloc_empty(int32_t count); DstValue dst_nanbox_from_pointer(void *p, uint64_t tagmask); DstValue dst_nanbox_from_cpointer(const void *p, uint64_t tagmask); @@ -176,10 +196,10 @@ DstValue dst_nanbox_from_bits(uint64_t bits); dst_nanbox_from_bits(dst_nanbox_tag(t) | (p)) #define dst_nanbox_wrap_(p, t) \ - dst_nanbox_from_pointer((p), dst_nanbox_tag(t) | 0x7FF8000000000000lu) + dst_nanbox_from_pointer((p), dst_nanbox_tag(t)) #define dst_nanbox_wrap_c(p, t) \ - dst_nanbox_from_cpointer((p), dst_nanbox_tag(t) | 0x7FF8000000000000lu) + dst_nanbox_from_cpointer((p), dst_nanbox_tag(t)) /* Wrap the simple types */ #define dst_wrap_nil() dst_nanbox_from_payload(DST_NIL, 1) @@ -191,7 +211,7 @@ DstValue dst_nanbox_from_bits(uint64_t bits); /* Unwrap the simple types */ #define dst_unwrap_boolean(x) \ - (((x).u64 >> 48) == dst_nanbox_lowtag(DST_TRUE)) + (dst_checktype(x, DST_TRUE)) #define dst_unwrap_integer(x) \ ((int32_t)((x).u64 & 0xFFFFFFFFlu)) #define dst_unwrap_real(x) ((x).real) @@ -210,7 +230,7 @@ DstValue dst_nanbox_from_bits(uint64_t bits); #define dst_wrap_cfunction(s) dst_nanbox_wrap_((s), DST_CFUNCTION) /* Unwrap the pointer types */ -#define dst_unwrap_struct(x) ((const DstValue *)dst_nanbox_to_pointer(x)) +#define dst_unwrap_struct(x) ((const DstKV *)dst_nanbox_to_pointer(x)) #define dst_unwrap_tuple(x) ((const DstValue *)dst_nanbox_to_pointer(x)) #define dst_unwrap_fiber(x) ((DstFiber *)dst_nanbox_to_pointer(x)) #define dst_unwrap_array(x) ((DstArray *)dst_nanbox_to_pointer(x)) @@ -239,14 +259,14 @@ struct DstValue { }; #define dst_u64(x) ((x).as.u64) -#define dst_memempty(mem, count) memset((mem), 0, sizeof(DstValue) * (count)) -#define dst_memalloc_empty(count) calloc((count), sizeof(DstValue)) +#define dst_memempty(mem, count) memset((mem), 0, sizeof(DstKV) * (count)) +#define dst_memalloc_empty(count) calloc((count), sizeof(DstKV)) #define dst_type(x) ((x).type) #define dst_checktype(x, t) ((x).type == (t)) #define dst_truthy(x) \ ((x).type != DST_NIL && (x).type != DST_FALSE) -#define dst_unwrap_struct(x) ((const DstValue *)(x).as.pointer) +#define dst_unwrap_struct(x) ((const DstKV *)(x).as.pointer) #define dst_unwrap_tuple(x) ((const DstValue *)(x).as.pointer) #define dst_unwrap_fiber(x) ((DstFiber *)(x).as.pointer) #define dst_unwrap_array(x) ((DstArray *)(x).as.pointer) @@ -272,7 +292,7 @@ DstValue dst_wrap_string(const uint8_t *x); DstValue dst_wrap_symbol(const uint8_t *x); DstValue dst_wrap_array(DstArray *x); DstValue dst_wrap_tuple(const DstValue *x); -DstValue dst_wrap_struct(const DstValue *x); +DstValue dst_wrap_struct(const DstKV *x); DstValue dst_wrap_fiber(DstFiber *x); DstValue dst_wrap_buffer(DstBuffer *x); DstValue dst_wrap_function(DstFunction *x); @@ -332,12 +352,18 @@ struct DstBuffer { /* A mutable associative data type. Backed by a hashtable. */ struct DstTable { - DstValue *data; + DstKV *data; int32_t count; int32_t capacity; int32_t deleted; }; +/* A key value pair in a struct or table */ +struct DstKV { + DstValue key; + DstValue value; +}; + /* Some function defintion flags */ #define DST_FUNCDEF_FLAG_VARARG 1 #define DST_FUNCDEF_FLAG_NEEDSENV 4 diff --git a/unittests/array_test.c b/junkyard/array_test.c similarity index 100% rename from unittests/array_test.c rename to junkyard/array_test.c diff --git a/unittests/asm_test.c b/junkyard/asm_test.c similarity index 100% rename from unittests/asm_test.c rename to junkyard/asm_test.c diff --git a/unittests/buffer_test.c b/junkyard/buffer_test.c similarity index 100% rename from unittests/buffer_test.c rename to junkyard/buffer_test.c diff --git a/unittests/compile_test.c b/junkyard/compile_test.c similarity index 100% rename from unittests/compile_test.c rename to junkyard/compile_test.c diff --git a/unittests/fiber_test.c b/junkyard/fiber_test.c similarity index 100% rename from unittests/fiber_test.c rename to junkyard/fiber_test.c diff --git a/unittests/nanbox_test.c b/junkyard/nanbox_test.c similarity index 100% rename from unittests/nanbox_test.c rename to junkyard/nanbox_test.c diff --git a/unittests/parse_test.c b/junkyard/parse_test.c similarity index 100% rename from unittests/parse_test.c rename to junkyard/parse_test.c diff --git a/unittests/strtod_test.c b/junkyard/strtod_test.c similarity index 100% rename from unittests/strtod_test.c rename to junkyard/strtod_test.c diff --git a/unittests/table_test.c b/junkyard/table_test.c similarity index 100% rename from unittests/table_test.c rename to junkyard/table_test.c diff --git a/unittests/unit.h b/junkyard/unit.h similarity index 100% rename from unittests/unit.h rename to junkyard/unit.h diff --git a/packages/test.c b/packages/test.c new file mode 100644 index 00000000..928be974 --- /dev/null +++ b/packages/test.c @@ -0,0 +1 @@ +#include