diff --git a/Makefile b/Makefile index 2cb6d364..d98eb580 100644 --- a/Makefile +++ b/Makefile @@ -26,7 +26,7 @@ PREFIX?=/usr/local BINDIR=$(PREFIX)/bin VERSION=\"0.0.0-beta\" -CFLAGS=-std=c99 -Wall -Wextra -I./include -I./libs -g -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 @@ -38,39 +38,25 @@ DST_HEADERS=$(addprefix include/dst/,dst.h dstconfig.h dsttypes.h dststate.h dst ##### Generated headers ##### ############################# -DST_LANG_SOURCES=$(addprefix libs/, bootstrap.dst) -DST_LANG_HEADERS=$(patsubst %.dst,%.gen.h,$(DST_LANG_SOURCES)) -DST_ALL_HEADERS=$(DST_HEADERS) $(DST_INTERNAL_HEADERS) $(DST_LANG_HEADERS) +DST_ALL_HEADERS=$(DST_HEADERS) $(DST_INTERNAL_HEADERS) all: $(DST_TARGET) -####################### -##### Build tools ##### -####################### - -$(DST_XXD): libs/xxd.c - $(CC) -o $(DST_XXD) libs/xxd.c - -%.gen.h: %.dst $(DST_XXD) - ./$(DST_XXD) $< $@ $(basename $(notdir $<)) - ################################### ##### The core vm and runtime ##### ################################### DST_CORE_SOURCES=$(addprefix core/,\ - array.c asm.c buffer.c compile.c\ - fiber.c func.c gc.c math.c parse.c sourcemap.c string.c stl.c strtod.c\ - struct.c symcache.c table.c tuple.c userdata.c util.c\ + abstract.c array.c asm.c buffer.c compile.c\ + fiber.c func.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) -DST_CORE_OBJECTS=$(patsubst %.c,%.o,$(DST_CORE_SOURCES)) -$(DST_TARGET): client/main.o $(DST_CORE_OBJECTS) - $(CC) $(CFLAGS) -o $(DST_TARGET) $^ +DST_CLIENT_SOURCES=$(addprefix client/,\ + main.c) -# Compile all .c to .o -%.o: %.c $(DST_ALL_HEADERS) - $(CC) $(CFLAGS) -o $@ -c $< +$(DST_TARGET): $(DST_CORE_SOURCES) $(DST_CLIENT_SOURCES) $(DST_ALL_HEADERS) + $(CC) $(CFLAGS) $(DST_CORE_SOURCES) $(DST_CLIENT_SOURCES) -o $(DST_TARGET) ###################### ##### Unit Tests ##### @@ -120,7 +106,9 @@ valtest: $(DST_TARGET) clean: rm $(DST_TARGET) || true - rm $(DST_CORE_OBJECTS) || true + rm *.o || true + rm client/*.o || true + rm core/*.o || true rm $(DST_LANG_HEADERS) || true rm vgcore.* || true rm unittests/*.out || true diff --git a/client/main.c b/client/main.c index ed4511b3..f1dd6b38 100644 --- a/client/main.c +++ b/client/main.c @@ -65,6 +65,14 @@ static const uint8_t *loadsource(const char *fpath, int32_t *len) { return NULL; } +/* Shift bytes in buffer down */ +static void bshift(DstBuffer *buf, int32_t delta) { + buf->count -= delta; + if (delta) { + memmove(buf->data, buf->data + delta, buf->count); + } +} + /* simple repl */ static int repl() { DstBuffer b; @@ -74,29 +82,27 @@ static int repl() { DstParseResult res; DstCompileResult cres; DstCompileOptions opts; - if (b.count == 0) - printf("> "); - else - printf(">> "); - for (;;) { - c = fgetc(stdin); - if (c == EOF) { - printf("\n"); - goto done; - } - dst_buffer_push_u8(&b, c); - if (c == '\n') break; - } res = dst_parse(b.data, b.count); switch (res.status) { case DST_PARSE_NODATA: b.count = 0; - break; case DST_PARSE_UNEXPECTED_EOS: + if (b.count == 0) + printf("> "); + else + printf(">> "); + for (;;) { + c = fgetc(stdin); + if (c == EOF) { + printf("\n"); + goto done; + } + dst_buffer_push_u8(&b, c); + if (c == '\n') break; + } break; case DST_PARSE_ERROR: - dst_puts(dst_formatc("syntax error at %d: %S\n", - res.bytes_read + 1, res.error)); + dst_puts(dst_formatc("syntax error: %S\n", res.error)); b.count = 0; break; case DST_PARSE_OK: @@ -107,18 +113,18 @@ static int repl() { opts.env = env; cres = dst_compile(opts); if (cres.status == DST_COMPILE_OK) { + /*dst_puts(dst_formatc("asm: %v\n", dst_disasm(cres.funcdef)));*/ DstFunction *f = dst_compile_func(cres); DstValue ret; if (dst_run(dst_wrap_function(f), &ret)) { - dst_puts(dst_formatc("runtime error: %v\n", ret)); + dst_puts(dst_formatc("runtime error: %S\n", dst_to_string(ret))); } else { dst_puts(dst_formatc("%v\n", ret)); } } else { - dst_puts(dst_formatc("compile error at %d: %S\n", - cres.error_start + 1, cres.error)); + dst_puts(dst_formatc("compile error: %S\n", cres.error)); } - b.count = 0; + bshift(&b, res.bytes_read); } break; } @@ -157,9 +163,6 @@ static void runfile(const uint8_t *src, int32_t len) { DstFunction *f = dst_compile_func(cres); if (dst_run(dst_wrap_function(f), &ret)) { dst_puts(dst_formatc("runtime error: %v\n", ret)); - } else { - dst_puts(dst_formatc("runtime error: %v\n", ret)); - break; } } else { dst_puts(dst_formatc("compile error at %d: %S\n", @@ -176,7 +179,7 @@ int main(int argc, char **argv) { int status = -1; int i; int fileRead = 0; - uint32_t gcinterval = 8192; + uint32_t gcinterval = 0x10000; uint64_t flags = 0; /* Read the arguments. Ignore files. */ diff --git a/core/userdata.c b/core/abstract.c similarity index 79% rename from core/userdata.c rename to core/abstract.c index e24781e1..e5f56827 100644 --- a/core/userdata.c +++ b/core/abstract.c @@ -24,11 +24,11 @@ #include "gc.h" /* Create new userdata */ -void *dst_userdata(size_t size, const DstUserType *utype) { - char *data = dst_gcalloc(DST_MEMORY_USERDATA, sizeof(DstUserdataHeader) + size); - DstUserdataHeader *header = (DstUserdataHeader *)data; - void *user = data + sizeof(DstUserdataHeader); +void *dst_abstract(size_t size, const DstAbstractType *atype) { + char *data = dst_gcalloc(DST_MEMORY_ABSTRACT, sizeof(DstAbstractHeader) + size); + DstAbstractHeader *header = (DstAbstractHeader *)data; + void *a = data + sizeof(DstAbstractHeader); header->size = size; - header->type = utype; - return user; + header->type = atype; + return a; } diff --git a/core/asm.c b/core/asm.c index 6f86b870..f0510d92 100644 --- a/core/asm.c +++ b/core/asm.c @@ -29,12 +29,6 @@ /* Bytecode op argument types */ -/* s - a slot */ -/* c - a constant */ -/* i - a small integer */ -/* t - a type (have a simple type for non unions) */ -/* l - a label */ - typedef enum DstOpArgType DstOpArgType; enum DstOpArgType { DST_OAT_SLOT, @@ -43,12 +37,13 @@ enum DstOpArgType { DST_OAT_INTEGER, DST_OAT_TYPE, DST_OAT_SIMPLETYPE, - DST_OAT_LABEL + DST_OAT_LABEL, + DST_OAT_FUNCDEF }; /* Convert a slot to to an integer for bytecode */ -/* Types of instructions */ +/* Types of instructions (some of them) */ /* _0arg - op.---.--.-- (return-nil, noop, vararg arguments) * _s - op.src.--.-- (push1) * _l - op.XX.XX.XX (jump) @@ -71,6 +66,7 @@ enum DstInstructionType { DIT_SL, DIT_ST, DIT_SI, + DIT_SD, /* Closures (D for funcDef) */ DIT_SU, /* Unsigned */ DIT_SSS, DIT_SSI, @@ -94,7 +90,7 @@ struct DstAssembler { DstFuncDef *def; jmp_buf on_error; const uint8_t *errmessage; - const DstValue *errmap; + const uint8_t *name; int32_t environments_capacity; int32_t bytecode_count; /* Used for calculating labels */ @@ -103,6 +99,7 @@ struct DstAssembler { DstTable constants; /* symbol -> constant index */ DstTable slots; /* symbol -> slot index */ DstTable envs; /* symbol -> environment index */ + DstTable defs; /* symbol -> funcdefs index */ }; /* Dst opcode descriptions in lexographic order. This @@ -115,12 +112,12 @@ static const DstInstructionDef dst_ops[] = { {"add-immediate", DIT_SSI, DOP_ADD_IMMEDIATE}, {"add-integer", DIT_SSS, DOP_ADD_INTEGER}, {"add-real", DIT_SSS, DOP_ADD_REAL}, - {"bitand", DIT_SSS, DOP_BAND}, - {"bitnot", DIT_SS, DOP_BNOT}, - {"bitor", DIT_SSS, DOP_BOR}, - {"bitxor", DIT_SSS, DOP_BXOR}, + {"band", DIT_SSS, DOP_BAND}, + {"bnot", DIT_SS, DOP_BNOT}, + {"bor", DIT_SSS, DOP_BOR}, + {"bxor", DIT_SSS, DOP_BXOR}, {"call", DIT_SS, DOP_CALL}, - {"closure", DIT_SC, DOP_CLOSURE}, + {"closure", DIT_SD, DOP_CLOSURE}, {"compare", DIT_SSS, DOP_COMPARE}, {"divide", DIT_SSS, DOP_DIVIDE}, {"divide-immediate", DIT_SSI, DOP_DIVIDE_IMMEDIATE}, @@ -150,7 +147,6 @@ static const DstInstructionDef dst_ops[] = { {"multiply-real", DIT_SSS, DOP_MULTIPLY_REAL}, {"noop", DIT_0, DOP_NOOP}, {"push", DIT_S, DOP_PUSH}, - {"push-array", DIT_S, DOP_PUSH_ARRAY}, {"push2", DIT_SS, DOP_PUSH_2}, {"push3", DIT_SSS, DOP_PUSH_3}, {"put", DIT_SSS, DOP_PUT}, @@ -230,28 +226,56 @@ static void dst_asm_deinit(DstAssembler *a) { dst_table_deinit(&a->labels); dst_table_deinit(&a->envs); dst_table_deinit(&a->constants); + dst_table_deinit(&a->defs); } /* Throw some kind of assembly error */ -static void dst_asm_error(DstAssembler *a, const DstValue *map, const char *message) { +static void dst_asm_error(DstAssembler *a, const char *message) { a->errmessage = dst_cstring(message); - a->errmap = map; longjmp(a->on_error, 1); } -#define dst_asm_assert(a, c, map, m) do { if (!(c)) dst_asm_error((a), (map), (m)); } while (0) +#define dst_asm_assert(a, c, m) do { if (!(c)) dst_asm_error((a), (m)); } while (0) /* Throw some kind of assembly error */ -static void dst_asm_errorv(DstAssembler *a, const DstValue *map, const uint8_t *m) { +static void dst_asm_errorv(DstAssembler *a, const uint8_t *m) { a->errmessage = m; - a->errmap = map; longjmp(a->on_error, 1); } +/* Add a closure environment to the assembler. Sub funcdefs may need + * 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;*/ +/*}*/ + /* Parse an argument to an assembly instruction, and return the result as an - * integer. This integer will need to be trimmed and bound checked. */ + * integer. This integer will need to be bounds checked. */ static int32_t doarg_1( DstAssembler *a, - const DstValue *map, DstOpArgType argtype, DstValue x) { int32_t ret = -1; @@ -276,6 +300,9 @@ static int32_t doarg_1( case DST_OAT_LABEL: c = &a->labels; break; + case DST_OAT_FUNCDEF: + c = &a->defs; + break; } switch (dst_type(x)) { default: @@ -291,7 +318,7 @@ static int32_t doarg_1( int32_t i = 0; ret = 0; for (i = 0; i < dst_tuple_length(t); i++) { - ret |= doarg_1(a, map, DST_OAT_SIMPLETYPE, t[i]); + ret |= doarg_1(a, DST_OAT_SIMPLETYPE, t[i]); } } else { goto error; @@ -309,14 +336,14 @@ static int32_t doarg_1( ret = dst_unwrap_integer(result); } } else { - dst_asm_errorv(a, map, dst_formatc("unknown name %q", x)); + dst_asm_errorv(a, dst_formatc("unknown name %q", x)); } } else if (argtype == DST_OAT_TYPE || argtype == DST_OAT_SIMPLETYPE) { int32_t index = strsearch(dst_unwrap_symbol(x), dst_type_names); if (index != -1) { ret = index; } else { - dst_asm_errorv(a, map, dst_formatc("unknown type %q", x)); + dst_asm_errorv(a, dst_formatc("unknown type %q", x)); } } else { goto error; @@ -329,7 +356,7 @@ static int32_t doarg_1( return ret; error: - dst_asm_errorv(a, map, dst_formatc("error parsing instruction argument %v", x)); + dst_asm_errorv(a, dst_formatc("error parsing instruction argument %v", x)); return 0; } @@ -337,22 +364,21 @@ static int32_t doarg_1( * try to convert arguments to bit patterns */ static uint32_t doarg( DstAssembler *a, - const DstValue *map, DstOpArgType argtype, int nth, int nbytes, int hassign, DstValue x) { - int32_t arg = doarg_1(a, map, argtype, x); + int32_t arg = doarg_1(a, argtype, x); /* Calculate the min and max values that can be stored given * nbytes, and whether or not the storage is signed */ int32_t min = (-hassign) << ((nbytes << 3) - 1); int32_t max = ~((-1) << ((nbytes << 3) - hassign)); if (arg < min) - dst_asm_errorv(a, map, dst_formatc("instruction argument %v is too small, must be %d byte%s", + dst_asm_errorv(a, dst_formatc("instruction argument %v is too small, must be %d byte%s", x, nbytes, nbytes > 1 ? "s" : "")); if (arg > max) - dst_asm_errorv(a, map, dst_formatc("instruction argument %v is too large, must be %d byte%s", + dst_asm_errorv(a, dst_formatc("instruction argument %v is too large, must be %d byte%s", x, nbytes, nbytes > 1 ? "s" : "")); return ((uint32_t) arg) << (nth << 3); } @@ -360,7 +386,6 @@ static uint32_t doarg( /* Provide parsing methods for the different kinds of arguments */ static uint32_t read_instruction( DstAssembler *a, - const DstValue *map, const DstInstructionDef *idef, const DstValue *argt) { uint32_t instr = idef->opcode; @@ -368,73 +393,81 @@ static uint32_t read_instruction( case DIT_0: { if (dst_tuple_length(argt) != 1) - dst_asm_error(a, map, "expected 0 arguments: (op)"); + dst_asm_error(a, "expected 0 arguments: (op)"); break; } case DIT_S: { if (dst_tuple_length(argt) != 2) - dst_asm_error(a, map, "expected 1 argument: (op, slot)"); - instr |= doarg(a, dst_sourcemap_index(map, 1), DST_OAT_SLOT, 1, 3, 0, argt[1]); + dst_asm_error(a, "expected 1 argument: (op, slot)"); + instr |= doarg(a, DST_OAT_SLOT, 1, 3, 0, argt[1]); break; } case DIT_L: { if (dst_tuple_length(argt) != 2) - dst_asm_error(a, map, "expected 1 argument: (op, label)"); - instr |= doarg(a, dst_sourcemap_index(map, 1), DST_OAT_LABEL, 1, 3, 1, argt[1]); + dst_asm_error(a, "expected 1 argument: (op, label)"); + instr |= doarg(a, DST_OAT_LABEL, 1, 3, 1, argt[1]); break; } case DIT_SS: { if (dst_tuple_length(argt) != 3) - dst_asm_error(a, map, "expected 2 arguments: (op, slot, slot)"); - instr |= doarg(a, dst_sourcemap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]); - instr |= doarg(a, dst_sourcemap_index(map, 2), DST_OAT_SLOT, 2, 2, 0, argt[2]); + dst_asm_error(a, "expected 2 arguments: (op, slot, slot)"); + instr |= doarg(a, DST_OAT_SLOT, 1, 1, 0, argt[1]); + instr |= doarg(a, DST_OAT_SLOT, 2, 2, 0, argt[2]); break; } case DIT_SL: { if (dst_tuple_length(argt) != 3) - dst_asm_error(a, map, "expected 2 arguments: (op, slot, label)"); - instr |= doarg(a, dst_sourcemap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]); - instr |= doarg(a, dst_sourcemap_index(map, 2), DST_OAT_LABEL, 2, 2, 1, argt[2]); + dst_asm_error(a, "expected 2 arguments: (op, slot, label)"); + instr |= doarg(a, DST_OAT_SLOT, 1, 1, 0, argt[1]); + instr |= doarg(a, DST_OAT_LABEL, 2, 2, 1, argt[2]); break; } case DIT_ST: { if (dst_tuple_length(argt) != 3) - dst_asm_error(a, map, "expected 2 arguments: (op, slot, type)"); - instr |= doarg(a, dst_sourcemap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]); - instr |= doarg(a, dst_sourcemap_index(map, 2), DST_OAT_TYPE, 2, 2, 0, argt[2]); + dst_asm_error(a, "expected 2 arguments: (op, slot, type)"); + instr |= doarg(a, DST_OAT_SLOT, 1, 1, 0, argt[1]); + instr |= doarg(a, DST_OAT_TYPE, 2, 2, 0, argt[2]); break; } case DIT_SI: case DIT_SU: { if (dst_tuple_length(argt) != 3) - dst_asm_error(a, map, "expected 2 arguments: (op, slot, integer)"); - instr |= doarg(a, dst_sourcemap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]); - instr |= doarg(a, dst_sourcemap_index(map, 2), DST_OAT_INTEGER, 2, 2, idef->type == DIT_SI, argt[2]); + dst_asm_error(a, "expected 2 arguments: (op, slot, integer)"); + instr |= doarg(a, DST_OAT_SLOT, 1, 1, 0, argt[1]); + instr |= doarg(a, DST_OAT_INTEGER, 2, 2, idef->type == DIT_SI, argt[2]); + break; + } + case DIT_SD: + { + if (dst_tuple_length(argt) != 3) + dst_asm_error(a, "expected 2 arguments: (op, slot, funcdef)"); + instr |= doarg(a, DST_OAT_SLOT, 1, 1, 0, argt[1]); + instr |= doarg(a, DST_OAT_FUNCDEF, 2, 2, 0, argt[2]); break; } case DIT_SSS: { if (dst_tuple_length(argt) != 4) - dst_asm_error(a, map, "expected 3 arguments: (op, slot, slot, slot)"); - instr |= doarg(a, dst_sourcemap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]); - instr |= doarg(a, dst_sourcemap_index(map, 2), DST_OAT_SLOT, 2, 1, 0, argt[2]); - instr |= doarg(a, dst_sourcemap_index(map, 3), DST_OAT_SLOT, 3, 1, 0, argt[3]); + dst_asm_error(a, "expected 3 arguments: (op, slot, slot, slot)"); + instr |= doarg(a, DST_OAT_SLOT, 1, 1, 0, argt[1]); + instr |= doarg(a, DST_OAT_SLOT, 2, 1, 0, argt[2]); + instr |= doarg(a, DST_OAT_SLOT, 3, 1, 0, argt[3]); break; } case DIT_SSI: case DIT_SSU: { if (dst_tuple_length(argt) != 4) - dst_asm_error(a, map, "expected 3 arguments: (op, slot, slot, integer)"); - instr |= doarg(a, dst_sourcemap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]); - instr |= doarg(a, dst_sourcemap_index(map, 2), DST_OAT_SLOT, 2, 1, 0, argt[2]); - instr |= doarg(a, dst_sourcemap_index(map, 3), DST_OAT_INTEGER, 3, 1, idef->type == DIT_SSI, argt[3]); + dst_asm_error(a, "expected 3 arguments: (op, slot, slot, integer)"); + instr |= doarg(a, DST_OAT_SLOT, 1, 1, 0, argt[1]); + instr |= doarg(a, DST_OAT_SLOT, 2, 1, 0, argt[2]); + instr |= doarg(a, DST_OAT_INTEGER, 3, 1, idef->type == DIT_SSI, argt[3]); break; } case DIT_SES: @@ -442,69 +475,35 @@ static uint32_t read_instruction( DstAssembler *b = a; uint32_t env; if (dst_tuple_length(argt) != 4) - dst_asm_error(a, map, "expected 3 arguments: (op, slot, environment, envslot)"); - instr |= doarg(a, dst_sourcemap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]); - env = doarg(a, dst_sourcemap_index(map, 2), DST_OAT_ENVIRONMENT, 0, 1, 0, argt[2]); + dst_asm_error(a, "expected 3 arguments: (op, slot, environment, envslot)"); + instr |= doarg(a, DST_OAT_SLOT, 1, 1, 0, argt[1]); + env = doarg(a, DST_OAT_ENVIRONMENT, 0, 1, 0, argt[2]); instr |= env << 16; for (env += 1; env > 0; env--) { b = b->parent; if (NULL == b) - dst_asm_error(a, dst_sourcemap_index(map, 2), "invalid environment index"); + dst_asm_error(a, "invalid environment index"); } - instr |= doarg(b, dst_sourcemap_index(map, 3), DST_OAT_SLOT, 3, 1, 0, argt[3]); + instr |= doarg(b, DST_OAT_SLOT, 3, 1, 0, argt[3]); break; } case DIT_SC: { if (dst_tuple_length(argt) != 3) - dst_asm_error(a, map, "expected 2 arguments: (op, slot, constant)"); - instr |= doarg(a, dst_sourcemap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]); - instr |= doarg(a, dst_sourcemap_index(map, 2), DST_OAT_CONSTANT, 2, 2, 0, argt[2]); + dst_asm_error(a, "expected 2 arguments: (op, slot, constant)"); + instr |= doarg(a, DST_OAT_SLOT, 1, 1, 0, argt[1]); + instr |= doarg(a, DST_OAT_CONSTANT, 2, 2, 0, argt[2]); break; } } return instr; } -/* Add a closure environment to the assembler. Sub funcdefs may need - * 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; -} - /* Helper to assembly. Return the assembly result */ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts) { DstAssembleResult result; DstAssembler a; - const DstValue *st = dst_unwrap_struct(opts.source); + DstValue s = opts.source; DstFuncDef *def; int32_t count, i; const DstValue *arr; @@ -521,6 +520,8 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts) def->source = NULL; def->sourcepath = NULL; def->sourcemap = NULL; + def->defs = NULL; + def->defs_length = 0; def->constants_length = 0; def->bytecode_length = 0; def->environments_length = 1; @@ -529,17 +530,14 @@ 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; - a.errmap = NULL; dst_table_init(&a.labels, 10); dst_table_init(&a.constants, 10); dst_table_init(&a.slots, 10); dst_table_init(&a.envs, 10); - - /* Initialize result */ - result.error_start = -1; - result.error_end = -1; + dst_table_init(&a.defs, 10); /* Set error jump */ if (setjmp(a.on_error)) { @@ -549,88 +547,65 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts) } result.error = a.errmessage; result.status = DST_ASSEMBLE_ERROR; - if (a.errmap != NULL) { - result.error_start = dst_unwrap_integer(a.errmap[0]); - result.error_end = dst_unwrap_integer(a.errmap[1]); - } dst_asm_deinit(&a); return result; } - dst_asm_assert(&a, dst_checktype(opts.source, DST_STRUCT), opts.sourcemap, "expected struct for assembly source"); + dst_asm_assert(&a, + dst_checktype(s, DST_STRUCT) || + dst_checktype(s, DST_TABLE), + "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); /* Set function arity */ - x = dst_struct_get(st, dst_csymbolv("arity")); + x = dst_get(s, dst_csymbolv("arity")); def->arity = dst_checktype(x, DST_INTEGER) ? dst_unwrap_integer(x) : 0; /* Check vararg */ - x = dst_struct_get(st, dst_csymbolv("vararg")); - if (dst_truthy(x)) - def->flags |= DST_FUNCDEF_FLAG_VARARG; + x = dst_get(s, dst_csymbolv("vararg")); + if (dst_truthy(x)) def->flags |= DST_FUNCDEF_FLAG_VARARG; /* Check source */ - x = dst_struct_get(st, dst_csymbolv("source")); - if (dst_checktype(x, DST_STRING)) { - def->source = dst_unwrap_string(x); - } + x = dst_get(s, dst_csymbolv("source")); + if (dst_checktype(x, DST_STRING)) def->source = dst_unwrap_string(x); /* Check source path */ - x = dst_struct_get(st, dst_csymbolv("sourcepath")); - if (dst_checktype(x, DST_STRING)) { - def->sourcepath = dst_unwrap_string(x); - } + x = dst_get(s, dst_csymbolv("sourcepath")); + if (dst_checktype(x, DST_STRING)) def->sourcepath = dst_unwrap_string(x); /* Create slot aliases */ - x = dst_struct_get(st, dst_csymbolv("slots")); + x = dst_get(s, dst_csymbolv("slots")); if (dst_seq_view(x, &arr, &count)) { - const DstValue *slotmap = - dst_sourcemap_value(opts.sourcemap, dst_csymbolv("slots")); for (i = 0; i < count; i++) { - const DstValue *imap = dst_sourcemap_index(slotmap, i); DstValue v = arr[i]; if (dst_checktype(v, DST_TUPLE)) { const DstValue *t = dst_unwrap_tuple(v); int32_t j; for (j = 0; j < dst_tuple_length(t); j++) { - const DstValue *tjmap = dst_sourcemap_index(imap, j); if (!dst_checktype(t[j], DST_SYMBOL)) - dst_asm_error(&a, tjmap, "slot names must be symbols"); + dst_asm_error(&a, "slot names must be symbols"); dst_table_put(&a.slots, t[j], dst_wrap_integer(i)); } } else if (dst_checktype(v, DST_SYMBOL)) { dst_table_put(&a.slots, v, dst_wrap_integer(i)); } else { - dst_asm_error(&a, imap, "slot names must be symbols or tuple of symbols"); - } - } - } - - /* Create environment aliases */ - x = dst_struct_get(st, dst_csymbolv("captures")); - if (dst_seq_view(x, &arr, &count)) { - const DstValue *emap = - dst_sourcemap_value(opts.sourcemap, dst_csymbolv("captures")); - for (i = 0; i < count; i++) { - const DstValue *imap = dst_sourcemap_index(emap, i); - dst_asm_assert(&a, dst_checktype(arr[i], DST_SYMBOL), imap, "environment must be a symbol"); - if (dst_asm_addenv(&a, arr[i]) < 0) { - dst_asm_error(&a, imap, "environment not found"); + dst_asm_error(&a, "slot names must be symbols or tuple of symbols"); } } } /* Parse constants */ - x = dst_struct_get(st, dst_csymbolv("constants")); + x = dst_get(s, dst_csymbolv("constants")); if (dst_seq_view(x, &arr, &count)) { - const DstValue *cmap = - dst_sourcemap_value(opts.sourcemap, dst_csymbolv("constants")); def->constants_length = count; def->constants = malloc(sizeof(DstValue) * count); if (NULL == def->constants) { DST_OUT_OF_MEMORY; } for (i = 0; i < count; i++) { - const DstValue *imap = dst_sourcemap_index(cmap, i); DstValue ct = arr[i]; if (dst_checktype(ct, DST_TUPLE) && dst_tuple_length(dst_unwrap_tuple(ct)) > 1 && @@ -646,9 +621,8 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts) def->constants[i] = t[2]; dst_table_put(&a.constants, t[1], dst_wrap_integer(i)); } else { - dst_asm_errorv(&a, imap, dst_formatc("could not parse constant \"%v\"", ct)); + dst_asm_errorv(&a, dst_formatc("could not parse constant \"%v\"", ct)); } - /* Todo - parse nested funcdefs */ } else { def->constants[i] = ct; } @@ -658,22 +632,25 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts) def->constants_length = 0; } + /* Parse sub funcdefs */ + /*x = dst_get(s, dst_csymbolv("closures"));*/ + /*if (dst_seq_view(x, &arr, &count)) {*/ + + /*}*/ + /* Parse bytecode and labels */ - x = dst_struct_get(st, dst_csymbolv("bytecode")); + x = dst_get(s, dst_csymbolv("bytecode")); if (dst_seq_view(x, &arr, &count)) { - const DstValue *bmap = - dst_sourcemap_value(opts.sourcemap, dst_csymbolv("bytecode")); /* Do labels and find length */ int32_t blength = 0; for (i = 0; i < count; ++i) { - const DstValue *imap = dst_sourcemap_index(bmap, i); DstValue instr = arr[i]; if (dst_checktype(instr, DST_SYMBOL)) { dst_table_put(&a.labels, instr, dst_wrap_integer(blength)); } else if (dst_checktype(instr, DST_TUPLE)) { blength++; } else { - dst_asm_error(&a, imap, "expected assembly instruction"); + dst_asm_error(&a, "expected assembly instruction"); } } /* Allocate bytecode array */ @@ -684,7 +661,6 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts) } /* Do bytecode */ for (i = 0; i < count; ++i) { - const DstValue *imap = dst_sourcemap_index(bmap, i); DstValue instr = arr[i]; if (dst_checktype(instr, DST_SYMBOL)) { continue; @@ -692,49 +668,44 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts) uint32_t op; const DstInstructionDef *idef; const DstValue *t; - dst_asm_assert(&a, dst_checktype(instr, DST_TUPLE), imap, "expected tuple"); + dst_asm_assert(&a, dst_checktype(instr, DST_TUPLE), "expected tuple"); t = dst_unwrap_tuple(instr); if (dst_tuple_length(t) == 0) { op = 0; } else { - dst_asm_assert(&a, dst_checktype(t[0], DST_SYMBOL), imap, + dst_asm_assert(&a, dst_checktype(t[0], DST_SYMBOL), "expected symbol in assembly instruction"); idef = dst_findi(dst_unwrap_symbol(t[0])); if (NULL == idef) - dst_asm_errorv(&a, imap, dst_formatc("unknown instruction %v", instr)); - op = read_instruction(&a, imap, idef, t); + dst_asm_errorv(&a, dst_formatc("unknown instruction %v", instr)); + op = read_instruction(&a, idef, t); } def->bytecode[a.bytecode_count++] = op; } } } else { - dst_asm_error(&a, opts.sourcemap, "bytecode expected"); + dst_asm_error(&a, "bytecode expected"); } /* Check for source mapping */ - x = dst_struct_get(st, dst_csymbolv("sourcemap")); + x = dst_get(s, dst_csymbolv("sourcemap")); if (dst_seq_view(x, &arr, &count)) { - const DstValue *bmap = - dst_sourcemap_value(opts.sourcemap, dst_csymbolv("sourcemap")); - dst_asm_assert(&a, count != 2 * def->bytecode_length, bmap, "sourcemap must have twice the length of the bytecode"); + dst_asm_assert(&a, count != 2 * def->bytecode_length, "sourcemap must have twice the length of the bytecode"); def->sourcemap = malloc(sizeof(int32_t) * 2 * count); for (i = 0; i < count; i += 2) { DstValue start = arr[i]; DstValue end = arr[i + 1]; if (!(dst_checktype(start, DST_INTEGER) || dst_unwrap_integer(start) < 0)) { - const DstValue *submap = dst_sourcemap_index(bmap, i); - dst_asm_error(&a, submap, "expected positive integer"); + dst_asm_error(&a, "expected positive integer"); } if (!(dst_checktype(end, DST_INTEGER) || dst_unwrap_integer(end) < 0)) { - const DstValue *submap = dst_sourcemap_index(bmap, i + 1); - dst_asm_error(&a, submap, "expected positive integer"); + dst_asm_error(&a, "expected positive integer"); } def->sourcemap[i] = dst_unwrap_integer(start); def->sourcemap[i+1] = dst_unwrap_integer(end); } - } /* Finish everything and return funcdef */ @@ -806,7 +777,7 @@ static DstValue tup4(DstValue w, DstValue x, DstValue y, DstValue z) { } /* Given an argument, convert it to the appriate integer or symbol */ -static DstValue dst_asm_decode_instruction(uint32_t instr) { +DstValue dst_asm_decode_instruction(uint32_t instr) { const DstInstructionDef *def = dst_asm_reverse_lookup(instr); DstValue name; if (NULL == def) { @@ -825,6 +796,7 @@ static DstValue dst_asm_decode_instruction(uint32_t instr) { case DIT_ST: case DIT_SC: case DIT_SU: + case DIT_SD: return tup3(name, dst_wrap_integer(oparg(1, 0xFF)), dst_wrap_integer(oparg(2, 0xFFFF))); @@ -857,10 +829,11 @@ DstValue dst_disasm(DstFuncDef *def) { if (def->arity) dst_table_put(ret, dst_csymbolv("arity"), dst_wrap_integer(def->arity)); dst_table_put(ret, dst_csymbolv("bytecode"), dst_wrap_array(bcode)); - if (def->sourcepath) { - dst_table_put(ret, dst_csymbolv("sourcepath"), dst_wrap_string(def->sourcepath)); + if (NULL != def->sourcepath) { + dst_table_put(ret, dst_csymbolv("sourcepath"), + dst_wrap_string(def->sourcepath)); } - if (def->source) { + if (NULL != def->source) { dst_table_put(ret, dst_csymbolv("source"), dst_wrap_string(def->source)); } if (def->flags & DST_FUNCDEF_FLAG_VARARG) { @@ -891,7 +864,7 @@ DstValue dst_disasm(DstFuncDef *def) { bcode->count = def->bytecode_length; /* Add source map */ - if (def->sourcemap) { + if (NULL != def->sourcemap) { DstArray *sourcemap = dst_array(def->bytecode_length * 2); for (i = 0; i < def->bytecode_length * 2; i++) { sourcemap->data[i] = dst_wrap_integer(def->sourcemap[i]); @@ -901,7 +874,7 @@ DstValue dst_disasm(DstFuncDef *def) { } /* Add environments */ - if (def->environments) { + if (NULL != def->environments) { DstArray *envs = dst_array(def->environments_length); for (i = 0; i < def->environments_length; i++) { envs->data[i] = dst_wrap_integer(def->environments[i]); @@ -910,6 +883,17 @@ DstValue dst_disasm(DstFuncDef *def) { dst_table_put(ret, dst_csymbolv("environments"), dst_wrap_array(envs)); } + /* Add closures */ + /* Funcdefs cannot be recursive */ + if (NULL != def->defs) { + DstArray *defs = dst_array(def->defs_length); + for (i = 0; i < def->defs_length; i++) { + defs->data[i] = dst_disasm(def->defs[i]); + } + defs->count = def->defs_length; + dst_table_put(ret, dst_csymbolv("defs"), dst_wrap_array(defs)); + } + /* Add slotcount */ dst_table_put(ret, dst_csymbolv("slotcount"), dst_wrap_integer(def->slotcount)); diff --git a/core/compile.c b/core/compile.c index 73b609e3..459d6ca8 100644 --- a/core/compile.c +++ b/core/compile.c @@ -26,12 +26,6 @@ #include "gc.h" #include "sourcemap.h" -/* Lazily sort the optimizers */ -/*static int optimizers_sorted = 0;*/ - -/* Lookups for specials and optimizable c functions. */ -/*DstCFunctionOptimizer dst_compiler_optimizers[255];*/ - /* Throw an error with a dst string */ void dst_compile_error(DstCompiler *c, const DstValue *sourcemap, const uint8_t *m) { if (NULL != sourcemap) { @@ -56,27 +50,33 @@ DstFormOptions dst_compile_getopts_index(DstFormOptions opts, int32_t index) { const DstValue *sourcemap = dst_sourcemap_index(opts.sourcemap, index); DstValue nextval = dst_getindex(opts.x, index); opts.x = nextval; + opts.flags = 0; opts.sourcemap = sourcemap; return opts; } +/* Index into the key of a table or struct */ DstFormOptions dst_compile_getopts_key(DstFormOptions opts, DstValue key) { const DstValue *sourcemap = dst_sourcemap_key(opts.sourcemap, key); opts.x = key; opts.sourcemap = sourcemap; + opts.flags = 0; return opts; } +/* Index into the value of a table or struct */ DstFormOptions dst_compile_getopts_value(DstFormOptions opts, DstValue key) { const DstValue *sourcemap = dst_sourcemap_value(opts.sourcemap, key); DstValue nextval = dst_get(opts.x, key); opts.x = nextval; opts.sourcemap = sourcemap; + opts.flags = 0; return opts; } /* Allocate a slot index */ -static int32_t slotalloc_index(DstScope *scope) { +static int32_t slotalloc_index(DstCompiler *c) { + DstScope *scope = dst_compile_topscope(c); /* Get the nth bit in the array */ int32_t i, biti; biti = -1; @@ -112,30 +112,29 @@ static int32_t slotalloc_index(DstScope *scope) { return biti; } -/* Allocate a slot */ -static DstSlot slotalloc(DstScope *scope) { - DstSlot ret; - ret.index = slotalloc_index(scope); - ret.envindex = 0; - ret.constant = dst_wrap_nil(); - ret.flags = 0; - return ret; -} - /* Free a slot index */ -static void slotfree_index(DstScope *scope, int32_t index) { +static void slotfree_index(DstCompiler *c, int32_t index) { + DstScope *scope = dst_compile_topscope(c); /* Don't free the pre allocated slots */ - if (index < 0xF0 || index > 0xFF) + if (index >= 0 && (index < 0xF0 || index > 0xFF) && index < (scope->scap << 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); + if (ret > max) { + slotfree_index(c, ret); + ret = 0xF0 + nth; + } + return ret; +} + /* Free a slot */ -static void slotfree(DstScope *scope, DstSlot s) { - if (s.flags & DST_SLOT_CONSTANT) - return; - if (s.envindex > 0) - return; - slotfree_index(scope, s.index); +void dst_compile_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. */ @@ -144,6 +143,7 @@ static int slotsymfind(DstScope *scope, const uint8_t *sym, DstSlot *out) { 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; } } @@ -151,7 +151,8 @@ static int slotsymfind(DstScope *scope, const uint8_t *sym, DstSlot *out) { } /* Add a slot to a scope with a symbol associated with it (def or var). */ -static void slotsym(DstScope *scope, const uint8_t *sym, DstSlot s) { +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) { @@ -228,6 +229,10 @@ void dst_compile_scope(DstCompiler *c, int flags) { scope->envs = NULL; scope->envcount = 0; scope->envcap = 0; + + scope->defs = NULL; + scope->dcount = 0; + scope->dcap = 0; scope->bytecode_start = c->buffercount; @@ -236,6 +241,20 @@ void dst_compile_scope(DstCompiler *c, int flags) { scope->scap = 0; scope->smax = -1; + /* 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; + } + } + } + scope->flags = flags; } @@ -246,7 +265,7 @@ void dst_compile_popscope(DstCompiler *c) { scope = c->scopes + --c->scopecount; /* 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) && c->scopecount) { + 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; @@ -255,6 +274,7 @@ void dst_compile_popscope(DstCompiler *c) { free(scope->slots); free(scope->syms); free(scope->envs); + free(scope->defs); } DstSlot dst_compile_constantslot(DstValue x) { @@ -267,9 +287,6 @@ DstSlot dst_compile_constantslot(DstValue x) { } /* Free a single slot */ -void dst_compile_freeslot(DstCompiler *c, DstSlot slot) { - slotfree(dst_compile_topscope(c), slot); -} /* * The mechanism for passing environments to closures is a bit complicated, @@ -288,6 +305,56 @@ void dst_compile_freeslot(DstCompiler *c, DstSlot slot) { * * 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( @@ -297,11 +364,13 @@ DstSlot dst_compile_resolve( DstSlot ret = dst_compile_constantslot(dst_wrap_nil()); DstScope *scope = dst_compile_topscope(c); - int32_t envindex = 0; int foundlocal = 1; + int unused = 0; /* Search scopes for symbol, starting from top */ while (scope >= c->scopes) { + if (scope->flags & DST_SCOPE_UNUSED) + unused = 1; if (slotsymfind(scope, sym, &ret)) goto found; if (scope->flags & DST_SCOPE_FUNCTION) @@ -310,50 +379,36 @@ DstSlot dst_compile_resolve( } /* Symbol not found - check for global */ - { - DstValue check = dst_get(c->env, dst_wrap_symbol(sym)); - if (dst_checktype(check, DST_STRUCT) || dst_checktype(check, DST_TABLE)) { - DstValue ref = dst_get(check, dst_csymbolv("ref")); - if (dst_checktype(ref, DST_ARRAY)) { - DstSlot ret = dst_compile_constantslot(ref); - ret.flags |= DST_SLOT_REF | DST_SLOT_NAMED | DST_SLOT_MUTABLE; - return ret; - } else { - DstValue value = dst_get(check, dst_csymbolv("value")); - return dst_compile_constantslot(value); - } - } else { - dst_compile_error(c, sourcemap, dst_formatc("unknown symbol %q", sym)); - } - } + return checkglobal(c, sourcemap, sym); /* Symbol was found */ found: /* Constants can be returned immediately (they are stateless) */ - if (ret.flags & DST_SLOT_CONSTANT) + if (ret.flags & (DST_SLOT_CONSTANT | DST_SLOT_REF)) return ret; + /* Unused references and locals shouldn't add captured envs. */ + if (unused || foundlocal) { + ret.envindex = 0; + return ret; + } + /* non-local scope needs to expose its environment */ if (!foundlocal) { + /* Find function scope */ + while (scope >= c->scopes && !(scope->flags & DST_SCOPE_FUNCTION)) scope--; + dst_assert(scope >= c->scopes, "invalid scopes"); scope->flags |= DST_SCOPE_ENV; - 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; - } + envinitscope(scope); scope++; } /* Propogate env up to current scope */ + int32_t envindex = 0; while (scope <= dst_compile_topscope(c)) { if (scope->flags & DST_SCOPE_FUNCTION) { int32_t j; - int32_t newcount = scope->envcount + 1; int scopefound = 0; /* Check if scope already has env. If so, break */ for (j = 1; j < scope->envcount; j++) { @@ -364,20 +419,7 @@ DstSlot dst_compile_resolve( } } /* Add the environment if it is not already referenced */ - if (!scopefound) { - envindex = scope->envcount; - /* 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[scope->envcount] = envindex; - scope->envcount = newcount; - } + if (!scopefound) envindex = addenvindex(scope, envindex); } scope++; } @@ -407,16 +449,6 @@ void dst_compile_emit(DstCompiler *c, const DstValue *sourcemap, uint32_t instr) c->buffer[index] = instr; } -/* Helper */ -static int32_t slotalloc_temp(DstScope *scope, int32_t max, int32_t nth) { - int32_t ret = slotalloc_index(scope); - if (ret > max) { - slotfree_index(scope, ret); - ret = 0xF0 + nth; - } - return ret; -} - /* 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( @@ -426,15 +458,14 @@ static int32_t dst_compile_preread( int nth, DstSlot s) { - DstScope *scope = dst_compile_topscope(c); int32_t ret; if (s.flags & DST_SLOT_REF) max = 0xFF; - if (s.flags & DST_SLOT_CONSTANT) { + if (s.flags & (DST_SLOT_CONSTANT | DST_SLOT_REF)) { int32_t cindex; - ret = slotalloc_temp(scope, max, nth); + ret = slotalloc_temp(c, 0xFF, nth); /* Use instructions for loading certain constants */ switch (dst_type(s.constant)) { case DST_NIL: @@ -474,14 +505,14 @@ static int32_t dst_compile_preread( DOP_GET_INDEX); } } else if (s.envindex > 0 || s.index > max) { - ret = slotalloc_temp(scope, max, nth); + ret = slotalloc_temp(c, max, nth); dst_compile_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(scope, max, nth); + ret = slotalloc_temp(c, max, nth); dst_compile_emit(c, sourcemap, ((uint32_t)(s.index) << 16) | ((uint32_t)(ret) << 8) | @@ -497,8 +528,7 @@ static int32_t dst_compile_preread( static void dst_compile_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 */ - DstScope *scope = dst_compile_topscope(c); - slotfree_index(scope, index); + slotfree_index(c, index); } } @@ -512,10 +542,9 @@ static void dst_compile_copy( int32_t destlocal = -1; int32_t srclocal = -1; int32_t reflocal = -1; - DstScope *scope = dst_compile_topscope(c); - /* Only write to mutable slots */ - if (!(dest.flags & DST_SLOT_MUTABLE)) { + /* Can't write to constants */ + if (dest.flags & DST_SLOT_CONSTANT) { dst_compile_cerror(c, sourcemap, "cannot write to constant"); } @@ -523,7 +552,7 @@ static void dst_compile_copy( if (dest.flags == src.flags && dest.index == src.index && dest.envindex == src.envindex) { - if (dest.flags & DST_SLOT_REF) { + if (dest.flags & (DST_SLOT_REF)) { if (dst_equals(dest.constant, src.constant)) return; } else { @@ -540,7 +569,7 @@ static void dst_compile_copy( if (dest.flags & DST_SLOT_REF) { writeback = 1; destlocal = srclocal; - reflocal = slotalloc_temp(scope, 0xFF, 2); + reflocal = slotalloc_temp(c, 0xFF, 2); dst_compile_emit(c, sourcemap, (addconst(c, sourcemap, dest.constant) << 16) | (reflocal << 8) | @@ -584,56 +613,53 @@ static void dst_compile_copy( /* Cleanup */ if (reflocal >= 0) { - slotfree_index(scope, reflocal); + slotfree_index(c, reflocal); } dst_compile_postread(c, src, srclocal); } /* Generate the return instruction for a slot. */ -static void dst_compile_return(DstCompiler *c, const DstValue *sourcemap, DstSlot s) { - if (s.flags & DST_SLOT_CONSTANT && dst_checktype(s.constant, DST_NIL)) { - dst_compile_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); +static DstSlot dst_compile_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); + } 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); + } + s.flags |= DST_SLOT_RETURNED; } + return s; } -/* Check if the last instructions emitted returned. Relies on the fact that - * a form should emit no more instructions after returning. */ -static int dst_compile_did_return(DstCompiler *c) { - uint32_t lastop; - if (!c->buffercount) - return 0; - lastop = (c->buffer[c->buffercount - 1]) & 0xFF; - return lastop == DOP_RETURN || - lastop == DOP_RETURN_NIL || - lastop == DOP_TAILCALL; -} - -/* Get a target slot for emitting an instruction. */ +/* Get a target slot for emitting an instruction. Will always return + * a local slot. */ static DstSlot dst_compile_gettarget(DstFormOptions opts) { - DstScope *scope; - DstSlot ret; - if (opts.flags & DST_FOPTS_HINT) { - return opts.hint; + DstSlot slot; + if ((opts.flags & DST_FOPTS_HINT) && + (opts.hint.envindex == 0) && + (opts.hint.index >= 0 && opts.hint.index <= 0xFF)) { + slot = opts.hint; + } else { + slot.envindex = 0; + slot.constant = dst_wrap_nil(); + slot.flags = 0; + slot.index = slotalloc_temp(opts.compiler, 0xFF, 4); } - scope = dst_compile_topscope(opts.compiler); - ret = slotalloc(scope); - /* Inherit type of opts */ - ret.flags |= opts.flags & DST_SLOTTYPE_ANY; - return ret; + return slot; } /* Push a series of values */ static void dst_compile_pushtuple( DstCompiler *c, const DstValue *sourcemap, - DstValue x) { + DstValue x, + int32_t start) { DstFormOptions opts; int32_t i, len; + /* Set basic opts */ opts.compiler = c; opts.hint = dst_compile_constantslot(dst_wrap_nil()); opts.flags = 0; @@ -641,7 +667,7 @@ static void dst_compile_pushtuple( opts.sourcemap = sourcemap; len = dst_length(x); - for (i = 1; i < len - 2; i += 3) { + 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); @@ -690,16 +716,14 @@ static void dst_compile_pushtuple( } } -/* Quote */ 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]); } -/* Var */ DstSlot dst_compile_var(DstFormOptions opts, int32_t argn, const DstValue *argv) { - DstScope *scope = dst_compile_topscope(opts.compiler); + DstCompiler *c = opts.compiler; DstFormOptions subopts; DstSlot ret; if (argn != 2) @@ -707,9 +731,9 @@ DstSlot dst_compile_var(DstFormOptions opts, int32_t argn, const DstValue *argv) if (!dst_checktype(argv[0], DST_SYMBOL)) dst_compile_cerror(opts.compiler, opts.sourcemap, "expected symbol"); subopts = dst_compile_getopts_index(opts, 2); - subopts.flags &= ~DST_FOPTS_TAIL; + subopts.flags = opts.flags & ~DST_FOPTS_TAIL; ret = dst_compile_value(subopts); - if (scope->flags & DST_SCOPE_TOP) { + if (dst_compile_topscope(c)->flags & DST_SCOPE_TOP) { DstCompiler *c = opts.compiler; const DstValue *sm = opts.sourcemap; DstSlot refslot, refarrayslot; @@ -731,20 +755,23 @@ DstSlot dst_compile_var(DstFormOptions opts, int32_t argn, const DstValue *argv) DOP_PUT_INDEX); dst_compile_postread(c, refarrayslot, refarrayindex); dst_compile_postread(c, ret, retindex); - dst_compile_freeslot(c, refarrayslot); + /*dst_compile_freeslot(c, refarrayslot);*/ ret = refslot; } else { /* Non root scope, bring to local slot */ - DstSlot localslot = dst_compile_gettarget(opts); - localslot.flags |= DST_SLOT_NAMED | DST_SLOT_MUTABLE; + 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(scope, dst_unwrap_symbol(argv[0]), localslot); + slotsym(c, dst_unwrap_symbol(argv[0]), localslot); ret = localslot; } return ret; } -/* Varset */ DstSlot dst_compile_varset(DstFormOptions opts, int32_t argn, const DstValue *argv) { DstFormOptions subopts; DstSlot ret, dest; @@ -752,21 +779,20 @@ DstSlot dst_compile_varset(DstFormOptions opts, int32_t argn, const DstValue *ar 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); - subopts.flags &= ~DST_FOPTS_TAIL; 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"); } - subopts.flags |= DST_FOPTS_HINT; + subopts = dst_compile_getopts_index(opts, 2); + subopts.flags = DST_FOPTS_HINT; subopts.hint = dest; ret = dst_compile_value(subopts); + dst_compile_copy(opts.compiler, subopts.sourcemap, dest, ret); return ret; } -/* Def */ DstSlot dst_compile_def(DstFormOptions opts, int32_t argn, const DstValue *argv) { - DstScope *scope = dst_compile_topscope(opts.compiler); + DstCompiler *c = opts.compiler; DstFormOptions subopts; DstSlot ret; if (argn != 2) @@ -777,7 +803,7 @@ DstSlot dst_compile_def(DstFormOptions opts, int32_t argn, const DstValue *argv) subopts.flags &= ~DST_FOPTS_TAIL; ret = dst_compile_value(subopts); ret.flags |= DST_SLOT_NAMED; - if (scope->flags & DST_SCOPE_TOP) { + if (dst_compile_topscope(c)->flags & DST_SCOPE_TOP) { /* Global def, generate code to store in env when executed */ DstCompiler *c = opts.compiler; const DstValue *sm = opts.sourcemap; @@ -817,23 +843,135 @@ DstSlot dst_compile_def(DstFormOptions opts, int32_t argn, const DstValue *argv) dst_compile_freeslot(c, tableslot); } else { /* Non root scope, simple slot alias */ - slotsym(scope, dst_unwrap_symbol(argv[0]), ret); + slotsym(c, dst_unwrap_symbol(argv[0]), ret); } return ret; } -/* Do */ +/* 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) { + 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; +} + +/* + * :condition + * ... + * jump-if-not condition :right + * :left + * ... + * jump done (only if not tail) + * :right + * ... + * :done + */ +DstSlot dst_compile_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; + DstFormOptions leftopts, rightopts, condopts; + DstSlot cond, left, right, target; + const int tail = opts.flags & DST_FOPTS_TAIL; + 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"); + + /* Get options */ + condopts = dst_compile_getopts_index(opts, 1); + leftopts = dst_compile_getopts_index(opts, 2); + rightopts = dst_compile_getopts_index(opts, 3); + if (argn == 2) rightopts.sourcemap = opts.sourcemap; + if (opts.flags & DST_FOPTS_HINT) { + leftopts.flags |= DST_FOPTS_HINT; + rightopts.flags |= DST_FOPTS_HINT; + } + if (tail) { + leftopts.flags |= DST_FOPTS_TAIL; + rightopts.flags |= DST_FOPTS_TAIL; + } + if (drop) { + leftopts.flags |= DST_FOPTS_DROP; + rightopts.flags |= DST_FOPTS_DROP; + } + + /* Compile condition */ + cond = dst_compile_value(condopts); + + /* Check constant condition. */ + /* TODO: Use type info for more short circuits */ + if ((cond.flags & DST_SLOT_CONSTANT) && !(cond.flags & DST_SLOT_REF)) { + DstFormOptions goodopts, badopts; + if (dst_truthy(cond.constant)) { + goodopts = leftopts; + badopts = rightopts; + } else { + goodopts = rightopts; + badopts = leftopts; + } + dst_compile_scope(c, 0); + target = dst_compile_value(goodopts); + dst_compile_popscope(c); + dst_compile_throwaway(badopts); + return target; + } + + /* Set target for compilation */ + target = (!drop && !tail) + ? dst_compile_gettarget(opts) + : dst_compile_constantslot(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); + + /* 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); + + /* Compile jump to done */ + labeljd = c->buffercount; + if (!tail) dst_compile_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); + + /* Write jumps - only add jump lengths if jump actually emitted */ + labeld = c->buffercount; + c->buffer[labeljr] |= (labelr - labeljr) << 16; + if (!tail) c->buffer[labeljd] |= (labeld - labeljd) << 8; + + if (tail) target.flags |= DST_SLOT_RETURNED; + return target; +} + DstSlot dst_compile_do(DstFormOptions opts, int32_t argn, const DstValue *argv) { int32_t i; DstSlot ret; dst_compile_scope(opts.compiler, 0); + (void) argv; for (i = 0; i < argn; i++) { DstFormOptions subopts = dst_compile_getopts_index(opts, i + 1); - subopts.x = argv[i]; - if (i == argn - 1) { - subopts.flags |= DST_FOPTS_TAIL; - } else { - subopts.flags &= ~DST_FOPTS_TAIL; + 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); if (i != argn - 1) { @@ -844,139 +982,66 @@ DstSlot dst_compile_do(DstFormOptions opts, int32_t argn, const DstValue *argv) return ret; } -/* Keep in lexographic order */ -static const DstSpecial dst_compiler_specials[] = { - {"def", dst_compile_def}, - {"do", dst_compile_do}, - {"quote", dst_compile_quote}, - {"var", dst_compile_var}, - {"varset", dst_compile_varset} -}; - -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 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 tuplle */ -DstSlot dst_compile_tuple(DstFormOptions opts) { - DstSlot head; - DstFormOptions subopts; +/* + * :whiletop + * ... + * :condition + * jump-if-not cond :done + * ... + * jump :whiletop + * :done + */ +DstSlot dst_compile_while(DstFormOptions opts, int32_t argn, const DstValue *argv) { DstCompiler *c = opts.compiler; - const DstValue *tup = dst_unwrap_tuple(opts.x); - int headcompiled = 0; - subopts = dst_compile_getopts_index(opts, 0); - subopts.flags &= DST_FUNCTION | DST_CFUNCTION; - if (dst_tuple_length(tup) == 0) { - return dst_compile_constantslot(opts.x); - } - if (dst_checktype(tup[0], DST_SYMBOL)) { - const DstSpecial *s = dst_finds(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); - headcompiled = 1; - /* - if ((head.flags & DST_SLOT_CONSTANT)) { - if (dst_checktype(head.constant, DST_CFUNCTION)) { - printf("add cfunction optimization here...\n"); - } - } - */ - } - /* Compile a normal function call */ - { - int32_t headindex; - DstSlot retslot; - if (!headcompiled) { - head = dst_compile_value(subopts); - headcompiled = 1; - } - headindex = dst_compile_preread(c, subopts.sourcemap, 0xFFFF, 1, head); - dst_compile_pushtuple(opts.compiler, opts.sourcemap, opts.x); - if (opts.flags & DST_FOPTS_TAIL) { - dst_compile_emit(c, subopts.sourcemap, (headindex << 8) | DOP_TAILCALL); - retslot = dst_compile_constantslot(dst_wrap_nil()); - } else { - int32_t retindex; - retslot = dst_compile_gettarget(opts); - retindex = dst_compile_preread(c, subopts.sourcemap, 0xFF, 2, retslot); - dst_compile_emit(c, subopts.sourcemap, (headindex << 16) | (retindex << 8) | DOP_CALL); - dst_compile_postread(c, retslot, retindex); - } - dst_compile_postread(c, head, headindex); - return retslot; - } -} + const DstValue *sm = opts.sourcemap; + DstSlot cond; + int32_t condlocal, labelwt, labeld, labeljt, labelc, i; + int infinite = 0; + (void) argv; -/* Compile a single value */ -DstSlot dst_compile_value(DstFormOptions opts) { - DstSlot ret; - if (opts.compiler->recursion_guard <= 0) { - dst_compile_cerror(opts.compiler, opts.sourcemap, "recursed too deeply"); + if (argn < 2) dst_compile_cerror(c, sm, "expected at least 2 arguments"); + dst_compile_scope(opts.compiler, 0); + labelwt = c->buffercount; + + /* Compile condition */ + cond = dst_compile_value(dst_compile_getopts_index(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()); + } + /* Infinite loop */ + infinite = 1; } - opts.compiler->recursion_guard--; - switch (dst_type(opts.x)) { - default: - ret = dst_compile_constantslot(opts.x); - break; - case DST_SYMBOL: - { - const uint8_t *sym = dst_unwrap_symbol(opts.x); - ret = dst_compile_resolve(opts.compiler, opts.sourcemap, sym); - break; - } - case DST_TUPLE: - ret = dst_compile_tuple(opts); - break; - /*case DST_ARRAY:*/ - /*ret = dst_compile_array(opts); */ - /*break;*/ - /*case DST_STRUCT:*/ - /*ret = dst_compile_struct(opts); */ - /*break;*/ - /*case DST_TABLE:*/ - /*ret = dst_compile_table(opts);*/ - /*break;*/ + + 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); } - if ((opts.flags & DST_FOPTS_TAIL) && !dst_compile_did_return(opts.compiler)) { - dst_compile_return(opts.compiler, opts.sourcemap, ret); - } else if (opts.flags & DST_FOPTS_HINT) { - dst_compile_copy(opts.compiler, opts.sourcemap, opts.hint, ret); - ret = opts.hint; + + /* Compile body */ + for (i = 1; i < argn; i++) { + DstFormOptions subopts = dst_compile_getopts_index(opts, i + 1); + subopts.flags = DST_FOPTS_DROP; + dst_compile_freeslot(c, dst_compile_value(subopts)); } - opts.compiler->recursion_guard++; - return ret; + + /* Compile jump to whiletop */ + labeljt = c->buffercount; + dst_compile_emit(c, sm, DOP_JUMP); + + /* Calculate jumps */ + labeld = c->buffercount; + 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()); } /* Compile a funcdef */ @@ -990,11 +1055,13 @@ static DstFuncDef *dst_compile_pop_funcdef(DstCompiler *c) { def->constants = NULL; def->source = NULL; def->sourcepath = NULL; + def->defs = NULL; + def->bytecode = NULL; def->slotcount = scope->smax + 1; /* Copy envs */ def->environments_length = scope->envcount; - if (def->environments_length) { + if (def->environments_length > 1) { def->environments = malloc(sizeof(int32_t) * def->environments_length); if (def->environments == NULL) { DST_OUT_OF_MEMORY; @@ -1005,7 +1072,7 @@ static DstFuncDef *dst_compile_pop_funcdef(DstCompiler *c) { /* Copy constants */ def->constants_length = scope->ccount; if (def->constants_length) { - def->constants = malloc(sizeof(DstValue) * scope->ccount); + def->constants = malloc(sizeof(DstValue) * def->constants_length); if (NULL == def->constants) { DST_OUT_OF_MEMORY; } @@ -1014,6 +1081,18 @@ static DstFuncDef *dst_compile_pop_funcdef(DstCompiler *c) { def->constants_length * sizeof(DstValue)); } + /* 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 *)); + } + /* Copy bytecode */ def->bytecode_length = c->buffercount - scope->bytecode_start; if (def->bytecode_length) { @@ -1041,10 +1120,10 @@ static DstFuncDef *dst_compile_pop_funcdef(DstCompiler *c) { c->buffercount = scope->bytecode_start; /* Manually set arity and flags later */ - def->flags = 0; def->arity = 0; /* Set some flags */ + def->flags = 0; if (scope->flags & DST_SCOPE_ENV) { def->flags |= DST_FUNCDEF_FLAG_NEEDSENV; } @@ -1055,6 +1134,310 @@ static DstFuncDef *dst_compile_pop_funcdef(DstCompiler *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); + 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; +} + +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) { + DstCompiler *c = opts.compiler; + const DstValue *sm = opts.sourcemap; + DstFuncDef *def; + DstSlot ret; + int32_t paramcount, argi, parami, arity, localslot, defindex; + const DstValue *params; + const DstValue *psm; + int varargs = 0; + + if (argn < 2) dst_compile_cerror(c, sm, "expected at least 2 arguments to function literal"); + + /* Begin function */ + dst_compile_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 (dst_seq_view(argv[parami], ¶ms, ¶mcount)) { + psm = dst_sourcemap_index(sm, parami + 1); + int32_t i; + for (i = 0; i < paramcount; i++) { + const DstValue *psmi = dst_sourcemap_index(psm, i); + if (dst_checktype(params[i], DST_SYMBOL)) { + DstSlot slot; + /* Check for varargs */ + if (0 == dst_strcompare(dst_unwrap_symbol(params[i]), "&")) { + if (i != paramcount - 2) { + dst_compile_cerror(c, psmi, "variable argument symbol in unexpected location"); + } + varargs = 1; + arity--; + continue; + } + 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); + arity++; + } else { + dst_compile_cerror(c, psmi, "expected symbol as function parameter"); + } + } + } else { + dst_compile_cerror(c, sm, "expected function parameters"); + } + + /* Compile function body */ + for (argi = parami + 1; argi < argn; argi++) { + DstSlot s; + DstFormOptions subopts = dst_compile_getopts_index(opts, argi + 1); + subopts.flags = argi == (argn - 1) ? DST_FOPTS_TAIL : DST_FOPTS_DROP; + s = dst_compile_value(subopts); + dst_compile_freeslot(c, s); + } + + /* Build function */ + def = dst_compile_pop_funcdef(c); + def->arity = arity; + if (varargs) def->flags |= DST_FUNCDEF_FLAG_VARARG; + defindex = dst_compile_addfuncdef(c, def); + + /* Instantiate closure */ + ret.flags = 0; + ret.envindex = 0; + ret.constant = dst_wrap_nil(); + ret.index = slotalloc_index(c); + + localslot = ret.index > 0xF0 ? 0xF1 : ret.index; + dst_compile_emit(c, sm, + (defindex << 16) | + (localslot << 8) | + DOP_CLOSURE); + + if (ret.index != localslot) { + dst_compile_emit(c, sm, + (ret.index << 16) | + (localslot << 8) | + DOP_MOVE_FAR); + } + + return ret; +} + +/* 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} +}; + +/* 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 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.flags = DST_FUNCTION | DST_CFUNCTION; + if (dst_tuple_length(tup) == 0) { + return dst_compile_constantslot(opts.x); + } + if (dst_checktype(tup[0], DST_SYMBOL)) { + const DstSpecial *s = dst_finds(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); + headcompiled = 1; + /* + if ((head.flags & DST_SLOT_CONSTANT)) { + if (dst_checktype(head.constant, DST_CFUNCTION)) { + printf("add cfunction optimization here...\n"); + } + } + */ + } + /* Compile a normal function call */ + { + int32_t headindex; + DstSlot retslot; + if (!headcompiled) { + head = dst_compile_value(subopts); + headcompiled = 1; + } + headindex = dst_compile_preread(c, subopts.sourcemap, 0xFFFF, 1, head); + dst_compile_pushtuple(opts.compiler, opts.sourcemap, opts.x, 1); + if (opts.flags & DST_FOPTS_TAIL) { + dst_compile_emit(c, subopts.sourcemap, (headindex << 8) | DOP_TAILCALL); + retslot = dst_compile_constantslot(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); + } + dst_compile_postread(c, head, headindex); + return retslot; + } +} + +static DstSlot dst_compile_array(DstFormOptions opts) { + DstCompiler *c = opts.compiler; + const DstValue *sm = opts.sourcemap; + DstSlot ctor, retslot; + 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); + if (opts.flags & DST_FOPTS_TAIL) { + dst_compile_emit(c, sm, (localindex << 8) | DOP_TAILCALL); + retslot = dst_compile_constantslot(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); + } + dst_compile_postread(c, ctor, localindex); + return retslot; +} + +static DstSlot dst_compile_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); + if (opts.flags & DST_FOPTS_TAIL) { + dst_compile_emit(c, sm, (localindex << 8) | DOP_TAILCALL); + retslot = dst_compile_constantslot(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); + } + dst_compile_postread(c, ctor, localindex); + return retslot; +} + +/* Compile a single value */ +DstSlot dst_compile_value(DstFormOptions opts) { + DstSlot ret; + if (opts.compiler->recursion_guard <= 0) { + dst_compile_cerror(opts.compiler, opts.sourcemap, "recursed too deeply"); + } + opts.compiler->recursion_guard--; + switch (dst_type(opts.x)) { + default: + ret = dst_compile_constantslot(opts.x); + break; + case DST_SYMBOL: + { + const uint8_t *sym = dst_unwrap_symbol(opts.x); + ret = dst_compile_resolve(opts.compiler, opts.sourcemap, sym); + break; + } + case DST_TUPLE: + ret = dst_compile_tuple(opts); + break; + case DST_ARRAY: + ret = dst_compile_array(opts); + break; + case DST_STRUCT: + ret = dst_compile_tablector(opts, dst_stl_struct); + break; + case DST_TABLE: + ret = dst_compile_tablector(opts, dst_stl_table); + break; + } + if (opts.flags & DST_FOPTS_TAIL) { + ret = dst_compile_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; @@ -1066,11 +1449,6 @@ static void dst_compile_init(DstCompiler *c, DstValue env) { c->mapbuffer = NULL; c->recursion_guard = DST_RECURSION_GUARD; c->env = env; - - /* Push an empty scope. This will be the global scope. */ - dst_compile_scope(c, 0); - - dst_compile_topscope(c)->flags |= DST_SCOPE_TOP; } /* Deinitialize a compiler struct */ @@ -1092,8 +1470,7 @@ DstCompileResult dst_compile_one(DstCompiler *c, DstCompileOptions opts) { DstSlot s; /* Ensure only one scope */ - while (c->scopecount > 1) - dst_compile_popscope(c); + while (c->scopecount) dst_compile_popscope(c); if (setjmp(c->on_error)) { c->result.status = DST_COMPILE_ERROR; diff --git a/core/compile.h b/core/compile.h index 801eee9b..05cf9416 100644 --- a/core/compile.h +++ b/core/compile.h @@ -40,6 +40,7 @@ typedef struct DstCFunctionOptimizer DstCFunctionOptimizer; #define DST_SLOT_NAMED 0x20000 #define DST_SLOT_MUTABLE 0x40000 #define DST_SLOT_REF 0x80000 +#define DST_SLOT_RETURNED 0x100000 /* Needed for handling single element arrays as global vars. */ #define DST_SLOTTYPE_ANY 0xFFFF @@ -69,6 +70,7 @@ struct DstSlot { #define DST_SCOPE_FUNCTION 1 #define DST_SCOPE_ENV 2 #define DST_SCOPE_TOP 4 +#define DST_SCOPE_UNUSED 8 /* A lexical scope during compilation */ struct DstScope { @@ -91,6 +93,11 @@ struct DstScope { 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 * that corresponds to the direct parent's stack will always have value 0. */ @@ -125,8 +132,9 @@ struct DstCompiler { #define DST_FOPTS_TAIL 0x10000 #define DST_FOPTS_HINT 0x20000 +#define DST_FOPTS_DROP 0x40000 -/* Compiler state */ +/* Options for compiling a single form */ struct DstFormOptions { DstCompiler *compiler; DstValue x; diff --git a/core/fiber.c b/core/fiber.c index 44bb3fd3..0cadda45 100644 --- a/core/fiber.c +++ b/core/fiber.c @@ -43,7 +43,7 @@ DstFiber *dst_fiber(int32_t capacity) { /* Clear a fiber (reset it) */ DstFiber *dst_fiber_reset(DstFiber *fiber) { fiber->frame = 0; - fiber->frametop = 0; + fiber->stackstart = DST_FRAME_SIZE; fiber->stacktop = DST_FRAME_SIZE; fiber->status = DST_FIBER_DEAD; fiber->parent = NULL; @@ -105,42 +105,15 @@ void dst_fiber_pushn(DstFiber *fiber, const DstValue *arr, int32_t n) { * 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->frametop + (int32_t)(DST_FRAME_SIZE)) { + if (newstacktop < fiber->stackstart) { return dst_wrap_nil(); } fiber->stacktop = newstacktop; return fiber->data[newstacktop]; } -/* Push a stack frame to a fiber */ -void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func) { - DstStackFrame *newframe; - - int32_t i; - int32_t oldframe = fiber->frame; - int32_t nextframe = fiber->frametop + DST_FRAME_SIZE; - int32_t nextframetop = nextframe + func->def->slotcount; - int32_t nextstacktop = nextframetop + DST_FRAME_SIZE; - - if (fiber->capacity < nextstacktop) { - dst_fiber_setcapacity(fiber, 2 * nextstacktop); - } - - /* Set the next frame */ - fiber->frame = nextframe; - fiber->frametop = nextframetop; - newframe = dst_fiber_frame(fiber); - - /* Set up the new frame */ - newframe->prevframe = oldframe; - newframe->pc = func->def->bytecode; - newframe->func = func; - - /* Nil unset locals (Needed for gc correctness) */ - for (i = fiber->stacktop; i < fiber->frametop; ++i) { - fiber->data[i] = dst_wrap_nil(); - } - +/* Help set up function */ +static void funcframe_helper(DstFiber *fiber, DstFunction *func) { /* Check varargs */ if (func->def->flags & DST_FUNCDEF_FLAG_VARARG) { int32_t tuplehead = fiber->frame + func->def->arity; @@ -153,8 +126,46 @@ void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func) { } } - /* Set stack top */ - fiber->stacktop = nextstacktop; + /* Check closure env */ + if (func->def->flags & DST_FUNCDEF_FLAG_NEEDSENV) { + /* Delayed capture of current stack frame */ + DstFuncEnv *env = dst_gcalloc(DST_MEMORY_FUNCENV, sizeof(DstFuncEnv)); + env->offset = fiber->frame; + env->as.fiber = fiber; + env->length = func->def->slotcount; + func->envs[0] = env; + } +} + +/* Push a stack frame to a fiber */ +void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func) { + DstStackFrame *newframe; + + int32_t i; + int32_t oldframe = fiber->frame; + int32_t nextframe = fiber->stackstart; + int32_t nextstacktop = nextframe + func->def->slotcount + DST_FRAME_SIZE; + + if (fiber->capacity < nextstacktop) { + dst_fiber_setcapacity(fiber, 2 * nextstacktop); + } + + /* Nil unset stack arguments (Needed for gc correctness) */ + for (i = fiber->stacktop; i < nextstacktop; ++i) { + fiber->data[i] = dst_wrap_nil(); + } + + /* Set up the next frame */ + fiber->frame = nextframe; + fiber->stacktop = fiber->stackstart = nextstacktop; + newframe = dst_fiber_frame(fiber); + newframe->prevframe = oldframe; + newframe->pc = func->def->bytecode; + newframe->func = func; + + /* Check varargs */ + funcframe_helper(fiber, func); + } /* Create a tail frame for a function */ @@ -162,42 +173,31 @@ void dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func) { int32_t i; int32_t nextframetop = fiber->frame + func->def->slotcount; int32_t nextstacktop = nextframetop + DST_FRAME_SIZE; - int32_t size = (fiber->stacktop - fiber->frametop) - DST_FRAME_SIZE; - int32_t argtop = fiber->frame + size; + int32_t stacksize = fiber->stacktop - fiber->stackstart; if (fiber->capacity < nextstacktop) { dst_fiber_setcapacity(fiber, 2 * nextstacktop); } DstValue *stack = fiber->data + fiber->frame; - DstValue *args = fiber->data + fiber->frametop + DST_FRAME_SIZE; + DstValue *args = fiber->data + fiber->stackstart; /* Detatch old function */ if (NULL != dst_fiber_frame(fiber)->func) dst_function_detach(dst_fiber_frame(fiber)->func); - memmove(stack, args, size * sizeof(DstValue)); + memmove(stack, args, stacksize * sizeof(DstValue)); /* Set stack stuff */ - fiber->stacktop = nextstacktop; - fiber->frametop = nextframetop; + fiber->stacktop = fiber->stackstart = nextstacktop; - /* Nil unset locals (Needed for gc correctness) */ - for (i = fiber->frame + size; i < fiber->frametop; ++i) { + /* Nil unset locals (Needed for functional correctness) */ + for (i = fiber->frame + stacksize; i < nextframetop; ++i) { fiber->data[i] = dst_wrap_nil(); } - /* Check varargs */ - if (func->def->flags & DST_FUNCDEF_FLAG_VARARG) { - int32_t tuplehead = fiber->frame + func->def->arity; - if (tuplehead >= argtop) { - fiber->data[tuplehead] = dst_wrap_tuple(dst_tuple_n(NULL, 0)); - } else { - fiber->data[tuplehead] = dst_wrap_tuple(dst_tuple_n( - fiber->data + tuplehead, - argtop - tuplehead)); - } - } + /* Varargs and func envs */ + funcframe_helper(fiber, func); /* Set frame stuff */ dst_fiber_frame(fiber)->func = func; @@ -209,9 +209,8 @@ void dst_fiber_cframe(DstFiber *fiber) { DstStackFrame *newframe; int32_t oldframe = fiber->frame; - int32_t nextframe = fiber->frametop + DST_FRAME_SIZE; - int32_t nextframetop = fiber->stacktop; - int32_t nextstacktop = nextframetop + DST_FRAME_SIZE; + int32_t nextframe = fiber->stackstart; + int32_t nextstacktop = fiber->stacktop + DST_FRAME_SIZE; if (fiber->capacity < nextstacktop) { dst_fiber_setcapacity(fiber, 2 * nextstacktop); @@ -219,8 +218,7 @@ void dst_fiber_cframe(DstFiber *fiber) { /* Set the next frame */ fiber->frame = nextframe; - fiber->frametop = nextframetop; - fiber->stacktop = nextstacktop; + fiber->stacktop = fiber->stackstart = nextstacktop; newframe = dst_fiber_frame(fiber); /* Set up the new frame */ @@ -229,35 +227,6 @@ void dst_fiber_cframe(DstFiber *fiber) { newframe->func = NULL; } -/* Create a cframe for a tail call */ -void dst_fiber_cframe_tail(DstFiber *fiber) { - int32_t size = (fiber->stacktop - fiber->frametop) - DST_FRAME_SIZE; - int32_t nextframetop = fiber->frame + size; - int32_t nextstacktop = nextframetop + DST_FRAME_SIZE; - - if (fiber->frame == 0) { - return dst_fiber_cframe(fiber); - } - - DstValue *stack = fiber->data + fiber->frame; - DstValue *args = fiber->data + fiber->frametop + DST_FRAME_SIZE; - - /* Detach old function */ - if (NULL != dst_fiber_frame(fiber)->func) - dst_function_detach(dst_fiber_frame(fiber)->func); - - /* Copy pushed args to frame */ - memmove(stack, args, size * sizeof(DstValue)); - - /* Set the next frame */ - fiber->frametop = nextframetop; - fiber->stacktop = nextstacktop; - - /* Set up the new frame */ - dst_fiber_frame(fiber)->func = NULL; - dst_fiber_frame(fiber)->pc = NULL; -} - /* Pop a stack frame from the fiber. Returns the new stack frame, or * NULL if there are no more frames */ void dst_fiber_popframe(DstFiber *fiber) { @@ -268,7 +237,6 @@ void dst_fiber_popframe(DstFiber *fiber) { dst_function_detach(frame->func); /* Shrink stack */ - fiber->stacktop = fiber->frame; - fiber->frametop = fiber->frame - DST_FRAME_SIZE; + fiber->stacktop = fiber->stackstart = fiber->frame; fiber->frame = frame->prevframe; } diff --git a/core/gc.c b/core/gc.c index be32ae4d..374d31a0 100644 --- a/core/gc.c +++ b/core/gc.c @@ -45,7 +45,7 @@ static void dst_mark_tuple(const DstValue *tuple); static void dst_mark_buffer(DstBuffer *buffer); static void dst_mark_string(const uint8_t *str); static void dst_mark_fiber(DstFiber *fiber); -static void dst_mark_udata(void *udata); +static void dst_mark_abstract(void *adata); /* Mark a value */ void dst_mark(DstValue x) { @@ -60,7 +60,7 @@ void dst_mark(DstValue x) { case DST_TUPLE: dst_mark_tuple(dst_unwrap_tuple(x)); break; case DST_BUFFER: dst_mark_buffer(dst_unwrap_buffer(x)); break; case DST_FIBER: dst_mark_fiber(dst_unwrap_fiber(x)); break; - case DST_USERDATA: dst_mark_udata(dst_unwrap_pointer(x)); break; + case DST_ABSTRACT: dst_mark_abstract(dst_unwrap_abstract(x)); break; } } @@ -72,8 +72,8 @@ static void dst_mark_buffer(DstBuffer *buffer) { dst_gc_mark(buffer); } -static void dst_mark_udata(void *udata) { - dst_gc_mark(dst_userdata_header(udata)); +static void dst_mark_abstract(void *adata) { + dst_gc_mark(dst_abstract_header(adata)); } /* Mark a bunch of items in memory */ @@ -129,21 +129,13 @@ static void dst_mark_funcenv(DstFuncEnv *env) { /* GC helper to mark a FuncDef */ static void dst_mark_funcdef(DstFuncDef *def) { - int32_t count, i; + int32_t i; if (dst_gc_reachable(def)) return; dst_gc_mark(def); - if (def->constants) { - count = def->constants_length; - for (i = 0; i < count; ++i) { - DstValue v = def->constants[i]; - /* Funcdefs use nil literals to store other funcdefs */ - if (dst_checktype(v, DST_NIL)) { - dst_mark_funcdef((DstFuncDef *) dst_unwrap_pointer(v)); - } else { - dst_mark(v); - } - } + dst_mark_many(def->constants, def->constants_length); + for (i = 0; i < def->defs_length; ++i) { + dst_mark_funcdef(def->defs[i]); } if (def->source) dst_mark_string(def->source); @@ -173,7 +165,7 @@ static void dst_mark_fiber(DstFiber *fiber) { dst_gc_mark(fiber); i = fiber->frame; - j = fiber->frametop; + j = fiber->stackstart - DST_FRAME_SIZE; while (i > 0) { frame = (DstStackFrame *)(fiber->data + i - DST_FRAME_SIZE); if (NULL != frame->func) @@ -186,14 +178,12 @@ static void dst_mark_fiber(DstFiber *fiber) { if (NULL != fiber->parent) dst_mark_fiber(fiber->parent); - - dst_mark(fiber->ret); } /* Deinitialize a block of memory */ static void dst_deinit_block(DstGCMemoryHeader *block) { void *mem = ((char *)(block + 1)); - DstUserdataHeader *h = (DstUserdataHeader *)mem; + DstAbstractHeader *h = (DstAbstractHeader *)mem; switch (block->flags & DST_MEM_TYPEBITS) { default: break; /* Do nothing for non gc types */ @@ -215,7 +205,7 @@ static void dst_deinit_block(DstGCMemoryHeader *block) { case DST_MEMORY_FUNCTION: free(((DstFunction *)mem)->envs); break; - case DST_MEMORY_USERDATA: + case DST_MEMORY_ABSTRACT: if (h->type->finalize) h->type->finalize((void *)(h + 1), h->size); break; @@ -251,6 +241,7 @@ 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; @@ -263,6 +254,22 @@ 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; @@ -287,6 +294,8 @@ 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); } diff --git a/core/gc.h b/core/gc.h index f15ffbcc..ded36f60 100644 --- a/core/gc.h +++ b/core/gc.h @@ -60,7 +60,7 @@ enum DstMemoryType { DST_MEMORY_FIBER, DST_MEMORY_BUFFER, DST_MEMORY_FUNCTION, - DST_MEMORY_USERDATA, + DST_MEMORY_ABSTRACT, DST_MEMORY_FUNCENV, DST_MEMORY_FUNCDEF }; diff --git a/core/math.c b/core/math.c index a4da665f..96370119 100644 --- a/core/math.c +++ b/core/math.c @@ -120,10 +120,9 @@ int dst_##name(int32_t argn, DstValue *argv, DstValue *ret) {\ } DST_DEFINE_REDUCER(add, dst_op_add, 0) -DST_DEFINE_REDUCER(subtract, dst_op_subtract, 0) DST_DEFINE_REDUCER(multiply, dst_op_multiply, 1) -#define DST_DEFINE_DIVIDER(name)\ +#define DST_DEFINE_DIVIDER(name, unarystart)\ int dst_##name(int32_t argn, DstValue *argv, DstValue *ret) {\ int32_t i;\ DstValue accum;\ @@ -131,7 +130,7 @@ int dst_##name(int32_t argn, DstValue *argv, DstValue *ret) {\ *ret = dst_cstringv("expected at least one argument");\ return 1;\ } else if (argn == 1) {\ - accum = dst_wrap_real(1);\ + accum = dst_wrap_real(unarystart);\ i = 0;\ } else {\ accum = argv[0];\ @@ -148,8 +147,9 @@ int dst_##name(int32_t argn, DstValue *argv, DstValue *ret) {\ return 0;\ } -DST_DEFINE_DIVIDER(divide) -DST_DEFINE_DIVIDER(modulo) +DST_DEFINE_DIVIDER(divide, 1) +DST_DEFINE_DIVIDER(modulo, 1) +DST_DEFINE_DIVIDER(subtract, 0) #undef ADD #undef SUB @@ -190,6 +190,33 @@ DST_DEFINE_BITOP(band, &=, -1) DST_DEFINE_BITOP(bor, |=, 0) DST_DEFINE_BITOP(bxor, ^=, 0) +int dst_lshift(int argn, DstValue *argv, DstValue *ret) { + if (argn != 2 || !dst_checktype(argv[0], DST_INTEGER) || !dst_checktype(argv[1], DST_INTEGER)) { + *ret = dst_cstringv("expected 2 integers"); + return 1; + } + *ret = dst_wrap_integer(dst_unwrap_integer(argv[0]) >> dst_unwrap_integer(argv[1])); + return 0; +} + +int dst_rshift(int argn, DstValue *argv, DstValue *ret) { + if (argn != 2 || !dst_checktype(argv[0], DST_INTEGER) || !dst_checktype(argv[1], DST_INTEGER)) { + *ret = dst_cstringv("expected 2 integers"); + return 1; + } + *ret = dst_wrap_integer(dst_unwrap_integer(argv[0]) << dst_unwrap_integer(argv[1])); + return 0; +} + +int dst_lshiftu(int argn, DstValue *argv, DstValue *ret) { + if (argn != 2 || !dst_checktype(argv[0], DST_INTEGER) || !dst_checktype(argv[1], DST_INTEGER)) { + *ret = dst_cstringv("expected 2 integers"); + return 1; + } + *ret = dst_wrap_integer((int32_t)((uint32_t)dst_unwrap_integer(argv[0]) >> dst_unwrap_integer(argv[1]))); + return 0; +} + #define DST_DEFINE_MATHOP(name, fop)\ int dst_##name(int32_t argn, DstValue *argv, DstValue *ret) {\ if (argn != 1) {\ diff --git a/core/opcodes.h b/core/opcodes.h index f564aef7..50495f1f 100644 --- a/core/opcodes.h +++ b/core/opcodes.h @@ -76,7 +76,6 @@ enum DstOpCode { DOP_PUSH, DOP_PUSH_2, DOP_PUSH_3, - DOP_PUSH_ARRAY, DOP_CALL, DOP_TAILCALL, DOP_TRANSFER, diff --git a/core/stl.c b/core/stl.c index 8039b88e..80aed5cc 100644 --- a/core/stl.c +++ b/core/stl.c @@ -39,6 +39,22 @@ int dst_stl_print(int32_t argn, DstValue *argv, DstValue *ret) { return 0; } +int dst_stl_describe(int32_t argn, DstValue *argv, DstValue *ret) { + (void)ret; + + int32_t i; + for (i = 0; i < argn; ++i) { + int32_t j, len; + const uint8_t *vstr = dst_description(argv[i]); + len = dst_string_length(vstr); + for (j = 0; j < len; ++j) { + putc(vstr[j], stdout); + } + } + putc('\n', stdout); + return 0; +} + int dst_stl_asm(int32_t argn, DstValue *argv, DstValue *ret) { DstAssembleOptions opts; DstAssembleResult res; @@ -47,9 +63,6 @@ int dst_stl_asm(int32_t argn, DstValue *argv, DstValue *ret) { return 1; } opts.source = argv[0]; - opts.sourcemap = (argn >= 2 && dst_checktype(argv[1], DST_TUPLE)) - ? dst_unwrap_tuple(argv[1]) - : NULL; opts.flags = 0; res = dst_asm(opts); if (res.status == DST_ASSEMBLE_OK) { @@ -61,6 +74,17 @@ int dst_stl_asm(int32_t argn, DstValue *argv, DstValue *ret) { } } +int dst_stl_disasm(int32_t argn, DstValue *argv, DstValue *ret) { + DstFunction *f; + if (argn < 1 || !dst_checktype(argv[0], DST_FUNCTION)) { + *ret = dst_cstringv("expected function"); + return 1; + } + f = dst_unwrap_function(argv[0]); + *ret = dst_disasm(f->def); + return 0; +} + int dst_stl_tuple(int32_t argn, DstValue *argv, DstValue *ret) { *ret = dst_wrap_tuple(dst_tuple_n(argv, argn)); return 0; @@ -159,6 +183,11 @@ static int dst_stl_notequal(int32_t argn, DstValue *argv, DstValue *ret) { return 0; } +static int dst_stl_not(int32_t argn, DstValue *argv, DstValue *ret) { + *ret = dst_wrap_boolean(argn == 0 || !dst_truthy(argv[0])); + return 0; +} + #define DST_DEFINE_COMPARATOR(name, pred)\ static int dst_stl_##name(int32_t argn, DstValue *argv, DstValue *ret) {\ int32_t i;\ @@ -179,11 +208,13 @@ DST_DEFINE_COMPARATOR(notascending, < 0) static DstReg stl[] = { {"print", dst_stl_print}, + {"describe", dst_stl_describe}, {"table", dst_stl_table}, {"array", dst_stl_array}, {"tuple", dst_stl_tuple}, {"struct", dst_stl_struct}, {"asm", dst_stl_asm}, + {"disasm", dst_stl_disasm}, {"get", dst_stl_get}, {"put", dst_stl_put}, {"+", dst_add}, @@ -203,12 +234,20 @@ static DstReg stl[] = { {"sqrt", dst_sqrt}, {"floor", dst_floor}, {"ceil", dst_ceil}, + {"pow", dst_pow}, {"=", dst_stl_equal}, {"not=", dst_stl_notequal}, {"<", dst_stl_ascending}, {">", dst_stl_descending}, {"<=", dst_stl_notdescending}, - {">=", dst_stl_notascending} + {">=", dst_stl_notascending}, + {"|", dst_bor}, + {"&", dst_band}, + {"^", dst_bxor}, + {">>", dst_lshift}, + {"<<", dst_rshift}, + {">>>", dst_lshiftu}, + {"not", dst_stl_not} }; DstValue dst_loadstl(int flags) { diff --git a/core/string.c b/core/string.c index 976f2610..25df919d 100644 --- a/core/string.c +++ b/core/string.c @@ -283,8 +283,10 @@ const uint8_t *dst_short_description(DstValue x) { return dst_unwrap_string(x); case DST_STRING: return dst_escape_string(dst_unwrap_string(x)); - case DST_USERDATA: - return string_description(dst_userdata_type(dst_unwrap_pointer(x))->name, dst_unwrap_pointer(x)); + case DST_ABSTRACT: + return string_description( + dst_abstract_type(dst_unwrap_abstract(x))->name, + dst_unwrap_abstract(x)); default: return string_description(dst_type_names[dst_type(x)], dst_unwrap_pointer(x)); } @@ -308,13 +310,17 @@ void dst_short_description_b(DstBuffer *buffer, DstValue x) { integer_to_string_b(buffer, dst_unwrap_integer(x)); return; case DST_SYMBOL: - dst_buffer_push_bytes(buffer, dst_unwrap_string(x), dst_string_length(dst_unwrap_string(x))); + dst_buffer_push_bytes(buffer, + dst_unwrap_string(x), + dst_string_length(dst_unwrap_string(x))); return; case DST_STRING: dst_escape_string_b(buffer, dst_unwrap_string(x)); return; - case DST_USERDATA: - string_description_b(buffer, dst_userdata_type(dst_unwrap_pointer(x))->name, dst_unwrap_pointer(x)); + case DST_ABSTRACT: + string_description_b(buffer, + dst_abstract_type(dst_unwrap_abstract(x))->name, + dst_unwrap_abstract(x)); return; default: string_description_b(buffer, dst_type_names[dst_type(x)], dst_unwrap_pointer(x)); @@ -379,7 +385,7 @@ static int is_print_ds(DstValue v) { DST_BUFFER, DST_FUNCTION, DST_CFUNCTION, - DST_USERDATA + DST_ABSTRACT */ static const char *dst_type_colors[16] = { "\x1B[35m", diff --git a/core/util.c b/core/util.c index 02199c28..2e535882 100644 --- a/core/util.c +++ b/core/util.c @@ -47,7 +47,7 @@ const char *dst_type_names[16] = { "buffer", "function", "cfunction", - "userdata" + "abstract" }; /* Computes hash of an array of values */ diff --git a/core/value.c b/core/value.c index be9e4ed7..9f8dea4e 100644 --- a/core/value.c +++ b/core/value.c @@ -47,6 +47,9 @@ int dst_equals(DstValue x, DstValue y) { case DST_STRING: result = dst_string_equal(dst_unwrap_string(x), dst_unwrap_string(y)); break; + case DST_TUPLE: + result = dst_tuple_equal(dst_unwrap_tuple(x), dst_unwrap_tuple(y)); + break; case DST_STRUCT: result = dst_struct_equal(dst_unwrap_struct(x), dst_unwrap_struct(y)); break; @@ -259,7 +262,7 @@ int32_t dst_capacity(DstValue x) { } } -/* Index into a data structure. Returns nil for out of bounds or invliad data structure */ +/* Index into a data structure. Returns nil for out of bounds or invlalid data structure */ DstValue dst_getindex(DstValue ds, int32_t index) { switch (dst_type(ds)) { default: diff --git a/core/vm.c b/core/vm.c index 82bab640..77bdee5f 100644 --- a/core/vm.c +++ b/core/vm.c @@ -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_cstringv((e)); goto vm_error; } while (0) +#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_assert(cond, e) do {if (!(cond)) vm_throw((e)); } while (0) #define vm_binop_integer(op) \ @@ -124,10 +124,13 @@ static int dst_continue(DstValue *returnreg) { * templated by the above macros. */ for (;;) { + /*dst_puts(dst_formatc("trace: %C\n", dst_asm_decode_instruction(*pc)));*/ + switch (*pc & 0xFF) { default: - vm_throw("unknown opcode"); + retreg = dst_wrap_string(dst_formatc("unknown opcode %d", *pc & 0xFF)); + goto vm_error; case DOP_NOOP: pc++; @@ -365,10 +368,13 @@ static int dst_continue(DstValue *returnreg) { vm_next(); case DOP_LOAD_CONSTANT: - vm_assert((int32_t)oparg(2, 0xFFFF) < func->def->constants_length, "invalid constant"); - stack[oparg(1, 0xFF)] = func->def->constants[(int32_t)oparg(2, 0xFFFF)]; - pc++; - vm_next(); + { + int32_t index = oparg(2, 0xFFFF); + vm_assert(index < func->def->constants_length, "invalid constant"); + stack[oparg(1, 0xFF)] = func->def->constants[index]; + pc++; + vm_next(); + } case DOP_LOAD_SELF: stack[oparg(1, 0xFFFFFF)] = dst_wrap_function(func); @@ -416,23 +422,18 @@ static int dst_continue(DstValue *returnreg) { int32_t i; DstFunction *fn; DstFuncDef *fd; - vm_assert((int32_t)oparg(2, 0xFFFF) < func->def->constants_length, "invalid constant"); - vm_assert(dst_checktype(func->def->constants[oparg(2, 0xFFFF)], DST_NIL), "constant must be funcdef"); - fd = (DstFuncDef *)(dst_unwrap_pointer(func->def->constants[(int32_t)oparg(2, 0xFFFF)])); + vm_assert((int32_t)oparg(2, 0xFFFF) < func->def->defs_length, "invalid funcdef"); + fd = func->def->defs[(int32_t)oparg(2, 0xFFFF)]; fn = dst_gcalloc(DST_MEMORY_FUNCTION, sizeof(DstFunction)); - fn->envs = malloc(sizeof(DstFuncEnv *) * fd->environments_length); - if (NULL == fn->envs) { - DST_OUT_OF_MEMORY; - } - if (fd->flags & DST_FUNCDEF_FLAG_NEEDSENV) { - /* Delayed capture of current stack frame */ - DstFuncEnv *env = dst_gcalloc(DST_MEMORY_FUNCENV, sizeof(DstFuncEnv)); - env->offset = dst_vm_fiber->frame; - env->as.fiber = dst_vm_fiber; - env->length = func->def->slotcount; - fn->envs[0] = env; - } else { + fn->def = fd; + if (fd->environments_length) { + fn->envs = malloc(sizeof(DstFuncEnv *) * fd->environments_length); + if (NULL == fn->envs) { + DST_OUT_OF_MEMORY; + } fn->envs[0] = NULL; + } else { + fn->envs = NULL; } for (i = 1; i < fd->environments_length; ++i) { int32_t inherit = fd->environments[i]; @@ -446,6 +447,7 @@ static int dst_continue(DstValue *returnreg) { case DOP_PUSH: dst_fiber_push(dst_vm_fiber, stack[oparg(1, 0xFFFFFF)]); pc++; + stack = dst_vm_fiber->data + dst_vm_fiber->frame; vm_checkgc_next(); case DOP_PUSH_2: @@ -453,6 +455,7 @@ static int dst_continue(DstValue *returnreg) { stack[oparg(1, 0xFF)], stack[oparg(2, 0xFFFF)]); pc++; + stack = dst_vm_fiber->data + dst_vm_fiber->frame; vm_checkgc_next(); case DOP_PUSH_3: @@ -461,42 +464,32 @@ static int dst_continue(DstValue *returnreg) { stack[oparg(2, 0xFF)], stack[oparg(3, 0xFF)]); pc++; + stack = dst_vm_fiber->data + dst_vm_fiber->frame; vm_checkgc_next(); - case DOP_PUSH_ARRAY: - { - int32_t count; - const DstValue *array; - if (dst_seq_view(stack[oparg(1, 0xFFFFFF)], &array, &count)) { - dst_fiber_pushn(dst_vm_fiber, array, count); - } else { - vm_throw("expected array or tuple"); - } - pc++; - vm_checkgc_next(); - } - case DOP_CALL: { DstValue callee = stack[oparg(2, 0xFFFF)]; if (dst_checktype(callee, DST_FUNCTION)) { func = dst_unwrap_function(callee); + dst_stack_frame(stack)->pc = pc; dst_fiber_funcframe(dst_vm_fiber, func); stack = dst_vm_fiber->data + dst_vm_fiber->frame; pc = func->def->bytecode; vm_checkgc_next(); } else if (dst_checktype(callee, DST_CFUNCTION)) { + int32_t argn = dst_vm_fiber->stacktop - dst_vm_fiber->stackstart; dst_fiber_cframe(dst_vm_fiber); retreg = dst_wrap_nil(); if (dst_unwrap_cfunction(callee)( - dst_vm_fiber->frametop - dst_vm_fiber->frame, - dst_vm_fiber->data + dst_vm_fiber->frame, - &retreg)) { + argn, + dst_vm_fiber->data + dst_vm_fiber->frame, + &retreg)) { goto vm_error; } goto vm_return_cfunc; } - vm_throw("cannot call non-function type"); + vm_throw("expected function"); } case DOP_TAILCALL: @@ -509,15 +502,16 @@ static int dst_continue(DstValue *returnreg) { pc = func->def->bytecode; vm_checkgc_next(); } else if (dst_checktype(callee, DST_CFUNCTION)) { - dst_fiber_cframe_tail(dst_vm_fiber); + int32_t argn = dst_vm_fiber->stacktop - dst_vm_fiber->stackstart; + dst_fiber_cframe(dst_vm_fiber); retreg = dst_wrap_nil(); if (dst_unwrap_cfunction(callee)( - dst_vm_fiber->frametop - dst_vm_fiber->frame, - dst_vm_fiber->data + dst_vm_fiber->frame, - &retreg)) { + argn, + dst_vm_fiber->data + dst_vm_fiber->frame, + &retreg)) { goto vm_error; } - goto vm_return_cfunc; + goto vm_return_cfunc_tail; } vm_throw("expected function"); } @@ -585,12 +579,23 @@ static int dst_continue(DstValue *returnreg) { *returnreg = retreg; return 0; } + stack = dst_vm_fiber->data + dst_vm_fiber->frame; stack[oparg(1, 0xFF)] = retreg; pc++; vm_checkgc_next(); } - /* Handle returning from stack frame. Expect return value in fiber->ret */ + vm_return_cfunc_tail: + { + dst_fiber_popframe(dst_vm_fiber); + if (dst_update_fiber()) { + *returnreg = retreg; + return 0; + } + /* Fall through to normal return */ + } + + /* Handle returning from stack frame. Expect return value in retreg */ vm_return: { dst_fiber_popframe(dst_vm_fiber); @@ -599,6 +604,7 @@ static int dst_continue(DstValue *returnreg) { return 0; } stack = dst_vm_fiber->data + dst_vm_fiber->frame; + func = dst_stack_frame(stack)->func; pc = dst_stack_frame(stack)->pc; stack[oparg(1, 0xFF)] = retreg; pc++; @@ -614,6 +620,7 @@ static int dst_continue(DstValue *returnreg) { return 1; } stack = dst_vm_fiber->data + dst_vm_fiber->frame; + func = dst_stack_frame(stack)->func; pc = dst_stack_frame(stack)->pc; stack[oparg(1, 0xFF)] = retreg; pc++; @@ -668,7 +675,7 @@ int dst_init() { * a collection pretty much every cycle, which is * horrible for performance, but helps ensure * there are no memory bugs during dev */ - dst_vm_gc_interval = 0x0000000; + dst_vm_gc_interval = 0x00000000; dst_symcache_init(); /* Set thread */ dst_vm_fiber = NULL; diff --git a/core/wrap.c b/core/wrap.c index e713133a..bf890973 100644 --- a/core/wrap.c +++ b/core/wrap.c @@ -140,8 +140,7 @@ DST_WRAP_DEFINE(buffer, DstBuffer *, DST_BUFFER, pointer) DST_WRAP_DEFINE(function, DstFunction *, DST_FUNCTION, pointer) DST_WRAP_DEFINE(cfunction, DstCFunction, DST_CFUNCTION, pointer) DST_WRAP_DEFINE(table, DstTable *, DST_TABLE, pointer) -DST_WRAP_DEFINE(userdata, void *, DST_USERDATA, pointer) -DST_WRAP_DEFINE(pointer, void *, DST_USERDATA, pointer) +DST_WRAP_DEFINE(abstract, void *, DST_ABSTRACT, pointer) #undef DST_WRAP_DEFINE diff --git a/gsttests/basic.dst b/dsttest/suite0.dst similarity index 82% rename from gsttests/basic.dst rename to dsttest/suite0.dst index 138ed15b..a5d28350 100644 --- a/gsttests/basic.dst +++ b/dsttest/suite0.dst @@ -36,8 +36,8 @@ (assert (= 10 (+ 1 2 3 4)) "addition") (assert (= -8 (- 1 2 3 4)) "subtraction") (assert (= 24 (* 1 2 3 4)) "multiplication") -(assert (= 4 (blshift 1 2)) "left shift") -(assert (= 1 (brshift 4 2)) "right shift") +(assert (= 4 (<< 1 2)) "left shift") +(assert (= 1 (>> 4 2)) "right shift") (assert (< 1 2 3 4 5 6) "less than integers") (assert (< 1.0 2.0 3.0 4.0 5.0 6.0) "less than reals") (assert (> 6 5 4 3 2 1) "greater than integers") @@ -53,7 +53,7 @@ (tuple 1 2 3) (table "a" "b" "c" false) (struct 1 2) - (thread (fn [x] x)) + (fiber (fn [x] x)) (buffer "hi") (fn [x] (+ x x)) +) "type ordering") @@ -61,49 +61,30 @@ (assert (not false) "false literal") (assert true "true literal") (assert (not nil) "nil literal") -(assert (= 7 (bor 3 4)) "bit or") -(assert (= 0 (band 3 4)) "bit and") +(assert (= 7 (| 3 4)) "bit or") +(assert (= 0 (& 3 4)) "bit and") (assert (= "hello" :hello) "keyword syntax for strings") (assert (= '(1 2 3) (quote (1 2 3)) (tuple 1 2 3)) "quote shorthand") -(assert (= (symbol :banana) 'banana) "symbol function") ((fn [] (var accum 1) (var count 0) (while (< count 16) - (varset! accum (blshift accum 1)) + (varset! accum (<< accum 1)) (varset! count (+ 1 count))) (assert (= accum 65536) "loop in closure"))) (var accum 1) (var count 0) (while (< count 16) - (varset! accum (blshift accum 1)) + (varset! accum (<< accum 1)) (varset! count (+ 1 count))) (assert (= accum 65536) "loop globally") (assert (= (struct 1 2 3 4 5 6 7 8) (struct 7 8 5 6 3 4 1 2)) "struct order does not matter") -# Serialization tests - -(def scheck (fn [x] - (def dat (serialize x)) - (def deser (deserialize dat)) - (assert (= x deser) (string "serialize " (description x))) -)) - -(scheck 1) -(scheck true) -(scheck false) -(scheck nil) -(scheck "asdasdasd") -(scheck (struct 1 2 3 4)) -(scheck (tuple 1 2 3)) -(scheck 123412.12) -(scheck (struct (struct 1 2 3 "a") (struct 1 2 3 "a") false 1 "asdasd" (tuple "a" "b"))) -(scheck "qwertyuiopasdfghjklzxcvbnm123456789") -(scheck "qwertyuiopasdfghjklzxcvbnm1234567890!@#$%^&*()") +# Fiber tests (def athread (thread (fn [x] (error (string "hello, " x))))) @@ -124,7 +105,7 @@ # Var arg tests -(def vargf (fn [x &] (apply + (if x x 0) 100 &))) +(def vargf (fn [x & more] (apply + (if x x 0) 100 more))) (assert (= 100 (vargf)) "var arg no arguments") (assert (= 101 (vargf 1)) "var arg no packed arguments") (assert (= 103 (vargf 1 2)) "var arg tuple size 1") diff --git a/dsttest/test.dst b/dsttest/test.dst new file mode 100644 index 00000000..8629edae --- /dev/null +++ b/dsttest/test.dst @@ -0,0 +1,8 @@ +# Simple test file +(def borker (fn [name] (print "Hello, " name ", you sexy beast!"))) + +(def make-borker (fn [name] (fn [] (borker name)))) + +(def calvin-borker (make-borker "Calvin")) + +(calvin-borker) diff --git a/include/dst/dst.h b/include/dst/dst.h index a390cfdf..45738ae3 100644 --- a/include/dst/dst.h +++ b/include/dst/dst.h @@ -133,7 +133,6 @@ 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_cframe_tail(DstFiber *fiber); void dst_fiber_popframe(DstFiber *fiber); /* Functions */ @@ -143,16 +142,17 @@ void dst_function_detach(DstFunction *func); DstAssembleResult dst_asm(DstAssembleOptions opts); DstFunction *dst_asm_func(DstAssembleResult result); DstValue dst_disasm(DstFuncDef *def); +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); -/* Userdata */ -#define dst_userdata_header(u) ((DstUserdataHeader *)(u) - 1) -#define dst_userdata_type(u) (dst_userdata_header(u)->type) -#define dst_userdata_size(u) (dst_userdata_header(u)->size) +/* Abstract */ +#define dst_abstract_header(u) ((DstAbstractHeader *)(u) - 1) +#define dst_abstract_type(u) (dst_abstract_header(u)->type) +#define dst_abstract_size(u) (dst_abstract_header(u)->size) /* Value functions */ int dst_equals(DstValue x, DstValue y); diff --git a/include/dst/dstconfig.h b/include/dst/dstconfig.h index ca15451e..4a83a272 100644 --- a/include/dst/dstconfig.h +++ b/include/dst/dstconfig.h @@ -116,6 +116,6 @@ #define DST_RECURSION_GUARD 1000 /* Use nanboxed values - uses 8 bytes per value instead of 12 or 16. */ -#define DST_NANBOX +//#define DST_NANBOX #endif /* DST_CONFIG_H_defined */ diff --git a/include/dst/dststl.h b/include/dst/dststl.h index 885211c1..d721ab11 100644 --- a/include/dst/dststl.h +++ b/include/dst/dststl.h @@ -47,10 +47,19 @@ int dst_sqrt(int32_t argn, DstValue *argv, DstValue *ret); int dst_ceil(int32_t argn, DstValue *argv, DstValue *ret); int dst_fabs(int32_t argn, DstValue *argv, DstValue *ret); int dst_floor(int32_t argn, DstValue *argv, DstValue *ret); +int dst_pow(int32_t argn, DstValue *argv, DstValue *ret); int dst_stl_table(int32_t argn, DstValue *argv, DstValue *ret); int dst_stl_array(int32_t argn, DstValue *argv, DstValue *ret); int dst_stl_struct(int32_t argn, DstValue *argv, DstValue *ret); int dst_stl_tuple(int32_t argn, DstValue *argv, DstValue *ret); +int dst_band(int32_t argn, DstValue *argv, DstValue *ret); +int dst_bor(int32_t argn, DstValue *argv, DstValue *ret); +int dst_bxor(int32_t argn, DstValue *argv, DstValue *ret); + +int dst_lshift(int argn, DstValue *argv, DstValue *ret); +int dst_rshift(int argn, DstValue *argv, DstValue *ret); +int dst_lshiftu(int argn, DstValue *argv, DstValue *ret); + #endif /* DST_MATH_H_defined */ diff --git a/include/dst/dsttypes.h b/include/dst/dsttypes.h index e0364dce..3f902801 100644 --- a/include/dst/dsttypes.h +++ b/include/dst/dsttypes.h @@ -41,11 +41,11 @@ typedef struct DstFiber DstFiber; /* Other structs */ typedef struct DstReg DstReg; -typedef struct DstUserdataHeader DstUserdataHeader; +typedef struct DstAbstractHeader DstAbstractHeader; typedef struct DstFuncDef DstFuncDef; typedef struct DstFuncEnv DstFuncEnv; typedef struct DstStackFrame DstStackFrame; -typedef struct DstUserType DstUserType; +typedef struct DstAbstractType DstAbstractType; typedef int (*DstCFunction)(int32_t argn, DstValue *argv, DstValue *ret); typedef enum DstAssembleStatus DstAssembleStatus; @@ -74,7 +74,7 @@ typedef enum DstType { DST_BUFFER, DST_FUNCTION, DST_CFUNCTION, - DST_USERDATA + DST_ABSTRACT } DstType; /* We provide two possible implemenations of DstValues. The preferred @@ -205,8 +205,7 @@ DstValue dst_nanbox_from_bits(uint64_t bits); #define dst_wrap_buffer(s) dst_nanbox_wrap_((s), DST_BUFFER) #define dst_wrap_string(s) dst_nanbox_wrap_c((s), DST_STRING) #define dst_wrap_symbol(s) dst_nanbox_wrap_c((s), DST_SYMBOL) -#define dst_wrap_userdata(s) dst_nanbox_wrap_((s), DST_USERDATA) -#define dst_wrap_pointer(s) dst_nanbox_wrap_((s), DST_USERDATA) +#define dst_wrap_abstract(s) dst_nanbox_wrap_((s), DST_ABSTRACT) #define dst_wrap_function(s) dst_nanbox_wrap_((s), DST_FUNCTION) #define dst_wrap_cfunction(s) dst_nanbox_wrap_((s), DST_CFUNCTION) @@ -219,7 +218,7 @@ DstValue dst_nanbox_from_bits(uint64_t bits); #define dst_unwrap_buffer(x) ((DstBuffer *)dst_nanbox_to_pointer(x)) #define dst_unwrap_string(x) ((const uint8_t *)dst_nanbox_to_pointer(x)) #define dst_unwrap_symbol(x) ((const uint8_t *)dst_nanbox_to_pointer(x)) -#define dst_unwrap_userdata(x) (dst_nanbox_to_pointer(x)) +#define dst_unwrap_abstract(x) (dst_nanbox_to_pointer(x)) #define dst_unwrap_pointer(x) (dst_nanbox_to_pointer(x)) #define dst_unwrap_function(x) ((DstFunction *)dst_nanbox_to_pointer(x)) #define dst_unwrap_cfunction(x) ((DstCFunction)dst_nanbox_to_pointer(x)) @@ -255,7 +254,7 @@ struct DstValue { #define dst_unwrap_buffer(x) ((DstBuffer *)(x).as.pointer) #define dst_unwrap_string(x) ((const uint8_t *)(x).as.pointer) #define dst_unwrap_symbol(x) ((const uint8_t *)(x).as.pointer) -#define dst_unwrap_userdata(x) ((x).as.pointer) +#define dst_unwrap_abstract(x) ((x).as.pointer) #define dst_unwrap_pointer(x) ((x).as.pointer) #define dst_unwrap_function(x) ((DstFunction *)(x).as.pointer) #define dst_unwrap_cfunction(x) ((DstCFunction)(x).as.pointer) @@ -279,8 +278,7 @@ DstValue dst_wrap_buffer(DstBuffer *x); DstValue dst_wrap_function(DstFunction *x); DstValue dst_wrap_cfunction(DstCFunction x); DstValue dst_wrap_table(DstTable *x); -DstValue dst_wrap_userdata(void *x); -DstValue dst_wrap_pointer(void *x); +DstValue dst_wrap_abstract(void *x); /* End of tagged union implementation */ #endif @@ -297,7 +295,7 @@ struct DstFiber { DstValue *data; DstFiber *parent; int32_t frame; /* Index of the stack frame */ - int32_t frametop; /* Index of top of stack frame */ + int32_t stackstart; /* Beginning of next args */ int32_t stacktop; /* Top of stack. Where values are pushed and popped from. */ int32_t capacity; enum { @@ -347,7 +345,8 @@ struct DstTable { /* A function definition. Contains information needed to instantiate closures. */ struct DstFuncDef { int32_t *environments; /* Which environments to capture from parent. */ - DstValue *constants; /* Contains strings, FuncDefs, etc. */ + DstValue *constants; + DstFuncDef **defs; uint32_t *bytecode; /* Various debug information */ @@ -361,6 +360,7 @@ struct DstFuncDef { int32_t constants_length; int32_t bytecode_length; int32_t environments_length; + int32_t defs_length; }; /* A fuction environment */ @@ -381,8 +381,8 @@ struct DstFunction { DstFuncEnv **envs; }; -/* Defines a type for userdata */ -struct DstUserType { +/* Defines an abstract type */ +struct DstAbstractType { const char *name; int (*serialize)(void *data, size_t len); int (*deserialize)(); @@ -390,8 +390,8 @@ struct DstUserType { }; /* Contains information about userdata */ -struct DstUserdataHeader { - const DstUserType *type; +struct DstAbstractHeader { + const DstAbstractType *type; size_t size; }; @@ -402,7 +402,6 @@ enum DstAssembleStatus { }; struct DstAssembleOptions { - const DstValue *sourcemap; DstValue source; uint32_t flags; }; @@ -410,8 +409,6 @@ struct DstAssembleOptions { struct DstAssembleResult { DstFuncDef *funcdef; const uint8_t *error; - int32_t error_start; - int32_t error_end; DstAssembleStatus status; };