mirror of
https://github.com/janet-lang/janet
synced 2024-12-24 15:30:27 +00:00
Merge branch 'master' of https://github.com/bakpakin/dst
This commit is contained in:
commit
44b8c5a8c8
4
Makefile
4
Makefile
@ -130,6 +130,10 @@ natives: $(DST_TARGET)
|
||||
$(MAKE) -C natives/hello
|
||||
$(MAKE) -j 8 -C natives/sqlite3
|
||||
|
||||
clean-natives:
|
||||
$(MAKE) -C natives/hello clean
|
||||
$(MAKE) -C natives/sqlite3 clean
|
||||
|
||||
#################
|
||||
##### Other #####
|
||||
#################
|
||||
|
@ -2,6 +2,7 @@ version: 1.0.{build}
|
||||
branches:
|
||||
only:
|
||||
- master
|
||||
- alpha
|
||||
clone_folder: c:\projects\dst
|
||||
image:
|
||||
- Visual Studio 2017
|
||||
|
51
extra/metabuild.dst
Normal file
51
extra/metabuild.dst
Normal file
@ -0,0 +1,51 @@
|
||||
# A script to help generate build files on different platforms
|
||||
|
||||
(def- make-cflags "-std=c99 -Wall -Wextra -O2 -shared -fpic")
|
||||
(def- make-ldflags "")
|
||||
|
||||
(defn $
|
||||
"Do and get the value of a subshell command"
|
||||
[command]
|
||||
(def f (file.popen command))
|
||||
(def ret (file.read f :all))
|
||||
(file.close f)
|
||||
ret)
|
||||
|
||||
(defn- emit-rule
|
||||
"Emit a rule in a makefile"
|
||||
@[out target deps recipe]
|
||||
(default recipe "@echo '-----'")
|
||||
(file.write
|
||||
out
|
||||
target
|
||||
": "
|
||||
(if (indexed? deps) (string.join deps " ") deps)
|
||||
"\n\t"
|
||||
(if (indexed? recipe) (string.join recipe "\n\t") recipe)
|
||||
"\n\n")
|
||||
out)
|
||||
|
||||
(defn generate-make
|
||||
"Generate a makefile"
|
||||
[out-path sources target]
|
||||
(def out (file.open out-path :w))
|
||||
(def csources (filter (fn [x] (= ".c" (string.slice x -2))) sources))
|
||||
(def hsources (filter (fn [x] (= ".h" (string.slice x -2))) sources))
|
||||
(file.write
|
||||
out
|
||||
"# Autogenerated Makefile, do not edit\n"
|
||||
"# Generated at " ($ `date`)
|
||||
"\nCFLAGS:=" make-cflags
|
||||
"\nLDFLAGS:=" make-ldflags
|
||||
"\nSOURCES:=" (string.join csources " ")
|
||||
"\nHEADERS:=" (string.join hsources " ")
|
||||
"\nOBJECTS:=$(patsubst %.c,%.o,${SOURCES})"
|
||||
"\nTARGET:=" target ".so"
|
||||
"\n\n")
|
||||
(emit-rule out "all" "${TARGET}")
|
||||
(emit-rule out "%.o" @["%.c" "${HEADERS}"] "${CC} ${CFLAGS} -o $@ $< ${LDFLAGS}")
|
||||
(emit-rule out "${TARGET}" "${SOURCES}" "${CC} ${CFLAGS} -o $@ $^ ${LDFLAGS}")
|
||||
(emit-rule out "clean" "" "rm ${OBJECTS}")
|
||||
# Phony targets
|
||||
(emit-rule out ".PHONY" @["all" "clean"])
|
||||
nil)
|
@ -54,4 +54,7 @@ clean:
|
||||
rm sqlite3.h
|
||||
rm $(TARGET)
|
||||
|
||||
install:
|
||||
cp $(TARGET) $(DST_PATH)
|
||||
|
||||
.PHONY: clean all
|
||||
|
@ -393,7 +393,7 @@ static const DstReg cfuns[] = {
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
int _dst_init(DstArgs args) {
|
||||
DST_MODULE_ENTRY(DstArgs args) {
|
||||
DstTable *env = dst_env_arg(args);
|
||||
dst_env_cfuns(env, cfuns);
|
||||
return 0;
|
||||
|
@ -24,21 +24,6 @@
|
||||
#include <dst/dst.h>
|
||||
#include "util.h"
|
||||
|
||||
/* Convert a slot to to an integer for bytecode */
|
||||
|
||||
/* Types of instructions (some of them) */
|
||||
/* _0arg - op.---.--.-- (return-nil, noop, vararg arguments)
|
||||
* _s - op.src.--.-- (push1)
|
||||
* _l - op.XX.XX.XX (jump)
|
||||
* _ss - op.dest.XX.XX (move, swap)
|
||||
* _sl - op.check.XX.XX (jump-if)
|
||||
* _st - op.check.TT.TT (typecheck)
|
||||
* _si - op.dest.XX.XX (load-integer)
|
||||
* _sss - op.dest.op1.op2 (add, subtract, arithmetic, comparison)
|
||||
* _ses - op.dest.up.which (load-upvalue, save-upvalue)
|
||||
* _sc - op.dest.CC.CC (load-constant, closure)
|
||||
*/
|
||||
|
||||
/* Definition for an instruction in the assembler */
|
||||
typedef struct DstInstructionDef DstInstructionDef;
|
||||
struct DstInstructionDef {
|
||||
@ -91,6 +76,7 @@ static const DstInstructionDef dst_ops[] = {
|
||||
{"eq", DOP_EQUALS},
|
||||
{"eqi", DOP_EQUALS_INTEGER},
|
||||
{"eqim", DOP_EQUALS_IMMEDIATE},
|
||||
{"eqn", DOP_NUMERIC_EQUAL},
|
||||
{"eqr", DOP_EQUALS_REAL},
|
||||
{"err", DOP_ERROR},
|
||||
{"get", DOP_GET},
|
||||
@ -98,7 +84,9 @@ static const DstInstructionDef dst_ops[] = {
|
||||
{"gt", DOP_GREATER_THAN},
|
||||
{"gti", DOP_GREATER_THAN_INTEGER},
|
||||
{"gtim", DOP_GREATER_THAN_IMMEDIATE},
|
||||
{"gtn", DOP_NUMERIC_GREATER_THAN},
|
||||
{"gtr", DOP_GREATER_THAN_REAL},
|
||||
{"gten", DOP_NUMERIC_GREATER_THAN_EQUAL},
|
||||
{"gter", DOP_GREATER_THAN_EQUAL_REAL},
|
||||
{"jmp", DOP_JUMP},
|
||||
{"jmpif", DOP_JUMP_IF},
|
||||
@ -114,7 +102,9 @@ static const DstInstructionDef dst_ops[] = {
|
||||
{"lt", DOP_LESS_THAN},
|
||||
{"lti", DOP_LESS_THAN_INTEGER},
|
||||
{"ltim", DOP_LESS_THAN_IMMEDIATE},
|
||||
{"ltn", DOP_NUMERIC_LESS_THAN},
|
||||
{"ltr", DOP_LESS_THAN_REAL},
|
||||
{"lten", DOP_NUMERIC_LESS_THAN_EQUAL},
|
||||
{"lter", DOP_LESS_THAN_EQUAL_REAL},
|
||||
{"mkarr", DOP_MAKE_ARRAY},
|
||||
{"mkbuf", DOP_MAKE_BUFFER},
|
||||
@ -304,7 +294,7 @@ static int32_t doarg_1(
|
||||
ret = dst_unwrap_integer(result);
|
||||
}
|
||||
} else {
|
||||
dst_asm_errorv(a, dst_formatc("unknown name %q", x));
|
||||
dst_asm_errorv(a, dst_formatc("unknown name %v", x));
|
||||
}
|
||||
} else if (argtype == DST_OAT_TYPE || argtype == DST_OAT_SIMPLETYPE) {
|
||||
const TypeAlias *alias = dst_strbinsearch(
|
||||
@ -315,7 +305,7 @@ static int32_t doarg_1(
|
||||
if (alias) {
|
||||
ret = alias->mask;
|
||||
} else {
|
||||
dst_asm_errorv(a, dst_formatc("unknown type %q", x));
|
||||
dst_asm_errorv(a, dst_formatc("unknown type %v", x));
|
||||
}
|
||||
} else {
|
||||
goto error;
|
||||
@ -324,7 +314,7 @@ static int32_t doarg_1(
|
||||
/* Add a new env */
|
||||
ret = dst_asm_addenv(a, x);
|
||||
if (ret < -1) {
|
||||
dst_asm_errorv(a, dst_formatc("unknown environment %q", x));
|
||||
dst_asm_errorv(a, dst_formatc("unknown environment %v", x));
|
||||
}
|
||||
}
|
||||
break;
|
||||
@ -539,6 +529,9 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, Dst source, int flags) {
|
||||
|
||||
/* Check for function name */
|
||||
a.name = dst_get(s, dst_csymbolv("name"));
|
||||
if (!dst_checktype(a.name, DST_NIL)) {
|
||||
def->name = dst_to_string(a.name);
|
||||
}
|
||||
|
||||
/* Set function arity */
|
||||
x = dst_get(s, dst_csymbolv("arity"));
|
||||
@ -683,7 +676,7 @@ static DstAssembleResult dst_asm1(DstAssembler *parent, Dst source, int flags) {
|
||||
sizeof(DstInstructionDef),
|
||||
dst_unwrap_symbol(t[0]));
|
||||
if (NULL == idef)
|
||||
dst_asm_errorv(&a, dst_formatc("unknown instruction %v", instr));
|
||||
dst_asm_errorv(&a, dst_formatc("unknown instruction %v", t[0]));
|
||||
op = read_instruction(&a, idef, t);
|
||||
}
|
||||
def->bytecode[a.bytecode_count++] = op;
|
||||
@ -842,6 +835,9 @@ Dst dst_disasm(DstFuncDef *def) {
|
||||
if (def->flags & DST_FUNCDEF_FLAG_VARARG) {
|
||||
dst_table_put(ret, dst_csymbolv("vararg"), dst_wrap_true());
|
||||
}
|
||||
if (NULL != def->name) {
|
||||
dst_table_put(ret, dst_csymbolv("name"), dst_wrap_string(def->name));
|
||||
}
|
||||
|
||||
/* Add constants */
|
||||
if (def->constants_length > 0) {
|
||||
@ -919,7 +915,7 @@ static int cfun_asm(DstArgs args) {
|
||||
}
|
||||
}
|
||||
|
||||
int cfun_disasm(DstArgs args) {
|
||||
static int cfun_disasm(DstArgs args) {
|
||||
DstFunction *f;
|
||||
DST_FIXARITY(args, 1);
|
||||
DST_ARG_FUNCTION(f, args, 0);
|
||||
|
@ -102,7 +102,12 @@ enum DstInstructionType dst_instructions[DOP_INSTRUCTION_COUNT] = {
|
||||
DIT_S, /* DOP_MAKE_TUPLE */
|
||||
DIT_S, /* DOP_MAKE_STRUCT */
|
||||
DIT_S, /* DOP_MAKE_TABLE */
|
||||
DIT_S /* DOP_MAKE_STRING */
|
||||
DIT_S, /* DOP_MAKE_STRING */
|
||||
DIT_SSS, /* DOP_NUMERIC_LESS_THAN */
|
||||
DIT_SSS, /* DOP_NUMERIC_LESS_THAN_EQUAL */
|
||||
DIT_SSS, /* DOP_NUMERIC_GREATER_THAN */
|
||||
DIT_SSS, /* DOP_NUMERIC_GREATER_THAN_EQUAL */
|
||||
DIT_SSS /* DOP_NUMERIC_EQUAL */
|
||||
};
|
||||
|
||||
/* Verify some bytecode */
|
||||
|
112
src/core/cfuns.c
112
src/core/cfuns.c
@ -36,6 +36,9 @@ static int fixarity1(DstFopts opts, DstSlot *args) {
|
||||
static int fixarity2(DstFopts opts, DstSlot *args) {
|
||||
(void) opts;
|
||||
return dst_v_count(args) == 2;
|
||||
}static int fixarity3(DstFopts opts, DstSlot *args) {
|
||||
(void) opts;
|
||||
return dst_v_count(args) == 3;
|
||||
}
|
||||
|
||||
/* Generic hanldling for $A = op $B */
|
||||
@ -91,7 +94,8 @@ static DstSlot do_get(DstFopts opts, DstSlot *args) {
|
||||
return opreduce(opts, args, DOP_GET, dst_wrap_nil());
|
||||
}
|
||||
static DstSlot do_put(DstFopts opts, DstSlot *args) {
|
||||
return opreduce(opts, args, DOP_PUT, dst_wrap_nil());
|
||||
dstc_emit_sss(opts.compiler, DOP_PUT, args[0], args[1], args[2], 0);
|
||||
return args[0];
|
||||
}
|
||||
static DstSlot do_length(DstFopts opts, DstSlot *args) {
|
||||
return genericSS(opts, DOP_LENGTH, args[0]);
|
||||
@ -118,7 +122,7 @@ static DstSlot do_apply1(DstFopts opts, DstSlot *args) {
|
||||
return target;
|
||||
}
|
||||
|
||||
/* Varidadic operatros specialization */
|
||||
/* Varidadic operators specialization */
|
||||
|
||||
static DstSlot do_add(DstFopts opts, DstSlot *args) {
|
||||
return opreduce(opts, args, DOP_ADD, dst_wrap_integer(0));
|
||||
@ -150,6 +154,85 @@ static DstSlot do_rshift(DstFopts opts, DstSlot *args) {
|
||||
static DstSlot do_rshiftu(DstFopts opts, DstSlot *args) {
|
||||
return opreduce(opts, args, DOP_SHIFT_RIGHT, dst_wrap_integer(1));
|
||||
}
|
||||
static DstSlot do_bnot(DstFopts opts, DstSlot *args) {
|
||||
return genericSS(opts, DOP_BNOT, args[0]);
|
||||
}
|
||||
|
||||
/* Specialization for comparators */
|
||||
static DstSlot compreduce(
|
||||
DstFopts opts,
|
||||
DstSlot *args,
|
||||
int op,
|
||||
int invert) {
|
||||
DstCompiler *c = opts.compiler;
|
||||
int32_t i, len;
|
||||
len = dst_v_count(args);
|
||||
int32_t *labels = NULL;
|
||||
DstSlot t;
|
||||
if (len < 2) {
|
||||
return invert
|
||||
? dstc_cslot(dst_wrap_false())
|
||||
: dstc_cslot(dst_wrap_true());
|
||||
}
|
||||
t = dstc_gettarget(opts);
|
||||
for (i = 1; i < len; i++) {
|
||||
dstc_emit_sss(c, op, t, args[i - 1], args[i], 1);
|
||||
if (i != (len - 1)) {
|
||||
int32_t label = dstc_emit_si(c, DOP_JUMP_IF_NOT, t, 0, 1);
|
||||
dst_v_push(labels, label);
|
||||
}
|
||||
}
|
||||
int32_t end = dst_v_count(c->buffer);
|
||||
if (invert) {
|
||||
dstc_emit_si(c, DOP_JUMP_IF, t, 3, 0);
|
||||
dstc_emit_s(c, DOP_LOAD_TRUE, t, 1);
|
||||
dstc_emit(c, DOP_JUMP | (2 << 8));
|
||||
dstc_emit_s(c, DOP_LOAD_FALSE, t, 1);
|
||||
}
|
||||
for (i = 0; i < dst_v_count(labels); i++) {
|
||||
int32_t label = labels[i];
|
||||
c->buffer[label] |= ((end - label) << 16);
|
||||
}
|
||||
dst_v_free(labels);
|
||||
return t;
|
||||
}
|
||||
|
||||
static DstSlot do_order_gt(DstFopts opts, DstSlot *args) {
|
||||
return compreduce(opts, args, DOP_GREATER_THAN, 0);
|
||||
}
|
||||
static DstSlot do_order_lt(DstFopts opts, DstSlot *args) {
|
||||
return compreduce(opts, args, DOP_LESS_THAN, 0);
|
||||
}
|
||||
static DstSlot do_order_gte(DstFopts opts, DstSlot *args) {
|
||||
return compreduce(opts, args, DOP_LESS_THAN, 1);
|
||||
}
|
||||
static DstSlot do_order_lte(DstFopts opts, DstSlot *args) {
|
||||
return compreduce(opts, args, DOP_GREATER_THAN, 1);
|
||||
}
|
||||
static DstSlot do_order_eq(DstFopts opts, DstSlot *args) {
|
||||
return compreduce(opts, args, DOP_EQUALS, 0);
|
||||
}
|
||||
static DstSlot do_order_neq(DstFopts opts, DstSlot *args) {
|
||||
return compreduce(opts, args, DOP_EQUALS, 1);
|
||||
}
|
||||
static DstSlot do_gt(DstFopts opts, DstSlot *args) {
|
||||
return compreduce(opts, args, DOP_NUMERIC_GREATER_THAN, 0);
|
||||
}
|
||||
static DstSlot do_lt(DstFopts opts, DstSlot *args) {
|
||||
return compreduce(opts, args, DOP_NUMERIC_LESS_THAN, 0);
|
||||
}
|
||||
static DstSlot do_gte(DstFopts opts, DstSlot *args) {
|
||||
return compreduce(opts, args, DOP_NUMERIC_GREATER_THAN_EQUAL, 0);
|
||||
}
|
||||
static DstSlot do_lte(DstFopts opts, DstSlot *args) {
|
||||
return compreduce(opts, args, DOP_NUMERIC_LESS_THAN_EQUAL, 0);
|
||||
}
|
||||
static DstSlot do_eq(DstFopts opts, DstSlot *args) {
|
||||
return compreduce(opts, args, DOP_NUMERIC_EQUAL, 0);
|
||||
}
|
||||
static DstSlot do_neq(DstFopts opts, DstSlot *args) {
|
||||
return compreduce(opts, args, DOP_NUMERIC_EQUAL, 1);
|
||||
}
|
||||
|
||||
/* Arranged by tag */
|
||||
static const DstFunOptimizer optimizers[] = {
|
||||
@ -159,7 +242,7 @@ static const DstFunOptimizer optimizers[] = {
|
||||
{fixarity1, do_yield},
|
||||
{fixarity2, do_resume},
|
||||
{fixarity2, do_get},
|
||||
{fixarity2, do_put},
|
||||
{fixarity3, do_put},
|
||||
{fixarity1, do_length},
|
||||
{NULL, do_add},
|
||||
{NULL, do_sub},
|
||||
@ -170,14 +253,29 @@ static const DstFunOptimizer optimizers[] = {
|
||||
{NULL, do_bxor},
|
||||
{NULL, do_lshift},
|
||||
{NULL, do_rshift},
|
||||
{NULL, do_rshiftu}
|
||||
{NULL, do_rshiftu},
|
||||
{fixarity1, do_bnot},
|
||||
{NULL, do_order_gt},
|
||||
{NULL, do_order_lt},
|
||||
{NULL, do_order_gte},
|
||||
{NULL, do_order_lte},
|
||||
{NULL, do_order_eq},
|
||||
{NULL, do_order_neq},
|
||||
{NULL, do_gt},
|
||||
{NULL, do_lt},
|
||||
{NULL, do_gte},
|
||||
{NULL, do_lte},
|
||||
{NULL, do_eq},
|
||||
{NULL, do_neq}
|
||||
};
|
||||
|
||||
const DstFunOptimizer *dstc_funopt(uint32_t flags) {
|
||||
uint32_t tag = flags & DST_FUNCDEF_FLAG_TAG;
|
||||
if (tag == 0 || tag >=
|
||||
((sizeof(optimizers)/sizeof(uint32_t) - 1)))
|
||||
if (tag == 0)
|
||||
return NULL;
|
||||
return optimizers + tag - 1;
|
||||
uint32_t index = tag - 1;
|
||||
if (index >= (sizeof(optimizers)/sizeof(optimizers[0])))
|
||||
return NULL;
|
||||
return optimizers + index;
|
||||
}
|
||||
|
||||
|
@ -118,6 +118,12 @@ void dstc_popscope(DstCompiler *c) {
|
||||
/* Move free slots to parent scope if not a new function.
|
||||
* We need to know the total number of slots used when compiling the function. */
|
||||
if (!(oldscope->flags & (DST_SCOPE_FUNCTION | DST_SCOPE_UNUSED)) && newscope) {
|
||||
/* Parent scopes inherit child's closure flag. Needed
|
||||
* for while loops. (if a while loop creates a closure, it
|
||||
* is compiled to a tail recursive iife) */
|
||||
if (oldscope->flags & DST_SCOPE_CLOSURE) {
|
||||
newscope->flags |= DST_SCOPE_CLOSURE;
|
||||
}
|
||||
if (newscope->ra.max < oldscope->ra.max)
|
||||
newscope->ra.max = oldscope->ra.max;
|
||||
|
||||
|
@ -45,6 +45,19 @@
|
||||
#define DST_FUN_LSHIFT 16
|
||||
#define DST_FUN_RSHIFT 17
|
||||
#define DST_FUN_RSHIFTU 18
|
||||
#define DST_FUN_BNOT 19
|
||||
#define DST_FUN_ORDER_GT 20
|
||||
#define DST_FUN_ORDER_LT 21
|
||||
#define DST_FUN_ORDER_GTE 22
|
||||
#define DST_FUN_ORDER_LTE 23
|
||||
#define DST_FUN_ORDER_EQ 24
|
||||
#define DST_FUN_ORDER_NEQ 25
|
||||
#define DST_FUN_GT 26
|
||||
#define DST_FUN_LT 27
|
||||
#define DST_FUN_GTE 28
|
||||
#define DST_FUN_LTE 29
|
||||
#define DST_FUN_EQ 30
|
||||
#define DST_FUN_NEQ 31
|
||||
|
||||
/* Compiler typedefs */
|
||||
typedef struct DstCompiler DstCompiler;
|
||||
@ -67,22 +80,23 @@ typedef struct DstSpecial DstSpecial;
|
||||
|
||||
/* A stack slot */
|
||||
struct DstSlot {
|
||||
Dst constant; /* If the slot has a constant value */
|
||||
int32_t index;
|
||||
int32_t envindex; /* 0 is local, positive number is an upvalue */
|
||||
uint32_t flags;
|
||||
Dst constant; /* If the slot has a constant value */
|
||||
};
|
||||
|
||||
#define DST_SCOPE_FUNCTION 1
|
||||
#define DST_SCOPE_ENV 2
|
||||
#define DST_SCOPE_TOP 4
|
||||
#define DST_SCOPE_UNUSED 8
|
||||
#define DST_SCOPE_CLOSURE 16
|
||||
|
||||
/* A symbol and slot pair */
|
||||
typedef struct SymPair {
|
||||
DstSlot slot;
|
||||
const uint8_t *sym;
|
||||
int keep;
|
||||
DstSlot slot;
|
||||
} SymPair;
|
||||
|
||||
/* A lexical scope during compilation */
|
||||
@ -101,12 +115,12 @@ struct DstScope {
|
||||
/* Map of symbols to slots. Use a simple linear scan for symbols. */
|
||||
SymPair *syms;
|
||||
|
||||
/* Regsiter allocator */
|
||||
DstcRegisterAllocator ra;
|
||||
|
||||
/* FuncDefs */
|
||||
DstFuncDef **defs;
|
||||
|
||||
/* Regsiter allocator */
|
||||
DstcRegisterAllocator ra;
|
||||
|
||||
/* Referenced closure environents. The values at each index correspond
|
||||
* to which index to get the environment from in the parent. The environment
|
||||
* that corresponds to the direct parent's stack will always have value 0. */
|
||||
@ -121,7 +135,6 @@ struct DstScope {
|
||||
|
||||
/* Compilation state */
|
||||
struct DstCompiler {
|
||||
int recursion_guard;
|
||||
|
||||
/* Pointer to current scope */
|
||||
DstScope *scope;
|
||||
@ -129,16 +142,20 @@ struct DstCompiler {
|
||||
uint32_t *buffer;
|
||||
DstSourceMapping *mapbuffer;
|
||||
|
||||
/* Keep track of where we are in the source */
|
||||
DstSourceMapping current_mapping;
|
||||
|
||||
/* Hold the environment */
|
||||
DstTable *env;
|
||||
|
||||
/* Name of source to attach to generated functions */
|
||||
const uint8_t *source;
|
||||
|
||||
/* The result of compilation */
|
||||
DstCompileResult result;
|
||||
|
||||
/* Keep track of where we are in the source */
|
||||
DstSourceMapping current_mapping;
|
||||
|
||||
/* Prevent unbounded recursion */
|
||||
int recursion_guard;
|
||||
};
|
||||
|
||||
#define DST_FOPTS_TAIL 0x10000
|
||||
@ -148,8 +165,8 @@ struct DstCompiler {
|
||||
/* Options for compiling a single form */
|
||||
struct DstFopts {
|
||||
DstCompiler *compiler;
|
||||
uint32_t flags; /* bit set of accepted primitive types */
|
||||
DstSlot hint;
|
||||
uint32_t flags; /* bit set of accepted primitive types */
|
||||
};
|
||||
|
||||
/* Get the default form options */
|
||||
|
@ -48,9 +48,29 @@
|
||||
[name & more]
|
||||
(apply1 tuple (array.concat @['def name :private] more)))
|
||||
|
||||
(defmacro defasm
|
||||
"Define a function using assembly"
|
||||
[name & body]
|
||||
(def tab (apply1 table body))
|
||||
(tuple 'def name (tuple asm (tuple 'quote tab))))
|
||||
|
||||
(defn defglobal
|
||||
"Dynamically create a global def."
|
||||
[name value]
|
||||
(def name* (symbol name))
|
||||
(put *env* name* @{:value value})
|
||||
nil)
|
||||
|
||||
(defn varglobal
|
||||
"Dynamically create a global var."
|
||||
[name init]
|
||||
(def name* (symbol name))
|
||||
(put *env* name* @{:ref @[init]})
|
||||
nil)
|
||||
|
||||
# Basic predicates
|
||||
(defn even? [x] (== 0 (% x 2)))
|
||||
(defn odd? [x] (== 1 (% x 2)))
|
||||
(defn odd? [x] (not= 0 (% x 2)))
|
||||
(defn zero? [x] (== x 0))
|
||||
(defn pos? [x] (> x 0))
|
||||
(defn neg? [x] (< x 0))
|
||||
@ -96,8 +116,6 @@
|
||||
:table true
|
||||
:struct true})
|
||||
(fn [x] (not (get non-atomic-types (type x))))))
|
||||
(defn sum [xs] (apply1 + xs))
|
||||
(defn product [xs] (apply1 * xs))
|
||||
|
||||
# C style macros and functions for imperative sugar
|
||||
(defn inc [x] (+ x 1))
|
||||
@ -214,88 +232,6 @@
|
||||
(array.concat accum body)
|
||||
(apply1 tuple accum))
|
||||
|
||||
(defmacro loop
|
||||
"A general purpose loop macro."
|
||||
[head & body]
|
||||
(def len (length head))
|
||||
(defn doone
|
||||
[i preds]
|
||||
(default preds @['and])
|
||||
(if (>= i len)
|
||||
(tuple.prepend body 'do)
|
||||
(do
|
||||
(def {
|
||||
i bindings
|
||||
(+ i 1) verb
|
||||
(+ i 2) object
|
||||
} head)
|
||||
(if (keyword? bindings)
|
||||
(case
|
||||
bindings
|
||||
:while (do
|
||||
(array.push preds verb)
|
||||
(doone (+ i 2) preds))
|
||||
:let (tuple 'let verb (doone (+ i 2)))
|
||||
:when (tuple 'if verb (doone (+ i 2)))
|
||||
(error ("unexpected loop predicate: " verb)))
|
||||
(case verb
|
||||
:iterate (do
|
||||
(def preds @['and (tuple ':= bindings object)])
|
||||
(def subloop (doone (+ i 3) preds))
|
||||
(tuple 'do
|
||||
(tuple 'var bindings nil)
|
||||
(tuple 'while (apply1 tuple preds)
|
||||
subloop)))
|
||||
:range (do
|
||||
(def [start end _inc] object)
|
||||
(def inc (if _inc _inc 1))
|
||||
(def endsym (gensym))
|
||||
(def preds @['and (tuple < bindings endsym)])
|
||||
(def subloop (doone (+ i 3) preds))
|
||||
(tuple 'do
|
||||
(tuple 'var bindings start)
|
||||
(tuple 'def endsym end)
|
||||
(tuple 'while (apply1 tuple preds)
|
||||
subloop
|
||||
(tuple ':= bindings (tuple + bindings inc)))))
|
||||
:keys (do
|
||||
(def $dict (gensym))
|
||||
(def preds @['and (tuple not= nil bindings)])
|
||||
(def subloop (doone (+ i 3) preds))
|
||||
(tuple 'do
|
||||
(tuple 'def $dict object)
|
||||
(tuple 'var bindings (tuple next $dict nil))
|
||||
(tuple 'while (apply1 tuple preds)
|
||||
subloop
|
||||
(tuple ':= bindings (tuple next $dict bindings)))))
|
||||
:in (do
|
||||
(def $len (gensym))
|
||||
(def $i (gensym))
|
||||
(def $indexed (gensym))
|
||||
(def preds @['and (tuple < $i $len)])
|
||||
(def subloop (doone (+ i 3) preds))
|
||||
(tuple 'do
|
||||
(tuple 'def $indexed object)
|
||||
(tuple 'def $len (tuple length $indexed))
|
||||
(tuple 'var $i 0)
|
||||
(tuple 'while (apply1 tuple preds)
|
||||
(tuple 'def bindings (tuple get $indexed $i))
|
||||
subloop
|
||||
(tuple ':= $i (tuple + 1 $i)))))
|
||||
(error ("unexpected loop verb: " verb)))))))
|
||||
(doone 0))
|
||||
|
||||
(defmacro for
|
||||
"Similar to loop, but accumulates the loop body into an array and returns that."
|
||||
[head & body]
|
||||
(def $accum (gensym))
|
||||
(tuple 'do
|
||||
(tuple 'def $accum @[])
|
||||
(tuple 'loop head
|
||||
(tuple array.push $accum
|
||||
(tuple.prepend body 'do)))
|
||||
$accum))
|
||||
|
||||
(defmacro and
|
||||
"Evaluates to the last argument if all preceding elements are true, otherwise
|
||||
evaluates to false."
|
||||
@ -327,16 +263,114 @@
|
||||
(tuple 'do (tuple 'def $fi fi)
|
||||
(tuple 'if $fi $fi (aux (inc i))))))))) 0)))
|
||||
|
||||
(defmacro loop
|
||||
"A general purpose loop macro."
|
||||
[head & body]
|
||||
(def len (length head))
|
||||
(defn doone
|
||||
@[i preds]
|
||||
(default preds @['and])
|
||||
(if (>= i len)
|
||||
(tuple.prepend body 'do)
|
||||
(do
|
||||
(def {
|
||||
i bindings
|
||||
(+ i 1) verb
|
||||
(+ i 2) object
|
||||
} head)
|
||||
(if (keyword? bindings)
|
||||
(case
|
||||
bindings
|
||||
:while (do
|
||||
(array.push preds verb)
|
||||
(doone (+ i 2) preds))
|
||||
:let (tuple 'let verb (doone (+ i 2)))
|
||||
:when (tuple 'if verb (doone (+ i 2)))
|
||||
(error ("unexpected loop predicate: " verb)))
|
||||
(case verb
|
||||
:iterate (do
|
||||
(def $iter (gensym))
|
||||
(def preds @['and (tuple ':= $iter object)])
|
||||
(def subloop (doone (+ i 3) preds))
|
||||
(tuple 'do
|
||||
(tuple 'var $iter nil)
|
||||
(tuple 'while (apply1 tuple preds)
|
||||
(tuple 'def bindings $iter)
|
||||
subloop)))
|
||||
:range (do
|
||||
(def [start end _inc] object)
|
||||
(def inc (if _inc _inc 1))
|
||||
(def endsym (gensym))
|
||||
(def $iter (gensym))
|
||||
(def preds @['and (tuple < $iter endsym)])
|
||||
(def subloop (doone (+ i 3) preds))
|
||||
(tuple 'do
|
||||
(tuple 'var $iter start)
|
||||
(tuple 'def endsym end)
|
||||
(tuple 'while (apply1 tuple preds)
|
||||
(tuple 'def bindings $iter)
|
||||
subloop
|
||||
(tuple ':= $iter (tuple + $iter inc)))))
|
||||
:keys (do
|
||||
(def $dict (gensym))
|
||||
(def $iter (gensym))
|
||||
(def preds @['and (tuple not= nil $iter)])
|
||||
(def subloop (doone (+ i 3) preds))
|
||||
(tuple 'do
|
||||
(tuple 'def $dict object)
|
||||
(tuple 'var $iter (tuple next $dict nil))
|
||||
(tuple 'while (apply1 tuple preds)
|
||||
(tuple 'def bindings $iter)
|
||||
subloop
|
||||
(tuple ':= $iter (tuple next $dict $iter)))))
|
||||
:in (do
|
||||
(def $len (gensym))
|
||||
(def $i (gensym))
|
||||
(def $indexed (gensym))
|
||||
(def preds @['and (tuple < $i $len)])
|
||||
(def subloop (doone (+ i 3) preds))
|
||||
(tuple 'do
|
||||
(tuple 'def $indexed object)
|
||||
(tuple 'def $len (tuple length $indexed))
|
||||
(tuple 'var $i 0)
|
||||
(tuple 'while (apply1 tuple preds)
|
||||
(tuple 'def bindings (tuple get $indexed $i))
|
||||
subloop
|
||||
(tuple ':= $i (tuple + 1 $i)))))
|
||||
(error (string "unexpected loop verb: " verb)))))))
|
||||
(doone 0 nil))
|
||||
|
||||
(defmacro for
|
||||
"Similar to loop, but accumulates the loop body into an array and returns that."
|
||||
[head & body]
|
||||
(def $accum (gensym))
|
||||
(tuple 'do
|
||||
(tuple 'def $accum @[])
|
||||
(tuple 'loop head
|
||||
(tuple array.push $accum
|
||||
(tuple.prepend body 'do)))
|
||||
$accum))
|
||||
|
||||
(defn sum [xs]
|
||||
(var accum 0)
|
||||
(loop [x :in xs] (+= accum x))
|
||||
accum)
|
||||
|
||||
(defn product [xs]
|
||||
(var accum 1)
|
||||
(loop [x :in xs] (*= accum x))
|
||||
accum)
|
||||
|
||||
(defmacro coro
|
||||
"A wrapper for making fibers. Same as (fiber (fn [] ...body))."
|
||||
[& body]
|
||||
(tuple fiber.new (apply tuple 'fn [] body)))
|
||||
(tuple fiber.new (apply tuple 'fn @[] body)))
|
||||
|
||||
(defmacro if-let
|
||||
"Takes the first one or two forms in a vector and if both are true binds
|
||||
all the forms with let and evaluates the first expression else
|
||||
evaluates the second"
|
||||
[bindings tru fal]
|
||||
@[bindings tru fal]
|
||||
(def len (length bindings))
|
||||
(if (zero? len) (error "expected at least 1 binding"))
|
||||
(if (odd? len) (error "expected an even number of bindings"))
|
||||
@ -443,12 +477,12 @@
|
||||
(sort-help a (+ piv 1) hi by))
|
||||
a)
|
||||
|
||||
(fn [a by]
|
||||
(fn @[a by]
|
||||
(sort-help a 0 (- (length a) 1) (or by order<)))))
|
||||
|
||||
(defn sorted
|
||||
"Returns the sorted version of an indexed data structure."
|
||||
[ind by]
|
||||
@[ind by]
|
||||
(def sa (sort (apply1 array ind) by))
|
||||
(if (= :tuple (type ind))
|
||||
(apply1 tuple sa)
|
||||
@ -457,7 +491,7 @@
|
||||
(defn reduce
|
||||
"Reduce, also know as fold-left in many languages, transforms
|
||||
an indexed type (array, tuple) with a function to produce a value."
|
||||
[f init ind]
|
||||
@[f init ind]
|
||||
(var res init)
|
||||
(loop [x :in ind]
|
||||
(:= res (f res x)))
|
||||
@ -476,14 +510,14 @@
|
||||
(def [i1 i2 i3 i4] inds)
|
||||
(def res (array.new limit))
|
||||
(case ninds
|
||||
1 (loop [i :range [0 limit]] (array.push res (f (get i1 i))))
|
||||
2 (loop [i :range [0 limit]] (array.push res (f (get i1 i) (get i2 i))))
|
||||
3 (loop [i :range [0 limit]] (array.push res (f (get i1 i) (get i2 i) (get i3 i))))
|
||||
4 (loop [i :range [0 limit]] (array.push res (f (get i1 i) (get i2 i) (get i3 i) (get i4 i))))
|
||||
1 (loop [i :range [0 limit]] (put res i (f (get i1 i))))
|
||||
2 (loop [i :range [0 limit]] (put res i (f (get i1 i) (get i2 i))))
|
||||
3 (loop [i :range [0 limit]] (put res i (f (get i1 i) (get i2 i) (get i3 i))))
|
||||
4 (loop [i :range [0 limit]] (put res i (f (get i1 i) (get i2 i) (get i3 i) (get i4 i))))
|
||||
(loop [i :range [0 limit]]
|
||||
(def args (array.new ninds))
|
||||
(loop [j :range [0 ninds]] (array.push args (get (get inds j) i)))
|
||||
(array.push res (apply1 f args))))
|
||||
(loop [j :range [0 ninds]] (put args j (get (get inds j) i)))
|
||||
(put res i (apply1 f args))))
|
||||
res)
|
||||
|
||||
(defn each
|
||||
@ -511,7 +545,7 @@
|
||||
"Map a function over every element in an array or tuple and
|
||||
use array to concatenate the results. Returns the same
|
||||
type as the input sequence."
|
||||
[f ind t]
|
||||
@[f ind t]
|
||||
(def res @[])
|
||||
(loop [x :in ind]
|
||||
(array.concat res (f x)))
|
||||
@ -522,7 +556,7 @@
|
||||
(defn filter
|
||||
"Given a predicate, take only elements from an array or tuple for
|
||||
which (pred element) is truthy. Returns the same type as the input sequence."
|
||||
[pred ind t]
|
||||
@[pred ind t]
|
||||
(def res @[])
|
||||
(loop [item :in ind]
|
||||
(if (pred item)
|
||||
@ -533,10 +567,19 @@
|
||||
|
||||
(defn range
|
||||
"Create an array of values [0, n)."
|
||||
[n]
|
||||
[& args]
|
||||
(case (length args)
|
||||
1 (do
|
||||
(def [n] args)
|
||||
(def arr (array.new n))
|
||||
(loop [i :range [0 n]] (put arr i i))
|
||||
arr)
|
||||
2 (do
|
||||
(def [n m] args)
|
||||
(def arr (array.new n))
|
||||
(loop [i :range [n m]] (put arr (- i n) i))
|
||||
arr)
|
||||
(error "expected 1 to 2 arguments to range")))
|
||||
|
||||
(defn find-index
|
||||
"Find the index of indexed type for which pred is true. Returns nil if not found."
|
||||
@ -630,12 +673,12 @@
|
||||
(if (zero? (length more)) f
|
||||
(fn [& r] (apply1 f (array.concat @[] more r)))))
|
||||
|
||||
(defn every? [pred seq]
|
||||
(defn every? [pred ind]
|
||||
(var res true)
|
||||
(var i 0)
|
||||
(def len (length seq))
|
||||
(def len (length ind))
|
||||
(while (< i len)
|
||||
(def item (get seq i))
|
||||
(def item (get ind i))
|
||||
(if (pred item)
|
||||
(++ i)
|
||||
(do (:= res false) (:= i len))))
|
||||
@ -666,7 +709,7 @@
|
||||
(defn zipcoll
|
||||
"Creates an table or tuple from two arrays/tuples. If a third argument of
|
||||
:struct is given result is struct else is table."
|
||||
[keys vals t]
|
||||
@[keys vals t]
|
||||
(def res @{})
|
||||
(def lk (length keys))
|
||||
(def lv (length vals))
|
||||
@ -866,16 +909,15 @@
|
||||
(def args (map macroexpand-1 (tuple.slice t 2)))
|
||||
(apply tuple 'fn (get t 1) args))
|
||||
|
||||
(def specs {
|
||||
':= expanddef
|
||||
(def specs
|
||||
{':= expanddef
|
||||
'def expanddef
|
||||
'do expandall
|
||||
'fn expandfn
|
||||
'if expandall
|
||||
'quote identity
|
||||
'var expanddef
|
||||
'while expandall
|
||||
})
|
||||
'while expandall})
|
||||
|
||||
(defn dotup [t]
|
||||
(def h (get t 0))
|
||||
@ -888,7 +930,8 @@
|
||||
m? (apply1 m (tuple.slice t 1))
|
||||
(apply1 tuple (map macroexpand-1 t))))
|
||||
|
||||
(def ret (case (type x)
|
||||
(def ret
|
||||
(case (type x)
|
||||
:tuple (dotup x)
|
||||
:array (map macroexpand-1 x)
|
||||
:struct (table.to-struct (dotable x macroexpand-1))
|
||||
@ -944,7 +987,8 @@
|
||||
###
|
||||
###
|
||||
|
||||
(defn make-env [parent]
|
||||
(defn make-env
|
||||
@[parent]
|
||||
(def parent (if parent parent _env))
|
||||
(def newenv (table.setproto @{} parent))
|
||||
(put newenv '_env @{:value newenv :private true})
|
||||
@ -962,7 +1006,7 @@
|
||||
This function can be used to implement a repl very easily, simply
|
||||
pass a function that reads line from stdin to chunks, and print to
|
||||
onvalue."
|
||||
[env chunks onvalue onerr where]
|
||||
@[env chunks onvalue onerr where]
|
||||
|
||||
# Are we done yet?
|
||||
(var going true)
|
||||
@ -1004,7 +1048,7 @@
|
||||
(var good true)
|
||||
(def f
|
||||
(fiber.new
|
||||
(fn []
|
||||
(fn @[]
|
||||
(def res (compile source env where))
|
||||
(if (= (type res) :function)
|
||||
(res)
|
||||
@ -1045,16 +1089,14 @@
|
||||
(when f
|
||||
(def st (fiber.stack f))
|
||||
(loop
|
||||
[{
|
||||
:function func
|
||||
[{:function func
|
||||
:tail tail
|
||||
:pc pc
|
||||
:c c
|
||||
:name name
|
||||
:source source
|
||||
:line source-line
|
||||
:column source-col
|
||||
} :in st]
|
||||
:column source-col} :in st]
|
||||
(file.write stdout " in")
|
||||
(when c (file.write stdout " cfunction"))
|
||||
(if name
|
||||
@ -1080,7 +1122,7 @@
|
||||
environment is needed, use run-context."
|
||||
[str]
|
||||
(var state (string str))
|
||||
(defn chunks [buf]
|
||||
(defn chunks [buf _]
|
||||
(def ret state)
|
||||
(:= state nil)
|
||||
(if ret
|
||||
@ -1089,21 +1131,26 @@
|
||||
(run-context *env* chunks (fn [x] (:= returnval x)) default-error-handler "eval")
|
||||
returnval)
|
||||
|
||||
(def module.paths
|
||||
(do
|
||||
(def syspath (or (os.getenv "DST_PATH") "/usr/local/lib/dst/"))
|
||||
(defglobal 'module.paths
|
||||
@["./?.dst"
|
||||
"./?/init.dst"
|
||||
"./dst_modules/?.dst"
|
||||
"./dst_modules/?/init.dst"
|
||||
"/usr/local/dst/0.0.0/?.dst"
|
||||
"/usr/local/dst/0.0.0/?/init.dst"])
|
||||
|
||||
(def module.native-paths
|
||||
(string syspath VERSION "/?.dst")
|
||||
(string syspath VERSION "/?/init.dst")
|
||||
(string syspath "/?.dst")
|
||||
(string syspath "/?/init.dst")])
|
||||
(defglobal 'module.native-paths
|
||||
@["./?.so"
|
||||
"./?/??.so"
|
||||
"./dst_modules/?.so"
|
||||
"./dst_modules/?/??.so"
|
||||
"/usr/local/dst/0.0.0/?.so"
|
||||
"/usr/local/dst/0.0.0/?/??.so"])
|
||||
(string syspath VERSION "/?.so")
|
||||
(string syspath VERSION "/?/??.so")
|
||||
(string syspath "/?.so")
|
||||
(string syspath "/?/??.so")]))
|
||||
|
||||
(defn module.find
|
||||
[path paths]
|
||||
@ -1145,7 +1192,7 @@
|
||||
|
||||
(def cache @{})
|
||||
(def loading @{})
|
||||
(fn require [path args]
|
||||
(fn require @[path args]
|
||||
(when (get loading path)
|
||||
(error (string "circular dependency: module " path " is loading")))
|
||||
(def {:exit exit-on-error} (or args {}))
|
||||
@ -1160,21 +1207,21 @@
|
||||
(if f
|
||||
(do
|
||||
# Normal dst module
|
||||
(defn chunks [buf] (file.read f 1024 buf))
|
||||
(defn chunks [buf _] (file.read f 1024 buf))
|
||||
(run-context newenv chunks identity
|
||||
(if exit-on-error
|
||||
(fn [a b c d] (default-error-handler a b c d) (os.exit 1))
|
||||
(fn @[a b c d] (default-error-handler a b c d) (os.exit 1))
|
||||
default-error-handler)
|
||||
path)
|
||||
(file.close f)
|
||||
(put loading path nil)
|
||||
newenv)
|
||||
(file.close f))
|
||||
(do
|
||||
# Try native module
|
||||
(def n (find-native path))
|
||||
(if (not n)
|
||||
(error (string "could not open file for module " path)))
|
||||
((native n)))))))))
|
||||
((native n) newenv)))
|
||||
(put loading path false)
|
||||
newenv)))))
|
||||
|
||||
(defn import* [env path & args]
|
||||
(def targs (apply1 table args))
|
||||
@ -1193,11 +1240,12 @@
|
||||
(put env (symbol prefix k) newv))
|
||||
(:= k (next newenv k))))
|
||||
|
||||
(defmacro import [path & args]
|
||||
(defmacro import
|
||||
"Import a module. First requires the module, and then merges its
|
||||
symbols into the current environment, prepending a given prefix as needed.
|
||||
(use the :as or :prefix option to set a prefix). If no prefix is provided,
|
||||
use the name of the module as a prefix."
|
||||
[path & args]
|
||||
(def argm (map (fn [x]
|
||||
(if (and (symbol? x) (= (get x 0) 58))
|
||||
x
|
||||
@ -1205,9 +1253,10 @@
|
||||
args))
|
||||
(apply tuple import* '_env (string path) argm))
|
||||
|
||||
(defn repl [getchunk onvalue onerr]
|
||||
(defn repl
|
||||
"Run a repl. The first parameter is an optional function to call to
|
||||
get a chunk of source code. Should return nil for end of file."
|
||||
@[getchunk onvalue onerr]
|
||||
(def newenv (make-env))
|
||||
(default getchunk (fn [buf]
|
||||
(file.read stdin :line buf)))
|
||||
@ -1219,7 +1268,7 @@
|
||||
|
||||
(defn all-symbols
|
||||
"Get all symbols available in the current environment."
|
||||
[env]
|
||||
@[env]
|
||||
(default env *env*)
|
||||
(def envs @[])
|
||||
(do (var e env) (while e (array.push envs e) (:= e (table.getproto e))))
|
||||
|
@ -256,10 +256,11 @@ static int dst_core_gcinterval(DstArgs args) {
|
||||
|
||||
static int dst_core_type(DstArgs args) {
|
||||
DST_FIXARITY(args, 1);
|
||||
if (dst_checktype(args.v[0], DST_ABSTRACT)) {
|
||||
DstType t = dst_type(args.v[0]);
|
||||
if (t == DST_ABSTRACT) {
|
||||
DST_RETURN(args, dst_csymbolv(dst_abstract_type(dst_unwrap_abstract(args.v[0]))->name));
|
||||
} else {
|
||||
DST_RETURN(args, dst_csymbolv(dst_type_names[dst_type(args.v[0])]));
|
||||
DST_RETURN(args, dst_csymbolv(dst_type_names[t]));
|
||||
}
|
||||
}
|
||||
|
||||
@ -282,9 +283,8 @@ static int dst_core_next(DstArgs args) {
|
||||
: dst_struct_find(st, args.v[1]);
|
||||
kv = dst_struct_next(st, kv);
|
||||
}
|
||||
if (kv) {
|
||||
if (kv)
|
||||
DST_RETURN(args, kv->key);
|
||||
}
|
||||
DST_RETURN_NIL(args);
|
||||
}
|
||||
|
||||
@ -344,57 +344,11 @@ static void dst_quick_asm(
|
||||
}
|
||||
|
||||
/* Macros for easier inline dst assembly */
|
||||
#define SSS(op, a, b, c) (op | (a << 8) | (b << 16) | (c << 24))
|
||||
#define SS(op, a, b) (op | (a << 8) | (b << 16))
|
||||
#define SSI(op, a, b, I) (op | (a << 8) | (b << 16) | ((uint32_t)(I) << 24))
|
||||
#define S(op, a) (op | (a << 8))
|
||||
#define SI(op, a, I) (op | (a << 8) | ((uint32_t)(I) << 16))
|
||||
|
||||
/* Variadic operator assembly. Must be templatized for each different opcode. */
|
||||
/* Reg 0: Argument tuple (args) */
|
||||
/* Reg 1: Argument count (argn) */
|
||||
/* Reg 2: Jump flag (jump?) */
|
||||
/* Reg 3: Accumulator (accum) */
|
||||
/* Reg 4: Next operand (operand) */
|
||||
/* Reg 5: Loop iterator (i) */
|
||||
static DST_THREAD_LOCAL uint32_t varop_asm[] = {
|
||||
SS(DOP_LENGTH, 1, 0), /* Put number of arguments in register 1 -> argn = count(args) */
|
||||
|
||||
/* Check nullary */
|
||||
SSS(DOP_EQUALS_IMMEDIATE, 2, 1, 0), /* Check if numargs equal to 0 */
|
||||
SI(DOP_JUMP_IF_NOT, 2, 3), /* If not 0, jump to next check */
|
||||
/* Nullary */
|
||||
SI(DOP_LOAD_INTEGER, 3, 0), /* accum = nullary value */
|
||||
S(DOP_RETURN, 3), /* return accum */
|
||||
|
||||
/* Check unary */
|
||||
SSI(DOP_EQUALS_IMMEDIATE, 2, 1, 1), /* Check if numargs equal to 1 */
|
||||
SI(DOP_JUMP_IF_NOT, 2, 5), /* If not 1, jump to next check */
|
||||
/* Unary */
|
||||
S(DOP_LOAD_INTEGER, 3), /* accum = unary value */
|
||||
SSI(DOP_GET_INDEX, 4, 0, 0), /* operand = args[0] */
|
||||
SSS(DOP_NOOP, 3, 3, 4), /* accum = accum op operand */
|
||||
S(DOP_RETURN, 3), /* return accum */
|
||||
|
||||
/* Mutli (2 or more) arity */
|
||||
/* Prime loop */
|
||||
SSI(DOP_GET_INDEX, 3, 0, 0), /* accum = args[0] */
|
||||
SI(DOP_LOAD_INTEGER, 5, 1), /* i = 1 */
|
||||
/* Main loop */
|
||||
SSS(DOP_GET, 4, 0, 5), /* operand = args[i] */
|
||||
SSS(DOP_NOOP, 3, 3, 4), /* accum = accum op operand */
|
||||
SSI(DOP_ADD_IMMEDIATE, 5, 5, 1), /* i++ */
|
||||
SSI(DOP_EQUALS_INTEGER, 2, 5, 1), /* jump? = (i == argn) */
|
||||
SI(DOP_JUMP_IF_NOT, 2, -4), /* if not jump? go back 4 */
|
||||
|
||||
/* Done, do last and return accumulator */
|
||||
S(DOP_RETURN, 3) /* return accum */
|
||||
};
|
||||
|
||||
#define VAROP_NULLARY_LOC 3
|
||||
#define VAROP_UNARY_LOC 7
|
||||
#define VAROP_OP_LOC1 9
|
||||
#define VAROP_OP_LOC2 14
|
||||
#define SSS(op, a, b, c) ((op) | ((a) << 8) | ((b) << 16) | ((c) << 24))
|
||||
#define SS(op, a, b) ((op) | ((a) << 8) | ((b) << 16))
|
||||
#define SSI(op, a, b, I) ((op) | ((a) << 8) | ((b) << 16) | ((uint32_t)(I) << 24))
|
||||
#define S(op, a) ((op) | ((a) << 8))
|
||||
#define SI(op, a, I) ((op) | ((a) << 8) | ((uint32_t)(I) << 16))
|
||||
|
||||
/* Templatize a varop */
|
||||
static void templatize_varop(
|
||||
@ -404,10 +358,48 @@ static void templatize_varop(
|
||||
int32_t nullary,
|
||||
int32_t unary,
|
||||
uint32_t op) {
|
||||
varop_asm[VAROP_NULLARY_LOC] = SS(DOP_LOAD_INTEGER, 3, nullary);
|
||||
varop_asm[VAROP_UNARY_LOC] = SS(DOP_LOAD_INTEGER, 3, unary);
|
||||
varop_asm[VAROP_OP_LOC1] = SSS(op, 3, 3, 4);
|
||||
varop_asm[VAROP_OP_LOC2] = SSS(op, 3, 3, 4);
|
||||
|
||||
/* Variadic operator assembly. Must be templatized for each different opcode. */
|
||||
/* Reg 0: Argument tuple (args) */
|
||||
/* Reg 1: Argument count (argn) */
|
||||
/* Reg 2: Jump flag (jump?) */
|
||||
/* Reg 3: Accumulator (accum) */
|
||||
/* Reg 4: Next operand (operand) */
|
||||
/* Reg 5: Loop iterator (i) */
|
||||
uint32_t varop_asm[] = {
|
||||
SS(DOP_LENGTH, 1, 0), /* Put number of arguments in register 1 -> argn = count(args) */
|
||||
|
||||
/* Check nullary */
|
||||
SSS(DOP_EQUALS_IMMEDIATE, 2, 1, 0), /* Check if numargs equal to 0 */
|
||||
SI(DOP_JUMP_IF_NOT, 2, 3), /* If not 0, jump to next check */
|
||||
/* Nullary */
|
||||
SI(DOP_LOAD_INTEGER, 3, nullary), /* accum = nullary value */
|
||||
S(DOP_RETURN, 3), /* return accum */
|
||||
|
||||
/* Check unary */
|
||||
SSI(DOP_EQUALS_IMMEDIATE, 2, 1, 1), /* Check if numargs equal to 1 */
|
||||
SI(DOP_JUMP_IF_NOT, 2, 5), /* If not 1, jump to next check */
|
||||
/* Unary */
|
||||
SI(DOP_LOAD_INTEGER, 3, unary), /* accum = unary value */
|
||||
SSI(DOP_GET_INDEX, 4, 0, 0), /* operand = args[0] */
|
||||
SSS(op, 3, 3, 4), /* accum = accum op operand */
|
||||
S(DOP_RETURN, 3), /* return accum */
|
||||
|
||||
/* Mutli (2 or more) arity */
|
||||
/* Prime loop */
|
||||
SSI(DOP_GET_INDEX, 3, 0, 0), /* accum = args[0] */
|
||||
SI(DOP_LOAD_INTEGER, 5, 1), /* i = 1 */
|
||||
/* Main loop */
|
||||
SSS(DOP_GET, 4, 0, 5), /* operand = args[i] */
|
||||
SSS(op, 3, 3, 4), /* accum = accum op operand */
|
||||
SSI(DOP_ADD_IMMEDIATE, 5, 5, 1), /* i++ */
|
||||
SSI(DOP_EQUALS_INTEGER, 2, 5, 1), /* jump? = (i == argn) */
|
||||
SI(DOP_JUMP_IF_NOT, 2, -4), /* if not jump? go back 4 */
|
||||
|
||||
/* Done, do last and return accumulator */
|
||||
S(DOP_RETURN, 3) /* return accum */
|
||||
};
|
||||
|
||||
dst_quick_asm(
|
||||
env,
|
||||
flags | DST_FUNCDEF_FLAG_VARARG,
|
||||
@ -418,38 +410,93 @@ static void templatize_varop(
|
||||
sizeof(varop_asm));
|
||||
}
|
||||
|
||||
DstTable *dst_stl_env(int flags) {
|
||||
static uint32_t error_asm[] = {
|
||||
/* Templatize variadic comparators */
|
||||
static void templatize_comparator(
|
||||
DstTable *env,
|
||||
int32_t flags,
|
||||
const char *name,
|
||||
int invert,
|
||||
uint32_t op) {
|
||||
|
||||
/* Reg 0: Argument tuple (args) */
|
||||
/* Reg 1: Argument count (argn) */
|
||||
/* Reg 2: Jump flag (jump?) */
|
||||
/* Reg 3: Last value (last) */
|
||||
/* Reg 4: Next operand (next) */
|
||||
/* Reg 5: Loop iterator (i) */
|
||||
uint32_t comparator_asm[] = {
|
||||
SS(DOP_LENGTH, 1, 0), /* Put number of arguments in register 1 -> argn = count(args) */
|
||||
SSS(DOP_LESS_THAN_IMMEDIATE, 2, 1, 2), /* Check if numargs less than 2 */
|
||||
SI(DOP_JUMP_IF, 2, 10), /* If numargs < 2, jump to done */
|
||||
|
||||
/* Prime loop */
|
||||
SSI(DOP_GET_INDEX, 3, 0, 0), /* last = args[0] */
|
||||
SI(DOP_LOAD_INTEGER, 5, 1), /* i = 1 */
|
||||
|
||||
/* Main loop */
|
||||
SSS(DOP_GET, 4, 0, 5), /* next = args[i] */
|
||||
SSS(op, 2, 3, 4), /* jump? = last compare next */
|
||||
SI(DOP_JUMP_IF_NOT, 2, 7), /* if not jump? goto fail (return false) */
|
||||
SSI(DOP_ADD_IMMEDIATE, 5, 5, 1), /* i++ */
|
||||
SS(DOP_MOVE_NEAR, 3, 4), /* last = next */
|
||||
SSI(DOP_EQUALS_INTEGER, 2, 5, 1), /* jump? = (i == argn) */
|
||||
SI(DOP_JUMP_IF_NOT, 2, -6), /* if not jump? go back 6 */
|
||||
|
||||
/* Done, return true */
|
||||
S(invert ? DOP_LOAD_FALSE : DOP_LOAD_TRUE, 3),
|
||||
S(DOP_RETURN, 3),
|
||||
|
||||
/* Failed, return false */
|
||||
S(invert ? DOP_LOAD_TRUE : DOP_LOAD_FALSE, 3),
|
||||
S(DOP_RETURN, 3)
|
||||
};
|
||||
|
||||
dst_quick_asm(
|
||||
env,
|
||||
flags | DST_FUNCDEF_FLAG_VARARG,
|
||||
name,
|
||||
0,
|
||||
6,
|
||||
comparator_asm,
|
||||
sizeof(comparator_asm));
|
||||
}
|
||||
|
||||
DstTable *dst_core_env(void) {
|
||||
static const uint32_t error_asm[] = {
|
||||
DOP_ERROR
|
||||
};
|
||||
static uint32_t apply_asm[] = {
|
||||
static const uint32_t apply_asm[] = {
|
||||
DOP_PUSH_ARRAY | (1 << 8),
|
||||
DOP_TAILCALL
|
||||
};
|
||||
static uint32_t debug_asm[] = {
|
||||
static const uint32_t debug_asm[] = {
|
||||
DOP_SIGNAL | (2 << 24),
|
||||
DOP_RETURN_NIL
|
||||
};
|
||||
static uint32_t yield_asm[] = {
|
||||
static const uint32_t yield_asm[] = {
|
||||
DOP_SIGNAL | (3 << 24),
|
||||
DOP_RETURN
|
||||
};
|
||||
static uint32_t resume_asm[] = {
|
||||
static const uint32_t resume_asm[] = {
|
||||
DOP_RESUME | (1 << 24),
|
||||
DOP_RETURN
|
||||
};
|
||||
static uint32_t get_asm[] = {
|
||||
static const uint32_t get_asm[] = {
|
||||
DOP_GET | (1 << 24),
|
||||
DOP_RETURN
|
||||
};
|
||||
static uint32_t put_asm[] = {
|
||||
static const uint32_t put_asm[] = {
|
||||
DOP_PUT | (1 << 16) | (2 << 24),
|
||||
DOP_RETURN
|
||||
};
|
||||
static uint32_t length_asm[] = {
|
||||
static const uint32_t length_asm[] = {
|
||||
DOP_LENGTH,
|
||||
DOP_RETURN
|
||||
};
|
||||
static const uint32_t bnot_asm[] = {
|
||||
DOP_BNOT,
|
||||
DOP_RETURN
|
||||
};
|
||||
|
||||
DstTable *env = dst_table(0);
|
||||
Dst ret = dst_wrap_table(env);
|
||||
@ -465,6 +512,7 @@ DstTable *dst_stl_env(int flags) {
|
||||
dst_quick_asm(env, DST_FUN_GET, "get", 2, 2, get_asm, sizeof(get_asm));
|
||||
dst_quick_asm(env, DST_FUN_PUT, "put", 3, 3, put_asm, sizeof(put_asm));
|
||||
dst_quick_asm(env, DST_FUN_LENGTH, "length", 1, 1, length_asm, sizeof(length_asm));
|
||||
dst_quick_asm(env, DST_FUN_BNOT, "~", 1, 1, bnot_asm, sizeof(bnot_asm));
|
||||
|
||||
/* Variadic ops */
|
||||
templatize_varop(env, DST_FUN_ADD, "+", 0, 0, DOP_ADD);
|
||||
@ -478,6 +526,20 @@ DstTable *dst_stl_env(int flags) {
|
||||
templatize_varop(env, DST_FUN_RSHIFT, ">>", 1, 1, DOP_SHIFT_RIGHT);
|
||||
templatize_varop(env, DST_FUN_RSHIFTU, ">>>", 1, 1, DOP_SHIFT_RIGHT_UNSIGNED);
|
||||
|
||||
/* Variadic comparators */
|
||||
templatize_comparator(env, DST_FUN_ORDER_GT, "order>", 0, DOP_GREATER_THAN);
|
||||
templatize_comparator(env, DST_FUN_ORDER_LT, "order<", 0, DOP_LESS_THAN);
|
||||
templatize_comparator(env, DST_FUN_ORDER_GTE, "order>=", 1, DOP_LESS_THAN);
|
||||
templatize_comparator(env, DST_FUN_ORDER_LTE, "order<=", 1, DOP_GREATER_THAN);
|
||||
templatize_comparator(env, DST_FUN_ORDER_EQ, "=", 0, DOP_EQUALS);
|
||||
templatize_comparator(env, DST_FUN_ORDER_NEQ, "not=", 1, DOP_EQUALS);
|
||||
templatize_comparator(env, DST_FUN_GT, ">", 0, DOP_NUMERIC_GREATER_THAN);
|
||||
templatize_comparator(env, DST_FUN_LT, "<", 0, DOP_NUMERIC_LESS_THAN);
|
||||
templatize_comparator(env, DST_FUN_GTE, ">=", 0, DOP_NUMERIC_GREATER_THAN_EQUAL);
|
||||
templatize_comparator(env, DST_FUN_LTE, "<=", 0, DOP_NUMERIC_LESS_THAN_EQUAL);
|
||||
templatize_comparator(env, DST_FUN_EQ, "==", 0, DOP_NUMERIC_EQUAL);
|
||||
templatize_comparator(env, DST_FUN_NEQ, "not==", 1, DOP_NUMERIC_EQUAL);
|
||||
|
||||
dst_env_def(env, "VERSION", dst_cstringv(DST_VERSION));
|
||||
|
||||
/* Set as gc root */
|
||||
@ -510,8 +572,5 @@ DstTable *dst_stl_env(int flags) {
|
||||
/* Run bootstrap source */
|
||||
dst_dobytes(env, dst_gen_core, sizeof(dst_gen_core), "core.dst");
|
||||
|
||||
if (flags & DST_STL_NOGCROOT)
|
||||
dst_gcunroot(dst_wrap_table(env));
|
||||
|
||||
return env;
|
||||
}
|
||||
|
@ -107,7 +107,7 @@ void dst_fiber_pushn(DstFiber *fiber, const Dst *arr, int32_t n) {
|
||||
}
|
||||
|
||||
/* Push a stack frame to a fiber */
|
||||
void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func) {
|
||||
int dst_fiber_funcframe(DstFiber *fiber, DstFunction *func) {
|
||||
DstStackFrame *newframe;
|
||||
|
||||
int32_t i;
|
||||
@ -116,6 +116,13 @@ void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func) {
|
||||
int32_t nextframe = fiber->stackstart;
|
||||
int32_t nextstacktop = nextframe + func->def->slotcount + DST_FRAME_SIZE;
|
||||
|
||||
/* Check strict arity */
|
||||
if (func->def->flags & DST_FUNCDEF_FLAG_FIXARITY) {
|
||||
if (func->def->arity != (fiber->stacktop - fiber->stackstart)) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
if (fiber->capacity < nextstacktop) {
|
||||
dst_fiber_setcapacity(fiber, 2 * nextstacktop);
|
||||
}
|
||||
@ -146,6 +153,9 @@ void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func) {
|
||||
oldtop - tuplehead));
|
||||
}
|
||||
}
|
||||
|
||||
/* Good return */
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* If a frame has a closure environment, detach it from
|
||||
@ -165,12 +175,19 @@ static void dst_env_detach(DstFuncEnv *env) {
|
||||
}
|
||||
|
||||
/* Create a tail frame for a function */
|
||||
void dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func) {
|
||||
int 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 stacksize;
|
||||
|
||||
/* Check strict arity */
|
||||
if (func->def->flags & DST_FUNCDEF_FLAG_FIXARITY) {
|
||||
if (func->def->arity != (fiber->stacktop - fiber->stackstart)) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
if (fiber->capacity < nextstacktop) {
|
||||
dst_fiber_setcapacity(fiber, 2 * nextstacktop);
|
||||
}
|
||||
@ -213,6 +230,9 @@ void dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func) {
|
||||
dst_fiber_frame(fiber)->func = func;
|
||||
dst_fiber_frame(fiber)->pc = func->def->bytecode;
|
||||
dst_fiber_frame(fiber)->flags |= DST_STACKFRAME_TAILCALL;
|
||||
|
||||
/* Good return */
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Push a stack frame to a fiber for a c function */
|
||||
@ -263,6 +283,11 @@ static int cfun_new(DstArgs args) {
|
||||
DST_MINARITY(args, 1);
|
||||
DST_MAXARITY(args, 2);
|
||||
DST_ARG_FUNCTION(func, args, 0);
|
||||
if (func->def->flags & DST_FUNCDEF_FLAG_FIXARITY) {
|
||||
if (func->def->arity != 1) {
|
||||
DST_THROW(args, "expected unit arity function in fiber constructor");
|
||||
}
|
||||
}
|
||||
fiber = dst_fiber(func, 64);
|
||||
if (args.n == 2) {
|
||||
const uint8_t *flags;
|
||||
|
@ -40,8 +40,8 @@ void dst_fiber_push(DstFiber *fiber, Dst x);
|
||||
void dst_fiber_push2(DstFiber *fiber, Dst x, Dst y);
|
||||
void dst_fiber_push3(DstFiber *fiber, Dst x, Dst y, Dst z);
|
||||
void dst_fiber_pushn(DstFiber *fiber, const Dst *arr, int32_t n);
|
||||
void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func);
|
||||
void dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func);
|
||||
int dst_fiber_funcframe(DstFiber *fiber, DstFunction *func);
|
||||
int dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func);
|
||||
void dst_fiber_cframe(DstFiber *fiber, DstCFunction cfun);
|
||||
void dst_fiber_popframe(DstFiber *fiber);
|
||||
|
||||
|
@ -339,6 +339,24 @@ void dst_gcroot(Dst root) {
|
||||
dst_vm_root_count = newcount;
|
||||
}
|
||||
|
||||
/* Identity equality for GC purposes */
|
||||
static int dst_gc_idequals(Dst lhs, Dst rhs) {
|
||||
if (dst_type(lhs) != dst_type(rhs))
|
||||
return 0;
|
||||
switch (dst_type(lhs)) {
|
||||
case DST_TRUE:
|
||||
case DST_FALSE:
|
||||
case DST_NIL:
|
||||
return 1;
|
||||
case DST_INTEGER:
|
||||
return dst_unwrap_integer(lhs) == dst_unwrap_integer(rhs);
|
||||
case DST_REAL:
|
||||
return dst_unwrap_real(lhs) == dst_unwrap_real(rhs);
|
||||
default:
|
||||
return dst_unwrap_pointer(lhs) == dst_unwrap_pointer(rhs);
|
||||
}
|
||||
}
|
||||
|
||||
/* Remove a root value from the GC. This allows the gc to potentially reclaim
|
||||
* a value and all its children. */
|
||||
int dst_gcunroot(Dst root) {
|
||||
@ -346,7 +364,7 @@ int dst_gcunroot(Dst root) {
|
||||
Dst *v = dst_vm_roots;
|
||||
/* Search from top to bottom as access is most likely LIFO */
|
||||
for (v = dst_vm_roots; v < vtop; v++) {
|
||||
if (dst_equals(root, *v)) {
|
||||
if (dst_gc_idequals(root, *v)) {
|
||||
*v = dst_vm_roots[--dst_vm_root_count];
|
||||
return 1;
|
||||
}
|
||||
@ -361,7 +379,7 @@ int dst_gcunrootall(Dst root) {
|
||||
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)) {
|
||||
if (dst_gc_idequals(root, *v)) {
|
||||
*v = dst_vm_roots[--dst_vm_root_count];
|
||||
vtop--;
|
||||
ret = 1;
|
||||
|
@ -154,10 +154,9 @@ static int dst_io_popen(DstArgs args) {
|
||||
}
|
||||
flags = (fmode[0] == 'r') ? IO_PIPED | IO_READ : IO_PIPED | IO_WRITE;
|
||||
#ifdef DST_WINDOWS
|
||||
f = _popen((const char *)fname, (const char *)fmode);
|
||||
#else
|
||||
f = popen((const char *)fname, (const char *)fmode);
|
||||
#define popen _popen
|
||||
#endif
|
||||
f = popen((const char *)fname, (const char *)fmode);
|
||||
if (!f) {
|
||||
if (errno == EMFILE) {
|
||||
DST_THROW(args, "too many streams are open");
|
||||
@ -317,10 +316,9 @@ static int dst_io_fclose(DstArgs args) {
|
||||
DST_THROW(args, "file not closable");
|
||||
if (iof->flags & IO_PIPED) {
|
||||
#ifdef DST_WINDOWS
|
||||
if (_pclose(iof->file)) DST_THROW(args, "could not close file");
|
||||
#else
|
||||
if (pclose(iof->file)) DST_THROW(args, "could not close file");
|
||||
#define pclose _pclose
|
||||
#endif
|
||||
if (pclose(iof->file)) DST_THROW(args, "could not close file");
|
||||
} else {
|
||||
if (fclose(iof->file)) DST_THROW(args, "could not close file");
|
||||
}
|
||||
|
@ -71,19 +71,6 @@ int dst_real(DstArgs args) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
int dst_bnot(DstArgs args) {
|
||||
if (args.n != 1) {
|
||||
*args.ret = dst_cstringv("expected 1 argument");
|
||||
return 1;
|
||||
}
|
||||
if (!dst_checktype(args.v[0], DST_INTEGER)) {
|
||||
*args.ret = dst_cstringv("expected integer");
|
||||
return 1;
|
||||
}
|
||||
*args.ret = dst_wrap_integer(~dst_unwrap_integer(args.v[0]));
|
||||
return 0;
|
||||
}
|
||||
|
||||
int dst_remainder(DstArgs args) {
|
||||
DST_FIXARITY(args, 2);
|
||||
if (dst_checktype(args.v[0], DST_INTEGER) &&
|
||||
@ -137,85 +124,13 @@ int dst_##name(DstArgs args) {\
|
||||
DST_DEFINE_MATH2OP(atan2, atan2)
|
||||
DST_DEFINE_MATH2OP(pow, pow)
|
||||
|
||||
/* Comparison */
|
||||
#define DST_DEFINE_COMPARATOR(name, pred)\
|
||||
static int dst_##name(DstArgs args) {\
|
||||
int32_t i;\
|
||||
for (i = 0; i < args.n - 1; i++) {\
|
||||
if (dst_compare(args.v[i], args.v[i+1]) pred) {\
|
||||
DST_RETURN_FALSE(args);\
|
||||
}\
|
||||
}\
|
||||
DST_RETURN_TRUE(args);\
|
||||
}
|
||||
|
||||
DST_DEFINE_COMPARATOR(ascending, >= 0)
|
||||
DST_DEFINE_COMPARATOR(descending, <= 0)
|
||||
DST_DEFINE_COMPARATOR(notdescending, > 0)
|
||||
DST_DEFINE_COMPARATOR(notascending, < 0)
|
||||
|
||||
/* Boolean logic */
|
||||
static int dst_strict_equal(DstArgs args) {
|
||||
int32_t i;
|
||||
for (i = 0; i < args.n - 1; i++) {
|
||||
if (!dst_equals(args.v[i], args.v[i+1])) {
|
||||
DST_RETURN(args, dst_wrap_false());
|
||||
}
|
||||
}
|
||||
DST_RETURN(args, dst_wrap_true());
|
||||
}
|
||||
|
||||
static int dst_strict_notequal(DstArgs args) {
|
||||
int32_t i;
|
||||
for (i = 0; i < args.n - 1; i++) {
|
||||
if (dst_equals(args.v[i], args.v[i+1])) {
|
||||
DST_RETURN(args, dst_wrap_false());
|
||||
}
|
||||
}
|
||||
DST_RETURN(args, dst_wrap_true());
|
||||
}
|
||||
|
||||
static int dst_not(DstArgs args) {
|
||||
DST_FIXARITY(args, 1);
|
||||
DST_RETURN_BOOLEAN(args, !dst_truthy(args.v[0]));
|
||||
}
|
||||
|
||||
#define DEF_NUMERIC_COMP(name, op) \
|
||||
int dst_numeric_##name(DstArgs args) { \
|
||||
int32_t i; \
|
||||
for (i = 1; i < args.n; i++) { \
|
||||
double x = 0, y = 0; \
|
||||
DST_ARG_NUMBER(x, args, i-1);\
|
||||
DST_ARG_NUMBER(y, args, i);\
|
||||
if (!(x op y)) { \
|
||||
DST_RETURN(args, dst_wrap_false()); \
|
||||
} \
|
||||
} \
|
||||
DST_RETURN(args, dst_wrap_true()); \
|
||||
}
|
||||
|
||||
DEF_NUMERIC_COMP(gt, >)
|
||||
DEF_NUMERIC_COMP(lt, <)
|
||||
DEF_NUMERIC_COMP(lte, <=)
|
||||
DEF_NUMERIC_COMP(gte, >=)
|
||||
DEF_NUMERIC_COMP(eq, ==)
|
||||
DEF_NUMERIC_COMP(neq, !=)
|
||||
|
||||
static const DstReg cfuns[] = {
|
||||
{"%", dst_remainder},
|
||||
{"=", dst_strict_equal},
|
||||
{"not=", dst_strict_notequal},
|
||||
{"order<", dst_ascending},
|
||||
{"order>", dst_descending},
|
||||
{"order<=", dst_notdescending},
|
||||
{"order>=", dst_notascending},
|
||||
{"==", dst_numeric_eq},
|
||||
{"not==", dst_numeric_neq},
|
||||
{"<", dst_numeric_lt},
|
||||
{">", dst_numeric_gt},
|
||||
{"<=", dst_numeric_lte},
|
||||
{">=", dst_numeric_gte},
|
||||
{"~", dst_bnot},
|
||||
{"not", dst_not},
|
||||
{"int", dst_int},
|
||||
{"real", dst_real},
|
||||
|
@ -153,6 +153,9 @@ static int os_getenv(DstArgs args) {
|
||||
DST_ARG_STRING(k, args, 0);
|
||||
const char *cstr = (const char *) k;
|
||||
const char *res = getenv(cstr);
|
||||
if (!res) {
|
||||
DST_RETURN_NIL(args);
|
||||
}
|
||||
DST_RETURN(args, cstr
|
||||
? dst_cstringv(res)
|
||||
: dst_wrap_nil());
|
||||
@ -195,10 +198,28 @@ static int os_exit(DstArgs args) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Clock shim for windows */
|
||||
#ifdef DST_WINDOWS
|
||||
static int clock_gettime(int x, struct timespec *spec) {
|
||||
(void) x;
|
||||
int64_t wintime = 0LL;
|
||||
GetSystemTimeAsFileTime((FILETIME*)&wintime);
|
||||
/* Windows epoch is January 1, 1601 apparently*/
|
||||
wintime -= 116444736000000000LL;
|
||||
spec->tv_sec = wintime / 10000000LL;
|
||||
/* Resolution is 100 nanoseconds. */
|
||||
spec->tv_nsec = wintime % 10000000LL * 100;
|
||||
return 0;
|
||||
}
|
||||
#define CLOCK_MONOTONIC 0
|
||||
#endif
|
||||
|
||||
static int os_clock(DstArgs args) {
|
||||
DST_FIXARITY(args, 0);
|
||||
clock_t time = clock();
|
||||
double dtime = time / (double) (CLOCKS_PER_SEC);
|
||||
struct timespec tv;
|
||||
if (clock_gettime(CLOCK_MONOTONIC, &tv))
|
||||
DST_THROW(args, "could not get time");
|
||||
double dtime = tv.tv_sec + (tv.tv_nsec / 1E9);
|
||||
DST_RETURN_REAL(args, dtime);
|
||||
}
|
||||
|
||||
|
@ -419,7 +419,7 @@ static int longstring(DstParser *p, DstParseState *state, uint8_t c) {
|
||||
} else if (state->flags & PFLAG_END_CANDIDATE) {
|
||||
int i;
|
||||
/* We are checking a potential end of the string */
|
||||
if (c != '`' && state->qcount == state->argn) {
|
||||
if (state->qcount == state->argn) {
|
||||
stringend(p, state);
|
||||
return 0;
|
||||
}
|
||||
|
@ -26,7 +26,7 @@
|
||||
#include "vector.h"
|
||||
#include "emit.h"
|
||||
|
||||
DstSlot dstc_quote(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
static DstSlot dstc_quote(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
if (argn != 1) {
|
||||
dstc_cerror(opts.compiler, "expected 1 argument");
|
||||
return dstc_cslot(dst_wrap_nil());
|
||||
@ -91,7 +91,7 @@ static int destructure(DstCompiler *c,
|
||||
}
|
||||
}
|
||||
|
||||
DstSlot dstc_varset(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
static DstSlot dstc_varset(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
DstFopts subopts = dstc_fopts_default(opts.compiler);
|
||||
DstSlot ret, dest;
|
||||
Dst head;
|
||||
@ -189,7 +189,7 @@ static int varleaf(
|
||||
}
|
||||
}
|
||||
|
||||
DstSlot dstc_var(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
static DstSlot dstc_var(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
DstCompiler *c = opts.compiler;
|
||||
Dst head;
|
||||
DstSlot ret = dohead(c, opts, &head, argn, argv);
|
||||
@ -222,7 +222,7 @@ static int defleaf(
|
||||
}
|
||||
}
|
||||
|
||||
DstSlot dstc_def(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
static DstSlot dstc_def(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
DstCompiler *c = opts.compiler;
|
||||
Dst head;
|
||||
opts.flags &= ~DST_FOPTS_HINT;
|
||||
@ -245,13 +245,13 @@ DstSlot dstc_def(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
* ...
|
||||
* :done
|
||||
*/
|
||||
DstSlot dstc_if(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
static DstSlot dstc_if(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
DstCompiler *c = opts.compiler;
|
||||
int32_t labelr, labeljr, labeld, labeljd;
|
||||
DstFopts condopts, bodyopts;
|
||||
DstSlot cond, left, right, target;
|
||||
Dst truebody, falsebody;
|
||||
DstScope tempscope;
|
||||
DstScope condscope, tempscope;
|
||||
const int tail = opts.flags & DST_FOPTS_TAIL;
|
||||
const int drop = opts.flags & DST_FOPTS_DROP;
|
||||
|
||||
@ -268,7 +268,13 @@ DstSlot dstc_if(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
condopts = dstc_fopts_default(c);
|
||||
bodyopts = opts;
|
||||
|
||||
/* Set target for compilation */
|
||||
target = (drop || tail)
|
||||
? dstc_cslot(dst_wrap_nil())
|
||||
: dstc_gettarget(opts);
|
||||
|
||||
/* Compile condition */
|
||||
dstc_scope(&condscope, c, 0, "if");
|
||||
cond = dstc_value(condopts, argv[0]);
|
||||
|
||||
/* Check constant condition. */
|
||||
@ -283,15 +289,11 @@ DstSlot dstc_if(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
dstc_scope(&tempscope, c, 0, "if-body");
|
||||
target = dstc_value(bodyopts, truebody);
|
||||
dstc_popscope(c);
|
||||
dstc_popscope(c);
|
||||
dstc_throwaway(bodyopts, falsebody);
|
||||
return target;
|
||||
}
|
||||
|
||||
/* Set target for compilation */
|
||||
target = (drop || tail)
|
||||
? dstc_cslot(dst_wrap_nil())
|
||||
: dstc_gettarget(opts);
|
||||
|
||||
/* Compile jump to right */
|
||||
labeljr = dstc_emit_si(c, DOP_JUMP_IF_NOT, cond, 0, 0);
|
||||
|
||||
@ -312,6 +314,9 @@ DstSlot dstc_if(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
if (!drop && !tail) dstc_copy(c, target, right);
|
||||
dstc_popscope(c);
|
||||
|
||||
/* Pop main scope */
|
||||
dstc_popscope(c);
|
||||
|
||||
/* Write jumps - only add jump lengths if jump actually emitted */
|
||||
labeld = dst_v_count(c->buffer);
|
||||
c->buffer[labeljr] |= (labelr - labeljr) << 16;
|
||||
@ -323,7 +328,7 @@ DstSlot dstc_if(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
|
||||
/* Compile a do form. Do forms execute their body sequentially and
|
||||
* evaluate to the last expression in the body. */
|
||||
DstSlot dstc_do(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
static DstSlot dstc_do(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
int32_t i;
|
||||
DstSlot ret = dstc_cslot(dst_wrap_nil());
|
||||
DstCompiler *c = opts.compiler;
|
||||
@ -345,6 +350,19 @@ DstSlot dstc_do(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Add a funcdef to the top most function scope */
|
||||
static int32_t dstc_addfuncdef(DstCompiler *c, DstFuncDef *def) {
|
||||
DstScope *scope = c->scope;
|
||||
while (scope) {
|
||||
if (scope->flags & DST_SCOPE_FUNCTION)
|
||||
break;
|
||||
scope = scope->parent;
|
||||
}
|
||||
dst_assert(scope, "could not add funcdef");
|
||||
dst_v_push(scope->defs, def);
|
||||
return dst_v_count(scope->defs) - 1;
|
||||
}
|
||||
|
||||
/*
|
||||
* :whiletop
|
||||
* ...
|
||||
@ -354,7 +372,7 @@ DstSlot dstc_do(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
* jump :whiletop
|
||||
* :done
|
||||
*/
|
||||
DstSlot dstc_while(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
static DstSlot dstc_while(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
DstCompiler *c = opts.compiler;
|
||||
DstSlot cond;
|
||||
DstFopts subopts = dstc_fopts_default(c);
|
||||
@ -369,6 +387,8 @@ DstSlot dstc_while(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
|
||||
labelwt = dst_v_count(c->buffer);
|
||||
|
||||
dstc_scope(&tempscope, c, 0, "while");
|
||||
|
||||
/* Compile condition */
|
||||
cond = dstc_value(subopts, argv[0]);
|
||||
|
||||
@ -376,20 +396,17 @@ DstSlot dstc_while(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
if (cond.flags & DST_SLOT_CONSTANT) {
|
||||
/* Loop never executes */
|
||||
if (!dst_truthy(cond.constant)) {
|
||||
dstc_popscope(c);
|
||||
return dstc_cslot(dst_wrap_nil());
|
||||
}
|
||||
/* Infinite loop */
|
||||
infinite = 1;
|
||||
}
|
||||
|
||||
dstc_scope(&tempscope, c, 0, "while");
|
||||
|
||||
/* Infinite loop does not need to check condition */
|
||||
if (!infinite) {
|
||||
labelc = dstc_emit_si(c, DOP_JUMP_IF_NOT, cond, 0, 0);
|
||||
} else {
|
||||
labelc = 0;
|
||||
}
|
||||
labelc = infinite
|
||||
? 0
|
||||
: dstc_emit_si(c, DOP_JUMP_IF_NOT, cond, 0, 0);
|
||||
|
||||
/* Compile body */
|
||||
for (i = 1; i < argn; i++) {
|
||||
@ -397,6 +414,44 @@ DstSlot dstc_while(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
dstc_freeslot(c, dstc_value(subopts, argv[i]));
|
||||
}
|
||||
|
||||
/* Check if closure created in while scope. If so,
|
||||
* recompile in a function scope. */
|
||||
if (tempscope.flags & DST_SCOPE_CLOSURE) {
|
||||
tempscope.flags |= DST_SCOPE_UNUSED;
|
||||
dstc_popscope(c);
|
||||
dst_v__cnt(c->buffer) = labelwt;
|
||||
dst_v__cnt(c->mapbuffer) = labelwt;
|
||||
|
||||
dstc_scope(&tempscope, c, DST_SCOPE_FUNCTION, "while-iife");
|
||||
|
||||
/* Recompile in the function scope */
|
||||
cond = dstc_value(subopts, argv[0]);
|
||||
if (!(cond.flags & DST_SLOT_CONSTANT)) {
|
||||
/* If not an infinte loop, return nil when condition false */
|
||||
dstc_emit_si(c, DOP_JUMP_IF, cond, 2, 0);
|
||||
dstc_emit(c, DOP_RETURN_NIL);
|
||||
}
|
||||
for (i = 1; i < argn; i++) {
|
||||
subopts.flags = DST_FOPTS_DROP;
|
||||
dstc_freeslot(c, dstc_value(subopts, argv[i]));
|
||||
}
|
||||
/* But now add tail recursion */
|
||||
int32_t tempself = dstc_regalloc_temp(&tempscope.ra, DSTC_REGTEMP_0);
|
||||
dstc_emit(c, DOP_LOAD_SELF | (tempself << 8));
|
||||
dstc_emit(c, DOP_TAILCALL | (tempself << 8));
|
||||
/* Compile function */
|
||||
DstFuncDef *def = dstc_pop_funcdef(c);
|
||||
def->name = dst_cstring("_while");
|
||||
int32_t defindex = dstc_addfuncdef(c, def);
|
||||
/* And then load the closure and call it. */
|
||||
int32_t cloreg = dstc_regalloc_temp(&c->scope->ra, DSTC_REGTEMP_0);
|
||||
dstc_emit(c, DOP_CLOSURE | (cloreg << 8) | (defindex << 16));
|
||||
dstc_emit(c, DOP_CALL | (cloreg << 8) | (cloreg << 16));
|
||||
dstc_regalloc_free(&c->scope->ra, cloreg);
|
||||
c->scope->flags |= DST_SCOPE_CLOSURE;
|
||||
return dstc_cslot(dst_wrap_nil());
|
||||
}
|
||||
|
||||
/* Compile jump to whiletop */
|
||||
labeljt = dst_v_count(c->buffer);
|
||||
dstc_emit(c, DOP_JUMP);
|
||||
@ -412,20 +467,7 @@ DstSlot dstc_while(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
return dstc_cslot(dst_wrap_nil());
|
||||
}
|
||||
|
||||
/* Add a funcdef to the top most function scope */
|
||||
static int32_t dstc_addfuncdef(DstCompiler *c, DstFuncDef *def) {
|
||||
DstScope *scope = c->scope;
|
||||
while (scope) {
|
||||
if (scope->flags & DST_SCOPE_FUNCTION)
|
||||
break;
|
||||
scope = scope->parent;
|
||||
}
|
||||
dst_assert(scope, "could not add funcdef");
|
||||
dst_v_push(scope->defs, def);
|
||||
return dst_v_count(scope->defs) - 1;
|
||||
}
|
||||
|
||||
DstSlot dstc_fn(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
static DstSlot dstc_fn(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
DstCompiler *c = opts.compiler;
|
||||
DstFuncDef *def;
|
||||
DstSlot ret;
|
||||
@ -439,6 +481,7 @@ DstSlot dstc_fn(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
int selfref = 0;
|
||||
|
||||
/* Begin function */
|
||||
c->scope->flags |= DST_SCOPE_CLOSURE;
|
||||
dstc_scope(&fnscope, c, DST_SCOPE_FUNCTION, "function");
|
||||
|
||||
if (argn < 2) {
|
||||
@ -506,7 +549,14 @@ DstSlot dstc_fn(DstFopts opts, int32_t argn, const Dst *argv) {
|
||||
/* Build function */
|
||||
def = dstc_pop_funcdef(c);
|
||||
def->arity = arity;
|
||||
if (varargs) def->flags |= DST_FUNCDEF_FLAG_VARARG;
|
||||
|
||||
/* Tuples indicated fixed arity, arrays indicate flexible arity */
|
||||
/* TODO - revisit this */
|
||||
if (varargs)
|
||||
def->flags |= DST_FUNCDEF_FLAG_VARARG;
|
||||
else if (dst_checktype(paramv, DST_TUPLE))
|
||||
def->flags |= DST_FUNCDEF_FLAG_FIXARITY;
|
||||
|
||||
if (selfref) def->name = dst_unwrap_symbol(head);
|
||||
defindex = dstc_addfuncdef(c, def);
|
||||
|
||||
|
@ -356,6 +356,19 @@ void dst_description_b(DstBuffer *buffer, Dst x) {
|
||||
}
|
||||
goto fallthrough;
|
||||
}
|
||||
case DST_FUNCTION:
|
||||
{
|
||||
DstFunction *fun = dst_unwrap_function(x);
|
||||
DstFuncDef *def = fun->def;
|
||||
if (def->name) {
|
||||
const uint8_t *n = def->name;
|
||||
dst_buffer_push_cstring(buffer, "<function ");
|
||||
dst_buffer_push_bytes(buffer, n, dst_string_length(n));
|
||||
dst_buffer_push_u8(buffer, '>');
|
||||
break;
|
||||
}
|
||||
goto fallthrough;
|
||||
}
|
||||
fallthrough:
|
||||
default:
|
||||
string_description_b(buffer, dst_type_names[dst_type(x)] + 1, dst_unwrap_pointer(x));
|
||||
@ -423,6 +436,15 @@ const uint8_t *dst_description(Dst x) {
|
||||
}
|
||||
goto fallthrough;
|
||||
}
|
||||
case DST_FUNCTION:
|
||||
{
|
||||
DstFunction *fun = dst_unwrap_function(x);
|
||||
DstFuncDef *def = fun->def;
|
||||
if (def->name) {
|
||||
return dst_formatc("<function %S>", def->name);
|
||||
}
|
||||
goto fallthrough;
|
||||
}
|
||||
fallthrough:
|
||||
default:
|
||||
return string_description(dst_type_names[dst_type(x)] + 1, dst_unwrap_pointer(x));
|
||||
|
@ -209,8 +209,10 @@ static void inc_gensym(void) {
|
||||
for (int i = sizeof(gensym_counter) - 2; i; i--) {
|
||||
if (gensym_counter[i] == '9') {
|
||||
gensym_counter[i] = 'a';
|
||||
break;
|
||||
} else if (gensym_counter[i] == 'z') {
|
||||
gensym_counter[i] = 'A';
|
||||
break;
|
||||
} else if (gensym_counter[i] == 'Z') {
|
||||
gensym_counter[i] = '0';
|
||||
} else {
|
||||
|
@ -190,6 +190,11 @@ static void *op_lookup[255] = {
|
||||
&&label_DOP_MAKE_STRUCT,
|
||||
&&label_DOP_MAKE_TABLE,
|
||||
&&label_DOP_MAKE_TUPLE,
|
||||
&&label_DOP_NUMERIC_LESS_THAN,
|
||||
&&label_DOP_NUMERIC_LESS_THAN_EQUAL,
|
||||
&&label_DOP_NUMERIC_GREATER_THAN,
|
||||
&&label_DOP_NUMERIC_GREATER_THAN_EQUAL,
|
||||
&&label_DOP_NUMERIC_EQUAL,
|
||||
&&label_unknown_op
|
||||
};
|
||||
#else
|
||||
@ -257,6 +262,23 @@ static void *op_lookup[255] = {
|
||||
vm_next();\
|
||||
}
|
||||
|
||||
#define vm_numcomp(op)\
|
||||
{\
|
||||
Dst op1 = stack[oparg(2, 0xFF)];\
|
||||
Dst op2 = stack[oparg(3, 0xFF)];\
|
||||
vm_assert_types(op1, DST_TFLAG_NUMBER);\
|
||||
vm_assert_types(op2, DST_TFLAG_NUMBER);\
|
||||
stack[oparg(1, 0xFF)] = dst_wrap_boolean(dst_checktype(op1, DST_INTEGER)\
|
||||
? (dst_checktype(op2, DST_INTEGER)\
|
||||
? dst_unwrap_integer(op1) op dst_unwrap_integer(op2)\
|
||||
: (double)dst_unwrap_integer(op1) op dst_unwrap_real(op2))\
|
||||
: (dst_checktype(op2, DST_INTEGER)\
|
||||
? dst_unwrap_real(op1) op (double)dst_unwrap_integer(op2)\
|
||||
: dst_unwrap_real(op1) op dst_unwrap_real(op2)));\
|
||||
pc++;\
|
||||
vm_next();\
|
||||
}
|
||||
|
||||
/* Main interpreter loop. Semantically is a switch on
|
||||
* (*pc & 0xFF) inside of an infinte loop. */
|
||||
VM_START();
|
||||
@ -325,6 +347,21 @@ static void *op_lookup[255] = {
|
||||
VM_OP(DOP_MULTIPLY)
|
||||
vm_binop(*);
|
||||
|
||||
VM_OP(DOP_NUMERIC_LESS_THAN)
|
||||
vm_numcomp(<);
|
||||
|
||||
VM_OP(DOP_NUMERIC_LESS_THAN_EQUAL)
|
||||
vm_numcomp(<=);
|
||||
|
||||
VM_OP(DOP_NUMERIC_GREATER_THAN)
|
||||
vm_numcomp(>);
|
||||
|
||||
VM_OP(DOP_NUMERIC_GREATER_THAN_EQUAL)
|
||||
vm_numcomp(>=);
|
||||
|
||||
VM_OP(DOP_NUMERIC_EQUAL)
|
||||
vm_numcomp(==);
|
||||
|
||||
VM_OP(DOP_DIVIDE_INTEGER)
|
||||
vm_assert(dst_unwrap_integer(stack[oparg(3, 0xFF)]) != 0, "integer divide error");
|
||||
vm_assert(!(dst_unwrap_integer(stack[oparg(3, 0xFF)]) == -1 &&
|
||||
@ -385,6 +422,7 @@ static void *op_lookup[255] = {
|
||||
|
||||
VM_OP(DOP_BNOT)
|
||||
stack[oparg(1, 0xFF)] = dst_wrap_integer(~dst_unwrap_integer(stack[oparg(2, 0xFFFF)]));
|
||||
++pc;
|
||||
vm_next();
|
||||
|
||||
VM_OP(DOP_SHIFT_RIGHT_UNSIGNED)
|
||||
@ -730,7 +768,8 @@ static void *op_lookup[255] = {
|
||||
if (dst_checktype(callee, DST_FUNCTION)) {
|
||||
func = dst_unwrap_function(callee);
|
||||
dst_stack_frame(stack)->pc = pc;
|
||||
dst_fiber_funcframe(fiber, func);
|
||||
if (dst_fiber_funcframe(fiber, func))
|
||||
goto vm_arity_error;
|
||||
stack = fiber->data + fiber->frame;
|
||||
pc = func->def->bytecode;
|
||||
vm_checkgc_next();
|
||||
@ -756,7 +795,8 @@ static void *op_lookup[255] = {
|
||||
Dst callee = stack[oparg(1, 0xFFFFFF)];
|
||||
if (dst_checktype(callee, DST_FUNCTION)) {
|
||||
func = dst_unwrap_function(callee);
|
||||
dst_fiber_funcframe_tail(fiber, func);
|
||||
if (dst_fiber_funcframe_tail(fiber, func))
|
||||
goto vm_arity_error;
|
||||
stack = fiber->data + fiber->frame;
|
||||
pc = func->def->bytecode;
|
||||
vm_checkgc_next();
|
||||
@ -1152,6 +1192,19 @@ static void *op_lookup[255] = {
|
||||
goto vm_reset;
|
||||
}
|
||||
|
||||
/* Handle function calls with bad arity */
|
||||
vm_arity_error:
|
||||
{
|
||||
int32_t nargs = fiber->stacktop - fiber->stackstart;
|
||||
retreg = dst_wrap_string(dst_formatc("%V called with %d argument%s, expected %d",
|
||||
dst_wrap_function(func),
|
||||
nargs,
|
||||
nargs == 1 ? "" : "s",
|
||||
func->def->arity));
|
||||
signal = DST_SIGNAL_ERROR;
|
||||
goto vm_exit;
|
||||
}
|
||||
|
||||
/* Resume a child fiber */
|
||||
vm_resume_child:
|
||||
{
|
||||
@ -1255,14 +1308,17 @@ DstSignal dst_call(
|
||||
*f = fiber;
|
||||
for (i = 0; i < argn; i++)
|
||||
dst_fiber_push(fiber, argv[i]);
|
||||
dst_fiber_funcframe(fiber, fiber->root);
|
||||
if (dst_fiber_funcframe(fiber, fiber->root)) {
|
||||
*out = dst_cstringv("arity mismatch");
|
||||
return DST_SIGNAL_ERROR;
|
||||
}
|
||||
/* Prevent push an extra value on the stack */
|
||||
dst_fiber_set_status(fiber, DST_STATUS_PENDING);
|
||||
return dst_continue(fiber, dst_wrap_nil(), out);
|
||||
}
|
||||
|
||||
/* Setup VM */
|
||||
int dst_init() {
|
||||
int dst_init(void) {
|
||||
/* Garbage collection */
|
||||
dst_vm_blocks = NULL;
|
||||
dst_vm_next_collection = 0;
|
||||
@ -1283,7 +1339,7 @@ int dst_init() {
|
||||
}
|
||||
|
||||
/* Clear all memory associated with the VM */
|
||||
void dst_deinit() {
|
||||
void dst_deinit(void) {
|
||||
dst_clear_memory();
|
||||
dst_symcache_deinit();
|
||||
free(dst_vm_roots);
|
||||
|
@ -515,9 +515,9 @@ Dst dst_wrap_abstract(void *x);
|
||||
|
||||
/* Hold components of arguments passed to DstCFunction. */
|
||||
struct DstArgs {
|
||||
int32_t n;
|
||||
Dst *v;
|
||||
Dst *ret;
|
||||
int32_t n;
|
||||
};
|
||||
|
||||
/* Fiber flags */
|
||||
@ -811,6 +811,11 @@ enum DstOpCode {
|
||||
DOP_MAKE_STRUCT,
|
||||
DOP_MAKE_TABLE,
|
||||
DOP_MAKE_TUPLE,
|
||||
DOP_NUMERIC_LESS_THAN,
|
||||
DOP_NUMERIC_LESS_THAN_EQUAL,
|
||||
DOP_NUMERIC_GREATER_THAN,
|
||||
DOP_NUMERIC_GREATER_THAN_EQUAL,
|
||||
DOP_NUMERIC_EQUAL,
|
||||
DOP_INSTRUCTION_COUNT
|
||||
};
|
||||
|
||||
@ -855,16 +860,16 @@ enum DstCompileStatus {
|
||||
DST_COMPILE_ERROR
|
||||
};
|
||||
struct DstCompileResult {
|
||||
enum DstCompileStatus status;
|
||||
DstFuncDef *funcdef;
|
||||
const uint8_t *error;
|
||||
DstFiber *macrofiber;
|
||||
DstSourceMapping error_mapping;
|
||||
enum DstCompileStatus status;
|
||||
};
|
||||
DstCompileResult dst_compile(Dst source, DstTable *env, const uint8_t *where);
|
||||
|
||||
/* Get the default environment for dst */
|
||||
DstTable *dst_stl_env();
|
||||
DstTable *dst_core_env(void);
|
||||
|
||||
int dst_dobytes(DstTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath);
|
||||
int dst_dostring(DstTable *env, const char *str, const char *sourcePath);
|
||||
@ -939,7 +944,7 @@ void dst_puts(const uint8_t *str);
|
||||
const uint8_t *dst_symbol(const uint8_t *str, int32_t len);
|
||||
const uint8_t *dst_symbol_from_string(const uint8_t *str);
|
||||
const uint8_t *dst_csymbol(const char *str);
|
||||
const uint8_t *dst_symbol_gen();
|
||||
const uint8_t *dst_symbol_gen(void);
|
||||
#define dst_symbolv(str, len) dst_wrap_symbol(dst_symbol((str), (len)))
|
||||
#define dst_csymbolv(cstr) dst_wrap_symbol(dst_csymbol(cstr))
|
||||
|
||||
@ -1033,10 +1038,6 @@ void dst_env_cfuns(DstTable *env, const DstReg *cfuns);
|
||||
DstBindingType dst_env_resolve(DstTable *env, const uint8_t *sym, Dst *out);
|
||||
DstTable *dst_env_arg(DstArgs args);
|
||||
|
||||
/* STL */
|
||||
#define DST_STL_NOGCROOT 1
|
||||
DstTable *dst_stl_env(int flags);
|
||||
|
||||
/* C Function helpers */
|
||||
int dst_arity_err(DstArgs args, int32_t n, const char *prefix);
|
||||
int dst_type_err(DstArgs args, int32_t n, DstType expected);
|
||||
@ -1058,6 +1059,9 @@ int dst_lib_parse(DstArgs args);
|
||||
int dst_lib_asm(DstArgs args);
|
||||
int dst_lib_compile(DstArgs args);
|
||||
|
||||
/* Helpers for writing modules */
|
||||
#define DST_MODULE_ENTRY int _dst_init
|
||||
|
||||
/***** END SECTION MAIN *****/
|
||||
|
||||
/***** START SECTION MACROS *****/
|
||||
@ -1151,7 +1155,7 @@ int dst_lib_compile(DstArgs args);
|
||||
#define DST_ARG_CFUNCTION(DEST, A, N) _DST_ARG(DST_CFUNCTION, cfunction, DEST, A, N)
|
||||
#define DST_ARG_ABSTRACT(DEST, A, N) _DST_ARG(DST_ABSTRACT, abstract, DEST, A, N)
|
||||
|
||||
#define DST_RETURN_NIL(A) return DST_SIGNAL_OK
|
||||
#define DST_RETURN_NIL(A) do { return DST_SIGNAL_OK; } while (0)
|
||||
#define DST_RETURN_FALSE(A) DST_RETURN(A, dst_wrap_false())
|
||||
#define DST_RETURN_TRUE(A) DST_RETURN(A, dst_wrap_true())
|
||||
#define DST_RETURN_BOOLEAN(A, X) DST_RETURN(A, dst_wrap_boolean(X))
|
||||
|
@ -1,5 +1,5 @@
|
||||
# Copyright 2017-2018 (C) Calvin Rose
|
||||
(table.setproto @{ 1 2} @{})
|
||||
|
||||
(do
|
||||
|
||||
(var *should-repl* :private false)
|
||||
@ -23,17 +23,17 @@
|
||||
-- Stop handling options`)
|
||||
(os.exit 0)
|
||||
1)
|
||||
"v" (fn [] (print VERSION) (os.exit 0) 1)
|
||||
"s" (fn [] (:= *raw-stdin* true) (:= *should-repl* true) 1)
|
||||
"r" (fn [] (:= *should-repl* true) 1)
|
||||
"p" (fn [] (:= *exit-on-error* false) 1)
|
||||
"-" (fn [] (:= *handleopts* false) 1)
|
||||
"e" (fn [i]
|
||||
"v" (fn @[] (print VERSION) (os.exit 0) 1)
|
||||
"s" (fn @[] (:= *raw-stdin* true) (:= *should-repl* true) 1)
|
||||
"r" (fn @[] (:= *should-repl* true) 1)
|
||||
"p" (fn @[] (:= *exit-on-error* false) 1)
|
||||
"-" (fn @[] (:= *handleopts* false) 1)
|
||||
"e" (fn @[i]
|
||||
(:= *no-file* false)
|
||||
(eval (get args (+ i 1)))
|
||||
2)})
|
||||
|
||||
(defn- dohandler [n i]
|
||||
(defn- dohandler @[n i]
|
||||
(def h (get handlers n))
|
||||
(if h (h i) (print "unknown flag -" n)))
|
||||
|
||||
|
@ -32,7 +32,7 @@ int main(int argc, char **argv) {
|
||||
|
||||
/* Set up VM */
|
||||
dst_init();
|
||||
env = dst_stl_env(0);
|
||||
env = dst_core_env();
|
||||
|
||||
/* Create args tuple */
|
||||
args = dst_array(argc);
|
||||
|
@ -155,7 +155,7 @@
|
||||
|
||||
# yield tests
|
||||
|
||||
(def t (fiber.new (fn [] (yield 1) (yield 2) 3)))
|
||||
(def t (fiber.new (fn @[] (yield 1) (yield 2) 3)))
|
||||
|
||||
(assert (= 1 (resume t)) "initial transfer to new fiber")
|
||||
(assert (= 2 (resume t)) "second transfer to fiber")
|
||||
|
@ -43,7 +43,7 @@
|
||||
(defn assert-many [f n e]
|
||||
(var good true)
|
||||
(loop [i :range [0 n]]
|
||||
(if (not (f i))
|
||||
(if (not (f))
|
||||
(:= good false)))
|
||||
(assert good e))
|
||||
|
||||
@ -76,9 +76,9 @@
|
||||
# More fiber semantics
|
||||
|
||||
(var myvar 0)
|
||||
(defn fiberstuff []
|
||||
(defn fiberstuff @[]
|
||||
(++ myvar)
|
||||
(def f (fiber.new (fn [] (++ myvar) (debug) (++ myvar))))
|
||||
(def f (fiber.new (fn @[] (++ myvar) (debug) (++ myvar))))
|
||||
(resume f)
|
||||
(++ myvar))
|
||||
|
||||
@ -198,4 +198,16 @@
|
||||
(def xs (apply1 tuple (for [x :range [0 10] :when (even? x)] (tuple (/ x 2) x))))
|
||||
(assert (= xs '((0 0) (1 2) (2 4) (3 6) (4 8))) "for macro 1")
|
||||
|
||||
# Some testing for not=
|
||||
(assert (not= 1 1 0) "not= 1")
|
||||
(assert (not= 0 1 1) "not= 2")
|
||||
|
||||
# Closure in while loop
|
||||
(def closures (for [i :range [0 5]] (fn [] i)))
|
||||
(assert (= 0 ((get closures 0))) "closure in loop 0")
|
||||
(assert (= 1 ((get closures 1))) "closure in loop 1")
|
||||
(assert (= 2 ((get closures 2))) "closure in loop 2")
|
||||
(assert (= 3 ((get closures 3))) "closure in loop 3")
|
||||
(assert (= 4 ((get closures 4))) "closure in loop 4")
|
||||
|
||||
(end-suite)
|
||||
|
Loading…
Reference in New Issue
Block a user