mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2025-12-02 22:58:09 +00:00
Code Issues 1 Releases Wiki Activity

Add vars, split up headers, remove fiber->ret, add comparators, etc.

Browse Source
This commit is contained in:
bakpakin
2017-12-30 16:46:59 -05:00
parent 34a83839f5
commit f273aa8b1b
26 changed files with 2144 additions and 2261 deletions
Download Patch File Download Diff File Expand all files Collapse all files

103
core/asm.c
View File

@@ -25,6 +25,7 @@
#include <dst/dst.h>
#include "opcodes.h"
#include "gc.h"
#include "sourcemap.h"
/* Bytecode op argument types */
@@ -139,7 +140,6 @@ static const DstInstructionDef dst_ops[] = {
{"load-integer", DIT_SI, DOP_LOAD_INTEGER},
{"load-nil", DIT_S, DOP_LOAD_NIL},
{"load-self", DIT_S, DOP_LOAD_SELF},
{"load-syscall", DIT_SU, DOP_LOAD_SYSCALL},
{"load-true", DIT_S, DOP_LOAD_TRUE},
{"load-upvalue", DIT_SES, DOP_LOAD_UPVALUE},
{"move-far", DIT_SS, DOP_MOVE_FAR},
@@ -164,8 +164,7 @@ static const DstInstructionDef dst_ops[] = {
{"shift-right-immediate", DIT_SSI, DOP_SHIFT_RIGHT_IMMEDIATE},
{"shift-right-unsigned", DIT_SSS, DOP_SHIFT_RIGHT_UNSIGNED},
{"shift-right-unsigned-immediate", DIT_SSS, DOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE},
{"subtract", DIT_SSS, 0x1F},
{"syscall", DIT_SU, DOP_SYSCALL},
{"subtract", DIT_SSS, DOP_SUBTRACT},
{"tailcall", DIT_S, DOP_TAILCALL},
{"transfer", DIT_SSS, DOP_TRANSFER},
{"typecheck", DIT_ST, DOP_TYPECHECK},
@@ -376,38 +375,38 @@ static uint32_t read_instruction(
{
if (dst_tuple_length(argt) != 2)
dst_asm_error(a, map, "expected 1 argument: (op, slot)");
instr |= doarg(a, dst_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 3, 0, argt[1]);
instr |= doarg(a, dst_sourcemap_index(map, 1), 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_parse_submap_index(map, 1), DST_OAT_LABEL, 1, 3, 1, argt[1]);
instr |= doarg(a, dst_sourcemap_index(map, 1), 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_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_parse_submap_index(map, 2), DST_OAT_SLOT, 2, 2, 0, argt[2]);
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]);
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_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_parse_submap_index(map, 2), DST_OAT_LABEL, 2, 2, 1, argt[2]);
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]);
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_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_parse_submap_index(map, 2), DST_OAT_TYPE, 2, 2, 0, argt[2]);
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]);
break;
}
case DIT_SI:
@@ -415,17 +414,17 @@ static uint32_t read_instruction(
{
if (dst_tuple_length(argt) != 3)
dst_asm_error(a, map, "expected 2 arguments: (op, slot, integer)");
instr |= doarg(a, dst_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_parse_submap_index(map, 2), DST_OAT_INTEGER, 2, 2, idef->type == DIT_SI, argt[2]);
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]);
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_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_parse_submap_index(map, 2), DST_OAT_SLOT, 2, 1, 0, argt[2]);
instr |= doarg(a, dst_parse_submap_index(map, 3), DST_OAT_SLOT, 3, 1, 0, argt[3]);
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]);
break;
}
case DIT_SSI:
@@ -433,9 +432,9 @@ static uint32_t read_instruction(
{
if (dst_tuple_length(argt) != 4)
dst_asm_error(a, map, "expected 3 arguments: (op, slot, slot, integer)");
instr |= doarg(a, dst_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_parse_submap_index(map, 2), DST_OAT_SLOT, 2, 1, 0, argt[2]);
instr |= doarg(a, dst_parse_submap_index(map, 3), DST_OAT_INTEGER, 3, 1, idef->type == DIT_SSI, argt[3]);
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]);
break;
}
case DIT_SES:
@@ -444,23 +443,23 @@ static uint32_t read_instruction(
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_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
env = doarg(a, dst_parse_submap_index(map, 2), DST_OAT_ENVIRONMENT, 0, 1, 0, argt[2]);
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]);
instr |= env << 16;
for (env += 1; env > 0; env--) {
b = b->parent;
if (NULL == b)
dst_asm_error(a, dst_parse_submap_index(map, 2), "invalid environment index");
dst_asm_error(a, dst_sourcemap_index(map, 2), "invalid environment index");
}
instr |= doarg(b, dst_parse_submap_index(map, 3), DST_OAT_SLOT, 3, 1, 0, argt[3]);
instr |= doarg(b, dst_sourcemap_index(map, 3), 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_parse_submap_index(map, 1), DST_OAT_SLOT, 1, 1, 0, argt[1]);
instr |= doarg(a, dst_parse_submap_index(map, 2), DST_OAT_CONSTANT, 2, 2, 0, argt[2]);
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]);
break;
}
}
@@ -585,15 +584,15 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts)
x = dst_struct_get(st, dst_csymbolv("slots"));
if (dst_seq_view(x, &arr, &count)) {
const DstValue *slotmap =
dst_parse_submap_value(opts.sourcemap, dst_csymbolv("slots"));
dst_sourcemap_value(opts.sourcemap, dst_csymbolv("slots"));
for (i = 0; i < count; i++) {
const DstValue *imap = dst_parse_submap_index(slotmap, 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_parse_submap_index(imap, 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_table_put(&a.slots, t[j], dst_wrap_integer(i));
@@ -610,9 +609,9 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts)
x = dst_struct_get(st, dst_csymbolv("captures"));
if (dst_seq_view(x, &arr, &count)) {
const DstValue *emap =
dst_parse_submap_value(opts.sourcemap, dst_csymbolv("captures"));
dst_sourcemap_value(opts.sourcemap, dst_csymbolv("captures"));
for (i = 0; i < count; i++) {
const DstValue *imap = dst_parse_submap_index(emap, 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");
@@ -624,14 +623,14 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts)
x = dst_struct_get(st, dst_csymbolv("constants"));
if (dst_seq_view(x, &arr, &count)) {
const DstValue *cmap =
dst_parse_submap_value(opts.sourcemap, dst_csymbolv("constants"));
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_parse_submap_index(cmap, 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 &&
@@ -663,11 +662,11 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts)
x = dst_struct_get(st, dst_csymbolv("bytecode"));
if (dst_seq_view(x, &arr, &count)) {
const DstValue *bmap =
dst_parse_submap_value(opts.sourcemap, dst_csymbolv("bytecode"));
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_parse_submap_index(bmap, 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));
@@ -685,7 +684,7 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts)
}
/* Do bytecode */
for (i = 0; i < count; ++i) {
const DstValue *imap = dst_parse_submap_index(bmap, i);
const DstValue *imap = dst_sourcemap_index(bmap, i);
DstValue instr = arr[i];
if (dst_checktype(instr, DST_SYMBOL)) {
continue;
@@ -716,7 +715,7 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts)
x = dst_struct_get(st, dst_csymbolv("sourcemap"));
if (dst_seq_view(x, &arr, &count)) {
const DstValue *bmap =
dst_parse_submap_value(opts.sourcemap, dst_csymbolv("sourcemap"));
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);
for (i = 0; i < count; i += 2) {
@@ -724,12 +723,12 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, DstAssembleOptions opts)
DstValue end = arr[i + 1];
if (!(dst_checktype(start, DST_INTEGER) ||
dst_unwrap_integer(start) < 0)) {
const DstValue *submap = dst_parse_submap_index(bmap, i);
const DstValue *submap = dst_sourcemap_index(bmap, i);
dst_asm_error(&a, submap, "expected positive integer");
}
if (!(dst_checktype(end, DST_INTEGER) ||
dst_unwrap_integer(end) < 0)) {
const DstValue *submap = dst_parse_submap_index(bmap, i + 1);
const DstValue *submap = dst_sourcemap_index(bmap, i + 1);
dst_asm_error(&a, submap, "expected positive integer");
}
def->sourcemap[i] = dst_unwrap_integer(start);
@@ -853,11 +852,11 @@ static DstValue dst_asm_decode_instruction(uint32_t instr) {
DstValue dst_disasm(DstFuncDef *def) {
int32_t i;
DstArray *bcode = dst_array(def->bytecode_length);
DstArray *constants = dst_array(def->constants_length);
DstArray *constants;
DstTable *ret = dst_table(10);
dst_table_put(ret, dst_csymbolv("arity"), dst_wrap_integer(def->arity));
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));
dst_table_put(ret, dst_csymbolv("constants"), dst_wrap_array(constants));
if (def->sourcepath) {
dst_table_put(ret, dst_csymbolv("sourcepath"), dst_wrap_string(def->sourcepath));
}
@@ -869,17 +868,21 @@ DstValue dst_disasm(DstFuncDef *def) {
}
/* Add constants */
for (i = 0; i < def->constants_length; i++) {
DstValue src = def->constants[i];
DstValue dest;
if (dst_checktype(src, DST_TUPLE)) {
dest = tup2(dst_csymbolv("quote"), src);
} else {
dest = src;
if (def->constants_length > 0) {
constants = dst_array(def->constants_length);
dst_table_put(ret, dst_csymbolv("constants"), dst_wrap_array(constants));
for (i = 0; i < def->constants_length; i++) {
DstValue src = def->constants[i];
DstValue dest;
if (dst_checktype(src, DST_TUPLE)) {
dest = tup2(dst_csymbolv("quote"), src);
} else {
dest = src;
}
constants->data[i] = dest;
}
constants->data[i] = dest;
constants->count = def->constants_length;
}
constants->count = def->constants_length;
/* Add bytecode */
for (i = 0; i < def->bytecode_length; i++) {

510
core/compile.c
View File

@@ -21,21 +21,27 @@
*/
#include <dst/dst.h>
#include <dst/dststl.h>
#include "compile.h"
#include "gc.h"
#include "sourcemap.h"
/* Lazily sort the optimizers */
/*static int optimizers_sorted = 0;*/
/* Lookups for specials and optimizable c functions. */
/*DstCFunctionOptimizer dst_compiler_optimizers[255];*/
/*DstSpecial dst_compiler_specials[16];*/
/* Throw an error with a dst string */
void dst_compile_error(DstCompiler *c, const DstValue *sourcemap, const uint8_t *m) {
c->results.error_start = dst_unwrap_integer(sourcemap[0]);
c->results.error_end = dst_unwrap_integer(sourcemap[1]);
c->results.error = m;
if (NULL != sourcemap) {
c->result.error_start = dst_unwrap_integer(sourcemap[0]);
c->result.error_end = dst_unwrap_integer(sourcemap[1]);
} else {
c->result.error_start = -1;
c->result.error_end = -1;
}
c->result.error = m;
longjmp(c->on_error, 1);
}
@@ -47,20 +53,22 @@ void dst_compile_cerror(DstCompiler *c, const DstValue *sourcemap, const char *m
/* Use these to get sub options. They will traverse the source map so
* compiler errors make sense. Then modify the returned options. */
DstFormOptions dst_compile_getopts_index(DstFormOptions opts, int32_t index) {
const DstValue *sourcemap = dst_parse_submap_index(opts.sourcemap, index);
const DstValue *sourcemap = dst_sourcemap_index(opts.sourcemap, index);
DstValue nextval = dst_getindex(opts.x, index);
opts.x = nextval;
opts.sourcemap = sourcemap;
return opts;
}
DstFormOptions dst_compile_getopts_key(DstFormOptions opts, DstValue key) {
const DstValue *sourcemap = dst_parse_submap_key(opts.sourcemap, key);
const DstValue *sourcemap = dst_sourcemap_key(opts.sourcemap, key);
opts.x = key;
opts.sourcemap = sourcemap;
return opts;
}
DstFormOptions dst_compile_getopts_value(DstFormOptions opts, DstValue key) {
const DstValue *sourcemap = dst_parse_submap_value(opts.sourcemap, key);
const DstValue *sourcemap = dst_sourcemap_value(opts.sourcemap, key);
DstValue nextval = dst_get(opts.x, key);
opts.x = nextval;
opts.sourcemap = sourcemap;
@@ -163,6 +171,12 @@ static void slotsym(DstScope *scope, const uint8_t *sym, DstSlot s) {
static int32_t addconst(DstCompiler *c, const DstValue *sourcemap, DstValue x) {
DstScope *scope = dst_compile_topscope(c);
int32_t i, index, newcount;
/* Get the topmost function scope */
while (scope > c->scopes) {
if (scope->flags & DST_SCOPE_FUNCTION)
break;
scope--;
}
for (i = 0; i < scope->ccount; i++) {
if (dst_equals(x, scope->consts[i]))
return i;
@@ -185,7 +199,7 @@ static int32_t addconst(DstCompiler *c, const DstValue *sourcemap, DstValue x) {
}
/* Enter a new scope */
void dst_compile_scope(DstCompiler *c, int newfn) {
void dst_compile_scope(DstCompiler *c, int flags) {
int32_t newcount, oldcount;
DstScope *scope;
oldcount = c->scopecount;
@@ -222,7 +236,7 @@ void dst_compile_scope(DstCompiler *c, int newfn) {
scope->scap = 0;
scope->smax = -1;
scope->flags = newfn ? DST_SCOPE_FUNCTION : 0;
scope->flags = flags;
}
/* Leave a scope. */
@@ -302,7 +316,7 @@ DstSlot dst_compile_resolve(
DstValue ref = dst_get(check, dst_csymbolv("ref"));
if (dst_checktype(ref, DST_ARRAY)) {
DstSlot ret = dst_compile_constantslot(ref);
ret.flags |= DST_SLOT_REF;
ret.flags |= DST_SLOT_REF | DST_SLOT_NAMED | DST_SLOT_MUTABLE;
return ret;
} else {
DstValue value = dst_get(check, dst_csymbolv("value"));
@@ -393,6 +407,16 @@ void dst_compile_emit(DstCompiler *c, const DstValue *sourcemap, uint32_t instr)
c->buffer[index] = instr;
}
/* Helper */
static int32_t slotalloc_temp(DstScope *scope, int32_t max, int32_t nth) {
int32_t ret = slotalloc_index(scope);
if (ret > max) {
slotfree_index(scope, ret);
ret = 0xF0 + nth;
}
return ret;
}
/* Realize any slot to a local slot. Call this to get a slot index
* that can be used in an instruction. */
static int32_t dst_compile_preread(
@@ -410,11 +434,7 @@ static int32_t dst_compile_preread(
if (s.flags & DST_SLOT_CONSTANT) {
int32_t cindex;
ret = slotalloc_index(scope);
if (ret > max) {
slotfree_index(scope, ret);
ret = 0xF0 + nth;
}
ret = slotalloc_temp(scope, max, nth);
/* Use instructions for loading certain constants */
switch (dst_type(s.constant)) {
case DST_NIL:
@@ -454,28 +474,18 @@ static int32_t dst_compile_preread(
DOP_GET_INDEX);
}
} else if (s.envindex > 0 || s.index > max) {
/* Get a local slot to shadow the environment or far slot */
ret = slotalloc_index(scope);
if (ret > max) {
slotfree_index(scope, ret);
ret = 0xF0 + nth;
}
/* Move the remote slot into the local space */
if (s.envindex > 0) {
/* Load the higher slot */
dst_compile_emit(c, sourcemap,
((uint32_t)(s.index) << 24) |
((uint32_t)(s.envindex) << 16) |
((uint32_t)(ret) << 8) |
DOP_LOAD_UPVALUE);
} else {
/* Slot is a far slot: greater than 0xFF. Get
* the far data and bring it to the near slot. */
dst_compile_emit(c, sourcemap,
((uint32_t)(s.index) << 16) |
((uint32_t)(ret) << 8) |
ret = slotalloc_temp(scope, max, nth);
dst_compile_emit(c, sourcemap,
((uint32_t)(s.index) << 24) |
((uint32_t)(s.envindex) << 16) |
((uint32_t)(ret) << 8) |
DOP_LOAD_UPVALUE);
} else if (s.index > max) {
ret = slotalloc_temp(scope, max, nth);
dst_compile_emit(c, sourcemap,
((uint32_t)(s.index) << 16) |
((uint32_t)(ret) << 8) |
DOP_MOVE_NEAR);
}
} else {
/* We have a normal slot that fits in the required bit width */
ret = s.index;
@@ -492,96 +502,91 @@ static void dst_compile_postread(DstCompiler *c, DstSlot s, int32_t index) {
}
}
/* Get a write slot index to emit an instruction. */
static int32_t dst_compile_prewrite(
/* Move values from one slot to another. The destination must be mutable. */
static void dst_compile_copy(
DstCompiler *c,
const DstValue *sourcemap,
int32_t nth,
DstSlot s) {
int32_t ret = 0;
if (s.flags & DST_SLOT_CONSTANT) {
if (!(s.flags & DST_SLOT_REF)) {
dst_compile_cerror(c, sourcemap, "cannot write to constant");
}
} else if (s.envindex > 0 || s.index > 0xFF) {
DstScope *scope = dst_compile_topscope(c);
/* Get a local slot to shadow the environment or far slot */
ret = slotalloc_index(scope);
if (ret > 0xFF) {
slotfree_index(scope, ret);
ret = 0xF0 + nth;
}
/* Move the remote slot into the local space */
if (s.envindex > 0) {
/* Load the higher slot */
dst_compile_emit(c, sourcemap,
((uint32_t)(s.index) << 24) |
((uint32_t)(s.envindex) << 16) |
((uint32_t)(ret) << 8) |
DOP_LOAD_UPVALUE);
DstSlot dest,
DstSlot src) {
int writeback = 0;
int32_t destlocal = -1;
int32_t srclocal = -1;
int32_t reflocal = -1;
DstScope *scope = dst_compile_topscope(c);
/* Only write to mutable slots */
if (!(dest.flags & DST_SLOT_MUTABLE)) {
dst_compile_cerror(c, sourcemap, "cannot write to constant");
}
/* Short circuit if dest and source are equal */
if (dest.flags == src.flags &&
dest.index == src.index &&
dest.envindex == src.envindex) {
if (dest.flags & DST_SLOT_REF) {
if (dst_equals(dest.constant, src.constant))
return;
} else {
/* Slot is a far slot: greater than 0xFF. Get
* the far data and bring it to the near slot. */
dst_compile_emit(c, sourcemap,
((uint32_t)(s.index) << 16) |
((uint32_t)(ret) << 8) |
DOP_MOVE_NEAR);
return;
}
} else {
/* We have a normal slot that fits in the required bit width */
ret = s.index;
}
return ret;
}
/* Release a write index after emitting the instruction */
static void dst_compile_postwrite(
DstCompiler *c,
const DstValue *sourcemap,
DstSlot s,
int32_t index) {
/* Process: src -> srclocal -> destlocal -> dest */
/* src -> srclocal */
srclocal = dst_compile_preread(c, sourcemap, 0xFF, 1, src);
/* Set the ref */
if (s.flags & DST_SLOT_REF) {
DstScope *scope = dst_compile_topscope(c);
int32_t cindex = addconst(c, sourcemap, s.constant);
int32_t refindex = slotalloc_index(scope);
if (refindex > 0xFF) {
slotfree_index(scope, refindex);
refindex = 0xFF;
}
dst_compile_emit(c, sourcemap,
(cindex << 16) |
(refindex << 8) |
DOP_LOAD_CONSTANT);
/* Pull down dest (find destlocal) */
if (dest.flags & DST_SLOT_REF) {
writeback = 1;
destlocal = srclocal;
reflocal = slotalloc_temp(scope, 0xFF, 2);
dst_compile_emit(c, sourcemap,
(index << 16) |
(refindex << 8) |
DOP_PUT_INDEX);
slotfree_index(scope, refindex);
return;
(addconst(c, sourcemap, dest.constant) << 16) |
(reflocal << 8) |
DOP_LOAD_CONSTANT);
} else if (dest.envindex > 0) {
writeback = 2;
destlocal = srclocal;
} else if (dest.index > 0xFF) {
writeback = 3;
destlocal = srclocal;
} else {
destlocal = dest.index;
}
/* We need to save the data in the local slot to the original slot */
if (s.envindex > 0) {
/* Load the higher slot */
/* srclocal -> destlocal */
if (srclocal != destlocal) {
dst_compile_emit(c, sourcemap,
((uint32_t)(srclocal) << 16) |
((uint32_t)(destlocal) << 8) |
DOP_MOVE_NEAR);
}
/* destlocal -> dest */
if (writeback == 1) {
dst_compile_emit(c, sourcemap,
(destlocal << 16) |
(reflocal << 8) |
DOP_PUT_INDEX);
} else if (writeback == 2) {
dst_compile_emit(c, sourcemap,
((uint32_t)(s.index) << 24) |
((uint32_t)(s.envindex) << 16) |
((uint32_t)(index) << 8) |
((uint32_t)(dest.index) << 24) |
((uint32_t)(dest.envindex) << 16) |
((uint32_t)(destlocal) << 8) |
DOP_SET_UPVALUE);
} else if (s.index != index) {
/* There was a local remapping */
dst_compile_emit(c, sourcemap,
((uint32_t)(s.index) << 16) |
((uint32_t)(index) << 8) |
} else if (writeback == 3) {
dst_compile_emit(c, sourcemap,
((uint32_t)(dest.index) << 16) |
((uint32_t)(destlocal) << 8) |
DOP_MOVE_FAR);
}
if (index != s.index || s.envindex > 0) {
/* We need to free the temporary slot */
DstScope *scope = dst_compile_topscope(c);
slotfree_index(scope, index);
/* Cleanup */
if (reflocal >= 0) {
slotfree_index(scope, reflocal);
}
dst_compile_postread(c, src, srclocal);
}
/* Generate the return instruction for a slot. */
@@ -685,6 +690,201 @@ static void dst_compile_pushtuple(
}
}
/* Quote */
DstSlot dst_compile_quote(DstFormOptions opts, int32_t argn, const DstValue *argv) {
if (argn != 1)
dst_compile_cerror(opts.compiler, opts.sourcemap, "expected 1 argument");
return dst_compile_constantslot(argv[0]);
}
/* Var */
DstSlot dst_compile_var(DstFormOptions opts, int32_t argn, const DstValue *argv) {
DstScope *scope = dst_compile_topscope(opts.compiler);
DstFormOptions subopts;
DstSlot ret;
if (argn != 2)
dst_compile_cerror(opts.compiler, opts.sourcemap, "expected 2 arguments");
if (!dst_checktype(argv[0], DST_SYMBOL))
dst_compile_cerror(opts.compiler, opts.sourcemap, "expected symbol");
subopts = dst_compile_getopts_index(opts, 2);
subopts.flags &= ~DST_FOPTS_TAIL;
ret = dst_compile_value(subopts);
if (scope->flags & DST_SCOPE_TOP) {
DstCompiler *c = opts.compiler;
const DstValue *sm = opts.sourcemap;
DstSlot refslot, refarrayslot;
/* Global var, generate var */
DstTable *reftab = dst_table(1);
DstArray *ref = dst_array(1);
dst_array_push(ref, dst_wrap_nil());
dst_table_put(reftab, dst_csymbolv("ref"), dst_wrap_array(ref));
dst_put(opts.compiler->env, argv[0], dst_wrap_table(reftab));
refslot = dst_compile_constantslot(dst_wrap_array(ref));
refarrayslot = refslot;
refslot.flags |= DST_SLOT_REF | DST_SLOT_NAMED | DST_SLOT_MUTABLE;
/* Generate code to set ref */
int32_t refarrayindex = dst_compile_preread(c, sm, 0xFF, 1, refarrayslot);
int32_t retindex = dst_compile_preread(c, sm, 0xFF, 2, ret);
dst_compile_emit(c, sm,
(retindex << 16) |
(refarrayindex << 8) |
DOP_PUT_INDEX);
dst_compile_postread(c, refarrayslot, refarrayindex);
dst_compile_postread(c, ret, retindex);
dst_compile_freeslot(c, refarrayslot);
ret = refslot;
} else {
/* Non root scope, bring to local slot */
DstSlot localslot = dst_compile_gettarget(opts);
localslot.flags |= DST_SLOT_NAMED | DST_SLOT_MUTABLE;
dst_compile_copy(opts.compiler, opts.sourcemap, localslot, ret);
slotsym(scope, dst_unwrap_symbol(argv[0]), localslot);
ret = localslot;
}
return ret;
}
/* Varset */
DstSlot dst_compile_varset(DstFormOptions opts, int32_t argn, const DstValue *argv) {
DstFormOptions subopts;
DstSlot ret, dest;
if (argn != 2)
dst_compile_cerror(opts.compiler, opts.sourcemap, "expected 2 arguments");
if (!dst_checktype(argv[0], DST_SYMBOL))
dst_compile_cerror(opts.compiler, opts.sourcemap, "expected symbol");
subopts = dst_compile_getopts_index(opts, 2);
subopts.flags &= ~DST_FOPTS_TAIL;
dest = dst_compile_resolve(opts.compiler, opts.sourcemap, dst_unwrap_symbol(argv[0]));
if (!(dest.flags & DST_SLOT_MUTABLE)) {
dst_compile_cerror(opts.compiler, opts.sourcemap, "cannot set constant");
}
subopts.flags |= DST_FOPTS_HINT;
subopts.hint = dest;
ret = dst_compile_value(subopts);
return ret;
}
/* Def */
DstSlot dst_compile_def(DstFormOptions opts, int32_t argn, const DstValue *argv) {
DstScope *scope = dst_compile_topscope(opts.compiler);
DstFormOptions subopts;
DstSlot ret;
if (argn != 2)
dst_compile_cerror(opts.compiler, opts.sourcemap, "expected 2 arguments");
if (!dst_checktype(argv[0], DST_SYMBOL))
dst_compile_cerror(opts.compiler, opts.sourcemap, "expected symbol");
subopts = dst_compile_getopts_index(opts, 2);
subopts.flags &= ~DST_FOPTS_TAIL;
ret = dst_compile_value(subopts);
ret.flags |= DST_SLOT_NAMED;
if (scope->flags & DST_SCOPE_TOP) {
/* Global def, generate code to store in env when executed */
DstCompiler *c = opts.compiler;
const DstValue *sm = opts.sourcemap;
/* Root scope, add to def table */
DstSlot envslot = dst_compile_constantslot(c->env);
DstSlot nameslot = dst_compile_constantslot(argv[0]);
DstSlot valsymslot = dst_compile_constantslot(dst_csymbolv("value"));
DstSlot tableslot = dst_compile_constantslot(dst_wrap_cfunction(dst_stl_table));
/* Create env entry */
int32_t valsymindex = dst_compile_preread(c, sm, 0xFF, 1, valsymslot);
int32_t retindex = dst_compile_preread(c, sm, 0xFFFF, 2, ret);
dst_compile_emit(c, sm,
(retindex << 16) |
(valsymindex << 8) |
DOP_PUSH_2);
dst_compile_postread(c, ret, retindex);
dst_compile_postread(c, valsymslot, valsymindex);
dst_compile_freeslot(c, valsymslot);
int32_t tableindex = dst_compile_preread(opts.compiler, opts.sourcemap, 0xFF, 1, tableslot);
dst_compile_emit(c, sm,
(tableindex << 16) |
(tableindex << 8) |
DOP_CALL);
/* Add env entry to env */
int32_t nameindex = dst_compile_preread(opts.compiler, opts.sourcemap, 0xFF, 2, nameslot);
int32_t envindex = dst_compile_preread(opts.compiler, opts.sourcemap, 0xFF, 3, envslot);
dst_compile_emit(opts.compiler, opts.sourcemap,
(tableindex << 24) |
(nameindex << 16) |
(envindex << 8) |
DOP_PUT);
dst_compile_postread(opts.compiler, envslot, envindex);
dst_compile_postread(opts.compiler, nameslot, nameindex);
dst_compile_postread(c, tableslot, tableindex);
dst_compile_freeslot(c, tableslot);
dst_compile_freeslot(c, envslot);
dst_compile_freeslot(c, tableslot);
} else {
/* Non root scope, simple slot alias */
slotsym(scope, dst_unwrap_symbol(argv[0]), ret);
}
return ret;
}
/* Do */
DstSlot dst_compile_do(DstFormOptions opts, int32_t argn, const DstValue *argv) {
int32_t i;
DstSlot ret;
dst_compile_scope(opts.compiler, 0);
for (i = 0; i < argn; i++) {
DstFormOptions subopts = dst_compile_getopts_index(opts, i + 1);
subopts.x = argv[i];
if (i == argn - 1) {
subopts.flags |= DST_FOPTS_TAIL;
} else {
subopts.flags &= ~DST_FOPTS_TAIL;
}
ret = dst_compile_value(subopts);
if (i != argn - 1) {
dst_compile_freeslot(opts.compiler, ret);
}
}
dst_compile_popscope(opts.compiler);
return ret;
}
/* Keep in lexographic order */
static const DstSpecial dst_compiler_specials[] = {
{"def", dst_compile_def},
{"do", dst_compile_do},
{"quote", dst_compile_quote},
{"var", dst_compile_var},
{"varset", dst_compile_varset}
};
static int dst_strcompare(const uint8_t *str, const char *other) {
int32_t len = dst_string_length(str);
int32_t index;
for (index = 0; index < len; index++) {
uint8_t c = str[index];
uint8_t k = ((const uint8_t *)other)[index];
if (c < k) return -1;
if (c > k) return 1;
if (k == '\0') break;
}
return (other[index] == '\0') ? 0 : -1;
}
/* Find an instruction definition given its name */
static const DstSpecial *dst_finds(const uint8_t *key) {
const DstSpecial *low = dst_compiler_specials;
const DstSpecial *hi = dst_compiler_specials +
(sizeof(dst_compiler_specials) / sizeof(DstSpecial));
while (low < hi) {
const DstSpecial *mid = low + ((hi - low) / 2);
int comp = dst_strcompare(key, mid->name);
if (comp < 0) {
hi = mid;
} else if (comp > 0) {
low = mid + 1;
} else {
return mid;
}
}
return NULL;
}
/* Compile a tuplle */
DstSlot dst_compile_tuple(DstFormOptions opts) {
DstSlot head;
@@ -698,18 +898,21 @@ DstSlot dst_compile_tuple(DstFormOptions opts) {
return dst_compile_constantslot(opts.x);
}
if (dst_checktype(tup[0], DST_SYMBOL)) {
/* Check specials */
} else {
const DstSpecial *s = dst_finds(dst_unwrap_symbol(tup[0]));
if (NULL != s) {
return s->compile(opts, dst_tuple_length(tup) - 1, tup + 1);
}
}
if (!headcompiled) {
head = dst_compile_value(subopts);
headcompiled = 1;
if ((head.flags & DST_SLOT_CONSTANT)) {
/*
if ((head.flags & DST_SLOT_CONSTANT)) {
if (dst_checktype(head.constant, DST_CFUNCTION)) {
/* Cfunction optimization */
printf("add cfunction optimization here...\n");
}
/* Could also later check for other optimizations here, such
* as function inlining and aot evaluation on pure functions. */
}
*/
}
/* Compile a normal function call */
{
@@ -750,11 +953,7 @@ DstSlot dst_compile_value(DstFormOptions opts) {
case DST_SYMBOL:
{
const uint8_t *sym = dst_unwrap_symbol(opts.x);
if (dst_string_length(sym) > 0 && sym[0] != ':') {
ret = dst_compile_resolve(opts.compiler, opts.sourcemap, sym);
} else {
ret = dst_compile_constantslot(opts.x);
}
ret = dst_compile_resolve(opts.compiler, opts.sourcemap, sym);
break;
}
case DST_TUPLE:
@@ -772,6 +971,9 @@ DstSlot dst_compile_value(DstFormOptions opts) {
}
if ((opts.flags & DST_FOPTS_TAIL) && !dst_compile_did_return(opts.compiler)) {
dst_compile_return(opts.compiler, opts.sourcemap, ret);
} else if (opts.flags & DST_FOPTS_HINT) {
dst_compile_copy(opts.compiler, opts.sourcemap, opts.hint, ret);
ret = opts.hint;
}
opts.compiler->recursion_guard++;
return ret;
@@ -807,7 +1009,9 @@ static DstFuncDef *dst_compile_pop_funcdef(DstCompiler *c) {
if (NULL == def->constants) {
DST_OUT_OF_MEMORY;
}
memcpy(def->constants, scope->consts, def->constants_length * sizeof(DstValue));
memcpy(def->constants,
scope->consts,
def->constants_length * sizeof(DstValue));
}
/* Copy bytecode */
@@ -817,7 +1021,9 @@ static DstFuncDef *dst_compile_pop_funcdef(DstCompiler *c) {
if (NULL == def->bytecode) {
DST_OUT_OF_MEMORY;
}
memcpy(def->bytecode, c->buffer + scope->bytecode_start, def->bytecode_length * sizeof(uint32_t));
memcpy(def->bytecode,
c->buffer + scope->bytecode_start,
def->bytecode_length * sizeof(uint32_t));
}
/* Copy source map over */
@@ -826,7 +1032,9 @@ static DstFuncDef *dst_compile_pop_funcdef(DstCompiler *c) {
if (NULL == def->sourcemap) {
DST_OUT_OF_MEMORY;
}
memcpy(def->sourcemap, c->mapbuffer + 2 * scope->bytecode_start, def->bytecode_length * 2 * sizeof(int32_t));
memcpy(def->sourcemap,
c->mapbuffer + 2 * scope->bytecode_start,
def->bytecode_length * 2 * sizeof(int32_t));
}
/* Reset bytecode gen */
@@ -847,31 +1055,8 @@ static DstFuncDef *dst_compile_pop_funcdef(DstCompiler *c) {
return def;
}
/* Merge an environment */
/* Load an environment */
void dst_compile_loadenv(DstCompiler *c, DstValue env) {
int32_t count, cap;
const DstValue *hmap;
DstValue defs = dst_get(env, dst_csymbolv("defs"));
/*DstValue vars = dst_get(env, dst_csymbol("vars"));*/
/* TODO - add global vars via single element arrays. */
if (dst_hashtable_view(defs, &hmap, &count, &cap)) {
DstScope *scope = dst_compile_topscope(c);
int32_t i;
for (i = 0; i < cap; i += 2) {
const uint8_t *sym;
if (!dst_checktype(hmap[i], DST_SYMBOL)) continue;
sym = dst_unwrap_symbol(hmap[i]);
slotsym(scope, sym, dst_compile_constantslot(hmap[i+1]));
}
}
}
/* Initialize a compiler */
static void dst_compile_init(DstCompiler *c) {
static void dst_compile_init(DstCompiler *c, DstValue env) {
c->scopecount = 0;
c->scopecap = 0;
c->scopes = NULL;
@@ -880,8 +1065,9 @@ static void dst_compile_init(DstCompiler *c) {
c->buffer = NULL;
c->mapbuffer = NULL;
c->recursion_guard = DST_RECURSION_GUARD;
c->env = env;
/* Push an empty function scope. This will be the global scope. */
/* Push an empty scope. This will be the global scope. */
dst_compile_scope(c, 0);
dst_compile_topscope(c)->flags |= DST_SCOPE_TOP;
@@ -901,7 +1087,7 @@ static void dst_compile_deinit(DstCompiler *c) {
}
/* Compile a single form */
DstCompileResults dst_compile_one(DstCompiler *c, DstCompileOptions opts) {
DstCompileResult dst_compile_one(DstCompiler *c, DstCompileOptions opts) {
DstFormOptions fopts;
DstSlot s;
@@ -910,13 +1096,13 @@ DstCompileResults dst_compile_one(DstCompiler *c, DstCompileOptions opts) {
dst_compile_popscope(c);
if (setjmp(c->on_error)) {
c->results.status = DST_COMPILE_ERROR;
c->results.funcdef = NULL;
return c->results;
c->result.status = DST_COMPILE_ERROR;
c->result.funcdef = NULL;
return c->result;
}
/* Push a function scope */
dst_compile_scope(c, 1);
dst_compile_scope(c, DST_SCOPE_FUNCTION | DST_SCOPE_TOP);
/* Set the global environment */
c->env = opts.env;
@@ -930,18 +1116,18 @@ DstCompileResults dst_compile_one(DstCompiler *c, DstCompileOptions opts) {
/* Compile the value */
s = dst_compile_value(fopts);
c->results.funcdef = dst_compile_pop_funcdef(c);
c->results.status = DST_COMPILE_OK;
c->result.funcdef = dst_compile_pop_funcdef(c);
c->result.status = DST_COMPILE_OK;
return c->results;
return c->result;
}
/* Compile a form. */
DstCompileResults dst_compile(DstCompileOptions opts) {
DstCompileResult dst_compile(DstCompileOptions opts) {
DstCompiler c;
DstCompileResults res;
DstCompileResult res;
dst_compile_init(&c);
dst_compile_init(&c, opts.env);
res = dst_compile_one(&c, opts);
@@ -950,7 +1136,7 @@ DstCompileResults dst_compile(DstCompileOptions opts) {
return res;
}
DstFunction *dst_compile_func(DstCompileResults res) {
DstFunction *dst_compile_func(DstCompileResult res) {
if (res.status != DST_COMPILE_OK) {
return NULL;
}

23
core/compile.h
View File

@@ -67,10 +67,8 @@ struct DstSlot {
*/
#define DST_SCOPE_FUNCTION 1
#define DST_SCOPE_LASTSLOT 2
#define DST_SCOPE_FIRSTSLOT 4
#define DST_SCOPE_ENV 8
#define DST_SCOPE_TOP 16
#define DST_SCOPE_ENV 2
#define DST_SCOPE_TOP 4
/* A lexical scope during compilation */
struct DstScope {
@@ -101,7 +99,7 @@ struct DstScope {
int32_t envcap;
int32_t bytecode_start;
uint32_t flags;
int flags;
};
#define dst_compile_topscope(c) ((c)->scopes + (c)->scopecount - 1)
@@ -122,7 +120,7 @@ struct DstCompiler {
/* Hold the environment */
DstValue env;
DstCompileResults results;
DstCompileResult result;
};
#define DST_FOPTS_TAIL 0x10000
@@ -152,22 +150,9 @@ typedef struct DstSpecial {
/* An array of optimizers sorted by key */
extern DstCFunctionOptimizer dst_compiler_optimizers[255];
/* An array of special forms */
extern DstSpecial dst_compiler_specials[16];
/* Dispatch to correct form compiler */
DstSlot dst_compile_value(DstFormOptions opts);
/* Compile special forms */
DstSlot dst_compile_do(DstFormOptions opts, int32_t argn, const DstValue *argv);
DstSlot dst_compile_fn(DstFormOptions opts, int32_t argn, const DstValue *argv);
DstSlot dst_compile_cond(DstFormOptions opts, int32_t argn, const DstValue *argv);
DstSlot dst_compile_while(DstFormOptions opts, int32_t argn, const DstValue *argv);
DstSlot dst_compile_quote(DstFormOptions opts, int32_t argn, const DstValue *argv);
DstSlot dst_compile_def(DstFormOptions opts, int32_t argn, const DstValue *argv);
DstSlot dst_compile_var(DstFormOptions opts, int32_t argn, const DstValue *argv);
DstSlot dst_compile_varset(DstFormOptions opts, int32_t argn, const DstValue *argv);
/****************************************************/
void dst_compile_error(DstCompiler *c, const DstValue *sourcemap, const uint8_t *m);

3
core/fiber.c
View File

@@ -47,7 +47,6 @@ DstFiber *dst_fiber_reset(DstFiber *fiber) {
fiber->stacktop = DST_FRAME_SIZE;
fiber->status = DST_FIBER_DEAD;
fiber->parent = NULL;
fiber->ret = dst_wrap_nil();
return fiber;
}
@@ -233,7 +232,7 @@ void dst_fiber_cframe(DstFiber *fiber) {
/* 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 nextframetop = fiber->frame + size;
int32_t nextstacktop = nextframetop + DST_FRAME_SIZE;
if (fiber->frame == 0) {

18
core/gc.c
View File

@@ -26,7 +26,7 @@
/* GC State */
void *dst_vm_blocks;
uint32_t dst_vm_memory_interval;
uint32_t dst_vm_gc_interval;
uint32_t dst_vm_next_collection;
/* Roots */
@@ -333,6 +333,22 @@ int dst_gcunroot(DstValue root) {
return 0;
}
/* Remove a root value from the GC. This sets the effective reference count to 0. */
int dst_gcunrootall(DstValue root) {
DstValue *vtop = dst_vm_roots + dst_vm_root_count;
DstValue *v = dst_vm_roots;
int ret = 0;
/* Search from top to bottom as access is most likely LIFO */
for (v = dst_vm_roots; v < vtop; v++) {
if (dst_equals(root, *v)) {
*v = dst_vm_roots[--dst_vm_root_count];
vtop--;
ret = 1;
}
}
return ret;
}
/* Free all allocated memory */
void dst_clear_memory() {
DstGCMemoryHeader *current = dst_vm_blocks;

268
core/math.c Normal file
View File

@@ -0,0 +1,268 @@
/*
* Copyright (c) 2017 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <math.h>
/* Convert a number to an integer */
int dst_int(int32_t argn, DstValue *argv, DstValue *ret) {
if (argn != 1) {
*ret = dst_cstringv("expected 1 argument");
return 1;
}
switch (dst_type(argv[0])) {
default:
*ret = dst_cstringv("could not convert to integer");
return 1;
case DST_REAL:
*ret = dst_wrap_integer((int32_t) dst_unwrap_real(argv[0]));
break;
case DST_INTEGER:
*ret = argv[0];
break;
}
return 0;
}
/* Convert a number to a real number */
int dst_real(int32_t argn, DstValue *argv, DstValue *ret) {
if (argn != 1) {
*ret = dst_cstringv("expected 1 argument");
return 1;
}
switch (dst_type(argv[0])) {
default:
*ret = dst_cstringv("could not convert to real");
return 1;
case DST_REAL:
*ret = argv[0];
break;
case DST_INTEGER:
*ret = dst_wrap_real((double) dst_unwrap_integer(argv[0]));
break;
}
return 0;
}
#define ADD(x, y) ((x) + (y))
#define SUB(x, y) ((x) - (y))
#define MUL(x, y) ((x) * (y))
#define MOD(x, y) ((x) % (y))
#define DIV(x, y) ((x) / (y))
#define DST_DEFINE_BINOP(name, op, rop, onerr)\
DstValue dst_op_##name(DstValue lhs, DstValue rhs) {\
if (!(dst_checktype(lhs, DST_INTEGER) || dst_checktype(lhs, DST_REAL))) onerr;\
if (!(dst_checktype(rhs, DST_INTEGER) || dst_checktype(rhs, DST_REAL))) onerr;\
return dst_checktype(lhs, DST_INTEGER)\
? (dst_checktype(rhs, DST_INTEGER)\
? dst_wrap_integer(op(dst_unwrap_integer(lhs), dst_unwrap_integer(rhs)))\
: dst_wrap_real(rop((double)dst_unwrap_integer(lhs), dst_unwrap_real(rhs))))\
: (dst_checktype(rhs, DST_INTEGER)\
? dst_wrap_real(rop(dst_unwrap_real(lhs), (double)dst_unwrap_integer(rhs)))\
: dst_wrap_real(rop(dst_unwrap_real(lhs), dst_unwrap_real(rhs))));\
}
DST_DEFINE_BINOP(add, ADD, ADD, return dst_wrap_nil())
DST_DEFINE_BINOP(subtract, SUB, SUB, return dst_wrap_nil())
DST_DEFINE_BINOP(multiply, MUL, MUL, return dst_wrap_nil())
#define DST_DEFINE_DIVIDER_OP(name, op, rop)\
DstValue dst_op_##name(DstValue lhs, DstValue rhs) {\
if (!(dst_checktype(lhs, DST_INTEGER) || dst_checktype(lhs, DST_REAL))) return dst_wrap_nil();\
if (!(dst_checktype(rhs, DST_INTEGER) || dst_checktype(rhs, DST_REAL))) return dst_wrap_nil();\
return dst_checktype(lhs, DST_INTEGER)\
? (dst_checktype(rhs, DST_INTEGER)\
? (dst_unwrap_integer(rhs) == 0 || ((dst_unwrap_integer(lhs) == INT32_MIN) && (dst_unwrap_integer(rhs) == -1)))\
? dst_wrap_nil()\
: dst_wrap_integer(op(dst_unwrap_integer(lhs), dst_unwrap_integer(rhs)))\
: dst_wrap_real(rop((double)dst_unwrap_integer(lhs), dst_unwrap_real(rhs))))\
: (dst_checktype(rhs, DST_INTEGER)\
? dst_wrap_real(rop(dst_unwrap_real(lhs), (double)dst_unwrap_integer(rhs)))\
: dst_wrap_real(rop(dst_unwrap_real(lhs), dst_unwrap_real(rhs))));\
}
DST_DEFINE_DIVIDER_OP(divide, DIV, DIV)
DST_DEFINE_DIVIDER_OP(modulo, MOD, fmod)
#define DST_DEFINE_REDUCER(name, fop, start)\
int dst_##name(int32_t argn, DstValue *argv, DstValue *ret) {\
int32_t i;\
DstValue accum = dst_wrap_integer(start);\
for (i = 0; i < argn; i++) {\
accum = fop(accum, argv[i]);\
}\
if (dst_checktype(accum, DST_NIL)) {\
*ret = dst_cstringv("expected number");\
return 1;\
}\
*ret = accum;\
return 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)
#define DST_DEFINE_DIVIDER(name)\
int dst_##name(int32_t argn, DstValue *argv, DstValue *ret) {\
int32_t i;\
DstValue accum;\
if (argn < 1) {\
*ret = dst_cstringv("expected at least one argument");\
return 1;\
} else if (argn == 1) {\
accum = dst_wrap_real(1);\
i = 0;\
} else {\
accum = argv[0];\
i = 1;\
}\
for (; i < argn; i++) {\
accum = dst_op_##name(accum, argv[i]);\
}\
if (dst_checktype(accum, DST_NIL)) {\
*ret = dst_cstringv("expected number or division error");\
return 1;\
}\
*ret = accum;\
return 0;\
}
DST_DEFINE_DIVIDER(divide)
DST_DEFINE_DIVIDER(modulo)
#undef ADD
#undef SUB
#undef MUL
#undef MOD
#undef DST_DEFINE_BINOP
int dst_bnot(int32_t argn, DstValue *argv, DstValue *ret) {
if (argn != 1) {
*ret = dst_cstringv("expected 1 argument");
return 1;
}
if (!dst_checktype(argv[0], DST_INTEGER)) {
*ret = dst_cstringv("expected integer");
return 1;
}
*ret = dst_wrap_integer(~dst_unwrap_integer(argv[0]));
return 0;
}
#define DST_DEFINE_BITOP(name, op, start)\
int dst_##name(int32_t argn, DstValue *argv, DstValue *ret) {\
int32_t i;\
int32_t accum = start;\
for (i = 0; i < argn; i++) {\
DstValue arg = argv[i];\
if (!dst_checktype(arg, DST_INTEGER)) {\
*ret = dst_cstringv("expected integer");\
return -1;\
}\
accum op dst_unwrap_integer(arg);\
}\
*ret = dst_wrap_integer(accum);\
return 0;\
}
DST_DEFINE_BITOP(band, &=, -1)
DST_DEFINE_BITOP(bor, |=, 0)
DST_DEFINE_BITOP(bxor, ^=, 0)
#define DST_DEFINE_MATHOP(name, fop)\
int dst_##name(int32_t argn, DstValue *argv, DstValue *ret) {\
if (argn != 1) {\
*ret = dst_cstringv("expected 1 argument");\
return 1;\
}\
if (dst_checktype(argv[0], DST_INTEGER)) {\
argv[0] = dst_wrap_real(dst_unwrap_integer(argv[0]));\
}\
if (!dst_checktype(argv[0], DST_REAL)) {\
*ret = dst_cstringv("expected number");\
return 1;\
}\
*ret = dst_wrap_real(fop(dst_unwrap_real(argv[0])));\
return 0;\
}
DST_DEFINE_MATHOP(acos, acos)
DST_DEFINE_MATHOP(asin, asin)
DST_DEFINE_MATHOP(atan, atan)
DST_DEFINE_MATHOP(cos, cos)
DST_DEFINE_MATHOP(cosh, cosh)
DST_DEFINE_MATHOP(sin, sin)
DST_DEFINE_MATHOP(sinh, sinh)
DST_DEFINE_MATHOP(tan, tan)
DST_DEFINE_MATHOP(tanh, tanh)
DST_DEFINE_MATHOP(exp, exp)
DST_DEFINE_MATHOP(log, log)
DST_DEFINE_MATHOP(log10, log10)
DST_DEFINE_MATHOP(sqrt, sqrt)
DST_DEFINE_MATHOP(ceil, ceil)
DST_DEFINE_MATHOP(fabs, fabs)
DST_DEFINE_MATHOP(floor, floor)
#define DST_DEFINE_MATH2OP(name, fop)\
int dst_##name(int32_t argn, DstValue *argv, DstValue *ret) {\
if (argn != 2) {\
*ret = dst_cstringv("expected 2 arguments");\
return 1;\
}\
if (dst_checktype(argv[0], DST_INTEGER))\
argv[0] = dst_wrap_real(dst_unwrap_integer(argv[0]));\
if (dst_checktype(argv[1], DST_INTEGER))\
argv[1] = dst_wrap_real(dst_unwrap_integer(argv[1]));\
if (!dst_checktype(argv[0], DST_REAL) || !dst_checktype(argv[1], DST_REAL)) {\
*ret = dst_cstringv("expected real");\
return 1;\
}\
*ret =\
dst_wrap_real(fop(dst_unwrap_real(argv[0]), dst_unwrap_real(argv[1])));\
return 0;\
}\
DST_DEFINE_MATH2OP(atan2, atan2)
DST_DEFINE_MATH2OP(pow, pow)
DST_DEFINE_MATH2OP(fmod, fmod)
int dst_modf(int32_t argn, DstValue *argv, DstValue *ret) {
double intpart;
DstValue *tup;
if (argn != 1) {
*ret = dst_cstringv("expected 1 argument");
return 1;
}
if (dst_checktype(argv[0], DST_INTEGER))
argv[0] = dst_wrap_real(dst_unwrap_integer(argv[0]));
if (!dst_checktype(argv[0], DST_REAL)) {
*ret = dst_cstringv("expected real");
return 1;
}
tup = dst_tuple_begin(2);
tup[0] = dst_wrap_real(modf(dst_unwrap_real(argv[0]), &intpart));
tup[1] = dst_wrap_real(intpart);
*ret = dst_wrap_tuple(dst_tuple_end(tup));
return 0;
}

2
core/opcodes.h
View File

@@ -79,8 +79,6 @@ enum DstOpCode {
DOP_PUSH_ARRAY,
DOP_CALL,
DOP_TAILCALL,
DOP_SYSCALL,
DOP_LOAD_SYSCALL,
DOP_TRANSFER,
DOP_GET,
DOP_PUT,

113
core/parse.c
View File

@@ -48,6 +48,7 @@ static int is_whitespace(uint8_t c) {
|| c == '\n'
|| c == '\r'
|| c == '\0'
|| c == ';'
|| c == ',';
}
@@ -69,6 +70,7 @@ static int is_symbol_char_gen(uint8_t c) {
if (c >= '0' && c <= '9') return 1;
return (c == '!' ||
c == '$' ||
c == '%' ||
c == '&' ||
c == '*' ||
c == '+' ||
@@ -89,9 +91,10 @@ static int is_symbol_char_gen(uint8_t c) {
The table contains 256 bits, where each bit is 1
if the corresponding ascci code is a symbol char, and 0
if not. */
if not. The upper characters are also considered symbol
chars and are then checked for utf-8 compliance. */
static uint32_t symchars[256] = {
0x00000000, 0x77ffec52, 0xd7ffffff, 0x57fffffe,
0x00000000, 0x77ffec72, 0xd7ffffff, 0x57fffffe,
0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff
};
@@ -215,7 +218,13 @@ static const uint8_t *parse_recur(
}
/* Check for end of source */
if (src >= end) goto unexpected_eos;
if (src >= end) {
if (qcount || recur != DST_RECURSION_GUARD) {
goto unexpected_eos;
} else {
goto nodata;
}
}
/* Open mapping */
mapstart = src;
@@ -248,7 +257,11 @@ static const uint8_t *parse_recur(
} else {
if (!valid_utf8(src, tokenend - src))
goto invalid_utf8;
ret = dst_symbolv(src, tokenend - src);
if (*src == ':') {
ret = dst_stringv(src + 1, tokenend - src - 1);
} else {
ret = dst_symbolv(src, tokenend - src);
}
}
}
src = tokenend;
@@ -382,7 +395,11 @@ static const uint8_t *parse_recur(
}
case '}':
{
if (n & 1) goto struct_oddargs;
if (n & 1) {
if (istable)
goto table_oddargs;
goto struct_oddargs;
}
if (istable) {
DstTable *t = dst_table(n);
DstTable *subt = dst_table(n);
@@ -419,12 +436,6 @@ static const uint8_t *parse_recur(
}
}
/* Quote the returned value qcount times */
while (qcount--) ret = quote(ret);
/* Push the result to the stack */
dst_array_push(&args->stack, ret);
/* Push source mapping */
if (dst_checktype(submapping, DST_NIL)) {
/* We just parsed an atom */
@@ -439,11 +450,33 @@ static const uint8_t *parse_recur(
submapping));
}
/* Quote the returned value qcount times */
while (qcount--) {
int32_t start = mapstart - args->srcstart;
int32_t end = src - args->srcstart;
DstValue sourcemap = dst_array_pop(&args->mapstack);
DstValue* tup = dst_tuple_begin(2);
tup[0] = atom_map(start, end);
tup[1] = sourcemap;
ret = quote(ret);
dst_array_push(&args->mapstack, ds_map(
start,
end,
dst_wrap_tuple(dst_tuple_end(tup))));
}
/* Push the result to the stack */
dst_array_push(&args->stack, ret);
/* Return the new source position for further calls */
return src;
/* Errors below */
nodata:
args->status = DST_PARSE_NODATA;
return NULL;
unexpected_eos:
args->errmsg = "unexpected end of source";
args->status = DST_PARSE_UNEXPECTED_EOS;
@@ -459,6 +492,11 @@ static const uint8_t *parse_recur(
args->status = DST_PARSE_ERROR;
return src;
table_oddargs:
args->errmsg = "table literal needs an even number of arguments";
args->status = DST_PARSE_ERROR;
return src;
struct_oddargs:
args->errmsg = "struct literal needs an even number of arguments";
args->status = DST_PARSE_ERROR;
@@ -525,56 +563,3 @@ DstParseResult dst_parsec(const char *src) {
while (src[len]) ++len;
return dst_parse((const uint8_t *)src, len);
}
/* Get the sub source map by indexing a value. Used to traverse
* into arrays and tuples */
const DstValue *dst_parse_submap_index(const DstValue *map, int32_t index) {
if (NULL != map && dst_tuple_length(map) >= 3) {
const DstValue *seq;
int32_t len;
if (dst_seq_view(map[2], &seq, &len)) {
if (index >= 0 && index < len) {
if (dst_checktype(seq[index], DST_TUPLE)) {
const DstValue *ret = dst_unwrap_tuple(seq[index]);
if (dst_tuple_length(ret) >= 2 &&
dst_checktype(ret[0], DST_INTEGER) &&
dst_checktype(ret[1], DST_INTEGER)) {
return ret;
}
}
}
}
}
return NULL;
}
/* Traverse into tables and structs */
static const DstValue *dst_parse_submap_kv(const DstValue *map, DstValue key, int kv) {
if (NULL != map && dst_tuple_length(map) >= 3) {
DstValue kvpair = dst_get(map[2], key);
if (dst_checktype(kvpair, DST_TUPLE)) {
const DstValue *kvtup = dst_unwrap_tuple(kvpair);
if (dst_tuple_length(kvtup) >= 2) {
if (dst_checktype(kvtup[kv], DST_TUPLE)) {
const DstValue *ret = dst_unwrap_tuple(kvtup[kv]);
if (dst_tuple_length(ret) >= 2 &&
dst_checktype(ret[0], DST_INTEGER) &&
dst_checktype(ret[1], DST_INTEGER)) {
return ret;
}
}
}
}
}
return NULL;
}
/* Traverse into a key of a table or struct */
const DstValue *dst_parse_submap_key(const DstValue *map, DstValue key) {
return dst_parse_submap_kv(map, key, 0);
}
/* Traverse into a value of a table or struct */
const DstValue *dst_parse_submap_value(const DstValue *map, DstValue key) {
return dst_parse_submap_kv(map, key, 1);
}

77
core/sourcemap.c Normal file
View File

@@ -0,0 +1,77 @@
/*
* Copyright (c) 2017 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include "sourcemap.h"
/* Get the sub source map by indexing a value. Used to traverse
* into arrays and tuples */
const DstValue *dst_sourcemap_index(const DstValue *map, int32_t index) {
if (NULL != map && dst_tuple_length(map) >= 3) {
const DstValue *seq;
int32_t len;
if (dst_seq_view(map[2], &seq, &len)) {
if (index >= 0 && index < len) {
if (dst_checktype(seq[index], DST_TUPLE)) {
const DstValue *ret = dst_unwrap_tuple(seq[index]);
if (dst_tuple_length(ret) >= 2 &&
dst_checktype(ret[0], DST_INTEGER) &&
dst_checktype(ret[1], DST_INTEGER)) {
return ret;
}
}
}
}
}
return NULL;
}
/* Traverse into tables and structs */
static const DstValue *dst_sourcemap_kv(const DstValue *map, DstValue key, int kv) {
if (NULL != map && dst_tuple_length(map) >= 3) {
DstValue kvpair = dst_get(map[2], key);
if (dst_checktype(kvpair, DST_TUPLE)) {
const DstValue *kvtup = dst_unwrap_tuple(kvpair);
if (dst_tuple_length(kvtup) >= 2) {
if (dst_checktype(kvtup[kv], DST_TUPLE)) {
const DstValue *ret = dst_unwrap_tuple(kvtup[kv]);
if (dst_tuple_length(ret) >= 2 &&
dst_checktype(ret[0], DST_INTEGER) &&
dst_checktype(ret[1], DST_INTEGER)) {
return ret;
}
}
}
}
}
return NULL;
}
/* Traverse into a key of a table or struct */
const DstValue *dst_sourcemap_key(const DstValue *map, DstValue key) {
return dst_sourcemap_kv(map, key, 0);
}
/* Traverse into a value of a table or struct */
const DstValue *dst_sourcemap_value(const DstValue *map, DstValue key) {
return dst_sourcemap_kv(map, key, 1);
}

44
core/sourcemap.h Normal file
View File

@@ -0,0 +1,44 @@
/*
* Copyright (c) 2017 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
#ifndef DST_SOURCEMAP_H_defined
#define DST_SOURCEMAP_H_defined
#include <dst/dst.h>
/* Get the sub source map by indexing a value. Used to traverse
* into arrays and tuples */
const DstValue *dst_sourcemap_index(const DstValue *map, int32_t index);
/* Traverse into a key of a table or struct */
const DstValue *dst_sourcemap_key(const DstValue *map, DstValue key);
/* Traverse into a value of a table or struct */
const DstValue *dst_sourcemap_value(const DstValue *map, DstValue key);
/* Try to rebuild a source map from given another map */
const DstValue *dst_sourcemap_remap(
const DstValue *oldmap,
DstValue oldsource,
DstValue newsource);
#endif

1021
core/stl.c
View File

File diff suppressed because it is too large Load Diff

41
core/string.c
View File

@@ -363,23 +363,41 @@ static int is_print_ds(DstValue v) {
/* VT100 Colors for types */
/* TODO - generalize into configurable headers and footers */
/*
DST_NIL,
DST_FALSE,
DST_TRUE,
DST_FIBER,
DST_INTEGER,
DST_REAL,
DST_STRING,
DST_SYMBOL,
DST_ARRAY,
DST_TUPLE,
DST_TABLE,
DST_STRUCT,
DST_BUFFER,
DST_FUNCTION,
DST_CFUNCTION,
DST_USERDATA
*/
static const char *dst_type_colors[16] = {
"\x1B[35m",
"\x1B[33m",
"\x1B[33m",
"\x1B[35m",
"\x1B[35m",
"\x1B[32m",
"",
"\x1B[33m",
"\x1B[33m",
"\x1B[36m",
"",
"",
"",
"",
"\x1B[37m",
"\x1B[37m",
"\x1B[37m",
"\x1B[37m",
"\x1B[37m"
"",
"",
"",
"",
""
};
/* Forward declaration */
@@ -629,6 +647,13 @@ const uint8_t *dst_formatc(const char *format, ...) {
dst_description_helper(&printer, va_arg(args, DstValue));
break;
}
case 'C':
{
dst_printer_defaults(&printer);
printer.flags |= DST_PRINTFLAG_COLORIZE;
dst_description_helper(&printer, va_arg(args, DstValue));
break;
}
case 'q':
{
const uint8_t *str = va_arg(args, const uint8_t *);

177
core/strtod.c
View File

@@ -70,7 +70,7 @@ static uint8_t digit_lookup[128] = {
/* Read in a mantissa and exponent of a certain base, and give
* back the double value. Should properly handle 0s, Inifinties, and
* denormalized numbers. (When the exponent values are too large) */
static double dst_convert_mantissa_exp(
static double convert(
int negative,
uint64_t mantissa,
int32_t base,
@@ -117,41 +117,58 @@ static double dst_convert_mantissa_exp(
}
}
}
/* Build the number to return */
return ldexp(mantissa, exponent2);
return negative
? -ldexp(mantissa, exponent2)
: ldexp(mantissa, exponent2);
}
/* Result of scanning a number source */
struct DstScanRes {
uint64_t mant;
int32_t ex;
int error;
int base;
int seenpoint;
int foundexp;
int neg;
};
/* Get the mantissa and exponent of decimal number. The
* mantissa will be stored in a 64 bit unsigned integer (always positive).
* The exponent will be in a signed 32 bit integer. Will also check if
* the decimal point has been seen. Returns -1 if there is an invalid
* number. */
DstValue dst_scan_number(
static struct DstScanRes dst_scan_impl(
const uint8_t *str,
int32_t len) {
struct DstScanRes res;
const uint8_t *end = str + len;
int32_t seenpoint = 0;
uint64_t mant = 0;
int32_t neg = 0;
int32_t ex = 0;
int foundExp = 0;
/* Set some constants */
int base = 10;
/* Initialize flags */
int seenadigit = 0;
/* Initialize result */
res.mant = 0;
res.ex = 0;
res.error = 0;
res.base = 10;
res.seenpoint = 0;
res.foundexp = 0;
res.neg = 0;
/* Prevent some kinds of overflow bugs relating to the exponent
* overflowing. For example, if a string was passed 2GB worth of 0s after
* the decimal point, exponent could wrap around and become positive. It's
* easier to reject ridiculously large inputs than to check for overflows.
* */
if (len > INT32_MAX / base) goto error;
if (len > INT32_MAX / 40) goto error;
/* Get sign */
if (str >= end) goto error;
if (*str == '-') {
neg = 1;
res.neg = 1;
str++;
} else if (*str == '+') {
str++;
@@ -159,53 +176,59 @@ DstValue dst_scan_number(
/* Skip leading zeros */
while (str < end && (*str == '0' || *str == '.')) {
if (seenpoint) ex--;
if (res.seenpoint) res.ex--;
if (*str == '.') {
if (seenpoint) goto error;
seenpoint = 1;
if (res.seenpoint) goto error;
res.seenpoint = 1;
}
seenadigit = 1;
str++;
}
/* Parse significant digits */
while (str < end) {
if (*str == '.') {
if (seenpoint) goto error;
seenpoint = 1;
if (res.seenpoint) goto error;
res.seenpoint = 1;
} else if (*str == '&') {
foundExp = 1;
res.foundexp = 1;
break;
} else if (base == 10 && (*str == 'E' || *str == 'e')) {
foundExp = 1;
} else if (res.base == 10 && (*str == 'E' || *str == 'e')) {
res.foundexp = 1;
break;
} else if (*str == 'x' || *str == 'X') {
if (seenpoint || mant > 0) goto error;
base = 16;
mant = 0;
if (res.seenpoint || res.mant > 0) goto error;
res.base = 16;
res.mant = 0;
} else if (*str == 'r' || *str == 'R') {
if (seenpoint) goto error;
if (mant < 2 || mant > 36) goto error;
base = mant;
mant = 0;
if (res.seenpoint) goto error;
if (res.mant < 2 || res.mant > 36) goto error;
res.base = res.mant;
res.mant = 0;
} else if (*str == '_') {
;
/* underscores are ignored - can be used for separator */
} else {
int digit = digit_lookup[*str & 0x7F];
if (digit >= base) goto error;
if (seenpoint) ex--;
if (mant > 0x00ffffffffffffff)
ex++;
if (digit >= res.base) goto error;
if (res.seenpoint) res.ex--;
if (res.mant > 0x00ffffffffffffff)
res.ex++;
else
mant = base * mant + digit;
res.mant = res.base * res.mant + digit;
seenadigit = 1;
}
str++;
}
if (!seenadigit)
goto error;
/* Read exponent */
if (str < end && foundExp) {
if (str < end && res.foundexp) {
int eneg = 0;
int ee = 0;
seenadigit = 0;
str++;
if (str >= end) goto error;
if (*str == '-') {
@@ -216,27 +239,81 @@ DstValue dst_scan_number(
}
/* Skip leading 0s in exponent */
while (str < end && *str == '0') str++;
while (str < end && ee < (INT32_MAX / base - base)) {
while (str < end && ee < (INT32_MAX / 40)) {
int digit = digit_lookup[*str & 0x7F];
if (digit >= base) goto error;
ee = base * ee + digit;
if (digit >= res.base) goto error;
ee = res.base * ee + digit;
str++;
seenadigit = 1;
}
if (eneg) ex -= ee; else ex += ee;
} else if (!seenpoint) {
/* Check for integer literal */
int64_t i64 = neg ? -mant : mant;
if (i64 <= INT32_MAX && i64 >= INT32_MIN)
return dst_wrap_integer((int32_t) i64);
} else if (str < end) {
if (eneg) res.ex -= ee; else res.ex += ee;
}
if (!seenadigit)
goto error;
}
/* Convert mantissa and exponent into double */
return dst_wrap_real(dst_convert_mantissa_exp(neg, mant, base, ex));
return res;
/* return dst_wrap_real(dst_convert_mantissa_exp(neg, mant, base, ex)); */
error:
return dst_wrap_nil();
res.error = 1;
return res;
}
/* Scan an integer from a string. If the string cannot be converted into
* and integer, set *err to 1 and return 0. */
int32_t dst_scan_integer(
const uint8_t *str,
int32_t len,
int *err) {
struct DstScanRes res = dst_scan_impl(str, len);
int64_t i64;
if (res.error)
goto error;
i64 = res.neg ? -res.mant : res.mant;
if (i64 > INT32_MAX || i64 < INT32_MIN)
goto error;
if (NULL != err)
*err = 0;
return (int32_t) i64;
error:
if (NULL != err)
*err = 1;
return 0;
}
/* Scan a real (double) from a string. If the string cannot be converted into
* and integer, set *err to 1 and return 0. */
double dst_scan_real(
const uint8_t *str,
int32_t len,
int *err) {
struct DstScanRes res = dst_scan_impl(str, len);
if (res.error) {
if (NULL != err)
*err = 1;
return 0.0;
} else {
if (NULL != err)
*err = 0;
}
return convert(res.neg, res.mant, res.base, res.ex);
}
/* Scans a number from a string. Can return either an integer or a real if
* the number cannot be represented as an integer. Will return nil in case of
* an error. */
DstValue dst_scan_number(
const uint8_t *str,
int32_t len) {
struct DstScanRes res = dst_scan_impl(str, len);
if (res.error)
return dst_wrap_nil();
if (!res.foundexp && !res.seenpoint) {
int64_t i64 = res.neg ? -res.mant : res.mant;
if (i64 <= INT32_MAX && i64 >= INT32_MIN) {
return dst_wrap_integer((int32_t) i64);
}
}
return dst_wrap_real(convert(res.neg, res.mant, res.base, res.ex));
}

146
core/syscalls.c
View File

@@ -1,146 +0,0 @@
/*
* Copyright (c) 2017 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
#include <dst/dst.h>
#include <stdio.h>
int dst_sys_print(DstValue *argv, int32_t argn) {
int32_t i;
for (i = 0; i < argn; ++i) {
int32_t j, len;
const uint8_t *vstr = dst_to_string(argv[i]);
len = dst_string_length(vstr);
for (j = 0; j < len; ++j) {
putc(vstr[j], stdout);
}
}
putc('\n', stdout);
return 0;
}
int dst_sys_asm(DstValue *argv, int32_t argn) {
DstAssembleOptions opts;
DstAssembleResult res;
if (argn < 1) {
dst_vm_fiber->ret = dst_cstringv("expected assembly source");
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) {
dst_vm_fiber->ret = dst_wrap_function(dst_asm_func(res));
return 0;
} else {
dst_vm_fiber->ret = dst_wrap_string(res.error);
return 1;
}
}
int dst_sys_tuple(DstValue *argv, int32_t argn) {
dst_vm_fiber->ret = dst_wrap_tuple(dst_tuple_n(argv, argn));
return 0;
}
int dst_sys_array(DstValue *argv, int32_t argn) {
DstArray *array = dst_array(argn);
array->count = argn;
memcpy(array->data, argv, argn * sizeof(DstValue));
dst_vm_fiber->ret = dst_wrap_array(array);
return 0;
}
int dst_sys_table(DstValue *argv, int32_t argn) {
int32_t i;
DstTable *table = dst_table(argn/2);
if (argn & 1) {
dst_vm_fiber->ret = dst_cstringv("expected even number of arguments");
return 1;
}
for (i = 0; i < argn; i += 2) {
dst_table_put(table, argv[i], argv[i + 1]);
}
dst_vm_fiber->ret = dst_wrap_table(table);
return 0;
}
int dst_sys_struct(DstValue *argv, int32_t argn) {
int32_t i;
DstValue *st = dst_struct_begin(argn/2);
if (argn & 1) {
dst_vm_fiber->ret = dst_cstringv("expected even number of arguments");
return 1;
}
for (i = 0; i < argn; i += 2) {
dst_struct_put(st, argv[i], argv[i + 1]);
}
dst_vm_fiber->ret = dst_wrap_struct(dst_struct_end(st));
return 0;
}
int dst_sys_get(DstValue *argv, int32_t argn) {
int32_t i;
DstValue ds;
if (argn < 1) {
dst_vm_fiber->ret = dst_cstringv("expected at least 1 argument");
return 1;
}
ds = argv[0];
for (i = 1; i < argn; i++) {
ds = dst_get(ds, argv[i]);
if (dst_checktype(ds, DST_NIL))
break;
}
dst_vm_fiber->ret = ds;
return 0;
}
int dst_sys_put(DstValue *argv, int32_t argn) {
DstValue ds, key, value;
if (argn < 3) {
dst_vm_fiber->ret = dst_cstringv("expected at least 3 arguments");
return 1;
}
if(dst_sys_get(argv, argn - 2))
return 1;
ds = dst_vm_fiber->ret;
key = argv[argn - 2];
value = argv[argn - 1];
dst_put(ds, key, value);
return 0;
}
const DstCFunction dst_vm_syscalls[256] = {
dst_sys_print,
dst_sys_asm,
dst_sys_tuple,
dst_sys_array,
dst_sys_struct,
dst_sys_table,
dst_sys_get,
dst_sys_put,
NULL
};

107
core/vm.c
View File

@@ -52,12 +52,13 @@ static int dst_update_fiber() {
}
/* Start running the VM from where it left off. */
int dst_continue() {
static int dst_continue(DstValue *returnreg) {
/* VM state */
DstValue *stack;
uint32_t *pc;
DstFunction *func;
DstValue retreg;
/* Eventually use computed gotos for more effient vm loop. */
#define vm_next() continue
@@ -67,7 +68,7 @@ int dst_continue() {
* Pulls out unsigned integers */
#define oparg(shift, mask) (((*pc) >> ((shift) << 3)) & (mask))
#define vm_throw(e) do { dst_vm_fiber->ret = dst_cstringv((e)); goto vm_error; } while (0)
#define vm_throw(e) do { retreg = dst_cstringv((e)); goto vm_error; } while (0)
#define vm_assert(cond, e) do {if (!(cond)) vm_throw((e)); } while (0)
#define vm_binop_integer(op) \
@@ -133,7 +134,7 @@ int dst_continue() {
vm_next();
case DOP_ERROR:
dst_vm_fiber->ret = stack[oparg(1, 0xFF)];
retreg = stack[oparg(1, 0xFF)];
goto vm_error;
case DOP_TYPECHECK:
@@ -143,11 +144,11 @@ int dst_continue() {
vm_next();
case DOP_RETURN:
dst_vm_fiber->ret = stack[oparg(1, 0xFFFFFF)];
retreg = stack[oparg(1, 0xFFFFFF)];
goto vm_return;
case DOP_RETURN_NIL:
dst_vm_fiber->ret = dst_wrap_nil();
retreg = dst_wrap_nil();
goto vm_return;
case DOP_ADD_INTEGER:
@@ -184,10 +185,10 @@ int dst_continue() {
vm_binop(*);
case DOP_DIVIDE_INTEGER:
vm_assert(dst_unwrap_integer(stack[oparg(3, 0xFF)]) != 0, "integer divide by zero");
vm_assert(dst_unwrap_integer(stack[oparg(3, 0xFF)]) != 0, "integer divide error");
vm_assert(!(dst_unwrap_integer(stack[oparg(3, 0xFF)]) == -1 &&
dst_unwrap_integer(stack[oparg(2, 0xFF)]) == DST_INTEGER_MIN),
"integer divide overflow");
dst_unwrap_integer(stack[oparg(2, 0xFF)]) == INT32_MIN),
"integer divide error");
vm_binop_integer(/);
case DOP_DIVIDE_IMMEDIATE:
@@ -198,9 +199,9 @@ int dst_continue() {
* min value by -1). These checks could be omitted if the arg is not
* 0 or -1. */
if (op2 == 0)
vm_throw("integer divide by zero");
if (op2 == -1)
vm_throw("integer divide overflow");
vm_throw("integer divide error");
if (op2 == -1 && op1 == INT32_MIN)
vm_throw("integer divide error");
else
stack[oparg(1, 0xFF)] = dst_wrap_integer(op1 / op2);
pc++;
@@ -217,10 +218,10 @@ int dst_continue() {
vm_assert(dst_checktype(op1, DST_INTEGER) || dst_checktype(op1, DST_REAL), "expected number");
vm_assert(dst_checktype(op2, DST_INTEGER) || dst_checktype(op2, DST_REAL), "expected number");
if (dst_checktype(op2, DST_INTEGER) && dst_unwrap_integer(op2) == 0)
op2 = dst_wrap_real(0.0);
vm_throw("integer divide error");
if (dst_checktype(op2, DST_INTEGER) && dst_unwrap_integer(op2) == -1 &&
dst_checktype(op1, DST_INTEGER) && dst_unwrap_integer(op1) == DST_INTEGER_MIN)
op2 = dst_wrap_real(-1.0);
dst_checktype(op1, DST_INTEGER) && dst_unwrap_integer(op1) == INT32_MIN)
vm_throw("integer divide error");
stack[oparg(1, 0xFF)] = dst_checktype(op1, DST_INTEGER)
? (dst_checktype(op2, DST_INTEGER)
? dst_wrap_integer(dst_unwrap_integer(op1) / dst_unwrap_integer(op2))
@@ -486,10 +487,11 @@ int dst_continue() {
vm_checkgc_next();
} else if (dst_checktype(callee, DST_CFUNCTION)) {
dst_fiber_cframe(dst_vm_fiber);
dst_vm_fiber->ret = dst_wrap_nil();
retreg = dst_wrap_nil();
if (dst_unwrap_cfunction(callee)(
dst_vm_fiber->frametop - dst_vm_fiber->frame,
dst_vm_fiber->data + dst_vm_fiber->frame,
dst_vm_fiber->frametop - dst_vm_fiber->frame)) {
&retreg)) {
goto vm_error;
}
goto vm_return_cfunc;
@@ -508,10 +510,11 @@ int dst_continue() {
vm_checkgc_next();
} else if (dst_checktype(callee, DST_CFUNCTION)) {
dst_fiber_cframe_tail(dst_vm_fiber);
dst_vm_fiber->ret = dst_wrap_nil();
retreg = dst_wrap_nil();
if (dst_unwrap_cfunction(callee)(
dst_vm_fiber->data + dst_vm_fiber->frame,
dst_vm_fiber->frametop - dst_vm_fiber->frame)) {
dst_vm_fiber->frametop - dst_vm_fiber->frame,
dst_vm_fiber->data + dst_vm_fiber->frame,
&retreg)) {
goto vm_error;
}
goto vm_return_cfunc;
@@ -519,34 +522,12 @@ int dst_continue() {
vm_throw("expected function");
}
case DOP_SYSCALL:
{
DstCFunction f = dst_vm_syscalls[oparg(2, 0xFF)];
vm_assert(NULL != f, "invalid syscall");
dst_fiber_cframe(dst_vm_fiber);
dst_vm_fiber->ret = dst_wrap_nil();
if (f(dst_vm_fiber->data + dst_vm_fiber->frame,
dst_vm_fiber->frametop - dst_vm_fiber->frame)) {
goto vm_error;
}
goto vm_return_cfunc;
}
case DOP_LOAD_SYSCALL:
{
DstCFunction f = dst_vm_syscalls[oparg(2, 0xFF)];
vm_assert(NULL != f, "invalid syscall");
stack[oparg(1, 0xFF)] = dst_wrap_cfunction(f);
pc++;
vm_next();
}
case DOP_TRANSFER:
{
DstFiber *nextfiber;
DstStackFrame *frame = dst_stack_frame(stack);
DstValue temp = stack[oparg(2, 0xFF)];
DstValue retvalue = stack[oparg(3, 0xFF)];
retreg = stack[oparg(3, 0xFF)];
vm_assert(dst_checktype(temp, DST_FIBER) ||
dst_checktype(temp, DST_NIL), "expected fiber");
nextfiber = dst_checktype(temp, DST_FIBER)
@@ -555,7 +536,7 @@ int dst_continue() {
/* Check for root fiber */
if (NULL == nextfiber) {
frame->pc = pc;
dst_vm_fiber->ret = retvalue;
*returnreg = retreg;
return 0;
}
vm_assert(nextfiber->status == DST_FIBER_PENDING, "can only transfer to pending fiber");
@@ -563,7 +544,7 @@ int dst_continue() {
dst_vm_fiber->status = DST_FIBER_PENDING;
dst_vm_fiber = nextfiber;
vm_init_fiber_state();
stack[oparg(1, 0xFF)] = retvalue;
stack[oparg(1, 0xFF)] = retreg;
pc++;
vm_next();
}
@@ -577,7 +558,7 @@ int dst_continue() {
case DOP_PUT_INDEX:
dst_setindex(stack[oparg(1, 0xFF)],
stack[oparg(3, 0xFF)],
stack[oparg(2, 0xFF)],
oparg(3, 0xFF));
++pc;
vm_next();
@@ -599,11 +580,12 @@ int dst_continue() {
/* Return from c function. Simpler than retuning from dst function */
vm_return_cfunc:
{
DstValue ret = dst_vm_fiber->ret;
dst_fiber_popframe(dst_vm_fiber);
if (dst_update_fiber())
if (dst_update_fiber()) {
*returnreg = retreg;
return 0;
stack[oparg(1, 0xFF)] = ret;
}
stack[oparg(1, 0xFF)] = retreg;
pc++;
vm_checkgc_next();
}
@@ -611,13 +593,14 @@ int dst_continue() {
/* Handle returning from stack frame. Expect return value in fiber->ret */
vm_return:
{
DstValue ret = dst_vm_fiber->ret;
dst_fiber_popframe(dst_vm_fiber);
if (dst_update_fiber())
if (dst_update_fiber()) {
*returnreg = retreg;
return 0;
}
stack = dst_vm_fiber->data + dst_vm_fiber->frame;
pc = dst_stack_frame(stack)->pc;
stack[oparg(1, 0xFF)] = ret;
stack[oparg(1, 0xFF)] = retreg;
pc++;
vm_checkgc_next();
}
@@ -625,13 +608,14 @@ int dst_continue() {
/* Handle errors from c functions and vm opcodes */
vm_error:
{
DstValue ret = dst_vm_fiber->ret;
dst_vm_fiber->status = DST_FIBER_ERROR;
if (dst_update_fiber())
if (dst_update_fiber()) {
*returnreg = retreg;
return 1;
}
stack = dst_vm_fiber->data + dst_vm_fiber->frame;
pc = dst_stack_frame(stack)->pc;
stack[oparg(1, 0xFF)] = ret;
stack[oparg(1, 0xFF)] = retreg;
pc++;
vm_checkgc_next();
}
@@ -654,21 +638,24 @@ int dst_continue() {
/* Run the vm with a given function. This function is
* called to start the vm. */
int dst_run(DstValue callee) {
int dst_run(DstValue callee, DstValue *returnreg) {
if (NULL == dst_vm_fiber) {
dst_vm_fiber = dst_fiber(0);
} else {
dst_fiber_reset(dst_vm_fiber);
}
if (dst_checktype(callee, DST_CFUNCTION)) {
dst_vm_fiber->ret = dst_wrap_nil();
*returnreg = dst_wrap_nil();
dst_fiber_cframe(dst_vm_fiber);
return dst_unwrap_cfunction(callee)(dst_vm_fiber->data + dst_vm_fiber->frame, 0);
return dst_unwrap_cfunction(callee)(
0,
dst_vm_fiber->data + dst_vm_fiber->frame,
returnreg);
} else if (dst_checktype(callee, DST_FUNCTION)) {
dst_fiber_funcframe(dst_vm_fiber, dst_unwrap_function(callee));
return dst_continue();
return dst_continue(returnreg);
}
dst_vm_fiber->ret = dst_cstringv("expected function");
*returnreg = dst_cstringv("expected function");
return 1;
}
@@ -681,7 +668,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_memory_interval = 0x0000000;
dst_vm_gc_interval = 0x0000000;
dst_symcache_init();
/* Set thread */
dst_vm_fiber = NULL;