mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-11-24 17:27:18 +00:00
Code Issues 1 Releases Wiki Activity

More compiler bug fixes. Added some features and functions like varargs.

Browse Source
This commit is contained in:
bakpakin 2018-01-03 21:36:10 -05:00
parent f273aa8b1b
commit e4735e14d2
23 changed files with 1155 additions and 743 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
Makefile
View File

@ -26,7 +26,7 @@ PREFIX?=/usr/local
BINDIR=$(PREFIX)/bin BINDIR=$(PREFIX)/bin
VERSION=\"0.0.0-beta\" 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 PREFIX=/usr/local
DST_TARGET=dst DST_TARGET=dst
DST_XXD=xxd DST_XXD=xxd
@ -38,39 +38,25 @@ DST_HEADERS=$(addprefix include/dst/,dst.h dstconfig.h dsttypes.h dststate.h dst
##### Generated headers ##### ##### Generated headers #####
############################# #############################
DST_LANG_SOURCES=$(addprefix libs/, bootstrap.dst) DST_ALL_HEADERS=$(DST_HEADERS) $(DST_INTERNAL_HEADERS)
DST_LANG_HEADERS=$(patsubst %.dst,%.gen.h,$(DST_LANG_SOURCES))
DST_ALL_HEADERS=$(DST_HEADERS) $(DST_INTERNAL_HEADERS) $(DST_LANG_HEADERS)
all: $(DST_TARGET) 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 ##### ##### The core vm and runtime #####
################################### ###################################
DST_CORE_SOURCES=$(addprefix core/,\ DST_CORE_SOURCES=$(addprefix core/,\
array.c asm.c buffer.c compile.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\ fiber.c func.c gc.c math.c parse.c sourcemap.c string.c\
struct.c symcache.c table.c tuple.c userdata.c util.c\ stl.c strtod.c struct.c symcache.c table.c tuple.c util.c\
value.c vm.c wrap.c) value.c vm.c wrap.c)
DST_CORE_OBJECTS=$(patsubst %.c,%.o,$(DST_CORE_SOURCES))
$(DST_TARGET): client/main.o $(DST_CORE_OBJECTS) DST_CLIENT_SOURCES=$(addprefix client/,\
$(CC) $(CFLAGS) -o $(DST_TARGET) $^ main.c)
# Compile all .c to .o $(DST_TARGET): $(DST_CORE_SOURCES) $(DST_CLIENT_SOURCES) $(DST_ALL_HEADERS)
%.o: %.c $(DST_ALL_HEADERS) $(CC) $(CFLAGS) $(DST_CORE_SOURCES) $(DST_CLIENT_SOURCES) -o $(DST_TARGET)
$(CC) $(CFLAGS) -o $@ -c $<
###################### ######################
##### Unit Tests ##### ##### Unit Tests #####
@ -120,7 +106,9 @@ valtest: $(DST_TARGET)
clean: clean:
rm $(DST_TARGET) || true 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 $(DST_LANG_HEADERS) || true
rm vgcore.* || true rm vgcore.* || true
rm unittests/*.out || true rm unittests/*.out || true

35
client/main.c
View File

@ -65,6 +65,14 @@ static const uint8_t *loadsource(const char *fpath, int32_t *len) {
return NULL; 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 */ /* simple repl */
static int repl() { static int repl() {
DstBuffer b; DstBuffer b;
@ -74,6 +82,11 @@ static int repl() {
DstParseResult res; DstParseResult res;
DstCompileResult cres; DstCompileResult cres;
DstCompileOptions opts; DstCompileOptions opts;
res = dst_parse(b.data, b.count);
switch (res.status) {
case DST_PARSE_NODATA:
b.count = 0;
case DST_PARSE_UNEXPECTED_EOS:
if (b.count == 0) if (b.count == 0)
printf("> "); printf("> ");
else else
@ -87,16 +100,9 @@ static int repl() {
dst_buffer_push_u8(&b, c); dst_buffer_push_u8(&b, c);
if (c == '\n') break; 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:
break; break;
case DST_PARSE_ERROR: case DST_PARSE_ERROR:
dst_puts(dst_formatc("syntax error at %d: %S\n", dst_puts(dst_formatc("syntax error: %S\n", res.error));
res.bytes_read + 1, res.error));
b.count = 0; b.count = 0;
break; break;
case DST_PARSE_OK: case DST_PARSE_OK:
@ -107,18 +113,18 @@ static int repl() {
opts.env = env; opts.env = env;
cres = dst_compile(opts); cres = dst_compile(opts);
if (cres.status == DST_COMPILE_OK) { if (cres.status == DST_COMPILE_OK) {
/*dst_puts(dst_formatc("asm: %v\n", dst_disasm(cres.funcdef)));*/
DstFunction *f = dst_compile_func(cres); DstFunction *f = dst_compile_func(cres);
DstValue ret; DstValue ret;
if (dst_run(dst_wrap_function(f), &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 { } else {
dst_puts(dst_formatc("%v\n", ret)); dst_puts(dst_formatc("%v\n", ret));
} }
} else { } else {
dst_puts(dst_formatc("compile error at %d: %S\n", dst_puts(dst_formatc("compile error: %S\n", cres.error));
cres.error_start + 1, cres.error));
} }
b.count = 0; bshift(&b, res.bytes_read);
} }
break; break;
} }
@ -157,9 +163,6 @@ static void runfile(const uint8_t *src, int32_t len) {
DstFunction *f = dst_compile_func(cres); DstFunction *f = dst_compile_func(cres);
if (dst_run(dst_wrap_function(f), &ret)) { if (dst_run(dst_wrap_function(f), &ret)) {
dst_puts(dst_formatc("runtime error: %v\n", ret)); dst_puts(dst_formatc("runtime error: %v\n", ret));
} else {
dst_puts(dst_formatc("runtime error: %v\n", ret));
break;
} }
} else { } else {
dst_puts(dst_formatc("compile error at %d: %S\n", dst_puts(dst_formatc("compile error at %d: %S\n",
@ -176,7 +179,7 @@ int main(int argc, char **argv) {
int status = -1; int status = -1;
int i; int i;
int fileRead = 0; int fileRead = 0;
uint32_t gcinterval = 8192; uint32_t gcinterval = 0x10000;
uint64_t flags = 0; uint64_t flags = 0;
/* Read the arguments. Ignore files. */ /* Read the arguments. Ignore files. */

12
core/userdata.c → core/abstract.c
View File

@ -24,11 +24,11 @@
#include "gc.h" #include "gc.h"
/* Create new userdata */ /* Create new userdata */
void *dst_userdata(size_t size, const DstUserType *utype) { void *dst_abstract(size_t size, const DstAbstractType *atype) {
char *data = dst_gcalloc(DST_MEMORY_USERDATA, sizeof(DstUserdataHeader) + size); char *data = dst_gcalloc(DST_MEMORY_ABSTRACT, sizeof(DstAbstractHeader) + size);
DstUserdataHeader *header = (DstUserdataHeader *)data; DstAbstractHeader *header = (DstAbstractHeader *)data;
void *user = data + sizeof(DstUserdataHeader); void *a = data + sizeof(DstAbstractHeader);
header->size = size; header->size = size;
header->type = utype; header->type = atype;
return user; return a;
} }

332
core/asm.c
View File

@ -29,12 +29,6 @@
/* Bytecode op argument types */ /* 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; typedef enum DstOpArgType DstOpArgType;
enum DstOpArgType { enum DstOpArgType {
DST_OAT_SLOT, DST_OAT_SLOT,
@ -43,12 +37,13 @@ enum DstOpArgType {
DST_OAT_INTEGER, DST_OAT_INTEGER,
DST_OAT_TYPE, DST_OAT_TYPE,
DST_OAT_SIMPLETYPE, DST_OAT_SIMPLETYPE,
DST_OAT_LABEL DST_OAT_LABEL,
DST_OAT_FUNCDEF
}; };
/* Convert a slot to to an integer for bytecode */ /* 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) /* _0arg - op.---.--.-- (return-nil, noop, vararg arguments)
* _s - op.src.--.-- (push1) * _s - op.src.--.-- (push1)
* _l - op.XX.XX.XX (jump) * _l - op.XX.XX.XX (jump)
@ -71,6 +66,7 @@ enum DstInstructionType {
DIT_SL, DIT_SL,
DIT_ST, DIT_ST,
DIT_SI, DIT_SI,
DIT_SD, /* Closures (D for funcDef) */
DIT_SU, /* Unsigned */ DIT_SU, /* Unsigned */
DIT_SSS, DIT_SSS,
DIT_SSI, DIT_SSI,
@ -94,7 +90,7 @@ struct DstAssembler {
DstFuncDef *def; DstFuncDef *def;
jmp_buf on_error; jmp_buf on_error;
const uint8_t *errmessage; const uint8_t *errmessage;
const DstValue *errmap; const uint8_t *name;
int32_t environments_capacity; int32_t environments_capacity;
int32_t bytecode_count; /* Used for calculating labels */ int32_t bytecode_count; /* Used for calculating labels */
@ -103,6 +99,7 @@ struct DstAssembler {
DstTable constants; /* symbol -> constant index */ DstTable constants; /* symbol -> constant index */
DstTable slots; /* symbol -> slot index */ DstTable slots; /* symbol -> slot index */
DstTable envs; /* symbol -> environment index */ DstTable envs; /* symbol -> environment index */
DstTable defs; /* symbol -> funcdefs index */
}; };
/* Dst opcode descriptions in lexographic order. This /* Dst opcode descriptions in lexographic order. This
@ -115,12 +112,12 @@ static const DstInstructionDef dst_ops[] = {
{"add-immediate", DIT_SSI, DOP_ADD_IMMEDIATE}, {"add-immediate", DIT_SSI, DOP_ADD_IMMEDIATE},
{"add-integer", DIT_SSS, DOP_ADD_INTEGER}, {"add-integer", DIT_SSS, DOP_ADD_INTEGER},
{"add-real", DIT_SSS, DOP_ADD_REAL}, {"add-real", DIT_SSS, DOP_ADD_REAL},
{"bitand", DIT_SSS, DOP_BAND}, {"band", DIT_SSS, DOP_BAND},
{"bitnot", DIT_SS, DOP_BNOT}, {"bnot", DIT_SS, DOP_BNOT},
{"bitor", DIT_SSS, DOP_BOR}, {"bor", DIT_SSS, DOP_BOR},
{"bitxor", DIT_SSS, DOP_BXOR}, {"bxor", DIT_SSS, DOP_BXOR},
{"call", DIT_SS, DOP_CALL}, {"call", DIT_SS, DOP_CALL},
{"closure", DIT_SC, DOP_CLOSURE}, {"closure", DIT_SD, DOP_CLOSURE},
{"compare", DIT_SSS, DOP_COMPARE}, {"compare", DIT_SSS, DOP_COMPARE},
{"divide", DIT_SSS, DOP_DIVIDE}, {"divide", DIT_SSS, DOP_DIVIDE},
{"divide-immediate", DIT_SSI, DOP_DIVIDE_IMMEDIATE}, {"divide-immediate", DIT_SSI, DOP_DIVIDE_IMMEDIATE},
@ -150,7 +147,6 @@ static const DstInstructionDef dst_ops[] = {
{"multiply-real", DIT_SSS, DOP_MULTIPLY_REAL}, {"multiply-real", DIT_SSS, DOP_MULTIPLY_REAL},
{"noop", DIT_0, DOP_NOOP}, {"noop", DIT_0, DOP_NOOP},
{"push", DIT_S, DOP_PUSH}, {"push", DIT_S, DOP_PUSH},
{"push-array", DIT_S, DOP_PUSH_ARRAY},
{"push2", DIT_SS, DOP_PUSH_2}, {"push2", DIT_SS, DOP_PUSH_2},
{"push3", DIT_SSS, DOP_PUSH_3}, {"push3", DIT_SSS, DOP_PUSH_3},
{"put", DIT_SSS, DOP_PUT}, {"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->labels);
dst_table_deinit(&a->envs); dst_table_deinit(&a->envs);
dst_table_deinit(&a->constants); dst_table_deinit(&a->constants);
dst_table_deinit(&a->defs);
} }
/* Throw some kind of assembly error */ /* 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->errmessage = dst_cstring(message);
a->errmap = map;
longjmp(a->on_error, 1); 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 */ /* 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->errmessage = m;
a->errmap = map;
longjmp(a->on_error, 1); 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 /* 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( static int32_t doarg_1(
DstAssembler *a, DstAssembler *a,
const DstValue *map,
DstOpArgType argtype, DstOpArgType argtype,
DstValue x) { DstValue x) {
int32_t ret = -1; int32_t ret = -1;
@ -276,6 +300,9 @@ static int32_t doarg_1(
case DST_OAT_LABEL: case DST_OAT_LABEL:
c = &a->labels; c = &a->labels;
break; break;
case DST_OAT_FUNCDEF:
c = &a->defs;
break;
} }
switch (dst_type(x)) { switch (dst_type(x)) {
default: default:
@ -291,7 +318,7 @@ static int32_t doarg_1(
int32_t i = 0; int32_t i = 0;
ret = 0; ret = 0;
for (i = 0; i < dst_tuple_length(t); i++) { 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 { } else {
goto error; goto error;
@ -309,14 +336,14 @@ static int32_t doarg_1(
ret = dst_unwrap_integer(result); ret = dst_unwrap_integer(result);
} }
} else { } 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) { } else if (argtype == DST_OAT_TYPE || argtype == DST_OAT_SIMPLETYPE) {
int32_t index = strsearch(dst_unwrap_symbol(x), dst_type_names); int32_t index = strsearch(dst_unwrap_symbol(x), dst_type_names);
if (index != -1) { if (index != -1) {
ret = index; ret = index;
} else { } else {
dst_asm_errorv(a, map, dst_formatc("unknown type %q", x)); dst_asm_errorv(a, dst_formatc("unknown type %q", x));
} }
} else { } else {
goto error; goto error;
@ -329,7 +356,7 @@ static int32_t doarg_1(
return ret; return ret;
error: 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; return 0;
} }
@ -337,22 +364,21 @@ static int32_t doarg_1(
* try to convert arguments to bit patterns */ * try to convert arguments to bit patterns */
static uint32_t doarg( static uint32_t doarg(
DstAssembler *a, DstAssembler *a,
const DstValue *map,
DstOpArgType argtype, DstOpArgType argtype,
int nth, int nth,
int nbytes, int nbytes,
int hassign, int hassign,
DstValue x) { 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 /* Calculate the min and max values that can be stored given
* nbytes, and whether or not the storage is signed */ * nbytes, and whether or not the storage is signed */
int32_t min = (-hassign) << ((nbytes << 3) - 1); int32_t min = (-hassign) << ((nbytes << 3) - 1);
int32_t max = ~((-1) << ((nbytes << 3) - hassign)); int32_t max = ~((-1) << ((nbytes << 3) - hassign));
if (arg < min) 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" : "")); x, nbytes, nbytes > 1 ? "s" : ""));
if (arg > max) 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" : "")); x, nbytes, nbytes > 1 ? "s" : ""));
return ((uint32_t) arg) << (nth << 3); return ((uint32_t) arg) << (nth << 3);
} }
@ -360,7 +386,6 @@ static uint32_t doarg(
/* Provide parsing methods for the different kinds of arguments */ /* Provide parsing methods for the different kinds of arguments */
static uint32_t read_instruction( static uint32_t read_instruction(
DstAssembler *a, DstAssembler *a,
const DstValue *map,
const DstInstructionDef *idef, const DstInstructionDef *idef,
const DstValue *argt) { const DstValue *argt) {
uint32_t instr = idef->opcode; uint32_t instr = idef->opcode;
@ -368,73 +393,81 @@ static uint32_t read_instruction(
case DIT_0: case DIT_0:
{ {
if (dst_tuple_length(argt) != 1) if (dst_tuple_length(argt) != 1)
dst_asm_error(a, map, "expected 0 arguments: (op)"); dst_asm_error(a, "expected 0 arguments: (op)");
break; break;
} }
case DIT_S: case DIT_S:
{ {
if (dst_tuple_length(argt) != 2) if (dst_tuple_length(argt) != 2)
dst_asm_error(a, map, "expected 1 argument: (op, slot)"); dst_asm_error(a, "expected 1 argument: (op, slot)");
instr |= doarg(a, dst_sourcemap_index(map, 1), DST_OAT_SLOT, 1, 3, 0, argt[1]); instr |= doarg(a, DST_OAT_SLOT, 1, 3, 0, argt[1]);
break; break;
} }
case DIT_L: case DIT_L:
{ {
if (dst_tuple_length(argt) != 2) if (dst_tuple_length(argt) != 2)
dst_asm_error(a, map, "expected 1 argument: (op, label)"); dst_asm_error(a, "expected 1 argument: (op, label)");
instr |= doarg(a, dst_sourcemap_index(map, 1), DST_OAT_LABEL, 1, 3, 1, argt[1]); instr |= doarg(a, DST_OAT_LABEL, 1, 3, 1, argt[1]);
break; break;
} }
case DIT_SS: case DIT_SS:
{ {
if (dst_tuple_length(argt) != 3) if (dst_tuple_length(argt) != 3)
dst_asm_error(a, map, "expected 2 arguments: (op, slot, slot)"); dst_asm_error(a, "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_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_sourcemap_index(map, 2), DST_OAT_SLOT, 2, 2, 0, argt[2]); instr |= doarg(a, DST_OAT_SLOT, 2, 2, 0, argt[2]);
break; break;
} }
case DIT_SL: case DIT_SL:
{ {
if (dst_tuple_length(argt) != 3) if (dst_tuple_length(argt) != 3)
dst_asm_error(a, map, "expected 2 arguments: (op, slot, label)"); dst_asm_error(a, "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_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_sourcemap_index(map, 2), DST_OAT_LABEL, 2, 2, 1, argt[2]); instr |= doarg(a, DST_OAT_LABEL, 2, 2, 1, argt[2]);
break; break;
} }
case DIT_ST: case DIT_ST:
{ {
if (dst_tuple_length(argt) != 3) if (dst_tuple_length(argt) != 3)
dst_asm_error(a, map, "expected 2 arguments: (op, slot, type)"); dst_asm_error(a, "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_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_sourcemap_index(map, 2), DST_OAT_TYPE, 2, 2, 0, argt[2]); instr |= doarg(a, DST_OAT_TYPE, 2, 2, 0, argt[2]);
break; break;
} }
case DIT_SI: case DIT_SI:
case DIT_SU: case DIT_SU:
{ {
if (dst_tuple_length(argt) != 3) if (dst_tuple_length(argt) != 3)
dst_asm_error(a, map, "expected 2 arguments: (op, slot, integer)"); dst_asm_error(a, "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_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]); 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; break;
} }
case DIT_SSS: case DIT_SSS:
{ {
if (dst_tuple_length(argt) != 4) if (dst_tuple_length(argt) != 4)
dst_asm_error(a, map, "expected 3 arguments: (op, slot, slot, slot)"); dst_asm_error(a, "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_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_OAT_SLOT, 2, 1, 0, argt[2]);
instr |= doarg(a, dst_sourcemap_index(map, 3), DST_OAT_SLOT, 3, 1, 0, argt[3]); instr |= doarg(a, DST_OAT_SLOT, 3, 1, 0, argt[3]);
break; break;
} }
case DIT_SSI: case DIT_SSI:
case DIT_SSU: case DIT_SSU:
{ {
if (dst_tuple_length(argt) != 4) if (dst_tuple_length(argt) != 4)
dst_asm_error(a, map, "expected 3 arguments: (op, slot, slot, integer)"); dst_asm_error(a, "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_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_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]); instr |= doarg(a, DST_OAT_INTEGER, 3, 1, idef->type == DIT_SSI, argt[3]);
break; break;
} }
case DIT_SES: case DIT_SES:
@ -442,69 +475,35 @@ static uint32_t read_instruction(
DstAssembler *b = a; DstAssembler *b = a;
uint32_t env; uint32_t env;
if (dst_tuple_length(argt) != 4) if (dst_tuple_length(argt) != 4)
dst_asm_error(a, map, "expected 3 arguments: (op, slot, environment, envslot)"); dst_asm_error(a, "expected 3 arguments: (op, slot, environment, envslot)");
instr |= doarg(a, dst_sourcemap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]); instr |= doarg(a, DST_OAT_SLOT, 1, 1, 0, argt[1]);
env = doarg(a, dst_sourcemap_index(map, 2), DST_OAT_ENVIRONMENT, 0, 1, 0, argt[2]); env = doarg(a, DST_OAT_ENVIRONMENT, 0, 1, 0, argt[2]);
instr |= env << 16; instr |= env << 16;
for (env += 1; env > 0; env--) { for (env += 1; env > 0; env--) {
b = b->parent; b = b->parent;
if (NULL == b) 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; break;
} }
case DIT_SC: case DIT_SC:
{ {
if (dst_tuple_length(argt) != 3) if (dst_tuple_length(argt) != 3)
dst_asm_error(a, map, "expected 2 arguments: (op, slot, constant)"); dst_asm_error(a, "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_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_sourcemap_index(map, 2), DST_OAT_CONSTANT, 2, 2, 0, argt[2]); instr |= doarg(a, DST_OAT_CONSTANT, 2, 2, 0, argt[2]);
break; break;
} }
} }
return instr; 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 */ /* Helper to assembly. Return the assembly result */
static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts) { static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts) {
DstAssembleResult result; DstAssembleResult result;
DstAssembler a; DstAssembler a;
const DstValue *st = dst_unwrap_struct(opts.source); DstValue s = opts.source;
DstFuncDef *def; DstFuncDef *def;
int32_t count, i; int32_t count, i;
const DstValue *arr; const DstValue *arr;
@ -521,6 +520,8 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts)
def->source = NULL; def->source = NULL;
def->sourcepath = NULL; def->sourcepath = NULL;
def->sourcemap = NULL; def->sourcemap = NULL;
def->defs = NULL;
def->defs_length = 0;
def->constants_length = 0; def->constants_length = 0;
def->bytecode_length = 0; def->bytecode_length = 0;
def->environments_length = 1; def->environments_length = 1;
@ -529,17 +530,14 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts)
a.def = def; a.def = def;
a.parent = parent; a.parent = parent;
a.errmessage = NULL; a.errmessage = NULL;
a.name = NULL;
a.environments_capacity = 0; a.environments_capacity = 0;
a.bytecode_count = 0; a.bytecode_count = 0;
a.errmap = NULL;
dst_table_init(&a.labels, 10); dst_table_init(&a.labels, 10);
dst_table_init(&a.constants, 10); dst_table_init(&a.constants, 10);
dst_table_init(&a.slots, 10); dst_table_init(&a.slots, 10);
dst_table_init(&a.envs, 10); dst_table_init(&a.envs, 10);
dst_table_init(&a.defs, 10);
/* Initialize result */
result.error_start = -1;
result.error_end = -1;
/* Set error jump */ /* Set error jump */
if (setjmp(a.on_error)) { if (setjmp(a.on_error)) {
@ -549,88 +547,65 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts)
} }
result.error = a.errmessage; result.error = a.errmessage;
result.status = DST_ASSEMBLE_ERROR; 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); dst_asm_deinit(&a);
return result; 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 */ /* 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; def->arity = dst_checktype(x, DST_INTEGER) ? dst_unwrap_integer(x) : 0;
/* Check vararg */ /* Check vararg */
x = dst_struct_get(st, dst_csymbolv("vararg")); x = dst_get(s, dst_csymbolv("vararg"));
if (dst_truthy(x)) if (dst_truthy(x)) def->flags |= DST_FUNCDEF_FLAG_VARARG;
def->flags |= DST_FUNCDEF_FLAG_VARARG;
/* Check source */ /* Check source */
x = dst_struct_get(st, dst_csymbolv("source")); x = dst_get(s, dst_csymbolv("source"));
if (dst_checktype(x, DST_STRING)) { if (dst_checktype(x, DST_STRING)) def->source = dst_unwrap_string(x);
def->source = dst_unwrap_string(x);
}
/* Check source path */ /* Check source path */
x = dst_struct_get(st, dst_csymbolv("sourcepath")); x = dst_get(s, dst_csymbolv("sourcepath"));
if (dst_checktype(x, DST_STRING)) { if (dst_checktype(x, DST_STRING)) def->sourcepath = dst_unwrap_string(x);
def->sourcepath = dst_unwrap_string(x);
}
/* Create slot aliases */ /* 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)) { if (dst_seq_view(x, &arr, &count)) {
const DstValue *slotmap =
dst_sourcemap_value(opts.sourcemap, dst_csymbolv("slots"));
for (i = 0; i < count; i++) { for (i = 0; i < count; i++) {
const DstValue *imap = dst_sourcemap_index(slotmap, i);
DstValue v = arr[i]; DstValue v = arr[i];
if (dst_checktype(v, DST_TUPLE)) { if (dst_checktype(v, DST_TUPLE)) {
const DstValue *t = dst_unwrap_tuple(v); const DstValue *t = dst_unwrap_tuple(v);
int32_t j; int32_t j;
for (j = 0; j < dst_tuple_length(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)) 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)); dst_table_put(&a.slots, t[j], dst_wrap_integer(i));
} }
} else if (dst_checktype(v, DST_SYMBOL)) { } else if (dst_checktype(v, DST_SYMBOL)) {
dst_table_put(&a.slots, v, dst_wrap_integer(i)); dst_table_put(&a.slots, v, dst_wrap_integer(i));
} else { } else {
dst_asm_error(&a, imap, "slot names must be symbols or tuple of symbols"); dst_asm_error(&a, "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");
} }
} }
} }
/* Parse constants */ /* Parse constants */
x = dst_struct_get(st, dst_csymbolv("constants")); x = dst_get(s, dst_csymbolv("constants"));
if (dst_seq_view(x, &arr, &count)) { if (dst_seq_view(x, &arr, &count)) {
const DstValue *cmap =
dst_sourcemap_value(opts.sourcemap, dst_csymbolv("constants"));
def->constants_length = count; def->constants_length = count;
def->constants = malloc(sizeof(DstValue) * count); def->constants = malloc(sizeof(DstValue) * count);
if (NULL == def->constants) { if (NULL == def->constants) {
DST_OUT_OF_MEMORY; DST_OUT_OF_MEMORY;
} }
for (i = 0; i < count; i++) { for (i = 0; i < count; i++) {
const DstValue *imap = dst_sourcemap_index(cmap, i);
DstValue ct = arr[i]; DstValue ct = arr[i];
if (dst_checktype(ct, DST_TUPLE) && if (dst_checktype(ct, DST_TUPLE) &&
dst_tuple_length(dst_unwrap_tuple(ct)) > 1 && 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]; def->constants[i] = t[2];
dst_table_put(&a.constants, t[1], dst_wrap_integer(i)); dst_table_put(&a.constants, t[1], dst_wrap_integer(i));
} else { } 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 { } else {
def->constants[i] = ct; def->constants[i] = ct;
} }
@ -658,22 +632,25 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts)
def->constants_length = 0; 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 */ /* 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)) { if (dst_seq_view(x, &arr, &count)) {
const DstValue *bmap =
dst_sourcemap_value(opts.sourcemap, dst_csymbolv("bytecode"));
/* Do labels and find length */ /* Do labels and find length */
int32_t blength = 0; int32_t blength = 0;
for (i = 0; i < count; ++i) { for (i = 0; i < count; ++i) {
const DstValue *imap = dst_sourcemap_index(bmap, i);
DstValue instr = arr[i]; DstValue instr = arr[i];
if (dst_checktype(instr, DST_SYMBOL)) { if (dst_checktype(instr, DST_SYMBOL)) {
dst_table_put(&a.labels, instr, dst_wrap_integer(blength)); dst_table_put(&a.labels, instr, dst_wrap_integer(blength));
} else if (dst_checktype(instr, DST_TUPLE)) { } else if (dst_checktype(instr, DST_TUPLE)) {
blength++; blength++;
} else { } else {
dst_asm_error(&a, imap, "expected assembly instruction"); dst_asm_error(&a, "expected assembly instruction");
} }
} }
/* Allocate bytecode array */ /* Allocate bytecode array */
@ -684,7 +661,6 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts)
} }
/* Do bytecode */ /* Do bytecode */
for (i = 0; i < count; ++i) { for (i = 0; i < count; ++i) {
const DstValue *imap = dst_sourcemap_index(bmap, i);
DstValue instr = arr[i]; DstValue instr = arr[i];
if (dst_checktype(instr, DST_SYMBOL)) { if (dst_checktype(instr, DST_SYMBOL)) {
continue; continue;
@ -692,49 +668,44 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts)
uint32_t op; uint32_t op;
const DstInstructionDef *idef; const DstInstructionDef *idef;
const DstValue *t; 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); t = dst_unwrap_tuple(instr);
if (dst_tuple_length(t) == 0) { if (dst_tuple_length(t) == 0) {
op = 0; op = 0;
} else { } 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"); "expected symbol in assembly instruction");
idef = dst_findi(dst_unwrap_symbol(t[0])); idef = dst_findi(dst_unwrap_symbol(t[0]));
if (NULL == idef) if (NULL == idef)
dst_asm_errorv(&a, imap, dst_formatc("unknown instruction %v", instr)); dst_asm_errorv(&a, dst_formatc("unknown instruction %v", instr));
op = read_instruction(&a, imap, idef, t); op = read_instruction(&a, idef, t);
} }
def->bytecode[a.bytecode_count++] = op; def->bytecode[a.bytecode_count++] = op;
} }
} }
} else { } else {
dst_asm_error(&a, opts.sourcemap, "bytecode expected"); dst_asm_error(&a, "bytecode expected");
} }
/* Check for source mapping */ /* 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)) { if (dst_seq_view(x, &arr, &count)) {
const DstValue *bmap = dst_asm_assert(&a, count != 2 * def->bytecode_length, "sourcemap must have twice the length of the bytecode");
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");
def->sourcemap = malloc(sizeof(int32_t) * 2 * count); def->sourcemap = malloc(sizeof(int32_t) * 2 * count);
for (i = 0; i < count; i += 2) { for (i = 0; i < count; i += 2) {
DstValue start = arr[i]; DstValue start = arr[i];
DstValue end = arr[i + 1]; DstValue end = arr[i + 1];
if (!(dst_checktype(start, DST_INTEGER) || if (!(dst_checktype(start, DST_INTEGER) ||
dst_unwrap_integer(start) < 0)) { dst_unwrap_integer(start) < 0)) {
const DstValue *submap = dst_sourcemap_index(bmap, i); dst_asm_error(&a, "expected positive integer");
dst_asm_error(&a, submap, "expected positive integer");
} }
if (!(dst_checktype(end, DST_INTEGER) || if (!(dst_checktype(end, DST_INTEGER) ||
dst_unwrap_integer(end) < 0)) { dst_unwrap_integer(end) < 0)) {
const DstValue *submap = dst_sourcemap_index(bmap, i + 1); dst_asm_error(&a, "expected positive integer");
dst_asm_error(&a, submap, "expected positive integer");
} }
def->sourcemap[i] = dst_unwrap_integer(start); def->sourcemap[i] = dst_unwrap_integer(start);
def->sourcemap[i+1] = dst_unwrap_integer(end); def->sourcemap[i+1] = dst_unwrap_integer(end);
} }
} }
/* Finish everything and return funcdef */ /* 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 */ /* 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); const DstInstructionDef *def = dst_asm_reverse_lookup(instr);
DstValue name; DstValue name;
if (NULL == def) { if (NULL == def) {
@ -825,6 +796,7 @@ static DstValue dst_asm_decode_instruction(uint32_t instr) {
case DIT_ST: case DIT_ST:
case DIT_SC: case DIT_SC:
case DIT_SU: case DIT_SU:
case DIT_SD:
return tup3(name, return tup3(name,
dst_wrap_integer(oparg(1, 0xFF)), dst_wrap_integer(oparg(1, 0xFF)),
dst_wrap_integer(oparg(2, 0xFFFF))); dst_wrap_integer(oparg(2, 0xFFFF)));
@ -857,10 +829,11 @@ DstValue dst_disasm(DstFuncDef *def) {
if (def->arity) if (def->arity)
dst_table_put(ret, dst_csymbolv("arity"), dst_wrap_integer(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)); dst_table_put(ret, dst_csymbolv("bytecode"), dst_wrap_array(bcode));
if (def->sourcepath) { if (NULL != def->sourcepath) {
dst_table_put(ret, dst_csymbolv("sourcepath"), dst_wrap_string(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)); dst_table_put(ret, dst_csymbolv("source"), dst_wrap_string(def->source));
} }
if (def->flags & DST_FUNCDEF_FLAG_VARARG) { if (def->flags & DST_FUNCDEF_FLAG_VARARG) {
@ -891,7 +864,7 @@ DstValue dst_disasm(DstFuncDef *def) {
bcode->count = def->bytecode_length; bcode->count = def->bytecode_length;
/* Add source map */ /* Add source map */
if (def->sourcemap) { if (NULL != def->sourcemap) {
DstArray *sourcemap = dst_array(def->bytecode_length * 2); DstArray *sourcemap = dst_array(def->bytecode_length * 2);
for (i = 0; i < def->bytecode_length * 2; i++) { for (i = 0; i < def->bytecode_length * 2; i++) {
sourcemap->data[i] = dst_wrap_integer(def->sourcemap[i]); sourcemap->data[i] = dst_wrap_integer(def->sourcemap[i]);
@ -901,7 +874,7 @@ DstValue dst_disasm(DstFuncDef *def) {
} }
/* Add environments */ /* Add environments */
if (def->environments) { if (NULL != def->environments) {
DstArray *envs = dst_array(def->environments_length); DstArray *envs = dst_array(def->environments_length);
for (i = 0; i < def->environments_length; i++) { for (i = 0; i < def->environments_length; i++) {
envs->data[i] = dst_wrap_integer(def->environments[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)); 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 */ /* Add slotcount */
dst_table_put(ret, dst_csymbolv("slotcount"), dst_wrap_integer(def->slotcount)); dst_table_put(ret, dst_csymbolv("slotcount"), dst_wrap_integer(def->slotcount));

959
core/compile.c
View File

File diff suppressed because it is too large Load Diff

10
core/compile.h
View File

@ -40,6 +40,7 @@ typedef struct DstCFunctionOptimizer DstCFunctionOptimizer;
#define DST_SLOT_NAMED 0x20000 #define DST_SLOT_NAMED 0x20000
#define DST_SLOT_MUTABLE 0x40000 #define DST_SLOT_MUTABLE 0x40000
#define DST_SLOT_REF 0x80000 #define DST_SLOT_REF 0x80000
#define DST_SLOT_RETURNED 0x100000
/* Needed for handling single element arrays as global vars. */ /* Needed for handling single element arrays as global vars. */
#define DST_SLOTTYPE_ANY 0xFFFF #define DST_SLOTTYPE_ANY 0xFFFF
@ -69,6 +70,7 @@ struct DstSlot {
#define DST_SCOPE_FUNCTION 1 #define DST_SCOPE_FUNCTION 1
#define DST_SCOPE_ENV 2 #define DST_SCOPE_ENV 2
#define DST_SCOPE_TOP 4 #define DST_SCOPE_TOP 4
#define DST_SCOPE_UNUSED 8
/* A lexical scope during compilation */ /* A lexical scope during compilation */
struct DstScope { struct DstScope {
@ -91,6 +93,11 @@ struct DstScope {
int32_t scap; int32_t scap;
int32_t smax; int32_t smax;
/* FuncDefs */
int32_t dcount;
int32_t dcap;
DstFuncDef **defs;
/* Referenced closure environents. The values at each index correspond /* Referenced closure environents. The values at each index correspond
* to which index to get the environment from in the parent. The enironment * to which index to get the environment from in the parent. The enironment
* that corresponds to the direct parent's stack will always have value 0. */ * 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_TAIL 0x10000
#define DST_FOPTS_HINT 0x20000 #define DST_FOPTS_HINT 0x20000
#define DST_FOPTS_DROP 0x40000
/* Compiler state */ /* Options for compiling a single form */
struct DstFormOptions { struct DstFormOptions {
DstCompiler *compiler; DstCompiler *compiler;
DstValue x; DstValue x;

144
core/fiber.c
View File

@ -43,7 +43,7 @@ DstFiber *dst_fiber(int32_t capacity) {
/* Clear a fiber (reset it) */ /* Clear a fiber (reset it) */
DstFiber *dst_fiber_reset(DstFiber *fiber) { DstFiber *dst_fiber_reset(DstFiber *fiber) {
fiber->frame = 0; fiber->frame = 0;
fiber->frametop = 0; fiber->stackstart = DST_FRAME_SIZE;
fiber->stacktop = DST_FRAME_SIZE; fiber->stacktop = DST_FRAME_SIZE;
fiber->status = DST_FIBER_DEAD; fiber->status = DST_FIBER_DEAD;
fiber->parent = NULL; 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. */ * If there is nothing to pop of of the stack, return nil. */
DstValue dst_fiber_popvalue(DstFiber *fiber) { DstValue dst_fiber_popvalue(DstFiber *fiber) {
int32_t newstacktop = fiber->stacktop - 1; int32_t newstacktop = fiber->stacktop - 1;
if (newstacktop < fiber->frametop + (int32_t)(DST_FRAME_SIZE)) { if (newstacktop < fiber->stackstart) {
return dst_wrap_nil(); return dst_wrap_nil();
} }
fiber->stacktop = newstacktop; fiber->stacktop = newstacktop;
return fiber->data[newstacktop]; return fiber->data[newstacktop];
} }
/* Push a stack frame to a fiber */ /* Help set up function */
void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func) { static void funcframe_helper(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();
}
/* Check varargs */ /* Check varargs */
if (func->def->flags & DST_FUNCDEF_FLAG_VARARG) { if (func->def->flags & DST_FUNCDEF_FLAG_VARARG) {
int32_t tuplehead = fiber->frame + func->def->arity; int32_t tuplehead = fiber->frame + func->def->arity;
@ -153,8 +126,46 @@ void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func) {
} }
} }
/* Set stack top */ /* Check closure env */
fiber->stacktop = nextstacktop; 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 */ /* 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 i;
int32_t nextframetop = fiber->frame + func->def->slotcount; int32_t nextframetop = fiber->frame + func->def->slotcount;
int32_t nextstacktop = nextframetop + DST_FRAME_SIZE; int32_t nextstacktop = nextframetop + DST_FRAME_SIZE;
int32_t size = (fiber->stacktop - fiber->frametop) - DST_FRAME_SIZE; int32_t stacksize = fiber->stacktop - fiber->stackstart;
int32_t argtop = fiber->frame + size;
if (fiber->capacity < nextstacktop) { if (fiber->capacity < nextstacktop) {
dst_fiber_setcapacity(fiber, 2 * nextstacktop); dst_fiber_setcapacity(fiber, 2 * nextstacktop);
} }
DstValue *stack = fiber->data + fiber->frame; DstValue *stack = fiber->data + fiber->frame;
DstValue *args = fiber->data + fiber->frametop + DST_FRAME_SIZE; DstValue *args = fiber->data + fiber->stackstart;
/* Detatch old function */ /* Detatch old function */
if (NULL != dst_fiber_frame(fiber)->func) if (NULL != dst_fiber_frame(fiber)->func)
dst_function_detach(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 */ /* Set stack stuff */
fiber->stacktop = nextstacktop; fiber->stacktop = fiber->stackstart = nextstacktop;
fiber->frametop = nextframetop;
/* Nil unset locals (Needed for gc correctness) */ /* Nil unset locals (Needed for functional correctness) */
for (i = fiber->frame + size; i < fiber->frametop; ++i) { for (i = fiber->frame + stacksize; i < nextframetop; ++i) {
fiber->data[i] = dst_wrap_nil(); fiber->data[i] = dst_wrap_nil();
} }
/* Check varargs */ /* Varargs and func envs */
if (func->def->flags & DST_FUNCDEF_FLAG_VARARG) { funcframe_helper(fiber, func);
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));
}
}
/* Set frame stuff */ /* Set frame stuff */
dst_fiber_frame(fiber)->func = func; dst_fiber_frame(fiber)->func = func;
@ -209,9 +209,8 @@ void dst_fiber_cframe(DstFiber *fiber) {
DstStackFrame *newframe; DstStackFrame *newframe;
int32_t oldframe = fiber->frame; int32_t oldframe = fiber->frame;
int32_t nextframe = fiber->frametop + DST_FRAME_SIZE; int32_t nextframe = fiber->stackstart;
int32_t nextframetop = fiber->stacktop; int32_t nextstacktop = fiber->stacktop + DST_FRAME_SIZE;
int32_t nextstacktop = nextframetop + DST_FRAME_SIZE;
if (fiber->capacity < nextstacktop) { if (fiber->capacity < nextstacktop) {
dst_fiber_setcapacity(fiber, 2 * nextstacktop); dst_fiber_setcapacity(fiber, 2 * nextstacktop);
@ -219,8 +218,7 @@ void dst_fiber_cframe(DstFiber *fiber) {
/* Set the next frame */ /* Set the next frame */
fiber->frame = nextframe; fiber->frame = nextframe;
fiber->frametop = nextframetop; fiber->stacktop = fiber->stackstart = nextstacktop;
fiber->stacktop = nextstacktop;
newframe = dst_fiber_frame(fiber); newframe = dst_fiber_frame(fiber);
/* Set up the new frame */ /* Set up the new frame */
@ -229,35 +227,6 @@ void dst_fiber_cframe(DstFiber *fiber) {
newframe->func = NULL; 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 /* Pop a stack frame from the fiber. Returns the new stack frame, or
* NULL if there are no more frames */ * NULL if there are no more frames */
void dst_fiber_popframe(DstFiber *fiber) { void dst_fiber_popframe(DstFiber *fiber) {
@ -268,7 +237,6 @@ void dst_fiber_popframe(DstFiber *fiber) {
dst_function_detach(frame->func); dst_function_detach(frame->func);
/* Shrink stack */ /* Shrink stack */
fiber->stacktop = fiber->frame; fiber->stacktop = fiber->stackstart = fiber->frame;
fiber->frametop = fiber->frame - DST_FRAME_SIZE;
fiber->frame = frame->prevframe; fiber->frame = frame->prevframe;
} }

51
core/gc.c
View File

@ -45,7 +45,7 @@ static void dst_mark_tuple(const DstValue *tuple);
static void dst_mark_buffer(DstBuffer *buffer); static void dst_mark_buffer(DstBuffer *buffer);
static void dst_mark_string(const uint8_t *str); static void dst_mark_string(const uint8_t *str);
static void dst_mark_fiber(DstFiber *fiber); static void dst_mark_fiber(DstFiber *fiber);
static void dst_mark_udata(void *udata); static void dst_mark_abstract(void *adata);
/* Mark a value */ /* Mark a value */
void dst_mark(DstValue x) { 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_TUPLE: dst_mark_tuple(dst_unwrap_tuple(x)); break;
case DST_BUFFER: dst_mark_buffer(dst_unwrap_buffer(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_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); dst_gc_mark(buffer);
} }
static void dst_mark_udata(void *udata) { static void dst_mark_abstract(void *adata) {
dst_gc_mark(dst_userdata_header(udata)); dst_gc_mark(dst_abstract_header(adata));
} }
/* Mark a bunch of items in memory */ /* Mark a bunch of items in memory */
@ -129,21 +129,13 @@ static void dst_mark_funcenv(DstFuncEnv *env) {
/* GC helper to mark a FuncDef */ /* GC helper to mark a FuncDef */
static void dst_mark_funcdef(DstFuncDef *def) { static void dst_mark_funcdef(DstFuncDef *def) {
int32_t count, i; int32_t i;
if (dst_gc_reachable(def)) if (dst_gc_reachable(def))
return; return;
dst_gc_mark(def); dst_gc_mark(def);
if (def->constants) { dst_mark_many(def->constants, def->constants_length);
count = def->constants_length; for (i = 0; i < def->defs_length; ++i) {
for (i = 0; i < count; ++i) { dst_mark_funcdef(def->defs[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);
}
}
} }
if (def->source) if (def->source)
dst_mark_string(def->source); dst_mark_string(def->source);
@ -173,7 +165,7 @@ static void dst_mark_fiber(DstFiber *fiber) {
dst_gc_mark(fiber); dst_gc_mark(fiber);
i = fiber->frame; i = fiber->frame;
j = fiber->frametop; j = fiber->stackstart - DST_FRAME_SIZE;
while (i > 0) { while (i > 0) {
frame = (DstStackFrame *)(fiber->data + i - DST_FRAME_SIZE); frame = (DstStackFrame *)(fiber->data + i - DST_FRAME_SIZE);
if (NULL != frame->func) if (NULL != frame->func)
@ -186,14 +178,12 @@ static void dst_mark_fiber(DstFiber *fiber) {
if (NULL != fiber->parent) if (NULL != fiber->parent)
dst_mark_fiber(fiber->parent); dst_mark_fiber(fiber->parent);
dst_mark(fiber->ret);
} }
/* Deinitialize a block of memory */ /* Deinitialize a block of memory */
static void dst_deinit_block(DstGCMemoryHeader *block) { static void dst_deinit_block(DstGCMemoryHeader *block) {
void *mem = ((char *)(block + 1)); void *mem = ((char *)(block + 1));
DstUserdataHeader *h = (DstUserdataHeader *)mem; DstAbstractHeader *h = (DstAbstractHeader *)mem;
switch (block->flags & DST_MEM_TYPEBITS) { switch (block->flags & DST_MEM_TYPEBITS) {
default: default:
break; /* Do nothing for non gc types */ break; /* Do nothing for non gc types */
@ -215,7 +205,7 @@ static void dst_deinit_block(DstGCMemoryHeader *block) {
case DST_MEMORY_FUNCTION: case DST_MEMORY_FUNCTION:
free(((DstFunction *)mem)->envs); free(((DstFunction *)mem)->envs);
break; break;
case DST_MEMORY_USERDATA: case DST_MEMORY_ABSTRACT:
if (h->type->finalize) if (h->type->finalize)
h->type->finalize((void *)(h + 1), h->size); h->type->finalize((void *)(h + 1), h->size);
break; break;
@ -251,6 +241,7 @@ void dst_sweep() {
previous = current; previous = current;
current->flags &= ~DST_MEM_REACHABLE; current->flags &= ~DST_MEM_REACHABLE;
} else { } else {
/*printf("freeing block %p\n", current);*/
dst_deinit_block(current); dst_deinit_block(current);
if (NULL != previous) { if (NULL != previous) {
previous->next = next; 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 */ /* Allocate some memory that is tracked for garbage collection */
void *dst_gcalloc(DstMemoryType type, size_t size) { void *dst_gcalloc(DstMemoryType type, size_t size) {
DstGCMemoryHeader *mdata; DstGCMemoryHeader *mdata;
@ -287,6 +294,8 @@ void *dst_gcalloc(DstMemoryType type, size_t size) {
mdata->next = dst_vm_blocks; mdata->next = dst_vm_blocks;
dst_vm_blocks = mdata; dst_vm_blocks = mdata;
/*printf("created block %p of size %lu, type %s\n", mem, size, memtypes[type]);*/
return mem + sizeof(DstGCMemoryHeader); return mem + sizeof(DstGCMemoryHeader);
} }

2
core/gc.h
View File

@ -60,7 +60,7 @@ enum DstMemoryType {
DST_MEMORY_FIBER, DST_MEMORY_FIBER,
DST_MEMORY_BUFFER, DST_MEMORY_BUFFER,
DST_MEMORY_FUNCTION, DST_MEMORY_FUNCTION,
DST_MEMORY_USERDATA, DST_MEMORY_ABSTRACT,
DST_MEMORY_FUNCENV, DST_MEMORY_FUNCENV,
DST_MEMORY_FUNCDEF DST_MEMORY_FUNCDEF
}; };

37
core/math.c
View File

@ -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(add, dst_op_add, 0)
DST_DEFINE_REDUCER(subtract, dst_op_subtract, 0)
DST_DEFINE_REDUCER(multiply, dst_op_multiply, 1) 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) {\ int dst_##name(int32_t argn, DstValue *argv, DstValue *ret) {\
int32_t i;\ int32_t i;\
DstValue accum;\ DstValue accum;\
@ -131,7 +130,7 @@ int dst_##name(int32_t argn, DstValue *argv, DstValue *ret) {\
*ret = dst_cstringv("expected at least one argument");\ *ret = dst_cstringv("expected at least one argument");\
return 1;\ return 1;\
} else if (argn == 1) {\ } else if (argn == 1) {\
accum = dst_wrap_real(1);\ accum = dst_wrap_real(unarystart);\
i = 0;\ i = 0;\
} else {\ } else {\
accum = argv[0];\ accum = argv[0];\
@ -148,8 +147,9 @@ int dst_##name(int32_t argn, DstValue *argv, DstValue *ret) {\
return 0;\ return 0;\
} }
DST_DEFINE_DIVIDER(divide) DST_DEFINE_DIVIDER(divide, 1)
DST_DEFINE_DIVIDER(modulo) DST_DEFINE_DIVIDER(modulo, 1)
DST_DEFINE_DIVIDER(subtract, 0)
#undef ADD #undef ADD
#undef SUB #undef SUB
@ -190,6 +190,33 @@ DST_DEFINE_BITOP(band, &=, -1)
DST_DEFINE_BITOP(bor, |=, 0) DST_DEFINE_BITOP(bor, |=, 0)
DST_DEFINE_BITOP(bxor, ^=, 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)\ #define DST_DEFINE_MATHOP(name, fop)\
int dst_##name(int32_t argn, DstValue *argv, DstValue *ret) {\ int dst_##name(int32_t argn, DstValue *argv, DstValue *ret) {\
if (argn != 1) {\ if (argn != 1) {\

1
core/opcodes.h
View File

@ -76,7 +76,6 @@ enum DstOpCode {
DOP_PUSH, DOP_PUSH,
DOP_PUSH_2, DOP_PUSH_2,
DOP_PUSH_3, DOP_PUSH_3,
DOP_PUSH_ARRAY,
DOP_CALL, DOP_CALL,
DOP_TAILCALL, DOP_TAILCALL,
DOP_TRANSFER, DOP_TRANSFER,

47
core/stl.c
View File

@ -39,6 +39,22 @@ int dst_stl_print(int32_t argn, DstValue *argv, DstValue *ret) {
return 0; 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) { int dst_stl_asm(int32_t argn, DstValue *argv, DstValue *ret) {
DstAssembleOptions opts; DstAssembleOptions opts;
DstAssembleResult res; DstAssembleResult res;
@ -47,9 +63,6 @@ int dst_stl_asm(int32_t argn, DstValue *argv, DstValue *ret) {
return 1; return 1;
} }
opts.source = argv[0]; opts.source = argv[0];
opts.sourcemap = (argn >= 2 && dst_checktype(argv[1], DST_TUPLE))
? dst_unwrap_tuple(argv[1])
: NULL;
opts.flags = 0; opts.flags = 0;
res = dst_asm(opts); res = dst_asm(opts);
if (res.status == DST_ASSEMBLE_OK) { 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) { int dst_stl_tuple(int32_t argn, DstValue *argv, DstValue *ret) {
*ret = dst_wrap_tuple(dst_tuple_n(argv, argn)); *ret = dst_wrap_tuple(dst_tuple_n(argv, argn));
return 0; return 0;
@ -159,6 +183,11 @@ static int dst_stl_notequal(int32_t argn, DstValue *argv, DstValue *ret) {
return 0; 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)\ #define DST_DEFINE_COMPARATOR(name, pred)\
static int dst_stl_##name(int32_t argn, DstValue *argv, DstValue *ret) {\ static int dst_stl_##name(int32_t argn, DstValue *argv, DstValue *ret) {\
int32_t i;\ int32_t i;\
@ -179,11 +208,13 @@ DST_DEFINE_COMPARATOR(notascending, < 0)
static DstReg stl[] = { static DstReg stl[] = {
{"print", dst_stl_print}, {"print", dst_stl_print},
{"describe", dst_stl_describe},
{"table", dst_stl_table}, {"table", dst_stl_table},
{"array", dst_stl_array}, {"array", dst_stl_array},
{"tuple", dst_stl_tuple}, {"tuple", dst_stl_tuple},
{"struct", dst_stl_struct}, {"struct", dst_stl_struct},
{"asm", dst_stl_asm}, {"asm", dst_stl_asm},
{"disasm", dst_stl_disasm},
{"get", dst_stl_get}, {"get", dst_stl_get},
{"put", dst_stl_put}, {"put", dst_stl_put},
{"+", dst_add}, {"+", dst_add},
@ -203,12 +234,20 @@ static DstReg stl[] = {
{"sqrt", dst_sqrt}, {"sqrt", dst_sqrt},
{"floor", dst_floor}, {"floor", dst_floor},
{"ceil", dst_ceil}, {"ceil", dst_ceil},
{"pow", dst_pow},
{"=", dst_stl_equal}, {"=", dst_stl_equal},
{"not=", dst_stl_notequal}, {"not=", dst_stl_notequal},
{"<", dst_stl_ascending}, {"<", dst_stl_ascending},
{">", dst_stl_descending}, {">", dst_stl_descending},
{"<=", dst_stl_notdescending}, {"<=", 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) { DstValue dst_loadstl(int flags) {

18
core/string.c
View File

@ -283,8 +283,10 @@ const uint8_t *dst_short_description(DstValue x) {
return dst_unwrap_string(x); return dst_unwrap_string(x);
case DST_STRING: case DST_STRING:
return dst_escape_string(dst_unwrap_string(x)); return dst_escape_string(dst_unwrap_string(x));
case DST_USERDATA: case DST_ABSTRACT:
return string_description(dst_userdata_type(dst_unwrap_pointer(x))->name, dst_unwrap_pointer(x)); return string_description(
dst_abstract_type(dst_unwrap_abstract(x))->name,
dst_unwrap_abstract(x));
default: default:
return string_description(dst_type_names[dst_type(x)], dst_unwrap_pointer(x)); 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)); integer_to_string_b(buffer, dst_unwrap_integer(x));
return; return;
case DST_SYMBOL: 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; return;
case DST_STRING: case DST_STRING:
dst_escape_string_b(buffer, dst_unwrap_string(x)); dst_escape_string_b(buffer, dst_unwrap_string(x));
return; return;
case DST_USERDATA: case DST_ABSTRACT:
string_description_b(buffer, dst_userdata_type(dst_unwrap_pointer(x))->name, dst_unwrap_pointer(x)); string_description_b(buffer,
dst_abstract_type(dst_unwrap_abstract(x))->name,
dst_unwrap_abstract(x));
return; return;
default: default:
string_description_b(buffer, dst_type_names[dst_type(x)], dst_unwrap_pointer(x)); 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_BUFFER,
DST_FUNCTION, DST_FUNCTION,
DST_CFUNCTION, DST_CFUNCTION,
DST_USERDATA DST_ABSTRACT
*/ */
static const char *dst_type_colors[16] = { static const char *dst_type_colors[16] = {
"\x1B[35m", "\x1B[35m",

2
core/util.c
View File

@ -47,7 +47,7 @@ const char *dst_type_names[16] = {
"buffer", "buffer",
"function", "function",
"cfunction", "cfunction",
"userdata" "abstract"
}; };
/* Computes hash of an array of values */ /* Computes hash of an array of values */

5
core/value.c
View File

@ -47,6 +47,9 @@ int dst_equals(DstValue x, DstValue y) {
case DST_STRING: case DST_STRING:
result = dst_string_equal(dst_unwrap_string(x), dst_unwrap_string(y)); result = dst_string_equal(dst_unwrap_string(x), dst_unwrap_string(y));
break; break;
case DST_TUPLE:
result = dst_tuple_equal(dst_unwrap_tuple(x), dst_unwrap_tuple(y));
break;
case DST_STRUCT: case DST_STRUCT:
result = dst_struct_equal(dst_unwrap_struct(x), dst_unwrap_struct(y)); result = dst_struct_equal(dst_unwrap_struct(x), dst_unwrap_struct(y));
break; 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) { DstValue dst_getindex(DstValue ds, int32_t index) {
switch (dst_type(ds)) { switch (dst_type(ds)) {
default: default:

77
core/vm.c
View File

@ -68,7 +68,7 @@ static int dst_continue(DstValue *returnreg) {
* Pulls out unsigned integers */ * Pulls out unsigned integers */
#define oparg(shift, mask) (((*pc) >> ((shift) << 3)) & (mask)) #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_assert(cond, e) do {if (!(cond)) vm_throw((e)); } while (0)
#define vm_binop_integer(op) \ #define vm_binop_integer(op) \
@ -124,10 +124,13 @@ static int dst_continue(DstValue *returnreg) {
* templated by the above macros. */ * templated by the above macros. */
for (;;) { for (;;) {
/*dst_puts(dst_formatc("trace: %C\n", dst_asm_decode_instruction(*pc)));*/
switch (*pc & 0xFF) { switch (*pc & 0xFF) {
default: default:
vm_throw("unknown opcode"); retreg = dst_wrap_string(dst_formatc("unknown opcode %d", *pc & 0xFF));
goto vm_error;
case DOP_NOOP: case DOP_NOOP:
pc++; pc++;
@ -365,10 +368,13 @@ static int dst_continue(DstValue *returnreg) {
vm_next(); vm_next();
case DOP_LOAD_CONSTANT: 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)]; int32_t index = oparg(2, 0xFFFF);
vm_assert(index < func->def->constants_length, "invalid constant");
stack[oparg(1, 0xFF)] = func->def->constants[index];
pc++; pc++;
vm_next(); vm_next();
}
case DOP_LOAD_SELF: case DOP_LOAD_SELF:
stack[oparg(1, 0xFFFFFF)] = dst_wrap_function(func); stack[oparg(1, 0xFFFFFF)] = dst_wrap_function(func);
@ -416,23 +422,18 @@ static int dst_continue(DstValue *returnreg) {
int32_t i; int32_t i;
DstFunction *fn; DstFunction *fn;
DstFuncDef *fd; DstFuncDef *fd;
vm_assert((int32_t)oparg(2, 0xFFFF) < func->def->constants_length, "invalid constant"); vm_assert((int32_t)oparg(2, 0xFFFF) < func->def->defs_length, "invalid funcdef");
vm_assert(dst_checktype(func->def->constants[oparg(2, 0xFFFF)], DST_NIL), "constant must be funcdef"); fd = func->def->defs[(int32_t)oparg(2, 0xFFFF)];
fd = (DstFuncDef *)(dst_unwrap_pointer(func->def->constants[(int32_t)oparg(2, 0xFFFF)]));
fn = dst_gcalloc(DST_MEMORY_FUNCTION, sizeof(DstFunction)); fn = dst_gcalloc(DST_MEMORY_FUNCTION, sizeof(DstFunction));
fn->def = fd;
if (fd->environments_length) {
fn->envs = malloc(sizeof(DstFuncEnv *) * fd->environments_length); fn->envs = malloc(sizeof(DstFuncEnv *) * fd->environments_length);
if (NULL == fn->envs) { if (NULL == fn->envs) {
DST_OUT_OF_MEMORY; 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->envs[0] = NULL; fn->envs[0] = NULL;
} else {
fn->envs = NULL;
} }
for (i = 1; i < fd->environments_length; ++i) { for (i = 1; i < fd->environments_length; ++i) {
int32_t inherit = fd->environments[i]; int32_t inherit = fd->environments[i];
@ -446,6 +447,7 @@ static int dst_continue(DstValue *returnreg) {
case DOP_PUSH: case DOP_PUSH:
dst_fiber_push(dst_vm_fiber, stack[oparg(1, 0xFFFFFF)]); dst_fiber_push(dst_vm_fiber, stack[oparg(1, 0xFFFFFF)]);
pc++; pc++;
stack = dst_vm_fiber->data + dst_vm_fiber->frame;
vm_checkgc_next(); vm_checkgc_next();
case DOP_PUSH_2: case DOP_PUSH_2:
@ -453,6 +455,7 @@ static int dst_continue(DstValue *returnreg) {
stack[oparg(1, 0xFF)], stack[oparg(1, 0xFF)],
stack[oparg(2, 0xFFFF)]); stack[oparg(2, 0xFFFF)]);
pc++; pc++;
stack = dst_vm_fiber->data + dst_vm_fiber->frame;
vm_checkgc_next(); vm_checkgc_next();
case DOP_PUSH_3: case DOP_PUSH_3:
@ -461,42 +464,32 @@ static int dst_continue(DstValue *returnreg) {
stack[oparg(2, 0xFF)], stack[oparg(2, 0xFF)],
stack[oparg(3, 0xFF)]); stack[oparg(3, 0xFF)]);
pc++; pc++;
stack = dst_vm_fiber->data + dst_vm_fiber->frame;
vm_checkgc_next(); 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: case DOP_CALL:
{ {
DstValue callee = stack[oparg(2, 0xFFFF)]; DstValue callee = stack[oparg(2, 0xFFFF)];
if (dst_checktype(callee, DST_FUNCTION)) { if (dst_checktype(callee, DST_FUNCTION)) {
func = dst_unwrap_function(callee); func = dst_unwrap_function(callee);
dst_stack_frame(stack)->pc = pc;
dst_fiber_funcframe(dst_vm_fiber, func); dst_fiber_funcframe(dst_vm_fiber, func);
stack = dst_vm_fiber->data + dst_vm_fiber->frame; stack = dst_vm_fiber->data + dst_vm_fiber->frame;
pc = func->def->bytecode; pc = func->def->bytecode;
vm_checkgc_next(); vm_checkgc_next();
} else if (dst_checktype(callee, DST_CFUNCTION)) { } else if (dst_checktype(callee, DST_CFUNCTION)) {
int32_t argn = dst_vm_fiber->stacktop - dst_vm_fiber->stackstart;
dst_fiber_cframe(dst_vm_fiber); dst_fiber_cframe(dst_vm_fiber);
retreg = dst_wrap_nil(); retreg = dst_wrap_nil();
if (dst_unwrap_cfunction(callee)( if (dst_unwrap_cfunction(callee)(
dst_vm_fiber->frametop - dst_vm_fiber->frame, argn,
dst_vm_fiber->data + dst_vm_fiber->frame, dst_vm_fiber->data + dst_vm_fiber->frame,
&retreg)) { &retreg)) {
goto vm_error; goto vm_error;
} }
goto vm_return_cfunc; goto vm_return_cfunc;
} }
vm_throw("cannot call non-function type"); vm_throw("expected function");
} }
case DOP_TAILCALL: case DOP_TAILCALL:
@ -509,15 +502,16 @@ static int dst_continue(DstValue *returnreg) {
pc = func->def->bytecode; pc = func->def->bytecode;
vm_checkgc_next(); vm_checkgc_next();
} else if (dst_checktype(callee, DST_CFUNCTION)) { } 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(); retreg = dst_wrap_nil();
if (dst_unwrap_cfunction(callee)( if (dst_unwrap_cfunction(callee)(
dst_vm_fiber->frametop - dst_vm_fiber->frame, argn,
dst_vm_fiber->data + dst_vm_fiber->frame, dst_vm_fiber->data + dst_vm_fiber->frame,
&retreg)) { &retreg)) {
goto vm_error; goto vm_error;
} }
goto vm_return_cfunc; goto vm_return_cfunc_tail;
} }
vm_throw("expected function"); vm_throw("expected function");
} }
@ -585,12 +579,23 @@ static int dst_continue(DstValue *returnreg) {
*returnreg = retreg; *returnreg = retreg;
return 0; return 0;
} }
stack = dst_vm_fiber->data + dst_vm_fiber->frame;
stack[oparg(1, 0xFF)] = retreg; stack[oparg(1, 0xFF)] = retreg;
pc++; pc++;
vm_checkgc_next(); 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: vm_return:
{ {
dst_fiber_popframe(dst_vm_fiber); dst_fiber_popframe(dst_vm_fiber);
@ -599,6 +604,7 @@ static int dst_continue(DstValue *returnreg) {
return 0; return 0;
} }
stack = dst_vm_fiber->data + dst_vm_fiber->frame; stack = dst_vm_fiber->data + dst_vm_fiber->frame;
func = dst_stack_frame(stack)->func;
pc = dst_stack_frame(stack)->pc; pc = dst_stack_frame(stack)->pc;
stack[oparg(1, 0xFF)] = retreg; stack[oparg(1, 0xFF)] = retreg;
pc++; pc++;
@ -614,6 +620,7 @@ static int dst_continue(DstValue *returnreg) {
return 1; return 1;
} }
stack = dst_vm_fiber->data + dst_vm_fiber->frame; stack = dst_vm_fiber->data + dst_vm_fiber->frame;
func = dst_stack_frame(stack)->func;
pc = dst_stack_frame(stack)->pc; pc = dst_stack_frame(stack)->pc;
stack[oparg(1, 0xFF)] = retreg; stack[oparg(1, 0xFF)] = retreg;
pc++; pc++;
@ -668,7 +675,7 @@ int dst_init() {
* a collection pretty much every cycle, which is * a collection pretty much every cycle, which is
* horrible for performance, but helps ensure * horrible for performance, but helps ensure
* there are no memory bugs during dev */ * there are no memory bugs during dev */
dst_vm_gc_interval = 0x0000000; dst_vm_gc_interval = 0x00000000;
dst_symcache_init(); dst_symcache_init();
/* Set thread */ /* Set thread */
dst_vm_fiber = NULL; dst_vm_fiber = NULL;

3
core/wrap.c
View File

@ -140,8 +140,7 @@ DST_WRAP_DEFINE(buffer, DstBuffer *, DST_BUFFER, pointer)
DST_WRAP_DEFINE(function, DstFunction *, DST_FUNCTION, pointer) DST_WRAP_DEFINE(function, DstFunction *, DST_FUNCTION, pointer)
DST_WRAP_DEFINE(cfunction, DstCFunction, DST_CFUNCTION, pointer) DST_WRAP_DEFINE(cfunction, DstCFunction, DST_CFUNCTION, pointer)
DST_WRAP_DEFINE(table, DstTable *, DST_TABLE, pointer) DST_WRAP_DEFINE(table, DstTable *, DST_TABLE, pointer)
DST_WRAP_DEFINE(userdata, void *, DST_USERDATA, pointer) DST_WRAP_DEFINE(abstract, void *, DST_ABSTRACT, pointer)
DST_WRAP_DEFINE(pointer, void *, DST_USERDATA, pointer)
#undef DST_WRAP_DEFINE #undef DST_WRAP_DEFINE

37
gsttests/basic.dst → dsttest/suite0.dst
View File

@ -36,8 +36,8 @@
(assert (= 10 (+ 1 2 3 4)) "addition") (assert (= 10 (+ 1 2 3 4)) "addition")
(assert (= -8 (- 1 2 3 4)) "subtraction") (assert (= -8 (- 1 2 3 4)) "subtraction")
(assert (= 24 (* 1 2 3 4)) "multiplication") (assert (= 24 (* 1 2 3 4)) "multiplication")
(assert (= 4 (blshift 1 2)) "left shift") (assert (= 4 (<< 1 2)) "left shift")
(assert (= 1 (brshift 4 2)) "right shift") (assert (= 1 (>> 4 2)) "right shift")
(assert (< 1 2 3 4 5 6) "less than integers") (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 (< 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") (assert (> 6 5 4 3 2 1) "greater than integers")
@ -53,7 +53,7 @@
(tuple 1 2 3) (tuple 1 2 3)
(table "a" "b" "c" false) (table "a" "b" "c" false)
(struct 1 2) (struct 1 2)
(thread (fn [x] x)) (fiber (fn [x] x))
(buffer "hi") (buffer "hi")
(fn [x] (+ x x)) (fn [x] (+ x x))
+) "type ordering") +) "type ordering")
@ -61,49 +61,30 @@
(assert (not false) "false literal") (assert (not false) "false literal")
(assert true "true literal") (assert true "true literal")
(assert (not nil) "nil literal") (assert (not nil) "nil literal")
(assert (= 7 (bor 3 4)) "bit or") (assert (= 7 (| 3 4)) "bit or")
(assert (= 0 (band 3 4)) "bit and") (assert (= 0 (& 3 4)) "bit and")
(assert (= "hello" :hello) "keyword syntax for strings") (assert (= "hello" :hello) "keyword syntax for strings")
(assert (= '(1 2 3) (quote (1 2 3)) (tuple 1 2 3)) "quote shorthand") (assert (= '(1 2 3) (quote (1 2 3)) (tuple 1 2 3)) "quote shorthand")
(assert (= (symbol :banana) 'banana) "symbol function")
((fn [] ((fn []
(var accum 1) (var accum 1)
(var count 0) (var count 0)
(while (< count 16) (while (< count 16)
(varset! accum (blshift accum 1)) (varset! accum (<< accum 1))
(varset! count (+ 1 count))) (varset! count (+ 1 count)))
(assert (= accum 65536) "loop in closure"))) (assert (= accum 65536) "loop in closure")))
(var accum 1) (var accum 1)
(var count 0) (var count 0)
(while (< count 16) (while (< count 16)
(varset! accum (blshift accum 1)) (varset! accum (<< accum 1))
(varset! count (+ 1 count))) (varset! count (+ 1 count)))
(assert (= accum 65536) "loop globally") (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") (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 # Fiber 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!@#$%^&*()")
(def athread (thread (fn [x] (def athread (thread (fn [x]
(error (string "hello, " x))))) (error (string "hello, " x)))))
@ -124,7 +105,7 @@
# Var arg tests # 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 (= 100 (vargf)) "var arg no arguments")
(assert (= 101 (vargf 1)) "var arg no packed arguments") (assert (= 101 (vargf 1)) "var arg no packed arguments")
(assert (= 103 (vargf 1 2)) "var arg tuple size 1") (assert (= 103 (vargf 1 2)) "var arg tuple size 1")

8
dsttest/test.dst Normal file
View File

@ -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)

10
include/dst/dst.h
View File

@ -133,7 +133,6 @@ DstValue dst_fiber_popvalue(DstFiber *fiber);
void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func); void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func);
void dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func); void dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func);
void dst_fiber_cframe(DstFiber *fiber); void dst_fiber_cframe(DstFiber *fiber);
void dst_fiber_cframe_tail(DstFiber *fiber);
void dst_fiber_popframe(DstFiber *fiber); void dst_fiber_popframe(DstFiber *fiber);
/* Functions */ /* Functions */
@ -143,16 +142,17 @@ void dst_function_detach(DstFunction *func);
DstAssembleResult dst_asm(DstAssembleOptions opts); DstAssembleResult dst_asm(DstAssembleOptions opts);
DstFunction *dst_asm_func(DstAssembleResult result); DstFunction *dst_asm_func(DstAssembleResult result);
DstValue dst_disasm(DstFuncDef *def); DstValue dst_disasm(DstFuncDef *def);
DstValue dst_asm_decode_instruction(uint32_t instr);
/* Treat similar types through uniform interfaces for iteration */ /* Treat similar types through uniform interfaces for iteration */
int dst_seq_view(DstValue seq, const DstValue **data, int32_t *len); 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_chararray_view(DstValue str, const uint8_t **data, int32_t *len);
int dst_hashtable_view(DstValue tab, const DstValue **data, int32_t *len, int32_t *cap); int dst_hashtable_view(DstValue tab, const DstValue **data, int32_t *len, int32_t *cap);
/* Userdata */ /* Abstract */
#define dst_userdata_header(u) ((DstUserdataHeader *)(u) - 1) #define dst_abstract_header(u) ((DstAbstractHeader *)(u) - 1)
#define dst_userdata_type(u) (dst_userdata_header(u)->type) #define dst_abstract_type(u) (dst_abstract_header(u)->type)
#define dst_userdata_size(u) (dst_userdata_header(u)->size) #define dst_abstract_size(u) (dst_abstract_header(u)->size)
/* Value functions */ /* Value functions */
int dst_equals(DstValue x, DstValue y); int dst_equals(DstValue x, DstValue y);

2
include/dst/dstconfig.h
View File

@ -116,6 +116,6 @@
#define DST_RECURSION_GUARD 1000 #define DST_RECURSION_GUARD 1000
/* Use nanboxed values - uses 8 bytes per value instead of 12 or 16. */ /* Use nanboxed values - uses 8 bytes per value instead of 12 or 16. */
#define DST_NANBOX //#define DST_NANBOX
#endif /* DST_CONFIG_H_defined */ #endif /* DST_CONFIG_H_defined */

9
include/dst/dststl.h
View File

@ -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_ceil(int32_t argn, DstValue *argv, DstValue *ret);
int dst_fabs(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_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_table(int32_t argn, DstValue *argv, DstValue *ret);
int dst_stl_array(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_struct(int32_t argn, DstValue *argv, DstValue *ret);
int dst_stl_tuple(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 */ #endif /* DST_MATH_H_defined */

33
include/dst/dsttypes.h
View File

@ -41,11 +41,11 @@ typedef struct DstFiber DstFiber;
/* Other structs */ /* Other structs */
typedef struct DstReg DstReg; typedef struct DstReg DstReg;
typedef struct DstUserdataHeader DstUserdataHeader; typedef struct DstAbstractHeader DstAbstractHeader;
typedef struct DstFuncDef DstFuncDef; typedef struct DstFuncDef DstFuncDef;
typedef struct DstFuncEnv DstFuncEnv; typedef struct DstFuncEnv DstFuncEnv;
typedef struct DstStackFrame DstStackFrame; typedef struct DstStackFrame DstStackFrame;
typedef struct DstUserType DstUserType; typedef struct DstAbstractType DstAbstractType;
typedef int (*DstCFunction)(int32_t argn, DstValue *argv, DstValue *ret); typedef int (*DstCFunction)(int32_t argn, DstValue *argv, DstValue *ret);
typedef enum DstAssembleStatus DstAssembleStatus; typedef enum DstAssembleStatus DstAssembleStatus;
@ -74,7 +74,7 @@ typedef enum DstType {
DST_BUFFER, DST_BUFFER,
DST_FUNCTION, DST_FUNCTION,
DST_CFUNCTION, DST_CFUNCTION,
DST_USERDATA DST_ABSTRACT
} DstType; } DstType;
/* We provide two possible implemenations of DstValues. The preferred /* 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_buffer(s) dst_nanbox_wrap_((s), DST_BUFFER)
#define dst_wrap_string(s) dst_nanbox_wrap_c((s), DST_STRING) #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_symbol(s) dst_nanbox_wrap_c((s), DST_SYMBOL)
#define dst_wrap_userdata(s) dst_nanbox_wrap_((s), DST_USERDATA) #define dst_wrap_abstract(s) dst_nanbox_wrap_((s), DST_ABSTRACT)
#define dst_wrap_pointer(s) dst_nanbox_wrap_((s), DST_USERDATA)
#define dst_wrap_function(s) dst_nanbox_wrap_((s), DST_FUNCTION) #define dst_wrap_function(s) dst_nanbox_wrap_((s), DST_FUNCTION)
#define dst_wrap_cfunction(s) dst_nanbox_wrap_((s), DST_CFUNCTION) #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_buffer(x) ((DstBuffer *)dst_nanbox_to_pointer(x))
#define dst_unwrap_string(x) ((const uint8_t *)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_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_pointer(x) (dst_nanbox_to_pointer(x))
#define dst_unwrap_function(x) ((DstFunction *)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)) #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_buffer(x) ((DstBuffer *)(x).as.pointer)
#define dst_unwrap_string(x) ((const uint8_t *)(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_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_pointer(x) ((x).as.pointer)
#define dst_unwrap_function(x) ((DstFunction *)(x).as.pointer) #define dst_unwrap_function(x) ((DstFunction *)(x).as.pointer)
#define dst_unwrap_cfunction(x) ((DstCFunction)(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_function(DstFunction *x);
DstValue dst_wrap_cfunction(DstCFunction x); DstValue dst_wrap_cfunction(DstCFunction x);
DstValue dst_wrap_table(DstTable *x); DstValue dst_wrap_table(DstTable *x);
DstValue dst_wrap_userdata(void *x); DstValue dst_wrap_abstract(void *x);
DstValue dst_wrap_pointer(void *x);
/* End of tagged union implementation */ /* End of tagged union implementation */
#endif #endif
@ -297,7 +295,7 @@ struct DstFiber {
DstValue *data; DstValue *data;
DstFiber *parent; DstFiber *parent;
int32_t frame; /* Index of the stack frame */ 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 stacktop; /* Top of stack. Where values are pushed and popped from. */
int32_t capacity; int32_t capacity;
enum { enum {
@ -347,7 +345,8 @@ struct DstTable {
/* A function definition. Contains information needed to instantiate closures. */ /* A function definition. Contains information needed to instantiate closures. */
struct DstFuncDef { struct DstFuncDef {
int32_t *environments; /* Which environments to capture from parent. */ int32_t *environments; /* Which environments to capture from parent. */
DstValue *constants; /* Contains strings, FuncDefs, etc. */ DstValue *constants;
DstFuncDef **defs;
uint32_t *bytecode; uint32_t *bytecode;
/* Various debug information */ /* Various debug information */
@ -361,6 +360,7 @@ struct DstFuncDef {
int32_t constants_length; int32_t constants_length;
int32_t bytecode_length; int32_t bytecode_length;
int32_t environments_length; int32_t environments_length;
int32_t defs_length;
}; };
/* A fuction environment */ /* A fuction environment */
@ -381,8 +381,8 @@ struct DstFunction {
DstFuncEnv **envs; DstFuncEnv **envs;
}; };
/* Defines a type for userdata */ /* Defines an abstract type */
struct DstUserType { struct DstAbstractType {
const char *name; const char *name;
int (*serialize)(void *data, size_t len); int (*serialize)(void *data, size_t len);
int (*deserialize)(); int (*deserialize)();
@ -390,8 +390,8 @@ struct DstUserType {
}; };
/* Contains information about userdata */ /* Contains information about userdata */
struct DstUserdataHeader { struct DstAbstractHeader {
const DstUserType *type; const DstAbstractType *type;
size_t size; size_t size;
}; };
@ -402,7 +402,6 @@ enum DstAssembleStatus {
}; };
struct DstAssembleOptions { struct DstAssembleOptions {
const DstValue *sourcemap;
DstValue source; DstValue source;
uint32_t flags; uint32_t flags;
}; };
@ -410,8 +409,6 @@ struct DstAssembleOptions {
struct DstAssembleResult { struct DstAssembleResult {
DstFuncDef *funcdef; DstFuncDef *funcdef;
const uint8_t *error; const uint8_t *error;
int32_t error_start;
int32_t error_end;
DstAssembleStatus status; DstAssembleStatus status;
}; };