mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2025-01-10 23:50:26 +00:00
Code Issues 1 Releases Wiki Activity

Fix web build again, simplify fibers and fiber

Browse Source 
implementation code.
This commit is contained in:
Calvin Rose 2018-11-26 09:02:07 -05:00
parent beffba9f04
commit 8bfea73ee7
14 changed files with 269 additions and 283 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
Makefile
View File

@ -29,7 +29,7 @@ LIBDIR=$(PREFIX)/lib
BINDIR=$(PREFIX)/bin
JANET_VERSION?="\"commit-$(shell git log --pretty=format:'%h' -n 1)\""
#CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -fpic -g
#CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -fpic -g -DJANET_VERSION=$(JANET_VERSION)
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -fpic -O2 -fvisibility=hidden \
-DJANET_VERSION=$(JANET_VERSION)
CLIBS=-lm -ldl
@ -112,7 +112,8 @@ $(JANET_LIBRARY): $(JANET_CORE_OBJECTS)
EMCC=emcc
EMCCFLAGS=-std=c99 -Wall -Wextra -Isrc/include -O2 \
-s EXTRA_EXPORTED_RUNTIME_METHODS='["cwrap"]' \
-s ALLOW_MEMORY_GROWTH=1 -s WASM=1 \
-s ALLOW_MEMORY_GROWTH=1 \
-s AGGRESSIVE_VARIABLE_ELIMINATION=1 \
-DJANET_VERSION=$(JANET_VERSION)
JANET_EMTARGET=janet.js
JANET_WEB_SOURCES=$(JANET_CORE_SOURCES) $(JANET_WEBCLIENT_SOURCES)

88
src/core/core.janet
View File

