Add tran keyword to allow for continuations.

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 &&

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");
     }

core/ds.c

@@ -41,7 +41,7 @@ void gst_buffer_ensure(Gst *vm, GstBuffer *buffer, uint32_t capacity) {
     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;
 }

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;
 

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));

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},

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;
 }
 

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);
+            temp.type = GST_NIL;
-            if (vm->thread->count < GST_FRAME_SIZE) {
+            goto vm_return;
-                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;
 
         case GST_OP_RET: /* Return */
             temp = stack[pc[1]];
-            stack = gst_thread_popframe(vm, vm->thread);
+            goto vm_return;
-            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;
 
         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) {
+                    temp = vm->ret;
-                        vm->thread->status = GST_THREAD_DEAD;
+                    goto vm_return;
-                        return status;
-                    } else { 
-                        stack[gst_frame_ret(stack)] = vm->ret;
-                        pc = gst_frame_pc(stack);
-                    }
                 } 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 */
+        case GST_OP_TRN: /* Transfer */
-            temp = stack[pc[1]];
+            temp = stack[pc[2]]; /* The thread */
-            v1 = stack[pc[2]];
+            v1 = stack[pc[3]]; /* The value to pass in */
-            gst_assert(vm, v1.type == GST_THREAD, "expected thread");
+            if (temp.type != GST_THREAD)
-            gst_assert(vm, v1.data.thread->status != GST_THREAD_DEAD, "cannot rejoin dead thread");
+                gst_error(vm, "expected thread");
-            gst_frame_pc(stack) = pc + 3;
+            if (temp.data.thread->status == GST_THREAD_DEAD ||
-            vm->thread = v1.data.thread;
+                temp.data.thread->status == GST_THREAD_ERROR)
-            vm->thread->status = GST_THREAD_ALIVE;
+                gst_error(vm, "cannot enter dead thread");
-            stack = vm->thread->data + vm->thread->count;
+            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;

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 */
 };
 
 /****/

libs/repl.gst

@@ -19,9 +19,11 @@
 "Run a simple repl. Does not handle errors and other
 such details."
 (while 1
+    (: t (thread (fn []
         (write stdout ">> ")
         (: line (readline))
         (while line
             (: line (parse-charseq p line))
             (if (parse-hasvalue p)
-            (print ((compile (parse-consume p)))))))
+                ((compile (parse-consume p))))))))
+    (transfer t))