From 2a0dc5f1ad7a84b5b56530d851ca2505006e8bb6 Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sun, 11 Mar 2018 15:35:23 -0400 Subject: [PATCH] Switch to assymetric coroutines instead of symmetric. --- CMakeLists.txt | 1 + src/assembler/asm.c | 5 +- src/compiler/boot.dst | 91 +++++---- src/compiler/compile.c | 8 +- src/compiler/run.c | 5 +- src/compiler/stl.c | 16 +- src/core/bytecode.c | 3 +- src/core/corelib.c | 11 +- src/core/fiber.c | 17 +- src/core/fiber.h | 41 ++++ src/core/gc.c | 12 +- src/core/io.c | 6 +- src/core/vm.c | 357 ++++++++++++++--------------------- src/include/dst/dst.h | 21 +-- src/include/dst/dstcorelib.h | 2 +- src/include/dst/dstopcodes.h | 3 +- src/include/dst/dststate.h | 3 - src/include/dst/dsttypes.h | 5 +- test/suite0.dst | 10 +- 19 files changed, 301 insertions(+), 316 deletions(-) create mode 100644 src/core/fiber.h diff --git a/CMakeLists.txt b/CMakeLists.txt index 692f812b..d35e8433 100644 --- a/CMakeLists.txt +++ b/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 ) diff --git a/src/assembler/asm.c b/src/assembler/asm.c index e77067a5..709708da 100644 --- a/src/assembler/asm.c +++ b/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 diff --git a/src/compiler/boot.dst b/src/compiler/boot.dst index 09951c96..36fe7cec 100644 --- a/src/compiler/boot.dst +++ b/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] - (fiber (fn [parent] +(defn char-stream [getchunk] + (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)))) - (ondone)))) + (yield (get buf i)))) + 0))) -(defn val-stream [chars] - (fiber (fn [parent] - (var up parent) - (def me (fiber-current)) +(defn val-stream [chars ondone] + (fiber (fn [] (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)) - (def cs (char-stream getter (fn [] + (defn getter [buf] (file-read f 1024 buf) buf) + (defn resetter [] (put require-loading path nil) - (file-close f) (varset! *read* oldread) (varset! *onvalue* oldonvalue) - nil))) - (def vs (val-stream cs)) + (varset! *env* oldenv) + (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)))) - nil) + (varset! *read* (fn [] (resume vs))) + (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))) - (def vs (val-stream cs)) + nil) + (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") - buf) - (fn [] + (buffer-push-string buf "\n")) + (defn resetter [] (varset! *read* oldread) - nil))) - (def vs (val-stream cs)) + 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)))) (defn init-loop [] (while *read* @@ -204,7 +221,7 @@ (if (= (type res) :function) (*onvalue* (res)) (onerr "compile" (get res :error))))))) - (def eb (transfer wrapper)) - (if (= (fiber-status wrapper) :error) (onerr "runtime" eb)))) + (def eb (resume wrapper)) + (if (= (fiber-status wrapper) :error) (onerr "runtime" eb wrapper)))) (defn init-repl [] (dorepl) (init-loop)) diff --git a/src/compiler/compile.c b/src/compiler/compile.c index 979aa49f..34babf35 100644 --- a/src/compiler/compile.c +++ b/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); - if (status) { + DstFiber *f = dst_fiber(dst_unwrap_function(fn), 64); + 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 */ diff --git a/src/compiler/run.c b/src/compiler/run.c index 752066b5..bbad926b 100644 --- a/src/compiler/run.c +++ b/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; - if (dst_run(dst_wrap_function(f), &ret)) { + DstFiber *fiber = dst_fiber(f, 64); + 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; } diff --git a/src/compiler/stl.c b/src/compiler/stl.c index b8be4926..f8486d21 100644 --- a/src/compiler/stl.c +++ b/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_TRANSFER | (1 << 16), + DOP_YIELD, DOP_RETURN }; - static uint32_t transfer_asm[] = { - DOP_TRANSFER | (1 << 24), + static uint32_t resume_asm[] = { + 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)); diff --git a/src/core/bytecode.c b/src/core/bytecode.c index 7dc5996e..1a6ec168 100644 --- a/src/core/bytecode.c +++ b/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, */ diff --git a/src/core/corelib.c b/src/core/corelib.c index 18a82b8c..97870d9e 100644 --- a/src/core/corelib.c +++ b/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"); - fiber = dst_fiber(64); - fiber->parent = dst_vm_fiber; - dst_fiber_funcframe(fiber, dst_unwrap_function(args.v[0])); + if (!dst_checktype(args.v[0], DST_FUNCTION)) + return dst_throw(args, "expected a function"); + fiber = dst_fiber(dst_unwrap_function(args.v[0]), 64); 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; diff --git a/src/core/fiber.c b/src/core/fiber.c index 4bab1ef0..fe30539e 100644 --- a/src/core/fiber.c +++ b/src/core/fiber.c @@ -21,11 +21,15 @@ */ #include +#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; } diff --git a/src/core/fiber.h b/src/core/fiber.h new file mode 100644 index 00000000..1bb158b1 --- /dev/null +++ b/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 + +#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 diff --git a/src/core/gc.c b/src/core/gc.c index 9ce43639..dfc9b6e0 100644 --- a/src/core/gc.c +++ b/src/core/gc.c @@ -180,9 +180,13 @@ 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; @@ -198,8 +202,10 @@ static void dst_mark_fiber(DstFiber *fiber) { i = frame->prevframe; } - if (NULL != fiber->parent) - dst_mark_fiber(fiber->parent); + if (fiber->child) { + 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(); diff --git a/src/core/io.c b/src/core/io.c index 838c4a69..91020273 100644 --- a/src/core/io.c +++ b/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)) - return dst_throw(args, "could not close file"); + if (iof->flags & (IO_CLOSED)) + 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)); diff --git a/src/core/vm.c b/src/core/vm.c index 4e172e07..188ab317 100644 --- a/src/core/vm.c +++ b/src/core/vm.c @@ -22,35 +22,15 @@ #include #include -#include "symcache.h" +#include "fiber.h" #include "gc.h" +#include "symcache.h" -/* VM State */ -DstFiber *dst_vm_fiber = NULL; +/* VM state */ 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"); - return 1; + fiber->status = DST_FIBER_ERROR; + 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->as.fiber = dst_vm_fiber; + env->offset = fiber->frame; + env->as.fiber = fiber; env->length = func->def->slotcount; frame->env = env; } @@ -527,29 +511,29 @@ static void *op_lookup[255] = { stack[oparg(1, 0xFF)] = dst_wrap_function(fn); pc++; vm_checkgc_next(); - } + } 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 && - dst_vm_fiber->stacktop > dst_vm_fiber->maxstack) { + if (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); - stack = dst_vm_fiber->data + dst_vm_fiber->frame; + dst_fiber_funcframe(fiber, func); + 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; - dst_fiber_cframe(dst_vm_fiber); + args.n = fiber->stacktop - fiber->stackstart; + 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); - stack = dst_vm_fiber->data + dst_vm_fiber->frame; + dst_fiber_funcframe_tail(fiber, func); + 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; - dst_fiber_cframe(dst_vm_fiber); + args.n = fiber->stacktop - fiber->stackstart; + 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 temp = stack[oparg(2, 0xFF)]; - retreg = stack[oparg(3, 0xFF)]; - vm_assert(dst_checktype(temp, DST_FIBER) || - dst_checktype(temp, DST_NIL), "expected fiber"); - nextfiber = dst_checktype(temp, DST_FIBER) - ? dst_unwrap_fiber(temp) - : dst_vm_fiber->parent; - /* Check for root fiber */ - if (NULL == nextfiber) { - frame->pc = pc; - *returnreg = retreg; - dst_vm_stackn--; - return 0; + Dst fiberval = stack[oparg(2, 0xFF)]; + Dst val = stack[oparg(3, 0xFF)]; + vm_assert(dst_checktype(fiberval, DST_FIBER), "expected fiber"); + nextfiber = dst_unwrap_fiber(fiberval); + switch (nextfiber->status) { + default: + vm_throw("expected pending or new fiber"); + case DST_FIBER_NEW: + { + dst_fiber_push(nextfiber, val); + dst_fiber_funcframe(nextfiber, nextfiber->root); + nextfiber->flags &= ~DST_FIBER_FLAG_NEW; + break; + } + 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; - vm_assert(status == DST_FIBER_PENDING || - status == DST_FIBER_NEW, "can only transfer to new or pending fiber"); - frame->pc = pc; - dst_vm_fiber->status = DST_FIBER_PENDING; - dst_vm_fiber = nextfiber; - vm_init_fiber_state(); - if (status == DST_FIBER_PENDING) { - /* The next fiber is currently on a transfer instruction. */ - stack[oparg(1, 0xFF)] = retreg; - pc++; - } else { - /* The next fiber is new and is on the first instruction */ - if ((func->def->flags & DST_FUNCDEF_FLAG_VARARG) && - !func->def->arity) { - /* 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; - } + fiber->child = nextfiber; + retreg = dst_run(nextfiber); + switch (nextfiber->status) { + case DST_FIBER_DEBUG: + if (fiber->flags & DST_FIBER_MASK_DEBUG) goto vm_debug; + fiber->child = NULL; + break; + case DST_FIBER_ERROR: + if (fiber->flags & DST_FIBER_MASK_ERROR) goto vm_error; + fiber->child = NULL; + break; + default: + fiber->child = NULL; + if (fiber->flags & DST_FIBER_MASK_RETURN) goto vm_return_root; + break; } + 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); - if (dst_update_fiber(DST_FIBER_MASK_RETURN)) goto vm_exit_value; - stack = dst_vm_fiber->data + dst_vm_fiber->frame; + dst_fiber_popframe(fiber); + if (fiber->frame == 0) goto vm_return_root; + 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); - if (dst_update_fiber(DST_FIBER_MASK_RETURN)) goto vm_exit_value; - goto vm_return; + dst_fiber_popframe(fiber); + dst_fiber_popframe(fiber); + 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); - if (dst_update_fiber(DST_FIBER_MASK_RETURN)) goto vm_exit_value; + dst_fiber_popframe(fiber); + 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; - if (dst_update_fiber(DST_FIBER_MASK_ERROR)) goto vm_exit_error; - goto vm_reset; + fiber->status = DST_FIBER_ERROR; + goto vm_exit; } /* Handle debugger interrupts */ vm_debug: { - dst_vm_fiber->status = DST_FIBER_DEBUG; - if (dst_update_fiber(DST_FIBER_MASK_DEBUG)) goto vm_exit_debug; - goto vm_reset; + fiber->status = DST_FIBER_DEBUG; + goto vm_exit; + } + + /* 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 - * called to start the vm. */ -int dst_run(Dst callee, Dst *returnreg) { - if (dst_vm_fiber) { - dst_fiber_reset(dst_vm_fiber); - } else { - dst_vm_fiber = dst_fiber(64); + +Dst dst_resume(DstFiber *fiber, int32_t argn, const Dst *argv) { + switch (fiber->status) { + default: + dst_exit("expected new or pending or fiber"); + case DST_FIBER_NEW: + { + 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)) { - 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; + return dst_run(fiber); } /* 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; diff --git a/src/include/dst/dst.h b/src/include/dst/dst.h index 7afee58f..07f93027 100644 --- a/src/include/dst/dst.h +++ b/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); -#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); +DstFiber *dst_fiber(DstFunction *callee, int32_t capacity); /* 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); -int dst_call(Dst callee, Dst *returnreg, int32_t argn, const Dst *argv); -int dst_call_suspend(Dst callee, Dst *returnreg, int32_t argn, const Dst *argv); +Dst dst_run(DstFiber *fiber); +Dst dst_resume(DstFiber *fiber, int32_t argn, const Dst *argv); /* C Function helpers */ #define dst_throw(a, e) (*((a).ret) = dst_cstringv(e), 1) diff --git a/src/include/dst/dstcorelib.h b/src/include/dst/dstcorelib.h index 1345e213..77c74268 100644 --- a/src/include/dst/dstcorelib.h +++ b/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); diff --git a/src/include/dst/dstopcodes.h b/src/include/dst/dstopcodes.h index 4a5d2cec..b9c54f13 100644 --- a/src/include/dst/dstopcodes.h +++ b/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, diff --git a/src/include/dst/dststate.h b/src/include/dst/dststate.h index 1018be7c..168e1704 100644 --- a/src/include/dst/dststate.h +++ b/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 diff --git a/src/include/dst/dsttypes.h b/src/include/dst/dsttypes.h index d3a5f0ac..1ed68d3c 100644 --- a/src/include/dst/dsttypes.h +++ b/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. */ diff --git a/test/suite0.dst b/test/suite0.dst index a2335162..506b152c 100644 --- a/test/suite0.dst +++ b/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 (= 2 (transfer t)) "second transfer to fiber") -(assert (= 3 (transfer t)) "return from fiber") +(assert (= 1 (resume t)) "initial transfer to new fiber") +(assert (= 2 (resume t)) "second transfer to fiber") +(assert (= 3 (resume t)) "return from fiber") (assert (= (fiber-status t) :dead) "finished fiber is dead") # Var arg tests