diff --git a/core/compile.c b/core/compile.c index f3d65ca0..414d4703 100644 --- a/core/compile.c +++ b/core/compile.c @@ -878,6 +878,25 @@ static Slot compile_apply(GstCompiler *c, FormOptions opts, const GstValue *form } } +/* Transfer special */ +static Slot compile_tran(GstCompiler *c, FormOptions opts, const GstValue *form) { + GstBuffer *buffer = c->buffer; + Slot t, v, r; + if (gst_tuple_length(form) != 3 && gst_tuple_length(form) != 2) + c_error(c, "tran expects 2 or 3 arguments"); + t = compiler_realize_slot(c, compile_value(c, form_options_default(), form[1])); + if (gst_tuple_length(form) == 3) + v = compiler_realize_slot(c, compile_value(c, form_options_default(), form[2])); + else + v = compile_value(c, form_options_default(), gst_wrap_nil()); + r = compiler_get_target(c, opts); + gst_buffer_push_u16(c->vm, buffer, GST_OP_TRN); + gst_buffer_push_u16(c->vm, buffer, r.index); + gst_buffer_push_u16(c->vm, buffer, t.index); + gst_buffer_push_u16(c->vm, buffer, v.index); + return r; +} + /* Define a function type for Special Form helpers */ typedef Slot (*SpecialFormHelper) (GstCompiler *c, FormOptions opts, const GstValue *form); @@ -946,6 +965,15 @@ static SpecialFormHelper get_special(const GstValue *form) { } } break; + case 't': + { + if (gst_string_length(name) == 4 && + name[1] == 'r' && + name[2] == 'a' && + name[3] == 'n') { + return compile_tran; + } + } case 'w': { if (gst_string_length(name) == 5 && diff --git a/core/disasm.c b/core/disasm.c index 6260d449..de1b47a4 100644 --- a/core/disasm.c +++ b/core/disasm.c @@ -186,6 +186,8 @@ void gst_dasm(FILE * out, uint16_t *byteCode, uint32_t len) { case GST_OP_TCL: current += dasm_fixed_op(out, current, "tailCall", 1); break; + case GST_OP_TRN: + current += dasm_fixed_op(out, current, "transfer", 3); } fprintf(out, "\n"); } diff --git a/core/ds.c b/core/ds.c index fde0c9b0..bc7fa288 100644 --- a/core/ds.c +++ b/core/ds.c @@ -38,10 +38,10 @@ GstBuffer *gst_buffer(Gst *vm, uint32_t capacity) { /* Ensure that the buffer has enough internal capacity */ void gst_buffer_ensure(Gst *vm, GstBuffer *buffer, uint32_t capacity) { - uint8_t * newData; + uint8_t *newData; if (capacity <= buffer->capacity) return; newData = gst_alloc(vm, capacity * sizeof(uint8_t)); - gst_memcpy(newData, buffer->data, buffer->count * sizeof(uint8_t)); + gst_memcpy(newData, buffer->data, buffer->capacity * sizeof(uint8_t)); buffer->data = newData; buffer->capacity = capacity; } diff --git a/core/gc.c b/core/gc.c index ca328f51..3d71d430 100644 --- a/core/gc.c +++ b/core/gc.c @@ -145,6 +145,8 @@ void gst_mark(Gst *vm, GstValueUnion x, GstType type) { gc_header(thread->data)->color = vm->black; while (frame <= end) frame = gst_mark_stackframe(vm, frame); + if (x.thread->parent) + gst_mark_value(vm, gst_wrap_thread(x.thread->parent)); } break; diff --git a/core/parse.c b/core/parse.c index db56ef4b..6ed40d03 100644 --- a/core/parse.c +++ b/core/parse.c @@ -553,6 +553,8 @@ static int gst_stl_parser_consume(Gst *vm) { GstParser *p = gst_check_userdata(vm, 0, &gst_stl_parsetype); if (p == NULL) gst_c_throwc(vm, "expected parser"); + if (p->status == GST_PARSER_ERROR) + gst_c_return(vm, gst_string_cv(vm, p->error)); if (!gst_parse_hasvalue(p)) gst_c_throwc(vm, "parser has no pending value"); gst_c_return(vm, gst_parse_consume(p)); diff --git a/core/stl.c b/core/stl.c index 6b471fa1..97a21c2d 100644 --- a/core/stl.c +++ b/core/stl.c @@ -406,27 +406,9 @@ int gst_stl_thread(Gst *vm) { if (callee.type != GST_FUNCTION && callee.type != GST_CFUNCTION) gst_c_throwc(vm, "expected function"); t = gst_thread(vm, callee, 10); - t->parent = vm->thread; gst_c_return(vm, gst_wrap_thread(t)); } -/* Transfer to a new thread */ -int gst_stl_transfer(Gst *vm) { - GstThread *t; - GstValue ret = gst_arg(vm, 1); - if (!gst_check_thread(vm, 0, &t)) - gst_c_throwc(vm, "expected thread"); - if (t->status == GST_THREAD_DEAD) - gst_c_throwc(vm, "cannot transfer to dead thread"); - if (t->status == GST_THREAD_ALIVE) - gst_c_throwc(vm, "cannot transfer to current thread"); - gst_thread_beginframe(vm, t, gst_wrap_nil(), 0); - vm->thread->status = GST_THREAD_PENDING; - t->status = GST_THREAD_ALIVE; - vm->thread = t; - gst_c_return(vm, ret); -} - /* Get current thread */ int gst_stl_current(Gst *vm) { gst_c_return(vm, gst_wrap_thread(vm->thread)); @@ -879,7 +861,6 @@ static const GstModuleItem const std_module[] = { {"buffer", gst_stl_buffer}, {"string", gst_stl_string}, {"thread", gst_stl_thread}, - {"transfer", gst_stl_transfer}, {"status", gst_stl_status}, {"current", gst_stl_current}, {"parent", gst_stl_parent}, diff --git a/core/thread.c b/core/thread.c index 3659dd23..ada5f96d 100644 --- a/core/thread.c +++ b/core/thread.c @@ -32,6 +32,7 @@ GstThread *gst_thread(Gst *vm, GstValue callee, uint32_t capacity) { thread->count = GST_FRAME_SIZE; thread->data = data; thread->status = GST_THREAD_PENDING; + thread->retindex = 0; stack = data + GST_FRAME_SIZE; gst_frame_size(stack) = 0; gst_frame_prevsize(stack) = 0; @@ -41,7 +42,7 @@ GstThread *gst_thread(Gst *vm, GstValue callee, uint32_t capacity) { gst_frame_env(stack) = NULL; gst_frame_callee(stack) = callee; gst_thread_endframe(vm, thread); - thread->parent = NULL; + thread->parent = vm->thread; return thread; } diff --git a/core/vm.c b/core/vm.c index b6c24ed9..eba8c37b 100644 --- a/core/vm.c +++ b/core/vm.c @@ -29,9 +29,11 @@ static const char GST_EXPECTED_FUNCTION[] = "expected function"; int gst_continue(Gst *vm) { /* VM state */ GstValue *stack; - GstValue temp, v1, v2; uint16_t *pc; + /* Some temporary values */ + GstValue temp, v1, v2; + #define gst_exit(vm, r) return ((vm)->ret = (r), GST_RETURN_OK) #define gst_error(vm, e) do { (vm)->ret = gst_string_cv((vm), (e)); goto vm_error; } while (0) #define gst_crash(vm, e) return ((vm)->crash = (e), GST_RETURN_CRASH) @@ -184,27 +186,12 @@ int gst_continue(Gst *vm) { break; case GST_OP_RTN: /* Return nil */ - stack = gst_thread_popframe(vm, vm->thread); - if (vm->thread->count < GST_FRAME_SIZE) { - vm->thread->status = GST_THREAD_DEAD; - vm->ret.type = GST_NIL; - return GST_RETURN_OK; - } - pc = gst_frame_pc(stack); - stack[gst_frame_ret(stack)].type = GST_NIL; - continue; + temp.type = GST_NIL; + goto vm_return; case GST_OP_RET: /* Return */ temp = stack[pc[1]]; - stack = gst_thread_popframe(vm, vm->thread); - if (vm->thread->count < GST_FRAME_SIZE) { - vm->thread->status = GST_THREAD_DEAD; - vm->ret = temp; - return GST_RETURN_OK; - } - pc = gst_frame_pc(stack); - stack[gst_frame_ret(stack)] = temp; - continue; + goto vm_return; case GST_OP_PSK: /* Push stack */ { @@ -302,16 +289,11 @@ int gst_continue(Gst *vm) { int status; vm->ret.type = GST_NIL; status = temp.data.cfunction(vm); - stack = gst_thread_popframe(vm, vm->thread); if (status == GST_RETURN_OK) { - if (vm->thread->count < GST_FRAME_SIZE) { - vm->thread->status = GST_THREAD_DEAD; - return status; - } else { - stack[gst_frame_ret(stack)] = vm->ret; - pc = gst_frame_pc(stack); - } + temp = vm->ret; + goto vm_return; } else { + stack = gst_thread_popframe(vm, vm->thread); goto vm_error; } } else { @@ -366,24 +348,55 @@ int gst_continue(Gst *vm) { } break; - case GST_OP_YLD: /* Yield to new thread */ - temp = stack[pc[1]]; - v1 = stack[pc[2]]; - gst_assert(vm, v1.type == GST_THREAD, "expected thread"); - gst_assert(vm, v1.data.thread->status != GST_THREAD_DEAD, "cannot rejoin dead thread"); - gst_frame_pc(stack) = pc + 3; - vm->thread = v1.data.thread; - vm->thread->status = GST_THREAD_ALIVE; - stack = vm->thread->data + vm->thread->count; + case GST_OP_TRN: /* Transfer */ + temp = stack[pc[2]]; /* The thread */ + v1 = stack[pc[3]]; /* The value to pass in */ + if (temp.type != GST_THREAD) + gst_error(vm, "expected thread"); + if (temp.data.thread->status == GST_THREAD_DEAD || + temp.data.thread->status == GST_THREAD_ERROR) + gst_error(vm, "cannot enter dead thread"); + gst_frame_ret(stack) = pc[1]; + vm->thread->status = GST_THREAD_PENDING; + gst_frame_pc(stack) = pc + 4; + temp.data.thread->status = GST_THREAD_ALIVE; + vm->thread = temp.data.thread; + stack = gst_thread_stack(temp.data.thread); + stack[gst_frame_ret(stack)] = v1; pc = gst_frame_pc(stack); continue; + /* Handle returning from stack frame. Expect return value in temp. */ + vm_return: + stack = gst_thread_popframe(vm, vm->thread); + while (vm->thread->count < GST_FRAME_SIZE) { + vm->thread->status = GST_THREAD_DEAD; + if (vm->thread->parent) { + vm->thread = vm->thread->parent; + stack = vm->thread->data + vm->thread->count; + } else { + vm->ret = temp; + return GST_RETURN_OK; + } + } + pc = gst_frame_pc(stack); + stack[gst_frame_ret(stack)] = temp; + continue; + /* Handle errors from c functions and vm opcodes */ vm_error: - if (stack == NULL || vm->thread->parent == NULL) - return GST_RETURN_ERROR; vm->thread->status = GST_THREAD_ERROR; + if (vm->thread->parent == NULL) + return GST_RETURN_ERROR; vm->thread = vm->thread->parent; + while (vm->thread->count < GST_FRAME_SIZE) { + if (vm->thread->parent) { + vm->thread->status = GST_THREAD_DEAD; + vm->thread = vm->thread->parent; + } else { + return GST_RETURN_ERROR; + } + } stack = vm->thread->data + vm->thread->count; pc = gst_frame_pc(stack); continue; diff --git a/include/gst/gst.h b/include/gst/gst.h index 0f3b4efc..9fbdea14 100644 --- a/include/gst/gst.h +++ b/include/gst/gst.h @@ -204,6 +204,7 @@ struct GstValue { struct GstThread { uint32_t count; uint32_t capacity; + uint32_t retindex; GstValue *data; GstThread *parent; enum { @@ -333,7 +334,7 @@ enum GstOpCode { GST_OP_PAR, /* Push array or tuple */ GST_OP_CAL, /* Call function */ GST_OP_TCL, /* Tail call */ - GST_OP_YLD /* Yield from function */ + GST_OP_TRN, /* Transfer to new thread */ }; /****/ diff --git a/libs/repl.gst b/libs/repl.gst index 5f37f904..16a1748a 100644 --- a/libs/repl.gst +++ b/libs/repl.gst @@ -19,9 +19,11 @@ "Run a simple repl. Does not handle errors and other such details." (while 1 - (write stdout ">> ") - (: line (readline)) - (while line - (: line (parse-charseq p line)) - (if (parse-hasvalue p) - (print ((compile (parse-consume p))))))) + (: t (thread (fn [] + (write stdout ">> ") + (: line (readline)) + (while line + (: line (parse-charseq p line)) + (if (parse-hasvalue p) + ((compile (parse-consume p)))))))) + (transfer t))