mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-06-21 12:43:15 +00:00
Code Issues 1 Releases Wiki Activity

Use fewer special forms in c compiler. This should

Browse Source 
make the self hosted compiler easier to make. The
C version of the compiler does not need to be efficient.
This commit is contained in:
Calvin Rose 2017-04-12 10:31:50 -04:00
parent a0d3600ac0
commit ded3d06387
11 changed files with 634 additions and 859 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

278
core/compile.c
View File

@ -442,192 +442,6 @@ static Slot compile_symbol(GstCompiler *c, FormOptions opts, GstValue sym) {
return ret;
}
/* Compile values in a sequence and track the returned slots.
* If the result is unused, immediately drop slots we don't need. Can
* also ignore the end of the tuple sequence. */
static void tracker_init_tuple(GstCompiler *c, FormOptions opts,
SlotTracker *tracker, GstValue *tuple, uint32_t start, uint32_t fromEnd) {
GstScope *scope = c->tail;
FormOptions subOpts = form_options_default();
uint32_t i, count;
count = gst_tuple_length(tuple);
/* Calculate sub flags */
subOpts.resultUnused = opts.resultUnused;
/* Compile all of the arguments */
tracker_init(c, tracker);
/* Nothing to compile */
if (count <= fromEnd) return;
/* Compile body of array */
for (i = start; i < (count - fromEnd); ++i) {
Slot slot = compile_value(c, subOpts, tuple[i]);
if (subOpts.resultUnused)
compiler_drop_slot(c, scope, slot);
else
compiler_tracker_push(c, tracker, compiler_realize_slot(c, slot));
}
}
/* Define some flags for operators */
#define OP_REVERSE 1
#define OP_FOLD 2
#define OP_DEFAULT_INT 4
#define OP_1_REPEAT 8
#define OP_1_BOOLEAN 16
#define OP_0_BOOLEAN 32
/* Compile a special form in the form of an operator. There
* are four choices for opcodes - when the operator is called
* with 0, 1, 2, or n arguments. When the operator form is
* called with n arguments, the number of arguments is written
* after the op code, followed by those arguments.
*
* This function also takes flags to modify the behavior of the operators
* And give them capabilities beyond binary and unary operator. */
static Slot compile_operator(GstCompiler *c, FormOptions opts, GstValue *form,
int16_t op0, int16_t op1, int16_t op2, int16_t opn, int flags) {
GstScope *scope = c->tail;
GstBuffer *buffer = c->buffer;
Slot ret;
SlotTracker tracker;
uint32_t count = gst_tuple_length(form);
/* Check for some early exit conditions */
if (count == 2 && (flags & OP_1_REPEAT)) {
return compile_value(c, opts, form[1]);
}
if (opts.resultUnused) {
ret = nil_slot();
} else {
ret = compiler_get_target(c, opts);
/* Write the correct opcode */
if (count < 2) {
if (flags & OP_DEFAULT_INT) {
gst_buffer_push_u16(c->vm, buffer, GST_OP_I16);
gst_buffer_push_u16(c->vm, buffer, ret.index);
gst_buffer_push_i16(c->vm, buffer, op0);
} else if (flags & OP_0_BOOLEAN) {
gst_buffer_push_u16(c->vm, buffer, op0 ? GST_OP_TRU : GST_OP_FLS);
gst_buffer_push_u16(c->vm, buffer, ret.index);
} else if (op0 < 0) {
if (opn < 0) c_error(c, "this operator does not take 0 arguments");
goto opn;
} else {
gst_buffer_push_u16(c->vm, buffer, op0);
gst_buffer_push_u16(c->vm, buffer, ret.index);
}
} else if (count == 2) {
if (flags & OP_1_BOOLEAN) {
gst_buffer_push_u16(c->vm, buffer, op1 ? GST_OP_TRU : GST_OP_FLS);
gst_buffer_push_u16(c->vm, buffer, ret.index);
return ret;
} else if (op1 < 0) {
if (opn < 0) c_error(c, "this operator does not take 1 argument");
goto opn;
} else {
tracker_init_tuple(c, opts, &tracker, form, 1, 0);
compiler_tracker_free(c, scope, &tracker);
gst_buffer_push_u16(c->vm, buffer, op1);
gst_buffer_push_u16(c->vm, buffer, ret.index);
compiler_tracker_write(c, &tracker, flags & OP_REVERSE);
}
} else if (count == 3) {
if (op2 < 0) {
if (opn < 0) c_error(c, "this operator does not take 2 arguments");
goto opn;
} else {
tracker_init_tuple(c, opts, &tracker, form, 1, 0);
compiler_tracker_free(c, scope, &tracker);
gst_buffer_push_u16(c->vm, buffer, op2);
gst_buffer_push_u16(c->vm, buffer, ret.index);
compiler_tracker_write(c, &tracker, flags & OP_REVERSE);
}
} else {
opn:
/* Use a left-fold for arithmetic operators */
if (flags & OP_FOLD) {
uint32_t i;
FormOptions subOpts = form_options_default();
Slot lhs = compile_value(c, subOpts, form[1]);
Slot rhs = compile_value(c, subOpts, form[2]);
gst_buffer_push_u16(c->vm, buffer, op2);
gst_buffer_push_u16(c->vm, buffer, ret.index);
gst_buffer_push_u16(c->vm, buffer, lhs.index);
gst_buffer_push_u16(c->vm, buffer, rhs.index);
compiler_drop_slot(c, scope, lhs);
compiler_drop_slot(c, scope, rhs);
for (i = 3; i < count; ++i) {
rhs = compile_value(c, subOpts, form[i]);
gst_buffer_push_u16(c->vm, buffer, op2);
gst_buffer_push_u16(c->vm, buffer, ret.index);
gst_buffer_push_u16(c->vm, buffer, ret.index);
gst_buffer_push_u16(c->vm, buffer, rhs.index);
compiler_drop_slot(c, scope, rhs);
}
} else {
if (opn < 0) c_error(c, "this operator does not take n arguments");
tracker_init_tuple(c, opts, &tracker, form, 1, 0);
compiler_tracker_free(c, scope, &tracker);
gst_buffer_push_u16(c->vm, buffer, opn);
gst_buffer_push_u16(c->vm, buffer, ret.index);
gst_buffer_push_u16(c->vm, buffer, count - 1);
compiler_tracker_write(c, &tracker, flags & OP_REVERSE);
}
}
}
return ret;
}
/* Quickly define some specials */
#define MAKE_SPECIAL(name, op0, op1, op2, opn, flags) \
static Slot compile_##name (GstCompiler *c, FormOptions opts, GstValue *form) {\
return compile_operator(c, opts, form, (op0), (op1), (op2), (opn), (flags));\
}
MAKE_SPECIAL(addition, 0, -1, GST_OP_ADD, -1, OP_FOLD | OP_DEFAULT_INT | OP_1_REPEAT)
MAKE_SPECIAL(subtraction, 0, GST_OP_NEG, GST_OP_SUB, -1, OP_FOLD | OP_DEFAULT_INT)
MAKE_SPECIAL(multiplication, 1, -1, GST_OP_MUL, -1, OP_FOLD | OP_DEFAULT_INT | OP_1_REPEAT)
MAKE_SPECIAL(division, 1, GST_OP_INV, GST_OP_DIV, -1, OP_FOLD | OP_DEFAULT_INT)
MAKE_SPECIAL(equals, 1, 1, GST_OP_EQL, -1, OP_0_BOOLEAN | OP_1_BOOLEAN)
MAKE_SPECIAL(lt, 1, 1, GST_OP_LTN, -1, OP_0_BOOLEAN | OP_1_BOOLEAN)
MAKE_SPECIAL(lte, 1, 1, GST_OP_LTE, -1, OP_0_BOOLEAN | OP_1_BOOLEAN)
MAKE_SPECIAL(gt, 1, 1, GST_OP_LTN, -1, OP_0_BOOLEAN | OP_1_BOOLEAN | OP_REVERSE)
MAKE_SPECIAL(gte, 1, 1, GST_OP_LTE, -1, OP_0_BOOLEAN | OP_1_BOOLEAN | OP_REVERSE)
MAKE_SPECIAL(not, -1, GST_OP_NOT, -1, -1, 0)
MAKE_SPECIAL(get, -1, -1, GST_OP_GET, -1, 0)
MAKE_SPECIAL(make_tuple, -1, -1, -1, GST_OP_TUP, 0)
MAKE_SPECIAL(length, -1, GST_OP_LEN, -1, -1, 0)
#undef MAKE_SPECIAL
/* Associative set */
static Slot compile_set(GstCompiler *c, FormOptions opts, GstValue *form) {
GstBuffer *buffer = c->buffer;
FormOptions subOpts = form_options_default();
Slot ds, key, val;
if (gst_tuple_length(form) != 4) c_error(c, "set expects 4 arguments");
if (opts.resultUnused) {
ds = compiler_realize_slot(c, compile_value(c, subOpts, form[1]));
} else {
subOpts = opts;
subOpts.isTail = 0;
ds = compiler_realize_slot(c, compile_value(c, subOpts, form[1]));
subOpts = form_options_default();
}
key = compiler_realize_slot(c, compile_value(c, subOpts, form[2]));
val = compiler_realize_slot(c, compile_value(c, subOpts, form[3]));
gst_buffer_push_u16(c->vm, buffer, GST_OP_SET);
gst_buffer_push_u16(c->vm, buffer, ds.index);
gst_buffer_push_u16(c->vm, buffer, key.index);
gst_buffer_push_u16(c->vm, buffer, val.index);
compiler_drop_slot(c, c->tail, key);
compiler_drop_slot(c, c->tail, val);
if (opts.resultUnused) {
compiler_drop_slot(c, c->tail, ds);
return nil_slot();
} else {
return ds;
}
}
/* Compile an assignment operation */
static Slot compile_assign(GstCompiler *c, FormOptions opts, GstValue left, GstValue right) {
GstScope *scope = c->tail;
@ -849,20 +663,6 @@ static Slot compile_if(GstCompiler *c, FormOptions opts, GstValue *form) {
return condition;
}
/* Special to throw an error */
static Slot compile_error(GstCompiler *c, FormOptions opts, GstValue *form) {
GstBuffer *buffer = c->buffer;
Slot ret;
GstValue x;
if (gst_tuple_length(form) != 2)
c_error(c, "error takes exactly 1 argument");
x = form[1];
ret = compiler_realize_slot(c, compile_value(c, opts, x));
gst_buffer_push_u16(c->vm, buffer, GST_OP_ERR);
gst_buffer_push_u16(c->vm, buffer, ret.index);
return nil_slot();
}
/* Try catch special */
static Slot compile_try(GstCompiler *c, FormOptions opts, GstValue *form) {
GstScope *scope = c->tail;
@ -1018,16 +818,9 @@ static SpecialFormHelper get_special(GstValue *form) {
* problems. */
if (gst_string_length(name) == 0)
return NULL;
/* One character specials. Mostly math. */
/* One character specials. */
if (gst_string_length(name) == 1) {
switch(name[0]) {
case '+': return compile_addition;
case '-': return compile_subtraction;
case '*': return compile_multiplication;
case '/': return compile_division;
case '>': return compile_gt;
case '<': return compile_lt;
case '=': return compile_equals;
case ':': return compile_var;
default:
break;
@ -1035,40 +828,6 @@ static SpecialFormHelper get_special(GstValue *form) {
}
/* Multi character specials. Mostly control flow. */
switch (name[0]) {
case '>':
{
if (gst_string_length(name) == 2 &&
name[1] == '=') {
return compile_gte;
}
}
break;
case '<':
{
if (gst_string_length(name) == 2 &&
name[1] == '=') {
return compile_lte;
}
}
break;
case 'e':
{
if (gst_string_length(name) == 5 &&
name[1] == 'r' &&
name[2] == 'r' &&
name[3] == 'o' &&
name[4] == 'r') {
return compile_error;
}
}
case 'g':
{
if (gst_string_length(name) == 3 &&
name[1] == 'e' &&
name[2] == 't') {
return compile_get;
}
}
case 'd':
{
if (gst_string_length(name) == 2 &&
@ -1093,26 +852,6 @@ static SpecialFormHelper get_special(GstValue *form) {
}
}
break;
case 'l':
{
if (gst_string_length(name) == 6 &&
name[1] == 'e' &&
name[2] == 'n' &&
name[3] == 'g' &&
name[4] == 't' &&
name[5] == 'h') {
return compile_length;
}
}
case 'n':
{
if (gst_string_length(name) == 3 &&
name[1] == 'o' &&
name[2] == 't') {
return compile_not;
}
}
break;
case 'q':
{
if (gst_string_length(name) == 5 &&
@ -1124,27 +863,12 @@ static SpecialFormHelper get_special(GstValue *form) {
}
}
break;
case 's':
{
if (gst_string_length(name) == 3 &&
name[1] == 'e' &&
name[2] == 't') {
return compile_set;
}
}
break;
case 't':
{
if (gst_string_length(name) == 3 &&
name[1] == 'r' &&
name[2] == 'y') {
return compile_try;
} else if (gst_string_length(name) == 5 &&
name[1] == 'u' &&
name[2] == 'p' &&
name[3] == 'l' &&
name[4] == 'e') {
return compile_make_tuple;
}
}
case 'w':

6
core/disasm.c
View File

@ -169,12 +169,6 @@ void gst_dasm(FILE * out, uint16_t *byteCode, uint32_t len) {
case GST_OP_TUP:
current += dasm_varg_op(out, current, "tuple", 1);
break;
case GST_OP_GET:
current += dasm_fixed_op(out, current, "get", 3);
break;
case GST_OP_SET:
current += dasm_fixed_op(out, current, "set", 3);
break;
case GST_OP_ERR:
current += dasm_fixed_op(out, current, "error", 1);
break;

4
core/ds.c
View File

@ -136,7 +136,7 @@ GstValue gst_array_peek(GstArray *array) {
/* Tuple functions */
/****/
/* Create a new emoty tuple of the given size. Expected to be
/* Create a new empty tuple of the given size. Expected to be
* mutated immediately */
GstValue *gst_tuple(Gst *vm, uint32_t length) {
char *data = gst_alloc(vm, 2 * sizeof(uint32_t) + length * sizeof(GstValue));
@ -171,7 +171,7 @@ GstObject* gst_object(Gst *vm, uint32_t capacity) {
o->buckets = buckets;
o->capacity = capacity;
o->count = 0;
o->meta = NULL;
o->parent = NULL;
return o;
}

112
core/gc.c
View File

@ -15,19 +15,18 @@ struct GCMemoryHeader {
/* Helper to mark function environments */
static void gst_mark_funcenv(Gst *vm, GstFuncEnv *env) {
if (gc_header(env)->color != vm->black) {
GstValue temp;
gc_header(env)->color = vm->black;
if (env->thread) {
temp.type = GST_THREAD;
temp.data.thread = env->thread;
gst_mark(vm, &temp);
GstValueUnion x;
x.thread = env->thread;
gst_mark(vm, x, GST_THREAD);
}
if (env->values) {
uint32_t count = env->stackOffset;
uint32_t i;
gc_header(env->values)->color = vm->black;
for (i = 0; i < count; ++i)
gst_mark(vm, env->values + i);
gst_mark_value(vm, env->values[i]);
}
}
}
@ -42,7 +41,7 @@ static void gst_mark_funcdef(Gst *vm, GstFuncDef *def) {
count = def->literalsLen;
gc_header(def->literals)->color = vm->black;
for (i = 0; i < count; ++i)
gst_mark(vm, def->literals + i);
gst_mark_value(vm, def->literals[i]);
}
}
}
@ -50,18 +49,23 @@ static void gst_mark_funcdef(Gst *vm, GstFuncDef *def) {
/* Helper to mark a stack frame. Returns the next stackframe. */
static GstValue *gst_mark_stackframe(Gst *vm, GstValue *stack) {
uint32_t i;
gst_mark(vm, &gst_frame_callee(stack));
gst_mark_value(vm, gst_frame_callee(stack));
if (gst_frame_env(stack) != NULL)
gst_mark_funcenv(vm, gst_frame_env(stack));
for (i = 0; i < gst_frame_size(stack); ++i)
gst_mark(vm, stack + i);
gst_mark_value(vm, stack[i]);
return stack + gst_frame_size(stack) + GST_FRAME_SIZE;
}
/* Wrapper for marking values */
void gst_mark_value(Gst *vm, GstValue x) {
gst_mark(vm, x.data, x.type);
}
/* Mark allocated memory associated with a value. This is
* the main function for doing the garbage collection mark phase. */
void gst_mark(Gst *vm, GstValue *x) {
switch (x->type) {
void gst_mark(Gst *vm, GstValueUnion x, GstType type) {
switch (type) {
case GST_NIL:
case GST_BOOLEAN:
case GST_NUMBER:
@ -70,38 +74,38 @@ void gst_mark(Gst *vm, GstValue *x) {
case GST_STRING:
case GST_SYMBOL:
gc_header(gst_string_raw(x->data.string))->color = vm->black;
gc_header(gst_string_raw(x.string))->color = vm->black;
break;
case GST_BYTEBUFFER:
gc_header(x->data.buffer)->color = vm->black;
gc_header(x->data.buffer->data)->color = vm->black;
gc_header(x.buffer)->color = vm->black;
gc_header(x.buffer->data)->color = vm->black;
break;
case GST_ARRAY:
if (gc_header(x->data.array)->color != vm->black) {
if (gc_header(x.array)->color != vm->black) {
uint32_t i, count;
count = x->data.array->count;
gc_header(x->data.array)->color = vm->black;
gc_header(x->data.array->data)->color = vm->black;
count = x.array->count;
gc_header(x.array)->color = vm->black;
gc_header(x.array->data)->color = vm->black;
for (i = 0; i < count; ++i)
gst_mark(vm, x->data.array->data + i);
gst_mark_value(vm, x.array->data[i]);
}
break;
case GST_TUPLE:
if (gc_header(gst_tuple_raw(x->data.tuple))->color != vm->black) {
if (gc_header(gst_tuple_raw(x.tuple))->color != vm->black) {
uint32_t i, count;
count = gst_tuple_length(x->data.tuple);
gc_header(gst_tuple_raw(x->data.tuple))->color = vm->black;
count = gst_tuple_length(x.tuple);
gc_header(gst_tuple_raw(x.tuple))->color = vm->black;
for (i = 0; i < count; ++i)
gst_mark(vm, x->data.tuple + i);
gst_mark_value(vm, x.tuple[i]);
}
break;
case GST_THREAD:
if (gc_header(x->data.thread)->color != vm->black) {
GstThread *thread = x->data.thread;
if (gc_header(x.thread)->color != vm->black) {
GstThread *thread = x.thread;
GstValue *frame = thread->data + GST_FRAME_SIZE;
GstValue *end = thread->data + thread->count;
gc_header(thread)->color = vm->black;
@ -112,61 +116,58 @@ void gst_mark(Gst *vm, GstValue *x) {
break;
case GST_FUNCTION:
if (gc_header(x->data.function)->color != vm->black) {
GstFunction *f = x->data.function;
if (gc_header(x.function)->color != vm->black) {
GstFunction *f = x.function;
gc_header(f)->color = vm->black;
gst_mark_funcdef(vm, f->def);
if (f->env)
gst_mark_funcenv(vm, f->env);
if (f->parent) {
GstValue temp;
temp.type = GST_FUNCTION;
temp.data.function = f->parent;
gst_mark(vm, &temp);
GstValueUnion pval;
pval.function = f->parent;
gst_mark(vm, pval, GST_FUNCTION);
}
}
break;
case GST_OBJECT:
if (gc_header(x->data.object)->color != vm->black) {
if (gc_header(x.object)->color != vm->black) {
uint32_t i;
GstBucket *bucket;
gc_header(x->data.object)->color = vm->black;
gc_header(x->data.object->buckets)->color = vm->black;
for (i = 0; i < x->data.object->capacity; ++i) {
bucket = x->data.object->buckets[i];
gc_header(x.object)->color = vm->black;
gc_header(x.object->buckets)->color = vm->black;
for (i = 0; i < x.object->capacity; ++i) {
bucket = x.object->buckets[i];
while (bucket) {
gc_header(bucket)->color = vm->black;
gst_mark(vm, &bucket->key);
gst_mark(vm, &bucket->value);
gst_mark_value(vm, bucket->key);
gst_mark_value(vm, bucket->value);
bucket = bucket->next;
}
}
if (x->data.object->meta != NULL) {
GstValue temp;
temp.type = GST_OBJECT;
temp.data.object = x->data.object->meta;
gst_mark(vm, &temp);
if (x.object->parent != NULL) {
GstValueUnion temp;
temp.object = x.object->parent;
gst_mark(vm, temp, GST_OBJECT);
}
}
break;
case GST_USERDATA:
if (gc_header(x->data.string - sizeof(GstUserdataHeader))->color != vm->black) {
GstUserdataHeader *userHeader = (GstUserdataHeader *)x->data.string - 1;
if (gc_header(x.string - sizeof(GstUserdataHeader))->color != vm->black) {
GstUserdataHeader *userHeader = (GstUserdataHeader *)x.string - 1;
gc_header(userHeader)->color = vm->black;
GstValue temp;
temp.type = GST_OBJECT;
temp.data.object = userHeader->meta;
gst_mark(vm, &temp);
GstValueUnion temp;
temp.object = userHeader->meta;
gst_mark(vm, temp, GST_OBJECT);
}
case GST_FUNCENV:
gst_mark_funcenv(vm, x->data.env);
gst_mark_funcenv(vm, x.env);
break;
case GST_FUNCDEF:
gst_mark_funcdef(vm, x->data.def);
gst_mark_funcdef(vm, x.def);
break;
}
}
@ -234,15 +235,14 @@ void gst_mem_tag(void *mem, uint32_t tags) {
/* Run garbage collection */
void gst_collect(Gst *vm) {
GstValue temp;
/* Thread can be null */
if (vm->thread) {
temp.type = GST_THREAD;
temp.data.thread = vm->thread;
gst_mark(vm, &temp);
GstValueUnion t;
t.thread = vm->thread;
gst_mark(vm, t, GST_THREAD);
}
gst_mark(vm, &vm->rootenv);
gst_mark(vm, &vm->ret);
gst_mark_value(vm, vm->rootenv);
gst_mark_value(vm, vm->ret);
gst_sweep(vm);
vm->nextCollection = 0;
}

10
core/serialize.c
View File

@ -18,7 +18,7 @@
* Byte 209: Tuple - [u32 length]*[value... elements]
* Byte 210: Thread - [u8 state][u32 frames]*[[value callee][value env]
* [u32 pcoffset][u32 erroffset][u16 ret][u16 errloc][u16 size]*[value ...stack]
* Byte 211: Object - [value meta][u32 length]*2*[value... kvs]
* Byte 211: Object - [value parent][u32 length]*2*[value... kvs]
* Byte 212: FuncDef - [u32 locals][u32 arity][u32 flags][u32 literallen]*[value...
* literals][u32 bytecodelen]*[u16... bytecode]
* Byte 213: FunEnv - [value thread][u32 length]*[value ...upvalues]
@ -245,10 +245,10 @@ static const char *gst_deserialize_impl(
case 211: /* Object */
{
GstValue meta;
GstValue parent;
ret.type = GST_OBJECT;
ret.data.object = gst_object(vm, 10);
err = gst_deserialize_impl(vm, data, end, &data, visited, &meta);
err = gst_deserialize_impl(vm, data, end, &data, visited, &parent);
if (err != NULL) return err;
read_u32(length);
for (i = 0; i < length; i += 2) {
@ -259,8 +259,8 @@ static const char *gst_deserialize_impl(
if (err != NULL) return err;
gst_object_put(vm, ret.data.object, key, value);
}
if (meta.type == GST_OBJECT)
ret.data.object->meta = meta.data.object;
if (parent.type == GST_OBJECT)
ret.data.object->parent = parent.data.object;
gst_array_push(vm, visited, ret);
}
break;

546
core/stl.c
View File

@ -3,10 +3,331 @@
#include <gst/compile.h>
#include <gst/stl.h>
static const char GST_EXPECTED_NUMBER_OP[] = "expected operand to be number";
static const char GST_EXPECTED_STRING[] = "expected string";
/***/
/* Arithmetic */
/***/
#define SIMPLE_ACCUM_FUNCTION(name, start, op)\
int gst_stl_##name(Gst* vm) {\
GstValue ret;\
uint32_t j, count;\
ret.type = GST_NUMBER;\
ret.data.number = start;\
count = gst_count_args(vm);\
for (j = 0; j < count; ++j) {\
GstValue operand = gst_arg(vm, j);\
if (operand.type != GST_NUMBER)\
gst_c_throwc(vm, GST_EXPECTED_NUMBER_OP);\
ret.data.number op operand.data.number;\
}\
gst_c_return(vm, ret);\
}
SIMPLE_ACCUM_FUNCTION(add, 0, +=)
SIMPLE_ACCUM_FUNCTION(mul, 1, *=)
#undef SIMPLE_ACCUM_FUNCTION
#define UNARY_ACCUM_FUNCTION(name, zeroval, unaryop, op)\
int gst_stl_##name(Gst* vm) {\
GstValue ret;\
GstValue operand;\
uint32_t j, count;\
ret.type = GST_NUMBER;\
count = gst_count_args(vm);\
if (count == 0) {\
ret.data.number = zeroval;\
gst_c_return(vm, ret);\
}\
operand = gst_arg(vm, 0);\
if (operand.type != GST_NUMBER)\
gst_c_throwc(vm, GST_EXPECTED_NUMBER_OP);\
if (count == 1) {\
ret.data.number = unaryop operand.data.number;\
gst_c_return(vm, ret);\
} else {\
ret.data.number = operand.data.number;\
}\
for (j = 1; j < count; ++j) {\
operand = gst_arg(vm, j);\
if (operand.type != GST_NUMBER)\
gst_c_throwc(vm, GST_EXPECTED_NUMBER_OP);\
ret.data.number op operand.data.number;\
}\
gst_c_return(vm, ret);\
}
UNARY_ACCUM_FUNCTION(sub, 0, -, -=)
UNARY_ACCUM_FUNCTION(div, 1, 1/, /=)
#undef UNARY_ACCUM_FUNCTION
#define COMPARE_FUNCTION(name, check)\
int gst_stl_##name(Gst *vm) {\
GstValue ret;\
uint32_t i, count;\
count = gst_count_args(vm);\
ret.data.boolean = 1;\
ret.type = GST_BOOLEAN;\
if (count < 2) {\
gst_c_return(vm, ret);\
}\
for (i = 1; i < count; ++i) {\
GstValue lhs = gst_arg(vm, i - 1);\
GstValue rhs = gst_arg(vm, i);\
if (!(check)) {\
ret.data.boolean = 0;\
break;\
}\
}\
gst_c_return(vm, ret);\
}
COMPARE_FUNCTION(lessthan, gst_compare(lhs, rhs) < 0)
COMPARE_FUNCTION(greaterthan, gst_compare(lhs, rhs) > 0)
COMPARE_FUNCTION(equal, gst_equals(lhs, rhs))
COMPARE_FUNCTION(lessthaneq, gst_compare(lhs, rhs) <= 0)
COMPARE_FUNCTION(greaterthaneq, gst_compare(lhs, rhs) >= 0)
#undef COMPARE_FUNCTION
/****/
/* Core */
/****/
/* Get length of object */
int gst_stl_length(Gst *vm) {
GstValue ret;
uint32_t count = gst_count_args(vm);
if (count == 0) {
ret.type = GST_NIL;
gst_c_return(vm, ret);
}
if (count == 1) {
ret.type = GST_NUMBER;
GstValue x = gst_arg(vm, 0);
switch (x.type) {
default:
gst_c_throwc(vm, "cannot get length");
case GST_STRING:
case GST_SYMBOL:
ret.data.number = gst_string_length(x.data.string);
break;
case GST_ARRAY:
ret.data.number = x.data.array->count;
break;
case GST_BYTEBUFFER:
ret.data.number = x.data.buffer->count;
break;
case GST_TUPLE:
ret.data.number = gst_tuple_length(x.data.tuple);
break;
case GST_OBJECT:
ret.data.number = x.data.object->count;
break;
}
}
gst_c_return(vm, ret);
}
/* Get nth argument, not including first argument */
int gst_stl_select(Gst *vm) {
GstValue selector;
uint32_t count, n;
count = gst_count_args(vm);
if (count == 0)
gst_c_throwc(vm, "select takes at least one argument");
selector = gst_arg(vm, 0);
if (selector.type != GST_NUMBER)
gst_c_throwc(vm, GST_EXPECTED_NUMBER_OP);
n = selector.data.number;
gst_c_return(vm, gst_arg(vm, n + 1));
}
/* Get type of object */
int gst_stl_type(Gst *vm) {
GstValue x;
const char *typestr = "nil";
uint32_t count = gst_count_args(vm);
if (count == 0)
gst_c_throwc(vm, "expected at least 1 argument");
x = gst_arg(vm, 0);
switch (x.type) {
default:
break;
case GST_NUMBER:
typestr = "number";
break;
case GST_BOOLEAN:
typestr = "boolean";
break;
case GST_STRING:
typestr = "string";
break;
case GST_SYMBOL:
typestr = "symbol";
break;
case GST_ARRAY:
typestr = "array";
break;
case GST_TUPLE:
typestr = "tuple";
break;
case GST_THREAD:
typestr = "thread";
break;
case GST_BYTEBUFFER:
typestr = "buffer";
break;
case GST_FUNCTION:
typestr = "function";
break;
case GST_CFUNCTION:
typestr = "cfunction";
break;
case GST_OBJECT:
typestr = "object";
break;
case GST_USERDATA:
typestr = "userdata";
break;
case GST_FUNCENV:
typestr = "funcenv";
break;
case GST_FUNCDEF:
typestr = "funcdef";
break;
}
gst_c_return(vm, gst_load_cstring(vm, typestr));
}
/* Create array */
int gst_stl_array(Gst *vm) {
uint32_t i;
uint32_t count = gst_count_args(vm);
GstValue ret;
GstArray *array = gst_array(vm, count);
for (i = 0; i < count; ++i) {
array->data[i] = gst_arg(vm, i);
}
ret.type = GST_ARRAY;
ret.data.array = array;
gst_c_return(vm, ret);
}
/* Create tuple */
int gst_stl_tuple(Gst *vm) {
uint32_t i;
uint32_t count = gst_count_args(vm);
GstValue ret;
GstValue *tuple= gst_tuple(vm, count);
for (i = 0; i < count; ++i) {
tuple[i] = gst_arg(vm, i);
}
ret.type = GST_TUPLE;
ret.data.tuple = tuple;
gst_c_return(vm, ret);
}
/* Create object */
int gst_stl_object(Gst *vm) {
uint32_t i;
uint32_t count = gst_count_args(vm);
GstValue ret;
GstObject *object;
if (count % 2 != 0) {
gst_c_throwc(vm, "expected even number of arguments");
}
object = gst_object(vm, count);
for (i = 0; i < count; i += 2) {
gst_object_put(vm, object, gst_arg(vm, i), gst_arg(vm, i + 1));
}
ret.type = GST_OBJECT;
ret.data.object = object;
gst_c_return(vm, ret);
}
/* Create a buffer */
int gst_stl_buffer(Gst *vm) {
uint32_t i, count;
GstValue buf;
buf.type = GST_BYTEBUFFER;
buf.data.buffer = gst_buffer(vm, 10);
count = gst_count_args(vm);
for (i = 0; i < count; ++i) {
const uint8_t *string = gst_to_string(vm, gst_arg(vm, i));
gst_buffer_append(vm, buf.data.buffer, string, gst_string_length(string));
}
gst_c_return(vm, buf);
}
/* Concatenate string */
int gst_stl_strcat(Gst *vm) {
GstValue ret;
uint32_t j, count, length, index;
uint8_t *str;
const uint8_t *cstr;
count = gst_count_args(vm);
length = 0;
index = 0;
/* Find length and assert string arguments */
for (j = 0; j < count; ++j) {
GstValue arg = gst_arg(vm, j);
if (arg.type != GST_STRING && arg.type != GST_SYMBOL)
gst_c_throwc(vm, GST_EXPECTED_STRING);
length += gst_string_length(arg.data.string);
}
/* Make string */
str = gst_string_begin(vm, length);
for (j = 0; j < count; ++j) {
GstValue arg = gst_arg(vm, j);
uint32_t slen = gst_string_length(arg.data.string);
gst_memcpy(str + index, arg.data.string, slen);
index += slen;
}
cstr = gst_string_end(vm, str);
ret.type = GST_STRING;
ret.data.string = cstr;
gst_c_return(vm, ret);
}
/* Associative rawget */
int gst_stl_rawget(Gst *vm) {
GstValue ret;
uint32_t count;
const char *err;
count = gst_count_args(vm);
if (count != 2) {
gst_c_throwc(vm, "expects 2 arguments");
}
err = gst_get(gst_arg(vm, 0), gst_arg(vm, 1), &ret);
if (err != NULL)
gst_c_throwc(vm, err);
else
gst_c_return(vm, ret);
}
/* Associative rawset */
int gst_stl_rawset(Gst *vm) {
GstValue ret;
uint32_t count;
const char *err;
count = gst_count_args(vm);
if (count != 3) {
gst_c_throwc(vm, "expects 3 arguments");
}
err = gst_set(vm, gst_arg(vm, 0), gst_arg(vm, 1), gst_arg(vm, 2));
if (err != NULL) {
gst_c_throwc(vm, err);
} else {
ret.type = GST_NIL;
gst_c_return(vm, ret);
}
}
/* Print values for inspection */
int gst_stl_print(Gst *vm) {
uint32_t j, count;
@ -22,36 +343,6 @@ int gst_stl_print(Gst *vm) {
return GST_RETURN_OK;
}
/* Get class value */
int gst_stl_getclass(Gst *vm) {
GstValue class = gst_get_class(gst_arg(vm, 0));
gst_c_return(vm, class);
}
/* Set class value */
int gst_stl_setclass(Gst *vm) {
GstValue x = gst_arg(vm, 0);
GstValue class = gst_arg(vm, 1);
const char *err = gst_set_class(x, class);
if (err != NULL)
gst_c_throwc(vm, err);
gst_c_return(vm, x);
}
/* Create a buffer */
int gst_stl_make_buffer(Gst *vm) {
uint32_t i, count;
GstValue buf;
buf.type = GST_BYTEBUFFER;
buf.data.buffer = gst_buffer(vm, 10);
count = gst_count_args(vm);
for (i = 0; i < count; ++i) {
const uint8_t *string = gst_to_string(vm, gst_arg(vm, i));
gst_buffer_append(vm, buf.data.buffer, string, gst_string_length(string));
}
gst_c_return(vm, buf);
}
/* To string */
int gst_stl_tostring(Gst *vm) {
GstValue ret;
@ -70,149 +361,10 @@ int gst_stl_exit(Gst *vm) {
return GST_RETURN_OK;
}
/* Load core */
void gst_stl_load_core(GstCompiler *c) {
gst_compiler_add_global_cfunction(c, "print", gst_stl_print);
gst_compiler_add_global_cfunction(c, "get-class", gst_stl_getclass);
gst_compiler_add_global_cfunction(c, "set-class", gst_stl_setclass);
gst_compiler_add_global_cfunction(c, "make-buffer", gst_stl_make_buffer);
gst_compiler_add_global_cfunction(c, "tostring", gst_stl_tostring);
gst_compiler_add_global_cfunction(c, "exit", gst_stl_exit);
}
/****/
/* Parsing */
/****/
/* Get an integer power of 10 */
static double exp10(int power) {
if (power == 0) return 1;
if (power > 0) {
double result = 10;
int currentPower = 1;
while (currentPower * 2 <= power) {
result = result * result;
currentPower *= 2;
}
return result * exp10(power - currentPower);
} else {
return 1 / exp10(-power);
}
}
/* Read a number from a string. Returns if successfuly
* parsed a number from the enitre input string.
* If returned 1, output is int ret.*/
static int read_number(const uint8_t *string, const uint8_t *end, double *ret, int forceInt) {
int sign = 1, x = 0;
double accum = 0, exp = 1, place = 1;
/* Check the sign */
if (*string == '-') {
sign = -1;
++string;
} else if (*string == '+') {
++string;
}
if (string >= end) return 0;
while (string < end) {
if (*string == '.' && !forceInt) {
place = 0.1;
} else if (!forceInt && (*string == 'e' || *string == 'E')) {
/* Read the exponent */
++string;
if (string >= end) return 0;
if (!read_number(string, end, &exp, 1))
return 0;
exp = exp10(exp);
break;
} else {
x = *string;
if (x < '0' || x > '9') return 0;
x -= '0';
if (place < 1) {
accum += x * place;
place *= 0.1;
} else {
accum *= 10;
accum += x;
}
}
++string;
}
*ret = accum * sign * exp;
return 1;
}
/* Convert string to integer */
int gst_stl_parse_number(Gst *vm) {
GstValue ret;
double number;
const uint8_t *str = gst_to_string(vm, gst_arg(vm, 0));
const uint8_t *end = str + gst_string_length(str);
if (read_number(str, end, &number, 0)) {
ret.type = GST_NUMBER;
ret.data.number = number;
} else {
ret.type = GST_NIL;
}
gst_c_return(vm, ret);
}
/* Parse a source string into an AST */
int gst_stl_parse(Gst *vm) {
const uint8_t *source = gst_to_string(vm, gst_arg(vm, 0));
GstParser p;
/* init state */
gst_parser(&p, vm);
/* Get and parse input until we have a full form */
gst_parse_string(&p, source);
if (p.status == GST_PARSER_PENDING) {
gst_c_throwc(vm, "incomplete source");
} else if (p.status == GST_PARSER_ERROR) {
gst_c_throwc(vm, p.error);
} else {
gst_c_return(vm, p.value);
}
}
/* Load parsing */
void gst_stl_load_parse(GstCompiler *c) {
gst_compiler_add_global_cfunction(c, "parse", gst_stl_parse);
gst_compiler_add_global_cfunction(c, "parse-number", gst_stl_parse_number);
}
/****/
/* Compiling */
/****/
/* Compile an ast */
int gst_stl_compile(Gst *vm) {
GstValue ast = gst_arg(vm, 0);
GstValue env = gst_arg(vm, 1);
GstValue ret;
GstCompiler c;
/* init state */
if (env.type == GST_NIL) {
env = vm->rootenv;
}
gst_compiler(&c, vm);
gst_compiler_env(&c, env);
/* Prepare return value */
ret.type = GST_FUNCTION;
ret.data.function = gst_compiler_compile(&c, ast);
/* Check for errors */
if (c.error == NULL) {
gst_c_return(vm, ret);
} else {
gst_c_throwc(vm, c.error);
}
}
/* Load compilation */
void gst_stl_load_compile(GstCompiler *c) {
gst_compiler_add_global_cfunction(c, "compile", gst_stl_compile);
/* Throw error */
int gst_stl_error(Gst *vm) {
GstValue errval = gst_arg(vm, 0);
gst_c_throw(vm, errval);
}
/****/
@ -234,13 +386,6 @@ int gst_stl_serialize(Gst *vm) {
gst_c_return(vm, buffer);
}
/* Load serilization */
void gst_stl_load_serialization(GstCompiler *c) {
gst_compiler_add_global_cfunction(c, "serialize", gst_stl_serialize);
}
/* Read data from a linear sequence of memory */
/****/
/* IO */
/****/
@ -251,10 +396,43 @@ void gst_stl_load_serialization(GstCompiler *c) {
/* Bootstraping */
/****/
struct GstRegistryItem {
const char *name;
GstCFunction func;
};
static const struct GstRegistryItem const registry[] = {
{"+", gst_stl_add},
{"*", gst_stl_mul},
{"-", gst_stl_sub},
{"/", gst_stl_div},
{"<", gst_stl_lessthan},
{">", gst_stl_greaterthan},
{"=", gst_stl_equal},
{"<=", gst_stl_lessthaneq},
{">=", gst_stl_greaterthaneq},
{"length", gst_stl_length},
{"type", gst_stl_type},
{"select", gst_stl_select},
{"array", gst_stl_array},
{"tuple", gst_stl_tuple},
{"object", gst_stl_object},
{"buffer", gst_stl_buffer},
{"strcat", gst_stl_strcat},
{"print", gst_stl_print},
{"tostring", gst_stl_tostring},
{"exit", gst_stl_exit},
{"rawget", gst_stl_rawget},
{"rawset", gst_stl_rawset},
{"error", gst_stl_error},
{"serialize", gst_stl_serialize},
{NULL, NULL}
};
/* Load all libraries */
void gst_stl_load(GstCompiler *c) {
gst_stl_load_core(c);
gst_stl_load_parse(c);
gst_stl_load_compile(c);
gst_stl_load_serialization(c);
const struct GstRegistryItem *item;
for (item = registry; item->name; ++item) {
gst_compiler_add_global_cfunction(c, item->name, item->func);
}
}

47
core/thread.c
View File

@ -18,8 +18,9 @@ GstThread *gst_thread(Gst *vm, GstValue callee, uint32_t capacity) {
gst_frame_pc(stack) = NULL;
gst_frame_env(stack) = NULL;
gst_frame_errjmp(stack) = NULL;
gst_thread_expand_callable(vm, thread, callee);
gst_frame_callee(stack) = callee;
gst_thread_endframe(vm, thread);
thread->parent = NULL;
return thread;
}
@ -79,45 +80,6 @@ void gst_thread_tuplepack(Gst *vm, GstThread *thread, uint32_t n) {
}
}
/* Expand a callee on the stack frame to its delegate function. This means that
* objects and userdata that have a "call" attribut in their class will be
* replaced with their delegate function. Call this before pushing any
* arguments to the stack. Returns the new stack. */
GstValue *gst_thread_expand_callable(Gst *vm, GstThread *thread, GstValue callee) {
uint32_t i;
GstValue *stack;
GstObject *meta;
for (i = 0; i < 200; ++i) {
switch(callee.type) {
default:
return NULL;
case GST_FUNCTION:
stack = thread->data + thread->count;
gst_frame_callee(stack) = callee;
gst_frame_pc(stack) = callee.data.function->def->byteCode;
return stack;
case GST_CFUNCTION:
stack = thread->data + thread->count;
gst_frame_callee(stack) = callee;
gst_frame_pc(stack) = NULL;
return stack;
case GST_OBJECT:
meta = callee.data.object->meta;
if (meta == NULL) return NULL;
gst_thread_push(vm, thread, callee);
callee = gst_object_get(meta, gst_load_cstring(vm, "call"));
continue;
case GST_USERDATA:
meta = ((GstUserdataHeader *)callee.data.pointer - 1)->meta;
gst_thread_push(vm, thread, callee);
callee = gst_object_get(meta, gst_load_cstring(vm, "call"));
continue;
}
}
/* Callables nested too deeply */
return NULL;
}
/* Push a stack frame to a thread, with space for arity arguments. Returns the new
* stack. */
GstValue *gst_thread_beginframe(Gst *vm, GstThread *thread, GstValue callee, uint32_t arity) {
@ -133,11 +95,8 @@ GstValue *gst_thread_beginframe(Gst *vm, GstThread *thread, GstValue callee, uin
gst_frame_env(newStack) = NULL;
gst_frame_errjmp(newStack) = NULL;
gst_frame_size(newStack) = 0;
gst_frame_callee(newStack) = callee;
thread->count += frameOffset;
/* Get real callable */
if (gst_thread_expand_callable(vm, thread, callee) == NULL)
return NULL;
/* Ensure the extra space and initialize to nil */
gst_thread_pushnil(vm, thread, arity);

54
core/value.c
View File

@ -338,8 +338,6 @@ const char *gst_set(Gst *vm, GstValue ds, GstValue key, GstValue value) {
ds.data.buffer->data[index] = to_byte(value.data.number);
break;
case GST_OBJECT:
if (ds.data.object->meta != NULL) {
}
gst_object_put(vm, ds.data.object, key, value);
break;
default:
@ -348,46 +346,6 @@ const char *gst_set(Gst *vm, GstValue ds, GstValue key, GstValue value) {
return NULL;
}
/* Get the class object of a value */
GstValue gst_get_class(GstValue x) {
GstValue ret;
ret.type = GST_NIL;
switch (x.type) {
case GST_OBJECT:
if (x.data.object->meta != NULL) {
ret.type = GST_OBJECT;
ret.data.object = x.data.object->meta;
}
break;
case GST_USERDATA:
{
GstUserdataHeader *header = (GstUserdataHeader *)x.data.pointer - 1;
if (header->meta != NULL) {
ret.type = GST_OBJECT;
ret.data.object = header->meta;
}
}
break;
default:
break;
}
return ret;
}
/* Set the class object of a value. Returns possible c error string */
const char *gst_set_class(GstValue x, GstValue class) {
switch (x.type) {
case GST_OBJECT:
if (class.type != GST_OBJECT) return "class must be of type object";
/* TODO - check for class immutability */
x.data.object->meta = class.data.object;
break;
default:
return "cannot set class object";
}
return NULL;
}
/* Get the length of an object. Returns errors for invalid types */
int gst_length(Gst *vm, GstValue x, GstValue *len) {
uint32_t length;
@ -409,18 +367,6 @@ int gst_length(Gst *vm, GstValue x, GstValue *len) {
length = gst_tuple_length(x.data.tuple);
break;
case GST_OBJECT:
/* TODO - Check for class override */
if (x.data.object->meta != NULL) {
GstValue check = gst_object_get(
x.data.object->meta,
gst_load_cstring(vm, "length"));
if (check.type != GST_NIL) {
int status = gst_call(vm, check, 1, &x);
if (status == GST_RETURN_OK)
*len = vm->ret;
return status;
}
}
length = x.data.object->count;
break;
}

334
core/vm.c
View File

@ -52,68 +52,7 @@ static int gst_continue_size(Gst *vm, uint32_t stackBase) {
default:
gst_error(vm, "unknown opcode");
break;
#define OP_BINARY_MATH(op) \
v1 = stack[pc[2]]; \
v2 = stack[pc[3]]; \
gst_assert(vm, v1.type == GST_NUMBER, GST_EXPECTED_NUMBER_LOP); \
gst_assert(vm, v2.type == GST_NUMBER, GST_EXPECTED_NUMBER_ROP); \
temp.type = GST_NUMBER; \
temp.data.number = v1.data.number op v2.data.number; \
stack[pc[1]] = temp; \
pc += 4; \
continue;
case GST_OP_ADD: /* Addition */
OP_BINARY_MATH(+)
case GST_OP_SUB: /* Subtraction */
OP_BINARY_MATH(-)
case GST_OP_MUL: /* Multiplication */
OP_BINARY_MATH(*)
case GST_OP_DIV: /* Division */
OP_BINARY_MATH(/)
#undef OP_BINARY_MATH
case GST_OP_NOT: /* Boolean unary (Boolean not) */
temp.type = GST_BOOLEAN;
temp.data.boolean = !gst_truthy(stack[pc[2]]);
stack[pc[1]] = temp;
pc += 3;
continue;
case GST_OP_NEG: /* Unary negation */
v1 = stack[pc[2]];
gst_assert(vm, v1.type == GST_NUMBER, GST_EXPECTED_NUMBER_LOP);
temp.type = GST_NUMBER;
temp.data.number = -v1.data.number;
stack[pc[1]] = temp;
pc += 3;
continue;
case GST_OP_INV: /* Unary multiplicative inverse */
v1 = stack[pc[2]];
gst_assert(vm, v1.type == GST_NUMBER, GST_EXPECTED_NUMBER_LOP);
temp.type = GST_NUMBER;
temp.data.number = 1 / v1.data.number;
stack[pc[1]] = temp;
pc += 3;
continue;
case GST_OP_LEN: /* Length */
{
int status = gst_length(vm, stack[pc[2]], &v1);
if (status == GST_RETURN_OK)
stack[pc[1]] = v1;
else
goto vm_error;
pc += 3;
}
continue;
case GST_OP_FLS: /* Load False */
temp.type = GST_BOOLEAN;
temp.data.boolean = 0;
@ -241,94 +180,6 @@ static int gst_continue_size(Gst *vm, uint32_t stackBase) {
}
break;
case GST_OP_EQL: /* Equality */
temp.type = GST_BOOLEAN;
temp.data.boolean = gst_equals(stack[pc[2]], stack[pc[3]]);
stack[pc[1]] = temp;
pc += 4;
continue;
case GST_OP_LTN: /* Less Than */
temp.type = GST_BOOLEAN;
temp.data.boolean = (gst_compare(stack[pc[2]], stack[pc[3]]) == -1);
stack[pc[1]] = temp;
pc += 4;
continue;
case GST_OP_LTE: /* Less Than or Equal to */
temp.type = GST_BOOLEAN;
temp.data.boolean = (gst_compare(stack[pc[2]], stack[pc[3]]) != 1);
stack[pc[1]] = temp;
pc += 4;
continue;
case GST_OP_ARR: /* Array literal */
{
uint32_t i;
uint32_t arrayLen = pc[2];
GstArray *array = gst_array(vm, arrayLen);
array->count = arrayLen;
for (i = 0; i < arrayLen; ++i)
array->data[i] = stack[pc[3 + i]];
temp.type = GST_ARRAY;
temp.data.array = array;
stack[pc[1]] = temp;
pc += 3 + arrayLen;
}
break;
case GST_OP_DIC: /* Object literal */
{
uint32_t i = 3;
uint32_t kvs = pc[2];
GstObject *o = gst_object(vm, kvs + 2);
kvs = kvs + 3;
while (i < kvs) {
v1 = stack[pc[i++]];
v2 = stack[pc[i++]];
gst_object_put(vm, o, v1, v2);
}
temp.type = GST_OBJECT;
temp.data.object = o;
stack[pc[1]] = temp;
pc += kvs;
}
break;
case GST_OP_TUP: /* Tuple literal */
{
uint32_t i;
uint32_t len = pc[2];
GstValue *tuple = gst_tuple(vm, len);
for (i = 0; i < len; ++i)
tuple[i] = stack[pc[3 + i]];
temp.type = GST_TUPLE;
temp.data.tuple = tuple;
stack[pc[1]] = temp;
pc += 3 + len;
}
break;
case GST_OP_GET: /* Associative get */
{
const char *err;
err = gst_get(stack[pc[2]], stack[pc[3]], stack + pc[1]);
if (err != NULL)
gst_error(vm, err);
pc += 4;
}
continue;
case GST_OP_SET: /* Associative set */
{
const char *err;
err = gst_set(vm, stack[pc[1]], stack[pc[2]], stack[pc[3]]);
if (err != NULL)
gst_error(vm, err);
pc += 4;
}
break;
case GST_OP_ERR: /* Throw error */
vm->ret = stack[pc[1]];
goto vm_error;
@ -408,7 +259,7 @@ static int gst_continue_size(Gst *vm, uint32_t stackBase) {
status = temp.data.cfunction(vm);
GST_STATE_SYNC();
stack = gst_thread_popframe(vm, &thread);
if (status == GST_RETURN_OK)
if (status == GST_RETURN_OK) {
if (thread.count < stackBase) {
GST_STATE_WRITE();
return status;
@ -419,12 +270,149 @@ static int gst_continue_size(Gst *vm, uint32_t stackBase) {
else
pc += offset + arity;
}
else
} else {
goto vm_error;
}
}
}
break;
/* Faster implementations of standard functions
* These opcodes are nto strictlyre required and can
* be reimplemented with stanard library functions */
#define OP_BINARY_MATH(op) \
v1 = stack[pc[2]]; \
v2 = stack[pc[3]]; \
gst_assert(vm, v1.type == GST_NUMBER, GST_EXPECTED_NUMBER_LOP); \
gst_assert(vm, v2.type == GST_NUMBER, GST_EXPECTED_NUMBER_ROP); \
temp.type = GST_NUMBER; \
temp.data.number = v1.data.number op v2.data.number; \
stack[pc[1]] = temp; \
pc += 4; \
continue;
case GST_OP_ADD: /* Addition */
OP_BINARY_MATH(+)
case GST_OP_SUB: /* Subtraction */
OP_BINARY_MATH(-)
case GST_OP_MUL: /* Multiplication */
OP_BINARY_MATH(*)
case GST_OP_DIV: /* Division */
OP_BINARY_MATH(/)
#undef OP_BINARY_MATH
case GST_OP_NOT: /* Boolean unary (Boolean not) */
temp.type = GST_BOOLEAN;
temp.data.boolean = !gst_truthy(stack[pc[2]]);
stack[pc[1]] = temp;
pc += 3;
continue;
case GST_OP_NEG: /* Unary negation */
v1 = stack[pc[2]];
gst_assert(vm, v1.type == GST_NUMBER, GST_EXPECTED_NUMBER_LOP);
temp.type = GST_NUMBER;
temp.data.number = -v1.data.number;
stack[pc[1]] = temp;
pc += 3;
continue;
case GST_OP_INV: /* Unary multiplicative inverse */
v1 = stack[pc[2]];
gst_assert(vm, v1.type == GST_NUMBER, GST_EXPECTED_NUMBER_LOP);
temp.type = GST_NUMBER;
temp.data.number = 1 / v1.data.number;
stack[pc[1]] = temp;
pc += 3;
continue;
case GST_OP_EQL: /* Equality */
temp.type = GST_BOOLEAN;
temp.data.boolean = gst_equals(stack[pc[2]], stack[pc[3]]);
stack[pc[1]] = temp;
pc += 4;
continue;
case GST_OP_LTN: /* Less Than */
temp.type = GST_BOOLEAN;
temp.data.boolean = (gst_compare(stack[pc[2]], stack[pc[3]]) == -1);
stack[pc[1]] = temp;
pc += 4;
continue;
case GST_OP_LTE: /* Less Than or Equal to */
temp.type = GST_BOOLEAN;
temp.data.boolean = (gst_compare(stack[pc[2]], stack[pc[3]]) != 1);
stack[pc[1]] = temp;
pc += 4;
continue;
case GST_OP_ARR: /* Array literal */
{
uint32_t i;
uint32_t arrayLen = pc[2];
GstArray *array = gst_array(vm, arrayLen);
array->count = arrayLen;
for (i = 0; i < arrayLen; ++i)
array->data[i] = stack[pc[3 + i]];
temp.type = GST_ARRAY;
temp.data.array = array;
stack[pc[1]] = temp;
pc += 3 + arrayLen;
}
break;
case GST_OP_DIC: /* Object literal */
{
uint32_t i = 3;
uint32_t kvs = pc[2];
GstObject *o = gst_object(vm, kvs + 2);
kvs = kvs + 3;
while (i < kvs) {
v1 = stack[pc[i++]];
v2 = stack[pc[i++]];
gst_object_put(vm, o, v1, v2);
}
temp.type = GST_OBJECT;
temp.data.object = o;
stack[pc[1]] = temp;
pc += kvs;
}
break;
case GST_OP_TUP: /* Tuple literal */
{
uint32_t i;
uint32_t len = pc[2];
GstValue *tuple = gst_tuple(vm, len);
for (i = 0; i < len; ++i)
tuple[i] = stack[pc[3 + i]];
temp.type = GST_TUPLE;
temp.data.tuple = tuple;
stack[pc[1]] = temp;
pc += 3 + len;
}
break;
case GST_OP_YLD: /* Yield from function */
temp = stack[pc[1]];
if (thread.parent == NULL) {
vm->ret = temp;
return GST_RETURN_OK;
}
gst_frame_pc(stack) = pc + 2;
GST_STATE_WRITE();
vm->thread = thread.parent;
thread = *vm->thread;
stack = thread.data + thread.count;
pc = gst_frame_pc(stack);
break;
/* Handle errors from c functions and vm opcodes */
vm_error:
if (stack == NULL)
@ -454,8 +442,10 @@ int gst_continue(Gst *vm) {
return gst_continue_size(vm, vm->thread->count);
}
/* Run the vm with a given function */
/* Run the vm with a given function. This function is
* called to start the vm. */
int gst_run(Gst *vm, GstValue callee) {
int status;
GstValue *stack;
vm->thread = gst_thread(vm, callee, 64);
if (vm->thread == NULL)
@ -464,7 +454,6 @@ int gst_run(Gst *vm, GstValue callee) {
/* If callee was not actually a function, get the delegate function */
callee = gst_frame_callee(stack);
if (callee.type == GST_CFUNCTION) {
int status;
vm->ret.type = GST_NIL;
status = callee.data.cfunction(vm);
gst_thread_popframe(vm, vm->thread);
@ -474,43 +463,6 @@ int gst_run(Gst *vm, GstValue callee) {
}
}
/* Call a gst function */
int gst_call(Gst *vm, GstValue callee, uint32_t arity, GstValue *args) {
GstValue *stack;
uint32_t i, size;
int status;
/* Set the return position */
stack = gst_thread_stack(vm->thread);
gst_frame_ret(stack) = gst_frame_size(stack);
/* Add extra space for returning value */
gst_thread_pushnil(vm, vm->thread, 1);
stack = gst_thread_beginframe(vm, vm->thread, callee, arity);
/* Write args to stack */
size = gst_frame_size(stack) - arity;
for (i = 0; i < arity; ++i)
stack[i + size] = args[i];
gst_thread_endframe(vm, vm->thread);
/* Call function */
callee = gst_frame_callee(stack);
if (callee.type == GST_FUNCTION) {
gst_frame_pc(stack) = callee.data.function->def->byteCode;
status = gst_continue(vm);
} else {
vm->ret.type = GST_NIL;
status = callee.data.cfunction(vm);
gst_thread_popframe(vm, vm->thread);
}
/* Pop the extra nil */
--gst_frame_size(gst_thread_stack(vm->thread));
return status;
}
/* Get an argument from the stack */
GstValue gst_arg(Gst *vm, uint16_t index) {
GstValue *stack = gst_thread_stack(vm->thread);

72
include/gst/gst.h
View File

@ -126,34 +126,38 @@ typedef int (*GstCFunction)(Gst * vm);
typedef struct GstUserdataHeader GstUserdataHeader;
typedef struct GstFuncDef GstFuncDef;
typedef struct GstFuncEnv GstFuncEnv;
typedef union GstValueUnion GstValueUnion;
/* Definitely implementation details */
typedef struct GstBucket GstBucket;
/* Union datatype */
union GstValueUnion {
GstBoolean boolean;
GstNumber number;
GstArray *array;
GstBuffer *buffer;
GstObject *object;
GstThread *thread;
GstValue *tuple;
GstCFunction cfunction;
GstFunction *function;
GstFuncEnv *env;
GstFuncDef *def;
const uint8_t *string;
const char *cstring; /* Alias for ease of use from c */
/* Indirectly used union members */
uint16_t *u16p;
uint16_t hws[4];
uint8_t bytes[8];
void *pointer;
};
/* The general gst value type. Contains a large union and
* the type information of the value */
struct GstValue {
GstType type;
union {
GstBoolean boolean;
GstNumber number;
GstArray *array;
GstBuffer *buffer;
GstObject *object;
GstThread *thread;
GstValue *tuple;
GstCFunction cfunction;
GstFunction *function;
GstFuncEnv *env;
GstFuncDef *def;
const uint8_t *string;
const char *cstring; /* Alias for ease of use from c */
/* Indirectly used union members */
uint16_t *u16p;
uint16_t hws[4];
uint8_t bytes[8];
void *pointer;
} data;
GstValueUnion data;
};
/* A lightweight thread in gst. Does not correspond to
@ -162,6 +166,7 @@ struct GstThread {
uint32_t count;
uint32_t capacity;
GstValue *data;
GstThread *parent;
enum {
GST_THREAD_PENDING = 0,
GST_THREAD_ALIVE,
@ -183,19 +188,18 @@ struct GstBuffer {
uint8_t *data;
};
/* The main Gst type, an obect. Objects are just hashtables with some meta
* information attached in the meta value */
/* The main Gst type, an obect. Objects are just hashtables with a parent */
struct GstObject {
uint32_t count;
uint32_t capacity;
GstBucket **buckets;
GstObject *meta;
GstObject *parent;
};
/* Some function defintion flags */
#define GST_FUNCDEF_FLAG_VARARG 1
/* A function definition. Contains information need to instatiate closures. */
/* A function definition. Contains information need to instantiate closures. */
struct GstFuncDef {
uint32_t locals;
uint32_t arity; /* Not including varargs */
@ -237,7 +241,6 @@ struct GstUserdataHeader {
#define GST_RETURN_OK 0
#define GST_RETURN_ERROR 1
#define GST_RETURN_CRASH 2
#define GST_RETURN_YIELD 3
/* The VM state */
struct Gst {
@ -257,7 +260,6 @@ struct Gst {
GstValue rootenv;
/* Return state */
const char *crash;
uint32_t scratchFlags;
GstValue ret; /* Returned value from gst_start. Also holds errors. */
};
@ -267,15 +269,9 @@ enum GstOpCode {
GST_OP_SUB, /* Subtraction */
GST_OP_MUL, /* Multiplication */
GST_OP_DIV, /* Division */
GST_OP_MOD, /* Modulo division */
GST_OP_IDV, /* Integer division */
GST_OP_EXP, /* Exponentiation */
GST_OP_CCT, /* Concatenation */
GST_OP_NOT, /* Boolean invert */
GST_OP_NEG, /* Unary negation */
GST_OP_INV, /* Unary multiplicative inverse */
GST_OP_LEN, /* Length */
GST_OP_TYP, /* Type */
GST_OP_FLS, /* Load false */
GST_OP_TRU, /* Load true */
GST_OP_NIL, /* Load nil */
@ -295,15 +291,14 @@ enum GstOpCode {
GST_OP_ARR, /* Create array */
GST_OP_DIC, /* Create object */
GST_OP_TUP, /* Create tuple */
GST_OP_SET, /* Assocaitive set */
GST_OP_GET, /* Associative get */
GST_OP_ERR, /* Throw error */
GST_OP_TRY, /* Begin try block */
GST_OP_UTY, /* End try block */
GST_OP_RET, /* Return from function */
GST_OP_RTN, /* Return nil */
GST_OP_CAL, /* Call function */
GST_OP_TCL /* Tail call */
GST_OP_TCL, /* Tail call */
GST_OP_YLD /* Yield from function */
};
/****/
@ -378,7 +373,6 @@ void gst_thread_ensure_extra(Gst *vm, GstThread *thread, uint32_t extra);
void gst_thread_push(Gst *vm, GstThread *thread, GstValue x);
void gst_thread_pushnil(Gst *vm, GstThread *thread, uint32_t n);
void gst_thread_tuplepack(Gst *vm, GstThread *thread, uint32_t n);
GstValue *gst_thread_expand_callable(Gst *vm, GstThread *thread, GstValue callee);
GstValue *gst_thread_beginframe(Gst *vm, GstThread *thread, GstValue callee, uint32_t arity);
void gst_thread_endframe(Gst *vm, GstThread *thread);
GstValue *gst_thread_popframe(Gst *vm, GstThread *thread);
@ -396,8 +390,6 @@ const char *gst_get(GstValue ds, GstValue key, GstValue *out);
const char *gst_set(Gst *vm, GstValue ds, GstValue key, GstValue value);
const uint8_t *gst_to_string(Gst *vm, GstValue x);
uint32_t gst_hash(GstValue x);
GstValue gst_get_class(GstValue x);
const char *gst_set_class(GstValue obj, GstValue class);
int gst_length(Gst *vm, GstValue x, GstValue *len);
/****/
@ -448,7 +440,8 @@ const char *gst_serialize(Gst *vm, GstBuffer *buffer, GstValue x);
#define GST_MEMTAG_STRING 4
void gst_mark(Gst *vm, GstValue *x);
void gst_mark_value(Gst *vm, GstValue x);
void gst_mark(Gst *vm, GstValueUnion x, GstType type);
void gst_sweep(Gst *vm);
void *gst_alloc(Gst *vm, uint32_t size);
void *gst_zalloc(Gst *vm, uint32_t size);
@ -465,7 +458,6 @@ void gst_init(Gst *vm);
void gst_deinit(Gst *vm);
int gst_run(Gst *vm, GstValue func);
int gst_continue(Gst *vm);
int gst_call(Gst *vm, GstValue callee, uint32_t arity, GstValue *args);
GstValue gst_arg(Gst *vm, uint16_t index);
void gst_set_arg(Gst *vm, uint16_t index, GstValue x);
uint16_t gst_count_args(Gst *vm);

30
libs/compile.gst Normal file
View File

@ -0,0 +1,30 @@
# Real compiler
# Make compiler
(: make-compiler (fn [] {
'scopes []
'env []
'labels {}
}))
# Make default form options
(: make-formopts (fn [] {
'target nil
'resultUnused false
'canChoose true
'isTail false
}))
# Make scope
(: make-scope (fn [] {
'level 0
'nextSlot 0
'frameSize 0
'freeSlots []
'literals {}
'literalsArray []
'slotMap []
}))
# Push a scope onto the compiler