diff --git a/core/compile.c b/core/compile.c index 3acc3b4d..c421c764 100644 --- a/core/compile.c +++ b/core/compile.c @@ -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': diff --git a/core/disasm.c b/core/disasm.c index b8e24fb3..956f0af1 100644 --- a/core/disasm.c +++ b/core/disasm.c @@ -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; diff --git a/core/ds.c b/core/ds.c index e8fb8d0d..2b75d33b 100644 --- a/core/ds.c +++ b/core/ds.c @@ -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; } diff --git a/core/gc.c b/core/gc.c index 24b91921..b308c867 100644 --- a/core/gc.c +++ b/core/gc.c @@ -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; } diff --git a/core/serialize.c b/core/serialize.c index 49ca7174..cef1aeea 100644 --- a/core/serialize.c +++ b/core/serialize.c @@ -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; diff --git a/core/stl.c b/core/stl.c index ffcd42d1..43768a88 100644 --- a/core/stl.c +++ b/core/stl.c @@ -3,10 +3,331 @@ #include #include +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); + } } diff --git a/core/thread.c b/core/thread.c index db64dcc0..34dafd88 100644 --- a/core/thread.c +++ b/core/thread.c @@ -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); diff --git a/core/value.c b/core/value.c index d28a2b1f..ff0ca56f 100644 --- a/core/value.c +++ b/core/value.c @@ -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; } diff --git a/core/vm.c b/core/vm.c index 1ab60e98..433abb61 100644 --- a/core/vm.c +++ b/core/vm.c @@ -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); diff --git a/include/gst/gst.h b/include/gst/gst.h index 8c009af9..df318872 100644 --- a/include/gst/gst.h +++ b/include/gst/gst.h @@ -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); diff --git a/libs/compile.gst b/libs/compile.gst new file mode 100644 index 00000000..12d5b721 --- /dev/null +++ b/libs/compile.gst @@ -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 +