mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-06-22 21:23:16 +00:00
Code Issues 1 Releases Wiki Activity

Switch to assymetric coroutines instead of symmetric.

Browse Source
This commit is contained in:
Calvin Rose 2018-03-11 15:35:23 -04:00
parent 0b6ac1698c
commit 2a0dc5f1ad
19 changed files with 301 additions and 316 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
CMakeLists.txt
View File

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

5
src/assembler/asm.c
View File

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

91
src/compiler/boot.dst
View File

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

8
src/compiler/compile.c
View File

@ -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 */

5
src/compiler/run.c
View File

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

16
src/compiler/stl.c
View File

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

3
src/core/bytecode.c
View File

@ -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, */

11
src/core/corelib.c
View File

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

17
src/core/fiber.c
View File

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

41
src/core/fiber.h Normal file
View File

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

12
src/core/gc.c
View File

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

6
src/core/io.c
View File

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

357
src/core/vm.c
View File

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

21
src/include/dst/dst.h
View File

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

2
src/include/dst/dstcorelib.h
View File

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

3
src/include/dst/dstopcodes.h
View File

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

3
src/include/dst/dststate.h
View File

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

5
src/include/dst/dsttypes.h
View File

@ -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. */

10
test/suite0.dst
View File

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