Switch to assymetric coroutines instead of symmetric.

CMakeLists.txt

@@ -85,6 +85,7 @@ src/core/vm.c
 src/core/wrap.c
 
 src/core/gc.h
+src/core/fiber.h
 src/core/symcache.h
 src/core/util.h
 )

src/assembler/asm.c

@@ -120,6 +120,7 @@ static const DstInstructionDef dst_ops[] = {
     {"push3", DOP_PUSH_3},
     {"put", DOP_PUT},
     {"puti", DOP_PUT_INDEX},
+    {"res", DOP_RESUME},
     {"ret", DOP_RETURN},
     {"retn", DOP_RETURN_NIL},
     {"setu", DOP_SET_UPVALUE},
@@ -131,8 +132,8 @@ static const DstInstructionDef dst_ops[] = {
     {"sruim", DOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE},
     {"sub", DOP_SUBTRACT},
     {"tcall", DOP_TAILCALL},
-    {"tran", DOP_TRANSFER},
+    {"tchck", DOP_TYPECHECK},
-    {"tchck", DOP_TYPECHECK}
+    {"yield", DOP_YIELD}
 };
 
 /* Check a dst string against a bunch of test_strings. Return the 

src/compiler/boot.dst

@@ -25,9 +25,18 @@
         (varset! i (+ i 1))
         ret) 
     })
+  (defn fiber-seq [x]
+    {
+      :more (fn [] (or
+            (= (fiber-status x) :pending)
+            (= (fiber-status x) :new)))
+      :next (fn []
+          (resume x))
+    })
   (def seqs {
     :array array-seq
     :tuple array-seq
+    :fiber fiber-seq
     :struct (fn [x] x)})
   (fn [x]
    (def makeseq (get seqs (type x)))
@@ -81,8 +90,7 @@
     (tuple 'def endsym end)
     (tuple 'while (tuple '< sym endsym)
      (tuple-prepend body 'do)
-     (tuple 'varset! sym (tuple '+ sym 1))
+     (tuple 'varset! sym (tuple '+ sym 1)))))
-      )))
 
 (defn pairs [x]
  (var lastkey (next x nil))
@@ -118,15 +126,15 @@
 
 (var *read* nil)
 (var *onvalue* identity)
-(var *env* _env)
+(var *env* (setproto @{} _env))
 
 (def require-loading @{})
 
 (defn onerr [t e]
  (print (string t " error: " e)))
 
-(defn char-stream [getchunk ondone]
+(defn char-stream [getchunk]
- (fiber (fn [parent]
+ (fiber (fn []
    (def buf @"")
    (var len 1)
    (while (< 0 len)
@@ -134,66 +142,75 @@
       (getchunk buf) 
       (varset! len (length buf))
       (for [i 0 len]
-        (transfer parent (get buf i))))
+        (yield (get buf i))))
-   (ondone))))
+   0)))
 
-(defn val-stream [chars]
+(defn val-stream [chars ondone]
- (fiber (fn [parent]
+ (fiber (fn []
-    (var up parent)
-    (def me (fiber-current))
     (def p (parser 1)) 
-    (while true
+    (var going true)
+    (while going
       (def s (parser-status p)) 
       (if (= s :full)
-       (varset! up (transfer up (parser-produce p)))
+       (yield (parser-produce p))
        (if (= s :error)
         (onerr "parse" (parser-error p))
-        (parser-byte p (transfer chars me))))))))
+        (do
+         (def stat (fiber-status chars))
+         (if (or (= :new stat) (= :pending stat))
+          (parser-byte p (resume chars))
+          (varset! going false))))))
+    (ondone))))
 
 (defn require [path]
  (when (get require-loading path)
-  (error (string "circular dependency: module " path "is already loading")))
+  (error (string "circular dependency: module " path " is already loading")))
  (def oldread *read*)
  (def oldonvalue *onvalue*)
+ (def oldenv *env*)
  (def f (file-open path))
- (def getter (fn [buf] (file-read f 1024 buf) buf))
+ (defn getter [buf] (file-read f 1024 buf) buf)
- (def cs (char-stream getter (fn []
+ (defn resetter []
     (put require-loading path nil)
-    (file-close f)
     (varset! *read* oldread)
     (varset! *onvalue* oldonvalue)
-    nil)))
+    (varset! *env* oldenv)
- (def vs (val-stream cs))
+    (file-close f)
+    nil)
+ (def cs (char-stream getter))
+ (def vs (val-stream cs resetter))
  (varset! *onvalue* identity)
- (varset! *read* (fn [] (transfer vs (fiber-current))))
+ (varset! *read* (fn [] (resume vs)))
- nil)
+ (varset! *env* (setproto @{} _env))
+ *env*)
 
 (defn dorepl []
  (def oldread *read*)
- (def cs (char-stream (fn [buf]
+ (defn getter [buf]
     (file-write stdout ">> ")
     (file-read stdin :line buf))
-  (fn []
+ (defn resetter []
     (varset! *read* oldread)
-    nil)))
+    nil)
- (def vs (val-stream cs))
+ (def cs (char-stream getter))
+ (def vs (val-stream cs resetter))
  (varset! *onvalue* (fn [ret]
-  (put _env '_ @{'value ret})
+  (put *env* '_ @{'value ret})
   (describe ret)))
- (varset! *read* (fn [] (transfer vs (fiber-current)))))
+ (varset! *read* (fn [] (resume vs))))
 
 (defn dostring [str]
  (def oldread *read*)
- (def cs (char-stream (fn [buf]
+ (defn getter [buf]
     (buffer-push-string buf str)
-    (buffer-push-string buf "\n")
+    (buffer-push-string buf "\n"))
-    buf)
+ (defn resetter []
-  (fn []
     (varset! *read* oldread)
-    nil)))
+    nil)
- (def vs (val-stream cs))
+ (def cs (char-stream getter))
+ (def vs (val-stream cs resetter))
  (varset! *onvalue* identity)
- (varset! *read* (fn [] (transfer vs (fiber-current)))))
+ (varset! *read* (fn [] (resume vs))))
 
 (defn init-loop []
  (while *read*
@@ -204,7 +221,7 @@
       (if (= (type res) :function)
         (*onvalue* (res))
         (onerr "compile" (get res :error)))))))
-  (def eb (transfer wrapper))
+  (def eb (resume wrapper))
-  (if (= (fiber-status wrapper) :error) (onerr "runtime" eb))))
+  (if (= (fiber-status wrapper) :error) (onerr "runtime" eb wrapper))))
 
 (defn init-repl [] (dorepl) (init-loop))

src/compiler/compile.c

@@ -813,7 +813,6 @@ recur:
                         } else {
                             /* Check macro */
                             DstTable *env = c->env;
-                            int status;
                             Dst fn;
                             Dst entry = dst_table_get(env, headval);
                             for (;;) {
@@ -825,8 +824,11 @@ recur:
                                     dstc_cerror(c, ast, "macro expansion recursed too deeply");
                                     return dstc_cslot(dst_wrap_nil());
                                 } else {
-                                    status = dst_call_suspend(fn, &x, dst_tuple_length(tup) - 1, tup + 1);
+                                    DstFiber *f = dst_fiber(dst_unwrap_function(fn), 64);
-                                    if (status) {
+                                    int lock = dst_gclock();
+                                    x = dst_resume(f, dst_tuple_length(tup) - 1, tup + 1);
+                                    dst_gcunlock(lock);
+                                    if (f->status == DST_FIBER_ERROR || f->status == DST_FIBER_DEBUG) {
                                         dstc_cerror(c, ast, "error in macro expansion");
                                     }
                                     /* Tail recur on the value */

src/compiler/run.c

@@ -41,8 +41,9 @@ int dst_dobytes(DstTable *env, const uint8_t *bytes, int32_t len) {
                     DstCompileResult cres = dst_compile(form, env, 0);
                     if (cres.status == DST_COMPILE_OK) {
                         DstFunction *f = dst_thunk(cres.funcdef);
-                        Dst ret;
+                        DstFiber *fiber = dst_fiber(f, 64);
-                        if (dst_run(dst_wrap_function(f), &ret)) {
+                        Dst ret = dst_run(fiber);
+                        if (fiber->status != DST_FIBER_DEAD) {
                             printf("internal runtime error: %s\n", (const char *) dst_to_string(ret));
                             errflags |= 0x01;
                         }

src/compiler/stl.c

@@ -43,7 +43,6 @@ static const DstReg cfuns[] = {
     {"struct", dst_core_struct},
     {"fiber", dst_core_fiber},
     {"fiber-status", dst_core_fiber_status},
-    {"fiber-current", dst_core_fiber_current},
     {"buffer", dst_core_buffer},
     {"gensym", dst_core_gensym},
     {"get", dst_core_get},
@@ -74,13 +73,12 @@ DstTable *dst_stl_env() {
     };
 
     static uint32_t yield_asm[] = {
-        DOP_LOAD_NIL | (1 << 8),
+        DOP_YIELD,
-        DOP_TRANSFER | (1 << 16),
         DOP_RETURN
     };
 
-    static uint32_t transfer_asm[] = {
+    static uint32_t resume_asm[] = {
-        DOP_TRANSFER | (1 << 24),
+        DOP_RESUME | (1 << 24),
         DOP_RETURN
     };
 
@@ -93,13 +91,10 @@ DstTable *dst_stl_env() {
     dst_env_def(env, "error", dst_wrap_function(dst_quick_asm(1, 0, 1, error_asm, sizeof(error_asm))));
     dst_env_def(env, "apply", dst_wrap_function(dst_quick_asm(2, 0, 2, apply_asm, sizeof(apply_asm))));
     dst_env_def(env, "yield", dst_wrap_function(dst_quick_asm(1, 0, 2, yield_asm, sizeof(yield_asm))));
-    dst_env_def(env, "transfer", dst_wrap_function(dst_quick_asm(2, 0, 2, transfer_asm, sizeof(transfer_asm))));
+    dst_env_def(env, "resume", dst_wrap_function(dst_quick_asm(2, 0, 2, resume_asm, sizeof(resume_asm))));
 
     dst_env_def(env, "VERSION", dst_cstringv(DST_VERSION));
 
-    /* Allow references to the environment */
-    dst_env_def(env, "_env", ret);
-
     /* Set as gc root */
     dst_gcroot(dst_wrap_table(env));
 
@@ -119,6 +114,9 @@ DstTable *dst_stl_env() {
         dst_lib_asm(args);
     }
 
+    /* Allow references to the environment */
+    dst_env_def(env, "_env", ret);
+
     /* Run bootstrap source */
     dst_dobytes(env, dst_stl_bootstrap_gen, sizeof(dst_stl_bootstrap_gen));
 

src/core/bytecode.c

@@ -80,7 +80,8 @@ enum DstInstructionType dst_instructions[DOP_INSTRUCTION_COUNT] = {
     DIT_S, /* DOP_PUSH_ARRAY, */
     DIT_SS, /* DOP_CALL, */
     DIT_S, /* DOP_TAILCALL, */
-    DIT_SSS, /* DOP_TRANSFER, */
+    DIT_SSS, /* DOP_RESUME, */
+    DIT_SS, /* DOP_YIELD, */
     DIT_SSS, /* DOP_GET, */
     DIT_SSS, /* DOP_PUT, */
     DIT_SSU, /* DOP_GET_INDEX, */

src/core/corelib.c

@@ -137,10 +137,9 @@ int dst_core_struct(DstArgs args) {
 int dst_core_fiber(DstArgs args) {
     DstFiber *fiber;
     if (args.n < 1) return dst_throw(args, "expected at least one argument");
-    if (!dst_checktype(args.v[0], DST_FUNCTION)) return dst_throw(args, "expected a function");
+    if (!dst_checktype(args.v[0], DST_FUNCTION))
-    fiber = dst_fiber(64);
+        return dst_throw(args, "expected a function");
-    fiber->parent = dst_vm_fiber;
+    fiber = dst_fiber(dst_unwrap_function(args.v[0]), 64);
-    dst_fiber_funcframe(fiber, dst_unwrap_function(args.v[0]));
     return dst_return(args, dst_wrap_fiber(fiber));
 }
 
@@ -226,10 +225,6 @@ int dst_core_fiber_status(DstArgs args) {
     return dst_return(args, dst_csymbolv(status));
 }
 
-int dst_core_fiber_current(DstArgs args) {
-    return dst_return(args, dst_wrap_fiber(dst_vm_fiber));
-}
-
 int dst_core_put(DstArgs args) {
     Dst ds, key, value;
     DstArgs subargs = args;

src/core/fiber.c

@@ -21,11 +21,15 @@
 */
 
 #include <dst/dst.h>
+#include "fiber.h"
 #include "gc.h"
 
 /* Initialize a new fiber */
-DstFiber *dst_fiber(int32_t capacity) {
+DstFiber *dst_fiber(DstFunction *callee, int32_t capacity) {
     DstFiber *fiber = dst_gcalloc(DST_MEMORY_FIBER, sizeof(DstFiber));
+    if (capacity < 16) {
+        capacity = 16;
+    }
     fiber->capacity = capacity;
     if (capacity) {
         Dst *data = malloc(sizeof(Dst) * capacity);
@@ -33,22 +37,21 @@ DstFiber *dst_fiber(int32_t capacity) {
             DST_OUT_OF_MEMORY;
         }
         fiber->data = data;
-    } else {
-        fiber->data = NULL;
     }
-    fiber->parent = NULL;
     fiber->maxstack = DST_STACK_MAX;
     fiber->flags = DST_FIBER_MASK_DEBUG;
-    return dst_fiber_reset(fiber);
+    return dst_fiber_reset(fiber, callee);
 }
 
 /* Clear a fiber (reset it) */
-DstFiber *dst_fiber_reset(DstFiber *fiber) {
+DstFiber *dst_fiber_reset(DstFiber *fiber, DstFunction *callee) {
     fiber->frame = 0;
     fiber->stackstart = DST_FRAME_SIZE;
     fiber->stacktop = DST_FRAME_SIZE;
     fiber->status = DST_FIBER_NEW;
-    fiber->parent = NULL;
+    fiber->root = callee;
+    fiber->child = NULL;
+    fiber->flags |= DST_FIBER_FLAG_NEW;
     return fiber;
 }
 

src/core/fiber.h

@@ -0,0 +1,41 @@
+/*
+* Copyright (c) 2017 Calvin Rose
+*
+* Permission is hereby granted, free of charge, to any person obtaining a copy
+* of this software and associated documentation files (the "Software"), to
+* deal in the Software without restriction, including without limitation the
+* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+* sell copies of the Software, and to permit persons to whom the Software is
+* furnished to do so, subject to the following conditions:
+*
+* The above copyright notice and this permission notice shall be included in
+* all copies or substantial portions of the Software.
+*
+* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
+* IN THE SOFTWARE.
+*/
+
+#ifndef DST_FIBER_H_defined
+#define DST_FIBER_H_defined
+
+#include <dst/dst.h>
+
+#define dst_stack_frame(s) ((DstStackFrame *)((s) - DST_FRAME_SIZE))
+#define dst_fiber_frame(f) dst_stack_frame((f)->data + (f)->frame)
+DstFiber *dst_fiber_reset(DstFiber *fiber, DstFunction *callee);
+void dst_fiber_setcapacity(DstFiber *fiber, int32_t n);
+void dst_fiber_push(DstFiber *fiber, Dst x);
+void dst_fiber_push2(DstFiber *fiber, Dst x, Dst y);
+void dst_fiber_push3(DstFiber *fiber, Dst x, Dst y, Dst z);
+void dst_fiber_pushn(DstFiber *fiber, const Dst *arr, int32_t n);
+void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func);
+void dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func);
+void dst_fiber_cframe(DstFiber *fiber);
+void dst_fiber_popframe(DstFiber *fiber);
+
+#endif

src/core/gc.c

@@ -180,10 +180,14 @@ static void dst_mark_function(DstFunction *func) {
 static void dst_mark_fiber(DstFiber *fiber) {
     int32_t i, j;
     DstStackFrame *frame;
+recur:
     if (dst_gc_reachable(fiber))
         return;
     dst_gc_mark(fiber);
 
+    if (fiber->flags & DST_FIBER_FLAG_NEW) 
+        dst_mark_function(fiber->root);
+    
     i = fiber->frame;
     j = fiber->stackstart - DST_FRAME_SIZE;
     while (i > 0) {
@@ -198,8 +202,10 @@ static void dst_mark_fiber(DstFiber *fiber) {
         i = frame->prevframe;
     }
 
-    if (NULL != fiber->parent)
+    if (fiber->child) {
-        dst_mark_fiber(fiber->parent);
+        fiber = fiber->child;
+        goto recur;
+    }
 }
 
 /* Deinitialize a block of memory */
@@ -309,8 +315,6 @@ void *dst_gcalloc(enum DstMemoryType type, size_t size) {
 void dst_collect(void) {
     uint32_t i;
     if (dst_vm_gc_suspend) return;
-    if (dst_vm_fiber)
-        dst_mark_fiber(dst_vm_fiber);
     for (i = 0; i < dst_vm_root_count; i++)
         dst_mark(dst_vm_roots[i]);
     dst_sweep();

src/core/io.c

@@ -249,8 +249,10 @@ static int dst_io_gc(void *p, size_t len) {
 static int dst_io_fclose(DstArgs args) {
     IOFile *iof = checkfile(args, 0);
     if (!iof) return 1;
-    if (iof->flags & (IO_CLOSED | IO_NOT_CLOSEABLE))
+    if (iof->flags & (IO_CLOSED))
-        return dst_throw(args, "could not close file");
+        return dst_throw(args, "file already closed");
+    if (iof->flags & (IO_NOT_CLOSEABLE))
+        return dst_throw(args, "file not closable");
     if (fclose(iof->file)) return dst_throw(args, "could not close file");
     iof->flags |= IO_CLOSED;
     return dst_return(args, dst_wrap_abstract(iof));

src/core/vm.c

@@ -22,35 +22,15 @@
 
 #include <dst/dst.h>
 #include <dst/dstopcodes.h>
-#include "symcache.h"
+#include "fiber.h"
 #include "gc.h"
+#include "symcache.h"
 
-/* VM State */
+/* VM state */
-DstFiber *dst_vm_fiber = NULL;
 int dst_vm_stackn = 0;
 
-/* Helper to ensure proper fiber is activated after returning */
-static int dst_update_fiber(uint32_t mask) {
-    if (dst_vm_fiber->frame == 0) {
-        dst_vm_fiber->status = DST_FIBER_DEAD;
-    }
-    while (dst_vm_fiber->status == DST_FIBER_DEAD ||
-            dst_vm_fiber->status == DST_FIBER_ERROR ||
-            dst_vm_fiber->status == DST_FIBER_DEBUG ||
-            dst_vm_fiber->flags & mask) {
-        if (NULL != dst_vm_fiber->parent) {
-            dst_vm_fiber = dst_vm_fiber->parent;
-        } else {
-            /* The root thread has terminated */
-            return 1;
-        }
-    }
-    dst_vm_fiber->status = DST_FIBER_ALIVE;
-    return 0;
-}
-
 /* Start running the VM from where it left off. */
-static int dst_continue(Dst *returnreg) {
+Dst dst_run(DstFiber *fiber) {
 
     /* VM state */
     register Dst *stack;
@@ -63,11 +43,22 @@ static int dst_continue(Dst *returnreg) {
 
     /* Increment the stackn */
     if (dst_vm_stackn >= DST_RECURSION_GUARD) {
-        *returnreg = dst_cstringv("C stack recursed too deeply");
+        fiber->status = DST_FIBER_ERROR;
-        return 1;
+        return dst_cstringv("C stack recursed too deeply");
     }
     dst_vm_stackn++;
 
+    /* Reset fiber state */
+    if (fiber->flags & DST_FIBER_FLAG_NEW) {
+        dst_fiber_funcframe(fiber, fiber->root);
+        fiber->flags &= ~DST_FIBER_FLAG_NEW;
+    }
+    fiber->status = DST_FIBER_ALIVE;
+    dst_gcroot(dst_wrap_fiber(fiber));
+    stack = fiber->data + fiber->frame;
+    pc = dst_stack_frame(stack)->pc;
+    func = dst_stack_frame(stack)->func;
+
 /* Use computed gotos for GCC and clang, otherwise use switch */
 #ifdef __GNUC__
 #define VM_START() {vm_next();
@@ -130,7 +121,8 @@ static void *op_lookup[255] = {
     &&label_DOP_PUSH_ARRAY,
     &&label_DOP_CALL,
     &&label_DOP_TAILCALL,
-    &&label_DOP_TRANSFER,
+    &&label_DOP_RESUME,
+    &&label_DOP_YIELD,
     &&label_DOP_GET,
     &&label_DOP_PUT,
     &&label_DOP_GET_INDEX,
@@ -147,7 +139,7 @@ static void *op_lookup[255] = {
 #define vm_next() continue
 #endif
 
-#define vm_checkgc_next() dst_maybe_collect(); vm_next()
+#define vm_checkgc_next() do { dst_maybe_collect(); vm_next() } while (0)
 
     /* Used to extract bits from the opcode that correspond to arguments.
      * Pulls out unsigned integers */
@@ -194,14 +186,6 @@ static void *op_lookup[255] = {
         vm_next();\
     }
 
-#define vm_init_fiber_state() \
-    dst_vm_fiber->status = DST_FIBER_ALIVE;\
-    stack = dst_vm_fiber->data + dst_vm_fiber->frame;\
-    pc = dst_stack_frame(stack)->pc;\
-    func = dst_stack_frame(stack)->func;
-
-    vm_init_fiber_state();
-
     /* Main interpreter loop. Sematically is a switch on
      * (*pc & 0xFF) inside of an infinte loop. */
     VM_START();
@@ -513,8 +497,8 @@ static void *op_lookup[255] = {
                     if (!frame->env) {
                         /* Lazy capture of current stack frame */
                         DstFuncEnv *env = dst_gcalloc(DST_MEMORY_FUNCENV, sizeof(DstFuncEnv));
-                        env->offset = dst_vm_fiber->frame;
+                        env->offset = fiber->frame;
-                        env->as.fiber = dst_vm_fiber;
+                        env->as.fiber = fiber;
                         env->length = func->def->slotcount;
                         frame->env = env;
                     }
@@ -530,26 +514,26 @@ static void *op_lookup[255] = {
     } 
 
     VM_OP(DOP_PUSH)
-        dst_fiber_push(dst_vm_fiber, stack[oparg(1, 0xFFFFFF)]);
+        dst_fiber_push(fiber, stack[oparg(1, 0xFFFFFF)]);
         pc++;
-        stack = dst_vm_fiber->data + dst_vm_fiber->frame;
+        stack = fiber->data + fiber->frame;
         vm_checkgc_next();
 
     VM_OP(DOP_PUSH_2)
-        dst_fiber_push2(dst_vm_fiber, 
+        dst_fiber_push2(fiber, 
                 stack[oparg(1, 0xFF)],
                 stack[oparg(2, 0xFFFF)]);
     pc++;
-    stack = dst_vm_fiber->data + dst_vm_fiber->frame;
+    stack = fiber->data + fiber->frame;
     vm_checkgc_next();
 
     VM_OP(DOP_PUSH_3)
-        dst_fiber_push3(dst_vm_fiber, 
+        dst_fiber_push3(fiber, 
                 stack[oparg(1, 0xFF)],
                 stack[oparg(2, 0xFF)],
                 stack[oparg(3, 0xFF)]);
     pc++;
-    stack = dst_vm_fiber->data + dst_vm_fiber->frame;
+    stack = fiber->data + fiber->frame;
     vm_checkgc_next();
 
     VM_OP(DOP_PUSH_ARRAY)
@@ -557,35 +541,35 @@ static void *op_lookup[255] = {
         const Dst *vals;
         int32_t len;
         if (dst_seq_view(stack[oparg(1, 0xFFFFFF)], &vals, &len)) {
-            dst_fiber_pushn(dst_vm_fiber, vals, len);        
+            dst_fiber_pushn(fiber, vals, len);        
         } else {
             vm_throw("expected array/tuple");
         }
     }
     pc++;
-    stack = dst_vm_fiber->data + dst_vm_fiber->frame;
+    stack = fiber->data + fiber->frame;
     vm_checkgc_next();
 
     VM_OP(DOP_CALL)
     {
         Dst callee = stack[oparg(2, 0xFFFF)];
-        if (dst_vm_fiber->maxstack &&
+        if (fiber->maxstack &&
-                dst_vm_fiber->stacktop > dst_vm_fiber->maxstack) {
+                fiber->stacktop > fiber->maxstack) {
             vm_throw("stack overflow");
         }
         if (dst_checktype(callee, DST_FUNCTION)) {
             func = dst_unwrap_function(callee);
             dst_stack_frame(stack)->pc = pc;
-            dst_fiber_funcframe(dst_vm_fiber, func);
+            dst_fiber_funcframe(fiber, func);
-            stack = dst_vm_fiber->data + dst_vm_fiber->frame;
+            stack = fiber->data + fiber->frame;
             pc = func->def->bytecode;
             vm_checkgc_next();
         } else if (dst_checktype(callee, DST_CFUNCTION)) {
             DstArgs args;
-            args.n = dst_vm_fiber->stacktop - dst_vm_fiber->stackstart;
+            args.n = fiber->stacktop - fiber->stackstart;
-            dst_fiber_cframe(dst_vm_fiber);
+            dst_fiber_cframe(fiber);
             retreg = dst_wrap_nil();
-            args.v = dst_vm_fiber->data + dst_vm_fiber->frame;
+            args.v = fiber->data + fiber->frame;
             args.ret = &retreg;
             if (dst_unwrap_cfunction(callee)(args)) {
                 goto vm_error;
@@ -600,16 +584,16 @@ static void *op_lookup[255] = {
         Dst callee = stack[oparg(1, 0xFFFFFF)];
         if (dst_checktype(callee, DST_FUNCTION)) {
             func = dst_unwrap_function(callee);
-            dst_fiber_funcframe_tail(dst_vm_fiber, func);
+            dst_fiber_funcframe_tail(fiber, func);
-            stack = dst_vm_fiber->data + dst_vm_fiber->frame;
+            stack = fiber->data + fiber->frame;
             pc = func->def->bytecode;
             vm_checkgc_next();
         } else if (dst_checktype(callee, DST_CFUNCTION)) {
             DstArgs args;
-            args.n = dst_vm_fiber->stacktop - dst_vm_fiber->stackstart;
+            args.n = fiber->stacktop - fiber->stackstart;
-            dst_fiber_cframe(dst_vm_fiber);
+            dst_fiber_cframe(fiber);
             retreg = dst_wrap_nil();
-            args.v = dst_vm_fiber->data + dst_vm_fiber->frame;
+            args.v = fiber->data + fiber->frame;
             args.ret = &retreg;
             if (dst_unwrap_cfunction(callee)(args)) {
                 goto vm_error;
@@ -619,52 +603,59 @@ static void *op_lookup[255] = {
         vm_throw("expected function");
     }
 
-    VM_OP(DOP_TRANSFER)
+    VM_OP(DOP_RESUME)
     {
-        int status;
         DstFiber *nextfiber;
-        DstStackFrame *frame = dst_stack_frame(stack);
+        Dst fiberval = stack[oparg(2, 0xFF)];
-        Dst temp = stack[oparg(2, 0xFF)];
+        Dst val = stack[oparg(3, 0xFF)];
-        retreg = stack[oparg(3, 0xFF)];
+        vm_assert(dst_checktype(fiberval, DST_FIBER), "expected fiber");
-        vm_assert(dst_checktype(temp, DST_FIBER) ||
+        nextfiber = dst_unwrap_fiber(fiberval);
-                  dst_checktype(temp, DST_NIL), "expected fiber");
+        switch (nextfiber->status) {
-        nextfiber = dst_checktype(temp, DST_FIBER)
+            default:
-            ? dst_unwrap_fiber(temp)
+                vm_throw("expected pending or new fiber");
-            : dst_vm_fiber->parent;
+            case DST_FIBER_NEW:
-        /* Check for root fiber */
+                {
-        if (NULL == nextfiber) {
+                    dst_fiber_push(nextfiber, val);
-            frame->pc = pc;
+                    dst_fiber_funcframe(nextfiber, nextfiber->root);
-            *returnreg = retreg;
+                    nextfiber->flags &= ~DST_FIBER_FLAG_NEW;
-            dst_vm_stackn--;
+                    break;
-            return 0;
+                }
+            case DST_FIBER_PENDING:
+                {
+                    DstStackFrame *nextframe = dst_fiber_frame(nextfiber);
+                    nextfiber->data[nextfiber->frame + ((*nextframe->pc >> 8) & 0xFF)] = val;
+                    nextframe->pc++;
+                    break;
+                }
         }
-        status = nextfiber->status;
+        fiber->child = nextfiber;
-        vm_assert(status == DST_FIBER_PENDING ||
+        retreg = dst_run(nextfiber);
-                status == DST_FIBER_NEW, "can only transfer to new or pending fiber");
+        switch (nextfiber->status) {
-        frame->pc = pc;
+            case DST_FIBER_DEBUG:
-        dst_vm_fiber->status = DST_FIBER_PENDING;
+                if (fiber->flags & DST_FIBER_MASK_DEBUG) goto vm_debug;
-        dst_vm_fiber = nextfiber;
+                fiber->child = NULL;
-        vm_init_fiber_state();
+                break;
-        if (status == DST_FIBER_PENDING) {
+            case DST_FIBER_ERROR:
-            /* The next fiber is currently on a transfer instruction. */
+                if (fiber->flags & DST_FIBER_MASK_ERROR) goto vm_error;
-            stack[oparg(1, 0xFF)] = retreg;
+                fiber->child = NULL;
-            pc++;
+                break;
-        } else {
+            default:
-            /* The next fiber is new and is on the first instruction */
+                fiber->child = NULL;
-            if ((func->def->flags & DST_FUNCDEF_FLAG_VARARG) &&
+                if (fiber->flags & DST_FIBER_MASK_RETURN) goto vm_return_root;
-                    !func->def->arity) {
+                break;
-                /* Fully var arg function */
-                Dst *tup = dst_tuple_begin(1);
-                tup[0] = retreg;
-                stack[0] = dst_wrap_tuple(dst_tuple_end(tup));
-            } else if (func->def->arity) {
-                /* Non zero arity function */
-                stack[0] = retreg;
-            }
         }
+        stack[oparg(1, 0xFF)] = retreg;
+        pc++;
         vm_checkgc_next();
     }
 
+    VM_OP(DOP_YIELD)
+    {
+        retreg = stack[oparg(2, 0xFFFF)];
+        fiber->status = DST_FIBER_PENDING;
+        goto vm_exit;
+    }
+
     VM_OP(DOP_PUT)
     dst_put(stack[oparg(1, 0xFF)],
             stack[oparg(2, 0xFF)],
@@ -698,12 +689,12 @@ static void *op_lookup[255] = {
     ++pc;
     vm_next();
 
-    /* Return from c function. Simpler than retuning from dst function */
+    /* Return from c function. Simpler than returning from dst function */
     vm_return_cfunc:
     {
-        dst_fiber_popframe(dst_vm_fiber);
+        dst_fiber_popframe(fiber);
-        if (dst_update_fiber(DST_FIBER_MASK_RETURN)) goto vm_exit_value;
+        if (fiber->frame == 0) goto vm_return_root;
-        stack = dst_vm_fiber->data + dst_vm_fiber->frame;
+        stack = fiber->data + fiber->frame;
         stack[oparg(1, 0xFF)] = retreg;
         pc++;
         vm_checkgc_next();
@@ -712,39 +703,54 @@ static void *op_lookup[255] = {
     /* Return from a cfunction that is in tail position (pop 2 stack frames) */
     vm_return_cfunc_tail:
     {
-        dst_fiber_popframe(dst_vm_fiber);
+        dst_fiber_popframe(fiber);
-        if (dst_update_fiber(DST_FIBER_MASK_RETURN)) goto vm_exit_value;
+        dst_fiber_popframe(fiber);
-        goto vm_return;
+        if (fiber->frame == 0) goto vm_return_root;
+        goto vm_reset;
     }
 
     /* Handle returning from stack frame. Expect return value in retreg */
     vm_return:
     {
-        dst_fiber_popframe(dst_vm_fiber);
+        dst_fiber_popframe(fiber);
-        if (dst_update_fiber(DST_FIBER_MASK_RETURN)) goto vm_exit_value;
+        if (fiber->frame == 0) goto vm_return_root;
         goto vm_reset;
     }
 
+    /* Exit loop with return value */
+    vm_return_root:
+    {
+        fiber->status = DST_FIBER_DEAD;
+        goto vm_exit;
+    }
+
     /* Handle errors from c functions and vm opcodes */
     vm_error:
     {
-        dst_vm_fiber->status = DST_FIBER_ERROR;
+        fiber->status = DST_FIBER_ERROR;
-        if (dst_update_fiber(DST_FIBER_MASK_ERROR)) goto vm_exit_error;
+        goto vm_exit;
-        goto vm_reset;
     }
 
     /* Handle debugger interrupts */
     vm_debug:
     {
-        dst_vm_fiber->status = DST_FIBER_DEBUG;
+        fiber->status = DST_FIBER_DEBUG;
-        if (dst_update_fiber(DST_FIBER_MASK_DEBUG)) goto vm_exit_debug;
+        goto vm_exit;
-        goto vm_reset;
+    }
+
+    /* Exit from vm loop */
+    vm_exit:
+    {
+        dst_stack_frame(stack)->pc = pc;
+        dst_vm_stackn--;
+        dst_gcunroot(dst_wrap_fiber(fiber));
+        return retreg;
     }
 
     /* Reset state of machine */
     vm_reset:
     {
-        stack = dst_vm_fiber->data + dst_vm_fiber->frame;
+        stack = fiber->data + fiber->frame;
         func = dst_stack_frame(stack)->func;
         pc = dst_stack_frame(stack)->pc;
         stack[oparg(1, 0xFF)] = retreg;
@@ -752,30 +758,6 @@ static void *op_lookup[255] = {
         vm_checkgc_next();
     }   
 
-    /* Exit loop with return value */
-    vm_exit_value:
-    {
-        *returnreg = retreg;
-        dst_vm_stackn--;
-        return 0;
-    }
-
-    /* Exit loop with error value */
-    vm_exit_error:
-    {
-        *returnreg = retreg;
-        dst_vm_stackn--;
-        return 1;
-    }
-
-    /* Exit loop with debug */
-    vm_exit_debug:
-    {
-        *returnreg = dst_wrap_nil();
-        dst_vm_stackn--;
-        return 2;
-    }
-    
     VM_END()
 
 #undef oparg
@@ -786,81 +768,33 @@ static void *op_lookup[255] = {
 #undef vm_binop_real
 #undef vm_binop_integer
 #undef vm_binop_immediate
-#undef vm_init_fiber_state
 
 }
     
-/* Run the vm with a given function. This function is
+Dst dst_resume(DstFiber *fiber, int32_t argn, const Dst *argv) {
- * called to start the vm. */
+    switch (fiber->status) {
-int dst_run(Dst callee, Dst *returnreg) {
+        default:
-    if (dst_vm_fiber) {
+            dst_exit("expected new or pending or fiber");
-       dst_fiber_reset(dst_vm_fiber); 
+        case DST_FIBER_NEW:
-    } else {
+            {
-        dst_vm_fiber = dst_fiber(64);
+                int32_t i;
+                for (i = 0; i < argn; i++)
+                    dst_fiber_push(fiber, argv[i]);
+                dst_fiber_funcframe(fiber, fiber->root);
+                fiber->flags &= ~DST_FIBER_FLAG_NEW;
+                break;
+            }
+        case DST_FIBER_PENDING:
+            {
+                DstStackFrame *frame = dst_fiber_frame(fiber);
+                fiber->data[fiber->frame + ((*frame->pc >> 8) & 0xFF)] = argn > 0
+                    ? argv[0]
+                    : dst_wrap_nil();
+                frame->pc++;
+                break;
+            }
     }
-    if (dst_checktype(callee, DST_CFUNCTION)) {
+    return dst_run(fiber);
-        DstArgs args;
-        *returnreg = dst_wrap_nil();
-        dst_fiber_cframe(dst_vm_fiber);
-        args.n = 0;
-        args.v = dst_vm_fiber->data + dst_vm_fiber->frame;
-        args.ret = returnreg;
-        return dst_unwrap_cfunction(callee)(args);
-    } else if (dst_checktype(callee, DST_FUNCTION)) {
-        dst_fiber_funcframe(dst_vm_fiber, dst_unwrap_function(callee));
-        return dst_continue(returnreg);
-    }
-    *returnreg = dst_cstringv("expected function");
-    return 1;
-}
-
-/* Helper for calling a function */
-static int dst_call_help(Dst callee, Dst *returnreg, int32_t argn, const Dst* argv) {
-    dst_vm_fiber = dst_fiber(64);
-    dst_fiber_pushn(dst_vm_fiber, argv, argn);
-    if (dst_checktype(callee, DST_CFUNCTION)) {
-        DstArgs args;
-        *returnreg = dst_wrap_nil();
-        dst_fiber_cframe(dst_vm_fiber);
-        args.n = argn;
-        args.v = dst_vm_fiber->data + dst_vm_fiber->frame;
-        args.ret = returnreg;
-        return dst_unwrap_cfunction(callee)(args);
-    } else if (dst_checktype(callee, DST_FUNCTION)) {
-        dst_fiber_funcframe(dst_vm_fiber, dst_unwrap_function(callee));
-        return dst_continue(returnreg);
-    } else {
-        *returnreg = dst_cstringv("expected function");
-        return 1;
-    }
-}
-
-/* Run from inside a cfunction. This should only be used for
- * short functions as it prevents re-entering the current fiber
- * and suspend garbage collection. Currently used in the compiler
- * for macro evaluation. */
-int dst_call_suspend(Dst callee, Dst *returnreg, int32_t argn, const Dst *argv) {
-    int ret;
-    int lock;
-    DstFiber *oldfiber = dst_vm_fiber;
-    lock = dst_vm_gc_suspend++;
-    ret = dst_call_help(callee, returnreg, argn, argv);
-    dst_vm_fiber = oldfiber;
-    dst_vm_gc_suspend = lock;
-    return ret;
-}
-
-/* Run from inside a cfunction. This will not suspend GC, so
- * the caller must be sure that no Dst*'s are left dangling in the calling function.
- * Such values can be locked with dst_gcroot and unlocked with dst_gcunroot. */
-int dst_call(Dst callee, Dst *returnreg, int32_t argn, const Dst *argv) {
-    int ret;
-    DstFiber *oldfiber = dst_vm_fiber;
-    dst_gcroot(dst_wrap_fiber(oldfiber));
-    ret = dst_call_help(callee, returnreg, argn, argv);
-    dst_gcunroot(dst_wrap_fiber(oldfiber));
-    dst_vm_fiber = oldfiber;
-    return ret;
 }
 
 /* Setup functions */
@@ -874,8 +808,6 @@ int dst_init() {
      * there are no memory bugs during dev */
     dst_vm_gc_interval = 0x100000;
     dst_symcache_init();
-    /* Set thread */
-    dst_vm_fiber = NULL;
     /* Initialize gc roots */
     dst_vm_roots = NULL;
     dst_vm_root_count = 0;
@@ -886,7 +818,6 @@ int dst_init() {
 /* Clear all memory associated with the VM */
 void dst_deinit() {
     dst_clear_memory();
-    dst_vm_fiber = NULL;
     dst_symcache_deinit();
     free(dst_vm_roots);
     dst_vm_roots = NULL;

src/include/dst/dst.h

@@ -130,19 +130,7 @@ void dst_table_merge_struct(DstTable *table, const DstKV *other);
 DstKV *dst_table_find(DstTable *t, Dst key);
 
 /* Fiber */
-DstFiber *dst_fiber(int32_t capacity);
+DstFiber *dst_fiber(DstFunction *callee, int32_t capacity);
-#define dst_stack_frame(s) ((DstStackFrame *)((s) - DST_FRAME_SIZE))
-#define dst_fiber_frame(f) dst_stack_frame((f)->data + (f)->frame)
-DstFiber *dst_fiber_reset(DstFiber *fiber);
-void dst_fiber_setcapacity(DstFiber *fiber, int32_t n);
-void dst_fiber_push(DstFiber *fiber, Dst x);
-void dst_fiber_push2(DstFiber *fiber, Dst x, Dst y);
-void dst_fiber_push3(DstFiber *fiber, Dst x, Dst y, Dst z);
-void dst_fiber_pushn(DstFiber *fiber, const Dst *arr, int32_t n);
-void dst_fiber_funcframe(DstFiber *fiber, DstFunction *func);
-void dst_fiber_funcframe_tail(DstFiber *fiber, DstFunction *func);
-void dst_fiber_cframe(DstFiber *fiber);
-void dst_fiber_popframe(DstFiber *fiber);
 
 /* Treat similar types through uniform interfaces for iteration */
 int dst_seq_view(Dst seq, const Dst **data, int32_t *len);
@@ -169,7 +157,7 @@ int dst_gcunrootall(Dst root);
 #define dst_maybe_collect() do {\
     if (dst_vm_next_collection >= dst_vm_gc_interval) dst_collect(); } while (0)
 #define dst_gclock() (dst_vm_gc_suspend++)
-#define dst_gcunlock() (dst_vm_gc_suspend--)
+#define dst_gcunlock(lock) (dst_vm_gc_suspend = lock)
 
 /* Functions */
 DstFuncDef *dst_funcdef_alloc(void);
@@ -192,9 +180,8 @@ int dst_cstrcmp(const uint8_t *str, const char *other);
 /* VM functions */
 int dst_init(void);
 void dst_deinit(void);
-int dst_run(Dst callee, Dst *returnreg);
+Dst dst_run(DstFiber *fiber);
-int dst_call(Dst callee, Dst *returnreg, int32_t argn, const Dst *argv);
+Dst dst_resume(DstFiber *fiber, int32_t argn, const Dst *argv);
-int dst_call_suspend(Dst callee, Dst *returnreg, int32_t argn, const Dst *argv);
 
 /* C Function helpers */
 #define dst_throw(a, e) (*((a).ret) = dst_cstringv(e), 1)

src/include/dst/dstcorelib.h

@@ -94,7 +94,7 @@ int dst_core_rawget(DstArgs args);
 int dst_core_getproto(DstArgs args);
 int dst_core_setproto(DstArgs args);
 int dst_core_fiber_status(DstArgs args);
-int dst_core_fiber_current(DstArgs args);
+int dst_core_fiber_location(DstArgs args);
 int dst_core_put(DstArgs args);
 int dst_core_gccollect(DstArgs args);
 int dst_core_gcsetinterval(DstArgs args);

src/include/dst/dstopcodes.h

@@ -112,7 +112,8 @@ enum DstOpCode {
     DOP_PUSH_ARRAY,
     DOP_CALL,
     DOP_TAILCALL,
-    DOP_TRANSFER,
+    DOP_RESUME,
+    DOP_YIELD,
     DOP_GET,
     DOP_PUT,
     DOP_GET_INDEX,

src/include/dst/dststate.h

@@ -57,9 +57,6 @@ extern Dst *dst_vm_roots;
 extern uint32_t dst_vm_root_count;
 extern uint32_t dst_vm_root_capacity;
 
-/* GC roots - TODO consider a top level fiber pool (per thread?) */
-extern DstFiber *dst_vm_fiber;
-
 #ifdef __cplusplus
 }
 #endif

src/include/dst/dsttypes.h

@@ -310,11 +310,14 @@ struct DstArgs {
 #define DST_FIBER_MASK_ERROR 2
 #define DST_FIBER_MASK_DEBUG 4
 
+#define DST_FIBER_FLAG_NEW 8
+
 /* A lightweight green thread in dst. Does not correspond to
  * operating system threads. */
 struct DstFiber {
     Dst *data;
-    DstFiber *parent;
+    DstFiber *child; /* When a fiber enters the error or debug state, keep track of the original fiber that raised the error. */
+    DstFunction *root; /* First value */
     int32_t frame; /* Index of the stack frame */
     int32_t stackstart; /* Beginning of next args */
     int32_t stacktop; /* Top of stack. Where values are pushed and popped from. */

test/suite0.dst

@@ -160,18 +160,18 @@
 (def afiber (fiber (fn [x]
 	(error (string "hello, " x)))))
 
-(def afiber-result (transfer afiber "world!"))
+(def afiber-result (resume afiber "world!"))
 
 (assert (= afiber-result "hello, world!") "fiber error result")
 (assert (= (fiber-status afiber) :error) "fiber error status")
 
 # yield tests
 
-(def t (fiber (fn [] (transfer nil 1) (yield 2) 3)))
+(def t (fiber (fn [] (yield 1) (yield 2) 3)))
 
-(assert (= 1 (transfer t)) "initial transfer to new fiber")
+(assert (= 1 (resume t)) "initial transfer to new fiber")
-(assert (= 2 (transfer t)) "second transfer to fiber")
+(assert (= 2 (resume t)) "second transfer to fiber")
-(assert (= 3 (transfer t)) "return from fiber")
+(assert (= 3 (resume t)) "return from fiber")
 (assert (= (fiber-status t) :dead) "finished fiber is dead")
 
 # Var arg tests