1
0
mirror of https://github.com/janet-lang/janet synced 2024-11-28 11:09:54 +00:00

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

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

View File

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

View File

@ -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,6 +82,11 @@ static int repl() {
DstParseResult res;
DstCompileResult cres;
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)
printf("> ");
else
@ -87,16 +100,9 @@ static int repl() {
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:
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. */

View File

@ -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;
}

View File

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

File diff suppressed because it is too large Load Diff

View File

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

View File

@ -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;
}

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_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);
}

View File

@ -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
};

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(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) {\

View File

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

View File

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

View File

@ -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",

View File

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

View File

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

View File

@ -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)];
{
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->def = fd;
if (fd->environments_length) {
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->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,
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,
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;

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(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

View File

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

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)

View File

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

View File

@ -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 */

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_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 */

View File

@ -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;
};