@ -371,7 +371,7 @@
:generate (do
(def $fiber (gensym))
(def $yieldval (gensym))
(def preds @['and
(def preds @['and
(do
(def s (gensym))
(tuple 'do
@ -417,7 +417,7 @@
that yields all values inside the loop in order. See loop for details."
[head & body]
(tuple fiber.new
(tuple 'fn [tuple '&]
(tuple 'fn '[&]
(tuple 'loop head (tuple yield (tuple.prepend body 'do))))))
(defn sum [xs]
@ -433,7 +433,7 @@
(defmacro coro
"A wrapper for making fibers. Same as (fiber.new (fn [&] ...body))."
[& body]
(tuple fiber.new (apply tuple 'fn [tuple '&] body)))
(tuple fiber.new (apply tuple 'fn '[&] body)))
(defmacro if-let
"Takes the first one or two forms in a vector and if both are true binds
@ -1078,15 +1078,15 @@ value, one key will be ignored."
(def method (apply symbol (tuple.slice parts 1)))
(tuple (tuple 'quote method) self))
(def class
(def class
"(class obj)\n\nGets the class of an object."
table.getproto)
(defn instance-of?
"Checks if an object is an instance of a class."
[class obj]
(if obj (or
(= class obj)
(if obj (or
(= class obj)
(instance-of? class (table.getproto obj)))))
(defmacro call
@ -1169,41 +1169,12 @@ value, one key will be ignored."
# The parser object
(def p (parser.new))
# Fiber stream of characters
(def chars
(coro
(def buf @"")
(var len 1)
(while (< 0 len)
(buffer.clear buf)
(chunks buf p)
(:= len (length buf))
(loop [i :range [0 len]]
(yield (get buf i))))
0))
# Fiber stream of values
(def vals
(coro
(while going
(case (parser.status p)
:full (yield (parser.produce p))
:error (do
(def (line col) (parser.where p))
(onerr where "parse" (string (parser.error p) " on line " line ", column " col)))
(case (fiber.status chars)
:new (parser.byte p (resume chars nil))
:pending (parser.byte p (resume chars nil))
(:= going false))))
(when (not= :root (parser.status p))
(onerr where "parse" "unexpected end of source"))))
# Evaluate 1 source form
(defn eval1 [source]
(var good true)
(def f
(fiber.new
(fn [&]
(fn _thunk [&]
(def res (compile source env where))
(if (= (type res) :function)
(res)
@ -1226,10 +1197,28 @@ value, one key will be ignored."
(onvalue res)
(onerr where "runtime" res f)))))
# Run loop
(def oldenv *env*)
(:= *env* env)
(while going (eval1 (resume vals nil)))
# Run loop
(def buf @"")
(while going
(buffer.clear buf)
(chunks buf p)
(var pindex 0)
(def len (length buf))
(if (= len 0) (:= going false))
(while (> len pindex)
(+= pindex (parser.consume p buf pindex))
(case (parser.status p)
:full (eval1 (parser.produce p))
:error (do
(def (line col) (parser.where p))
(onerr where "parse"
(string (parser.error p)
" on line " line
", column " col))))))
(:= *env* oldenv)
env)
@ -1242,19 +1231,21 @@ value, one key will be ignored."
"\n")
(when f
(loop
[{:function func
[nf :in (array.reverse (fiber.lineage f))
:before (file.write stderr " (fiber)\n")
{:function func
:tail tail
:pc pc
:c c
:name name
:source source
:line source-line
:column source-col} :in (fiber.stack f)]
(file.write stderr " in")
:column source-col} :in (fiber.stack nf)]
(file.write stderr " in")
(when c (file.write stderr " cfunction"))
(if name
(file.write stderr " " name)
(when func (file.write stderr " " (string func))))
(when func (file.write stderr " <anonymous>")))
(if source
(do
(file.write stderr " [" source "]")
@ -1279,7 +1270,7 @@ value, one key will be ignored."
(def ret state)
(:= state nil)
(when ret
(buffer.push-string buf ret)
(buffer.push-string buf str)
(buffer.push-string buf "\n")))
(var returnval nil)
(run-context *env* chunks (fn [x] (:= returnval x)) default-error-handler "eval")
@ -1416,17 +1407,14 @@ value, one key will be ignored."
(defn repl
"Run a repl. The first parameter is an optional function to call to
get a chunk of source code. Should return nil for end of file."
[getchunk onvalue onerr &]
[chunks onvalue onerr &]
(def newenv (make-env))
(default getchunk (fn [buf &]
(file.read stdin :line buf)))
(def buf @"")
(default chunks (fn [&] (file.read stdin :line)))
(default onvalue (fn [x]
(put newenv '_ @{:value x})
(print (string.pretty x 20 buf))
(buffer.clear buf)))
(print (string.pretty x 20))))
(default onerr default-error-handler)
(run-context newenv getchunk onvalue onerr "repl"))
(run-context newenv chunks onvalue onerr "repl"))
(defn all-symbols
"Get all symbols available in the current environment."

47
src/core/fiber.c
View File

@ -25,36 +25,49 @@
#include "state.h"
#include "gc.h"
/* Initialize a new fiber */
JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity) {
static JanetFiber *make_fiber(int32_t capacity) {
Janet *data;
JanetFiber *fiber = janet_gcalloc(JANET_MEMORY_FIBER, sizeof(JanetFiber));
if (capacity < 16) {
capacity = 16;
}
fiber->capacity = capacity;
if (capacity) {
Janet *data = malloc(sizeof(Janet) * capacity);
if (NULL == data) {
JANET_OUT_OF_MEMORY;
}
fiber->data = data;
data = malloc(sizeof(Janet) * capacity);
if (NULL == data) {
JANET_OUT_OF_MEMORY;
}
fiber->data = data;
fiber->maxstack = JANET_STACK_MAX;
return janet_fiber_reset(fiber, callee);
}
/* Clear a fiber (reset it) */
JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee) {
fiber->frame = 0;
fiber->stackstart = JANET_FRAME_SIZE;
fiber->stacktop = JANET_FRAME_SIZE;
fiber->root = callee;
fiber->child = NULL;
fiber->flags = JANET_FIBER_MASK_YIELD;
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
return fiber;
}
/* Initialize a new fiber */
JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity) {
JanetFiber *fiber = make_fiber(capacity);
janet_fiber_funcframe(fiber, callee);
return fiber;
}
/* Clear a fiber (reset it) with argn values on the stack. */
JanetFiber *janet_fiber_n(JanetFunction *callee, int32_t capacity, const Janet *argv, int32_t argn) {
int32_t newstacktop;
JanetFiber *fiber = make_fiber(capacity);
newstacktop = fiber->stacktop + argn;
if (newstacktop >= fiber->capacity) {
janet_fiber_setcapacity(fiber, 2 * newstacktop);
}
memcpy(fiber->data + fiber->stacktop, argv, argn * sizeof(Janet));
fiber->stacktop = newstacktop;
janet_fiber_funcframe(fiber, callee);
return fiber;
}
/* Ensure that the fiber has enough extra capacity */
void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
Janet *newData = realloc(fiber->data, sizeof(Janet) * n);
@ -284,8 +297,8 @@ static int cfun_new(JanetArgs args) {
JANET_MAXARITY(args, 2);
JANET_ARG_FUNCTION(func, args, 0);
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
if (func->def->arity != 1) {
JANET_THROW(args, "expected unit arity function in fiber constructor");
if (func->def->arity != 0) {
JANET_THROW(args, "expected nullary function in fiber constructor");
}
}
fiber = janet_fiber(func, 64);
@ -460,7 +473,7 @@ static const JanetReg cfuns[] = {
"Create a new fiber with function body func. Can optionally "
"take a set of signals to block from the current parent fiber "
"when called. The mask is specified as symbol where each character "
"is used to indicate a signal to block. "
"is used to indicate a signal to block. The default sigmask is :y. "
"For example, \n\n"
"\t(fiber.new myfun :e123)\n\n"
"blocks error signals and user signals 1, 2 and 3. The signals are "

1
src/core/fiber.h
View File

@ -34,7 +34,6 @@ extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
#define janet_stack_frame(s) ((JanetStackFrame *)((s) - JANET_FRAME_SIZE))
#define janet_fiber_frame(f) janet_stack_frame((f)->data + (f)->frame)
JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee);
void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n);
void janet_fiber_push(JanetFiber *fiber, Janet x);
void janet_fiber_push2(JanetFiber *fiber, Janet x, Janet y);

4
src/core/gc.c
View File

@ -195,10 +195,6 @@ recur:
if (janet_gc_reachable(fiber))
return;
janet_gc_mark(fiber);
if (fiber->root)
janet_mark_function(fiber->root);
i = fiber->frame;
j = fiber->stackstart - JANET_FRAME_SIZE;
while (i > 0) {

49
src/core/marsh.c
View File

@ -44,7 +44,8 @@ enum {
MR_NYI,
MR_NRV,
MR_C_STACKFRAME,
MR_OVERFLOW
MR_OVERFLOW,
MR_LIVEFIBER
} MarshalResult;
const char *mr_strings[] = {
@ -53,7 +54,8 @@ const char *mr_strings[] = {
"type NYI",
"no registry value",
"fiber has c stack frame",
"buffer overflow"
"buffer overflow",
"alive fiber"
};
/* Lead bytes in marshaling protocol */
@ -162,7 +164,7 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
pushint(st, env->length);
if (env->offset) {
/* On stack variant */
marshal_one_fiber(st, env->as.fiber, flags + 1);
marshal_one(st, janet_wrap_fiber(env->as.fiber), flags + 1);
} else {
/* Off stack variant */
for (int32_t i = 0; i < env->length; i++)
@ -238,20 +240,21 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
}
#define JANET_FIBER_FLAG_HASCHILD (1 << 29)
#define JANET_STACKFRAME_HASENV 2
#define JANET_STACKFRAME_HASENV (1 << 30)
/* Marshal a fiber */
static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
int32_t fflags = fiber->flags;
if ((flags & 0xFFFF) > JANET_RECURSION_GUARD)
longjmp(st->err, MR_STACKOVERFLOW);
if (fiber->child) fiber->flags |= JANET_FIBER_FLAG_HASCHILD;
janet_table_put(&st->seen, janet_wrap_fiber(fiber), janet_wrap_integer(st->nextid++));
pushint(st, fiber->flags);
if (fiber->child) fflags |= JANET_FIBER_FLAG_HASCHILD;
if (janet_fiber_status(fiber) == JANET_STATUS_ALIVE)
longjmp(st->err, MR_LIVEFIBER);
pushint(st, fflags);
pushint(st, fiber->frame);
pushint(st, fiber->stackstart);
pushint(st, fiber->stacktop);
pushint(st, fiber->maxstack);
marshal_one(st, janet_wrap_function(fiber->root), flags + 1);
/* Do frames */
int32_t i = fiber->frame;
int32_t j = fiber->stackstart - JANET_FRAME_SIZE;
@ -272,8 +275,7 @@ static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
i = frame->prevframe;
}
if (fiber->child)
marshal_one_fiber(st, fiber->child, flags + 1);
fiber->flags &= ~JANET_FIBER_FLAG_HASCHILD;
marshal_one(st, janet_wrap_fiber(fiber->child), flags + 1);
}
/* The main body of the marshaling function. Is the main
@ -439,6 +441,7 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
goto done;
case JANET_FIBER:
{
MARK_SEEN();
pushbyte(st, LB_FIBER);
marshal_one_fiber(st, janet_unwrap_fiber(x), flags + 1);
}
@ -589,8 +592,11 @@ static const uint8_t *unmarshal_one_env(
int32_t offset = readint(st, &data);
int32_t length = readint(st, &data);
if (offset) {
Janet fiberv;
/* On stack variant */
data = unmarshal_one_fiber(st, data, &(env->as.fiber), flags);
data = unmarshal_one(st, data, &fiberv, flags);
if (!janet_checktype(fiberv, JANET_FIBER)) longjmp(st->err, UMR_EXPECTED_FIBER);
env->as.fiber = janet_unwrap_fiber(fiberv);
/* Unmarshaling fiber may set values */
if (env->offset != 0 && env->offset != offset) longjmp(st->err, UMR_UNKNOWN);
if (env->length != 0 && env->length != length) longjmp(st->err, UMR_UNKNOWN);
@ -763,7 +769,6 @@ static const uint8_t *unmarshal_one_fiber(
fiber->stackstart = 0;
fiber->stacktop = 0;
fiber->capacity = 0;
fiber->root = NULL;
fiber->child = NULL;
/* Set frame later so fiber can be GCed at anytime if unmarshaling fails */
@ -782,19 +787,10 @@ static const uint8_t *unmarshal_one_fiber(
if ((int32_t)(frame + JANET_FRAME_SIZE) > fiber->stackstart ||
fiber->stackstart > fiber->stacktop ||
fiber->stacktop > fiber->maxstack) {
printf("bad flags and ints.\n");
/* printf("bad flags and ints.\n"); */
goto error;
}
/* Get root fuction */
Janet funcv;
data = unmarshal_one(st, data, &funcv, flags + 1);
if (!janet_checktype(funcv, JANET_FUNCTION)) {
printf("bad root func.\n");
goto error;
}
fiber->root = janet_unwrap_function(funcv);
/* Allocate stack memory */
fiber->capacity = fiber->stacktop + 10;
fiber->data = malloc(sizeof(Janet) * fiber->capacity);
@ -808,7 +804,7 @@ static const uint8_t *unmarshal_one_fiber(
while (stack > 0) {
JanetFunction *func;
JanetFuncDef *def;
JanetFuncEnv *env;
JanetFuncEnv *env = NULL;
int32_t frameflags = readint(st, &data);
int32_t prevframe = readint(st, &data);
int32_t pcdiff = readint(st, &data);
@ -821,7 +817,7 @@ static const uint8_t *unmarshal_one_fiber(
Janet funcv;
data = unmarshal_one(st, data, &funcv, flags + 1);
if (!janet_checktype(funcv, JANET_FUNCTION)) {
printf("bad root func.\n");
/* printf("bad root func.\n"); */
goto error;
}
func = janet_unwrap_function(funcv);
@ -864,8 +860,11 @@ static const uint8_t *unmarshal_one_fiber(
/* Check for child fiber */
if (fiber->flags & JANET_FIBER_FLAG_HASCHILD) {
Janet fiberv;
fiber->flags &= ~JANET_FIBER_FLAG_HASCHILD;
data = unmarshal_one_fiber(st, data, &(fiber->child), flags + 1);
data = unmarshal_one(st, data, &fiberv, flags + 1);
if (!janet_checktype(fiberv, JANET_FIBER)) longjmp(st->err, UMR_EXPECTED_FIBER);
fiber->child = janet_unwrap_fiber(fiberv);
}
/* Return data */

25
src/core/parse.c
View File

@ -643,10 +643,19 @@ static int cfun_consume(JanetArgs args) {
int32_t len;
JanetParser *p;
int32_t i;
JANET_FIXARITY(args, 2);
JANET_MINARITY(args, 2);
JANET_MAXARITY(args, 3);
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
JANET_ARG_BYTES(bytes, len, args, 1);
if (args.n == 3) {
int32_t offset;
JANET_ARG_INTEGER(offset, args, 2);
if (offset < 0 || offset > len)
JANET_THROW(args, "invalid offset");
len -= offset;
bytes += offset;
}
for (i = 0; i < len; i++) {
janet_parser_consume(p, bytes[i]);
switch (janet_parser_status(p)) {
@ -654,14 +663,10 @@ static int cfun_consume(JanetArgs args) {
case JANET_PARSE_PENDING:
break;
default:
{
JanetBuffer *b = janet_buffer(len - i);
janet_buffer_push_bytes(b, bytes + i + 1, len - i - 1);
JANET_RETURN_BUFFER(args, b);
}
JANET_RETURN_INTEGER(args, i + 1);
}
}
JANET_RETURN(args, janet_wrap_nil());
JANET_RETURN_INTEGER(args, i);
}
static int cfun_byte(JanetArgs args) {
@ -786,10 +791,10 @@ static const JanetReg cfuns[] = {
"next value."
},
{"parser.consume", cfun_consume,
"(parser.consume parser bytes)\n\n"
"(parser.consume parser bytes [, index])\n\n"
"Input bytes into the parser and parse them. Will not throw errors "
"if there is a parse error. Returns the bytes not consumed if the parser is "
"full or errors, or nil if the parser is still pending."
"if there is a parse error. Starts at the byte index given by index. Returns "
"the number of bytes read."
},
{"parser.byte", cfun_byte,
"(parser.byte parser b)\n\n"

82
src/core/run.c
View File

@ -22,46 +22,58 @@
#include <janet/janet.h>
#include "state.h"
#include "vector.h"
/* Error reporting */
void janet_stacktrace(JanetFiber *fiber, const char *errtype, Janet err) {
int32_t fi;
const char *errstr = (const char *)janet_to_string(err);
printf("%s error: %s\n", errtype, errstr);
if (!fiber) return;
int32_t i = fiber->frame;
while (i > 0) {
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
JanetFuncDef *def = NULL;
i = frame->prevframe;
printf(" in");
JanetFiber **fibers = NULL;
fprintf(stderr, "%s error: %s\n", errtype, errstr);
if (frame->func) {
def = frame->func->def;
printf(" %s", def->name ? (const char *)def->name : "<anonymous>");
if (def->source) {
printf(" [%s]", (const char *)def->source);
}
} else {
JanetCFunction cfun = (JanetCFunction)(frame->pc);
if (cfun) {
Janet name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun));
if (!janet_checktype(name, JANET_NIL))
printf(" %s", (const char *)janet_to_string(name));
}
}
if (frame->flags & JANET_STACKFRAME_TAILCALL)
printf(" (tailcall)");
if (frame->func && frame->pc) {
int32_t off = (int32_t) (frame->pc - def->bytecode);
if (def->sourcemap) {
JanetSourceMapping mapping = def->sourcemap[off];
printf(" on line %d, column %d", mapping.line, mapping.column);
while (fiber) {
janet_v_push(fibers, fiber);
fiber = fiber->child;
}
for (fi = janet_v_count(fibers) - 1; fi >= 0; fi--) {
fiber = fibers[fi];
int32_t i = fiber->frame;
if (i > 0) fprintf(stderr, " (fiber)\n");
while (i > 0) {
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
JanetFuncDef *def = NULL;
i = frame->prevframe;
fprintf(stderr, " in");
if (frame->func) {
def = frame->func->def;
fprintf(stderr, " %s", def->name ? (const char *)def->name : "<anonymous>");
if (def->source) {
fprintf(stderr, " [%s]", (const char *)def->source);
}
} else {
printf(" pc=%d", off);
JanetCFunction cfun = (JanetCFunction)(frame->pc);
if (cfun) {
Janet name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun));
if (!janet_checktype(name, JANET_NIL))
fprintf(stderr, " %s", (const char *)janet_to_string(name));
else
fprintf(stderr, " <cfunction>");
}
}
if (frame->flags & JANET_STACKFRAME_TAILCALL)
fprintf(stderr, " (tailcall)");
if (frame->func && frame->pc) {
int32_t off = (int32_t) (frame->pc - def->bytecode);
if (def->sourcemap) {
JanetSourceMapping mapping = def->sourcemap[off];
fprintf(stderr, " on line %d, column %d", mapping.line, mapping.column);
} else {
fprintf(stderr, " pc=%d", off);
}
}
fprintf(stderr, "\n");
}
printf("\n");
}
}
@ -86,7 +98,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
if (cres.status == JANET_COMPILE_OK) {
JanetFunction *f = janet_thunk(cres.funcdef);
JanetFiber *fiber = janet_fiber(f, 64);
JanetSignal status = janet_run(fiber, &ret);
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
if (status != JANET_SIGNAL_OK) {
janet_stacktrace(fiber, "runtime", ret);
errflags |= 0x01;
@ -100,13 +112,13 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
break;
case JANET_PARSE_ERROR:
errflags |= 0x04;
printf("parse error: %s\n", janet_parser_error(&parser));
fprintf(stderr, "parse error: %s\n", janet_parser_error(&parser));
break;
case JANET_PARSE_PENDING:
if (index >= len) {
if (dudeol) {
errflags |= 0x04;
printf("internal parse error: unexpected end of source\n");
fprintf(stderr, "internal parse error: unexpected end of source\n");
} else {
dudeol = 1;
janet_parser_consume(&parser, '\n');

54
src/core/vm.c
View File

@ -77,18 +77,6 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
/* Setup fiber state */
janet_vm_fiber = fiber;
janet_gcroot(janet_wrap_fiber(fiber));
janet_gcroot(in);
if (startstatus == JANET_STATUS_NEW) {
janet_fiber_push(fiber, in);
if (janet_fiber_funcframe(fiber, fiber->root)) {
janet_gcunroot(janet_wrap_fiber(fiber));
janet_gcunroot(in);
*out = janet_wrap_string(janet_formatc(
"Could not start fiber with function of arity %d",
fiber->root->def->arity));
return JANET_SIGNAL_ERROR;
}
}
janet_fiber_set_status(fiber, JANET_STATUS_ALIVE);
stack = fiber->data + fiber->frame;
pc = janet_stack_frame(stack)->pc;
@ -98,17 +86,17 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
* Pulls out unsigned integers */
#define oparg(shift, mask) (((*pc) >> ((shift) << 3)) & (mask))
/* Check for child fiber. If there is a child, run child before self.
* This should only be hit when the current fiber is pending on a RESUME
* instruction. */
if (fiber->child) {
/* Check for child fiber. If there is a child, run child before self.
* This should only be hit when the current fiber is pending on a RESUME
* instruction. */
retreg = in;
goto vm_resume_child;
} else if (fiber->flags & JANET_FIBER_FLAG_SIGNAL_WAITING) {
} else if (startstatus != JANET_STATUS_NEW) {
/* Only should be hit if child is waiting on a SIGNAL instruction */
/* If waiting for response to signal, use input and increment pc */
stack[oparg(1, 0xFF)] = in;
pc++;
fiber->flags &= ~JANET_FIBER_FLAG_SIGNAL_WAITING;
}
/* Use computed gotos for GCC and clang, otherwise use switch */
@ -787,7 +775,8 @@ static void *op_lookup[255] = {
retreg = janet_wrap_nil();
args.v = fiber->data + fiber->frame;
args.ret = &retreg;
if ((signal = janet_unwrap_cfunction(callee)(args))) {
if (janet_unwrap_cfunction(callee)(args)) {
signal = JANET_SIGNAL_ERROR;
goto vm_exit;
}
goto vm_return_cfunc;
@ -814,7 +803,8 @@ static void *op_lookup[255] = {
retreg = janet_wrap_nil();
args.v = fiber->data + fiber->frame;
args.ret = &retreg;
if ((signal = janet_unwrap_cfunction(callee)(args))) {
if (janet_unwrap_cfunction(callee)(args)) {
signal = JANET_SIGNAL_ERROR;
goto vm_exit;
}
goto vm_return_cfunc_tail;
@ -840,7 +830,6 @@ static void *op_lookup[255] = {
if (s < 0) s = 0;
signal = s;
retreg = stack[oparg(2, 0xFF)];
fiber->flags |= JANET_FIBER_FLAG_SIGNAL_WAITING;
goto vm_exit;
}
@ -1223,11 +1212,9 @@ static void *op_lookup[255] = {
{
JanetFiber *child = fiber->child;
JanetFiberStatus status = janet_fiber_status(child);
if (status == JANET_STATUS_ALIVE ||
status == JANET_STATUS_DEAD ||
status == JANET_STATUS_ERROR) {
vm_throw("cannot resume alive, dead, or errored fiber");
}
if (status == JANET_STATUS_ALIVE) vm_throw("cannot resume live fiber");
if (status == JANET_STATUS_DEAD) vm_throw("cannot resume dead fiber");
if (status == JANET_STATUS_ERROR) vm_throw("cannot resume errored fiber");
signal = janet_continue(child, retreg, &retreg);
if (signal != JANET_SIGNAL_OK) {
if (child->flags & (1 << signal)) {
@ -1238,6 +1225,8 @@ static void *op_lookup[255] = {
/* Propogate signal */
goto vm_exit;
}
} else {
fiber->child = NULL;
}
stack[oparg(1, 0xFF)] = retreg;
pc++;
@ -1273,7 +1262,6 @@ static void *op_lookup[255] = {
{
janet_stack_frame(stack)->pc = pc;
janet_vm_stackn--;
janet_gcunroot(in);
janet_gcunroot(janet_wrap_fiber(fiber));
janet_vm_fiber = old_vm_fiber;
*out = retreg;
@ -1315,18 +1303,8 @@ JanetSignal janet_call(
const Janet *argv,
Janet *out,
JanetFiber **f) {
int32_t i;
JanetFiber *fiber = janet_fiber(fun, 64);
if (f)
*f = fiber;
for (i = 0; i < argn; i++)
janet_fiber_push(fiber, argv[i]);
if (janet_fiber_funcframe(fiber, fiber->root)) {
*out = janet_cstringv("arity mismatch");
return JANET_SIGNAL_ERROR;
}
/* Prevent push an extra value on the stack */
janet_fiber_set_status(fiber, JANET_STATUS_PENDING);
JanetFiber *fiber = janet_fiber_n(fun, 64, argv, argn);
if (f) *f = fiber;
return janet_continue(fiber, janet_wrap_nil(), out);
}

12
src/include/janet/janet.h
View File

@ -573,9 +573,6 @@ struct JanetArgs {
int32_t n;
};
/* Fiber flags */
#define JANET_FIBER_FLAG_SIGNAL_WAITING (1 << 30)
/* Fiber signal masks. */
#define JANET_FIBER_MASK_ERROR 2
#define JANET_FIBER_MASK_DEBUG 4
@ -603,7 +600,6 @@ struct JanetArgs {
struct JanetFiber {
Janet *data;
JanetFiber *child; /* Keep linked list of fibers for restarting pending fibers */
JanetFunction *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. */
@ -1039,6 +1035,7 @@ JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key);
/* Fiber */
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity);
JANET_API JanetFiber *janet_fiber_n(JanetFunction *callee, int32_t capacity, const Janet *argv, int32_t argn);
#define janet_fiber_status(f) (((f)->flags & JANET_FIBER_STATUS_MASK) >> JANET_FIBER_STATUS_OFFSET)
/* Treat similar types through uniform interfaces for iteration */
@ -1100,7 +1097,6 @@ JANET_API JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, Janet x);
JANET_API int janet_init(void);
JANET_API void janet_deinit(void);
JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
#define janet_run(F,O) janet_continue(F, janet_wrap_nil(), O)
JANET_API JanetSignal janet_call(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
JANET_API void janet_stacktrace(JanetFiber *fiber, const char *errtype, Janet err);
@ -1132,9 +1128,9 @@ JANET_API int janet_typeabstract_err(JanetArgs args, int32_t n, const JanetAbstr
/***** START SECTION MACROS *****/
/* Macros */
#define JANET_THROW(a, e) return (*((a).ret) = janet_cstringv(e), JANET_SIGNAL_ERROR)
#define JANET_THROWV(a, v) return (*((a).ret) = (v), JANET_SIGNAL_ERROR)
#define JANET_RETURN(a, v) return (*((a).ret) = (v), JANET_SIGNAL_OK)
#define JANET_THROW(a, e) return (*((a).ret) = janet_cstringv(e), 1)
#define JANET_THROWV(a, v) return (*((a).ret) = (v), 1)
#define JANET_RETURN(a, v) return (*((a).ret) = (v), 0)
/* Early exit macros */
#define JANET_MAXARITY(A, N) do { if ((A).n > (N))\

10
src/webclient/main.c
View File

@ -34,8 +34,7 @@ static int repl_yield(JanetArgs args) {
JANET_FIXARITY(args, 2);
JANET_ARG_STRING(line_prompt, args, 0);
JANET_ARG_BUFFER(line_buffer, args, 1);
/* Suspend janet repl by throwing a user defined signal */
return JANET_SIGNAL_USER9;
JANET_RETURN_NIL(args);
}
/* Re-enter the loop */
@ -70,15 +69,12 @@ void repl_init(void) {
/* Set up VM */
janet_init();
janet_register("repl-yield", repl_yield);
janet_register("js", cfun_js);
env = janet_core_env();
/* Janet line getter */
janet_def(env, "repl-yield", janet_wrap_cfunction(repl_yield), NULL);
janet_register("repl-yield", repl_yield);
/* Janet line getter */
janet_def(env, "js", janet_wrap_cfunction(cfun_js), NULL);
janet_register("js", cfun_js);
/* Run startup script */
Janet ret;

15
src/webclient/webinit.janet
View File

@ -1,11 +1,10 @@
# Copyright 2017-2018 (C) Calvin Rose
(print (string "Janet " janet.version " Copyright (C) 2017-2018 Calvin Rose"))
(fiber.new
(fn [&]
(repl (fn [buf p]
(def [line] (parser.where p))
(def prompt (string "janet:" line ":" (parser.state p) "> "))
(repl-yield prompt buf)
buf)))
:9e) # stop fiber on error signals and user9 signals
(fiber.new (fn webrepl []
(repl (fn get-line [buf p]
(def [line] (parser.where p))
(def prompt (string "janet:" line ":" (parser.state p) "> "))
(repl-yield prompt buf)
(yield)
buf))))

157
test/suite0.janet
View File

@ -38,16 +38,16 @@
(assert (= -7 (% -20 13)) "modulo 2")
(assert (order< nil false true
(fiber.new (fn [x] x))
1 1.0 "hi"
(quote hello)
(array 1 2 3)
(tuple 1 2 3)
(table "a" "b" "c" "d")
(struct 1 2 3 4)
(buffer "hi")
(fn [x] (+ x x))
print) "type ordering")
(fiber.new (fn [] 1))
1 1.0 "hi"
(quote hello)
(array 1 2 3)
(tuple 1 2 3)
(table "a" "b" "c" "d")
(struct 1 2 3 4)
(buffer "hi")
(fn [x] (+ x x))
print) "type ordering")
(assert (= (string (buffer "123" "456")) (string @"123456")) "buffer literal")
(assert (= (get {} 1) nil) "get nil from empty struct")
@ -109,13 +109,13 @@
# Closure in non function scope
(def outerfun (fn [x y]
(def c (do
(def someval (+ 10 y))
(def ctemp (if x (fn [] someval) (fn [] y)))
ctemp
))
(+ 1 2 3 4 5 6 7)
c))
(def c (do
(def someval (+ 10 y))
(def ctemp (if x (fn [] someval) (fn [] y)))
ctemp
))
(+ 1 2 3 4 5 6 7)
c))
(assert (= ((outerfun 1 2)) 12) "inner closure 1")
(assert (= ((outerfun nil 2)) 2) "inner closure 2")
@ -124,29 +124,29 @@
(assert (= '(1 2 3) (quote (1 2 3)) (tuple 1 2 3)) "quote shorthand")
((fn []
(var accum 1)
(var count 0)
(while (< count 16)
(:= accum (<< accum 1))
(:= count (+ 1 count)))
(assert (= accum 65536) "loop in closure")))
(var accum 1)
(var count 0)
(while (< count 16)
(:= accum (<< accum 1))
(:= count (+ 1 count)))
(assert (= accum 65536) "loop in closure")))
(var accum 1)
(var count 0)
(while (< count 16)
(:= accum (<< accum 1))
(:= count (+ 1 count)))
(:= accum (<< accum 1))
(:= count (+ 1 count)))
(assert (= accum 65536) "loop globally")
(assert (= (struct 1 2 3 4 5 6 7 8) (struct 7 8 5 6 3 4 1 2)) "struct order does not matter 1")
(assert (= (struct
:apple 1
6 :bork
'(1 2 3) 5)
(struct
6 :bork
'(1 2 3) 5
:apple 1)) "struct order does not matter 2")
(assert (= (struct
:apple 1
6 :bork
'(1 2 3) 5)
(struct
6 :bork
'(1 2 3) 5
:apple 1)) "struct order does not matter 2")
# Symbol function
@ -154,9 +154,11 @@
# Fiber tests
(def afiber (fiber.new (fn [x]
(error (string "hello, " x))) :e))
(def afiber (fiber.new (fn []
(def x (yield))
(error (string "hello, " x))) :ye))
(resume afiber) # first resume to prime
(def afiber-result (resume afiber "world!"))
(assert (= afiber-result "hello, world!") "fiber error result")
@ -214,30 +216,31 @@
# Merge sort
# Imperative merge sort merge
(def merge (fn [xs ys]
(def ret @[])
(def xlen (length xs))
(def ylen (length ys))
(var i 0)
(var j 0)
# Main merge
(while (if (< i xlen) (< j ylen))
(def xi (get xs i))
(def yj (get ys j))
(if (< xi yj)
(do (array.push ret xi) (:= i (+ i 1)))
(do (array.push ret yj) (:= j (+ j 1)))))
# Push rest of xs
(while (< i xlen)
(def xi (get xs i))
(array.push ret xi)
(:= i (+ i 1)))
# Push rest of ys
(while (< j ylen)
(def yj (get ys j))
(array.push ret yj)
(:= j (+ j 1)))
ret))
(defn merge
[xs ys]
(def ret @[])
(def xlen (length xs))
(def ylen (length ys))
(var i 0)
(var j 0)
# Main merge
(while (if (< i xlen) (< j ylen))
(def xi (get xs i))
(def yj (get ys j))
(if (< xi yj)
(do (array.push ret xi) (:= i (+ i 1)))
(do (array.push ret yj) (:= j (+ j 1)))))
# Push rest of xs
(while (< i xlen)
(def xi (get xs i))
(array.push ret xi)
(:= i (+ i 1)))
# Push rest of ys
(while (< j ylen)
(def yj (get ys j))
(array.push ret yj)
(:= j (+ j 1)))
ret)
(assert (apply <= (merge @[1 3 5] @[2 4 6])) "merge sort merge 1")
(assert (apply <= (merge @[1 2 3] @[4 5 6])) "merge sort merge 2")
@ -248,12 +251,12 @@
(assert (not= (gensym) (gensym)) "two gensyms not equal")
((fn []
(def syms (table))
(var count 0)
(while (< count 128)
(put syms (gensym) true)
(:= count (+ 1 count)))
(assert (= (length syms) 128) "many symbols")))
(def syms (table))
(var count 0)
(while (< count 128)
(put syms (gensym) true)
(:= count (+ 1 count)))
(assert (= (length syms) 128) "many symbols")))
# Let
@ -265,19 +268,19 @@
(defn dub [x] (+ x x))
(assert (= 2 (dub 1)) "defn macro")
(do
(defn trip [x] (+ x x x))
(assert (= 3 (trip 1)) "defn macro triple"))
(do
(var i 0)
(when true
(++ i)
(++ i)
(++ i)
(++ i)
(++ i)
(++ i))
(assert (= i 6) "when macro"))
(defn trip [x] (+ x x x))
(assert (= 3 (trip 1)) "defn macro triple"))
(do
(var i 0)
(when true
(++ i)
(++ i)
(++ i)
(++ i)
(++ i)
(++ i))
(assert (= i 6) "when macro"))
(end-suite)

3
test/suite1.janet
View File

@ -169,7 +169,8 @@
(testmarsh (fn thing [x] (+ 11 x x 30)) "marshal function 3")
(testmarsh mapa "marshal function 4")
(testmarsh reduce "marshal function 5")
(testmarsh (fiber.new (fn [&] (yield 1) 2)) "marshal simple fiber")
(testmarsh (fiber.new (fn [] (yield 1) 2)) "marshal simple fiber 1")
(testmarsh (fiber.new (fn [&] (yield 1) 2)) "marshal simple fiber 2")
# Large functions
(def manydefs (fora [i :range [0 300]] (tuple 'def (gensym) (string "value_" i))))