mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2025-10-26 05:07:41 +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
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 BINDIR=$(PREFIX)/bin
JANET_VERSION?="\"commit-$(shell git log --pretty=format:'%h' -n 1)\"" 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 \ CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -fpic -O2 -fvisibility=hidden \
-DJANET_VERSION=$(JANET_VERSION) -DJANET_VERSION=$(JANET_VERSION)
CLIBS=-lm -ldl CLIBS=-lm -ldl
@@ -112,7 +112,8 @@ $(JANET_LIBRARY): $(JANET_CORE_OBJECTS)
EMCC=emcc EMCC=emcc
EMCCFLAGS=-std=c99 -Wall -Wextra -Isrc/include -O2 \ EMCCFLAGS=-std=c99 -Wall -Wextra -Isrc/include -O2 \
-s EXTRA_EXPORTED_RUNTIME_METHODS='["cwrap"]' \ -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) -DJANET_VERSION=$(JANET_VERSION)
JANET_EMTARGET=janet.js JANET_EMTARGET=janet.js
JANET_WEB_SOURCES=$(JANET_CORE_SOURCES) $(JANET_WEBCLIENT_SOURCES) JANET_WEB_SOURCES=$(JANET_CORE_SOURCES) $(JANET_WEBCLIENT_SOURCES)

78
src/core/core.janet
View File

@@ -417,7 +417,7 @@
that yields all values inside the loop in order. See loop for details." that yields all values inside the loop in order. See loop for details."
[head & body] [head & body]
(tuple fiber.new (tuple fiber.new
(tuple 'fn [tuple '&] (tuple 'fn '[&]
(tuple 'loop head (tuple yield (tuple.prepend body 'do)))))) (tuple 'loop head (tuple yield (tuple.prepend body 'do))))))
(defn sum [xs] (defn sum [xs]
@@ -433,7 +433,7 @@
(defmacro coro (defmacro coro
"A wrapper for making fibers. Same as (fiber.new (fn [&] ...body))." "A wrapper for making fibers. Same as (fiber.new (fn [&] ...body))."
[& body] [& body]
(tuple fiber.new (apply tuple 'fn [tuple '&] body))) (tuple fiber.new (apply tuple 'fn '[&] body)))
(defmacro if-let (defmacro if-let
"Takes the first one or two forms in a vector and if both are true binds "Takes the first one or two forms in a vector and if both are true binds
@@ -1169,41 +1169,12 @@ value, one key will be ignored."
# The parser object # The parser object
(def p (parser.new)) (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 # Evaluate 1 source form
(defn eval1 [source] (defn eval1 [source]
(var good true) (var good true)
(def f (def f
(fiber.new (fiber.new
(fn [&] (fn _thunk [&]
(def res (compile source env where)) (def res (compile source env where))
(if (= (type res) :function) (if (= (type res) :function)
(res) (res)
@@ -1226,10 +1197,28 @@ value, one key will be ignored."
(onvalue res) (onvalue res)
(onerr where "runtime" res f))))) (onerr where "runtime" res f)))))
# Run loop
(def oldenv *env*) (def oldenv *env*)
(:= *env* 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* oldenv)
env) env)
@@ -1242,19 +1231,21 @@ value, one key will be ignored."
"\n") "\n")
(when f (when f
(loop (loop
[{:function func [nf :in (array.reverse (fiber.lineage f))
:before (file.write stderr " (fiber)\n")
{:function func
:tail tail :tail tail
:pc pc :pc pc
:c c :c c
:name name :name name
:source source :source source
:line source-line :line source-line
:column source-col} :in (fiber.stack f)] :column source-col} :in (fiber.stack nf)]
(file.write stderr " in") (file.write stderr " in")
(when c (file.write stderr " cfunction")) (when c (file.write stderr " cfunction"))
(if name (if name
(file.write stderr " " name) (file.write stderr " " name)
(when func (file.write stderr " " (string func)))) (when func (file.write stderr " <anonymous>")))
(if source (if source
(do (do
(file.write stderr " [" source "]") (file.write stderr " [" source "]")
@@ -1279,7 +1270,7 @@ value, one key will be ignored."
(def ret state) (def ret state)
(:= state nil) (:= state nil)
(when ret (when ret
(buffer.push-string buf ret) (buffer.push-string buf str)
(buffer.push-string buf "\n"))) (buffer.push-string buf "\n")))
(var returnval nil) (var returnval nil)
(run-context *env* chunks (fn [x] (:= returnval x)) default-error-handler "eval") (run-context *env* chunks (fn [x] (:= returnval x)) default-error-handler "eval")
@@ -1416,17 +1407,14 @@ value, one key will be ignored."
(defn repl (defn repl
"Run a repl. The first parameter is an optional function to call to "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." get a chunk of source code. Should return nil for end of file."
[getchunk onvalue onerr &] [chunks onvalue onerr &]
(def newenv (make-env)) (def newenv (make-env))
(default getchunk (fn [buf &] (default chunks (fn [&] (file.read stdin :line)))
(file.read stdin :line buf)))
(def buf @"")
(default onvalue (fn [x] (default onvalue (fn [x]
(put newenv '_ @{:value x}) (put newenv '_ @{:value x})
(print (string.pretty x 20 buf)) (print (string.pretty x 20))))
(buffer.clear buf)))
(default onerr default-error-handler) (default onerr default-error-handler)
(run-context newenv getchunk onvalue onerr "repl")) (run-context newenv chunks onvalue onerr "repl"))
(defn all-symbols (defn all-symbols
"Get all symbols available in the current environment." "Get all symbols available in the current environment."

41
src/core/fiber.c
View File

@@ -25,36 +25,49 @@
#include "state.h" #include "state.h"
#include "gc.h" #include "gc.h"
/* Initialize a new fiber */ static JanetFiber *make_fiber(int32_t capacity) {
JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity) { Janet *data;
JanetFiber *fiber = janet_gcalloc(JANET_MEMORY_FIBER, sizeof(JanetFiber)); JanetFiber *fiber = janet_gcalloc(JANET_MEMORY_FIBER, sizeof(JanetFiber));
if (capacity < 16) { if (capacity < 16) {
capacity = 16; capacity = 16;
} }
fiber->capacity = capacity; fiber->capacity = capacity;
if (capacity) { data = malloc(sizeof(Janet) * capacity);
Janet *data = malloc(sizeof(Janet) * capacity);
if (NULL == data) { if (NULL == data) {
JANET_OUT_OF_MEMORY; JANET_OUT_OF_MEMORY;
} }
fiber->data = data; fiber->data = data;
}
fiber->maxstack = JANET_STACK_MAX; 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->frame = 0;
fiber->stackstart = JANET_FRAME_SIZE; fiber->stackstart = JANET_FRAME_SIZE;
fiber->stacktop = JANET_FRAME_SIZE; fiber->stacktop = JANET_FRAME_SIZE;
fiber->root = callee;
fiber->child = NULL; fiber->child = NULL;
fiber->flags = JANET_FIBER_MASK_YIELD; fiber->flags = JANET_FIBER_MASK_YIELD;
janet_fiber_set_status(fiber, JANET_STATUS_NEW); janet_fiber_set_status(fiber, JANET_STATUS_NEW);
return fiber; 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 */ /* Ensure that the fiber has enough extra capacity */
void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) { void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
Janet *newData = realloc(fiber->data, sizeof(Janet) * n); Janet *newData = realloc(fiber->data, sizeof(Janet) * n);
@@ -284,8 +297,8 @@ static int cfun_new(JanetArgs args) {
JANET_MAXARITY(args, 2); JANET_MAXARITY(args, 2);
JANET_ARG_FUNCTION(func, args, 0); JANET_ARG_FUNCTION(func, args, 0);
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) { if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
if (func->def->arity != 1) { if (func->def->arity != 0) {
JANET_THROW(args, "expected unit arity function in fiber constructor"); JANET_THROW(args, "expected nullary function in fiber constructor");
} }
} }
fiber = janet_fiber(func, 64); fiber = janet_fiber(func, 64);
@@ -460,7 +473,7 @@ static const JanetReg cfuns[] = {
"Create a new fiber with function body func. Can optionally " "Create a new fiber with function body func. Can optionally "
"take a set of signals to block from the current parent fiber " "take a set of signals to block from the current parent fiber "
"when called. The mask is specified as symbol where each character " "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" "For example, \n\n"
"\t(fiber.new myfun :e123)\n\n" "\t(fiber.new myfun :e123)\n\n"
"blocks error signals and user signals 1, 2 and 3. The signals are " "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_stack_frame(s) ((JanetStackFrame *)((s) - JANET_FRAME_SIZE))
#define janet_fiber_frame(f) janet_stack_frame((f)->data + (f)->frame) #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_setcapacity(JanetFiber *fiber, int32_t n);
void janet_fiber_push(JanetFiber *fiber, Janet x); void janet_fiber_push(JanetFiber *fiber, Janet x);
void janet_fiber_push2(JanetFiber *fiber, Janet x, Janet y); 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)) if (janet_gc_reachable(fiber))
return; return;
janet_gc_mark(fiber); janet_gc_mark(fiber);
if (fiber->root)
janet_mark_function(fiber->root);
i = fiber->frame; i = fiber->frame;
j = fiber->stackstart - JANET_FRAME_SIZE; j = fiber->stackstart - JANET_FRAME_SIZE;
while (i > 0) { while (i > 0) {

49
src/core/marsh.c
View File

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

25
src/core/parse.c
View File

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

42
src/core/run.c
View File

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

50
src/core/vm.c
View File

@@ -77,18 +77,6 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
/* Setup fiber state */ /* Setup fiber state */
janet_vm_fiber = fiber; janet_vm_fiber = fiber;
janet_gcroot(janet_wrap_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); janet_fiber_set_status(fiber, JANET_STATUS_ALIVE);
stack = fiber->data + fiber->frame; stack = fiber->data + fiber->frame;
pc = janet_stack_frame(stack)->pc; pc = janet_stack_frame(stack)->pc;
@@ -98,17 +86,17 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
* Pulls out unsigned integers */ * Pulls out unsigned integers */
#define oparg(shift, mask) (((*pc) >> ((shift) << 3)) & (mask)) #define oparg(shift, mask) (((*pc) >> ((shift) << 3)) & (mask))
if (fiber->child) {
/* Check for child fiber. If there is a child, run child before self. /* 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 * This should only be hit when the current fiber is pending on a RESUME
* instruction. */ * instruction. */
if (fiber->child) {
retreg = in; retreg = in;
goto vm_resume_child; 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 */ /* If waiting for response to signal, use input and increment pc */
stack[oparg(1, 0xFF)] = in; stack[oparg(1, 0xFF)] = in;
pc++; pc++;
fiber->flags &= ~JANET_FIBER_FLAG_SIGNAL_WAITING;
} }
/* Use computed gotos for GCC and clang, otherwise use switch */ /* Use computed gotos for GCC and clang, otherwise use switch */
@@ -787,7 +775,8 @@ static void *op_lookup[255] = {
retreg = janet_wrap_nil(); retreg = janet_wrap_nil();
args.v = fiber->data + fiber->frame; args.v = fiber->data + fiber->frame;
args.ret = &retreg; 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_exit;
} }
goto vm_return_cfunc; goto vm_return_cfunc;
@@ -814,7 +803,8 @@ static void *op_lookup[255] = {
retreg = janet_wrap_nil(); retreg = janet_wrap_nil();
args.v = fiber->data + fiber->frame; args.v = fiber->data + fiber->frame;
args.ret = &retreg; 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_exit;
} }
goto vm_return_cfunc_tail; goto vm_return_cfunc_tail;
@@ -840,7 +830,6 @@ static void *op_lookup[255] = {
if (s < 0) s = 0; if (s < 0) s = 0;
signal = s; signal = s;
retreg = stack[oparg(2, 0xFF)]; retreg = stack[oparg(2, 0xFF)];
fiber->flags |= JANET_FIBER_FLAG_SIGNAL_WAITING;
goto vm_exit; goto vm_exit;
} }
@@ -1223,11 +1212,9 @@ static void *op_lookup[255] = {
{ {
JanetFiber *child = fiber->child; JanetFiber *child = fiber->child;
JanetFiberStatus status = janet_fiber_status(child); JanetFiberStatus status = janet_fiber_status(child);
if (status == JANET_STATUS_ALIVE || if (status == JANET_STATUS_ALIVE) vm_throw("cannot resume live fiber");
status == JANET_STATUS_DEAD || if (status == JANET_STATUS_DEAD) vm_throw("cannot resume dead fiber");
status == JANET_STATUS_ERROR) { if (status == JANET_STATUS_ERROR) vm_throw("cannot resume errored fiber");
vm_throw("cannot resume alive, dead, or errored fiber");
}
signal = janet_continue(child, retreg, &retreg); signal = janet_continue(child, retreg, &retreg);
if (signal != JANET_SIGNAL_OK) { if (signal != JANET_SIGNAL_OK) {
if (child->flags & (1 << signal)) { if (child->flags & (1 << signal)) {
@@ -1238,6 +1225,8 @@ static void *op_lookup[255] = {
/* Propogate signal */ /* Propogate signal */
goto vm_exit; goto vm_exit;
} }
} else {
fiber->child = NULL;
} }
stack[oparg(1, 0xFF)] = retreg; stack[oparg(1, 0xFF)] = retreg;
pc++; pc++;
@@ -1273,7 +1262,6 @@ static void *op_lookup[255] = {
{ {
janet_stack_frame(stack)->pc = pc; janet_stack_frame(stack)->pc = pc;
janet_vm_stackn--; janet_vm_stackn--;
janet_gcunroot(in);
janet_gcunroot(janet_wrap_fiber(fiber)); janet_gcunroot(janet_wrap_fiber(fiber));
janet_vm_fiber = old_vm_fiber; janet_vm_fiber = old_vm_fiber;
*out = retreg; *out = retreg;
@@ -1315,18 +1303,8 @@ JanetSignal janet_call(
const Janet *argv, const Janet *argv,
Janet *out, Janet *out,
JanetFiber **f) { JanetFiber **f) {
int32_t i; JanetFiber *fiber = janet_fiber_n(fun, 64, argv, argn);
JanetFiber *fiber = janet_fiber(fun, 64); if (f) *f = fiber;
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);
return janet_continue(fiber, janet_wrap_nil(), out); 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; int32_t n;
}; };
/* Fiber flags */
#define JANET_FIBER_FLAG_SIGNAL_WAITING (1 << 30)
/* Fiber signal masks. */ /* Fiber signal masks. */
#define JANET_FIBER_MASK_ERROR 2 #define JANET_FIBER_MASK_ERROR 2
#define JANET_FIBER_MASK_DEBUG 4 #define JANET_FIBER_MASK_DEBUG 4
@@ -603,7 +600,6 @@ struct JanetArgs {
struct JanetFiber { struct JanetFiber {
Janet *data; Janet *data;
JanetFiber *child; /* Keep linked list of fibers for restarting pending fibers */ 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 frame; /* Index of the stack frame */
int32_t stackstart; /* Beginning of next args */ int32_t stackstart; /* Beginning of next args */
int32_t stacktop; /* Top of stack. Where values are pushed and popped from. */ 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 */ /* Fiber */
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity); 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) #define janet_fiber_status(f) (((f)->flags & JANET_FIBER_STATUS_MASK) >> JANET_FIBER_STATUS_OFFSET)
/* Treat similar types through uniform interfaces for iteration */ /* 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 int janet_init(void);
JANET_API void janet_deinit(void); JANET_API void janet_deinit(void);
JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out); 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 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); 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 *****/ /***** START SECTION MACROS *****/
/* Macros */ /* Macros */
#define JANET_THROW(a, e) return (*((a).ret) = janet_cstringv(e), JANET_SIGNAL_ERROR) #define JANET_THROW(a, e) return (*((a).ret) = janet_cstringv(e), 1)
#define JANET_THROWV(a, v) return (*((a).ret) = (v), JANET_SIGNAL_ERROR) #define JANET_THROWV(a, v) return (*((a).ret) = (v), 1)
#define JANET_RETURN(a, v) return (*((a).ret) = (v), JANET_SIGNAL_OK) #define JANET_RETURN(a, v) return (*((a).ret) = (v), 0)
/* Early exit macros */ /* Early exit macros */
#define JANET_MAXARITY(A, N) do { if ((A).n > (N))\ #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_FIXARITY(args, 2);
JANET_ARG_STRING(line_prompt, args, 0); JANET_ARG_STRING(line_prompt, args, 0);
JANET_ARG_BUFFER(line_buffer, args, 1); JANET_ARG_BUFFER(line_buffer, args, 1);
/* Suspend janet repl by throwing a user defined signal */ JANET_RETURN_NIL(args);
return JANET_SIGNAL_USER9;
} }
/* Re-enter the loop */ /* Re-enter the loop */
@@ -70,15 +69,12 @@ void repl_init(void) {
/* Set up VM */ /* Set up VM */
janet_init(); janet_init();
janet_register("repl-yield", repl_yield);
janet_register("js", cfun_js);
env = janet_core_env(); env = janet_core_env();
/* Janet line getter */
janet_def(env, "repl-yield", janet_wrap_cfunction(repl_yield), NULL); 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_def(env, "js", janet_wrap_cfunction(cfun_js), NULL);
janet_register("js", cfun_js);
/* Run startup script */ /* Run startup script */
Janet ret; Janet ret;

9
src/webclient/webinit.janet
View File

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

13
test/suite0.janet
View File

@@ -38,7 +38,7 @@
(assert (= -7 (% -20 13)) "modulo 2") (assert (= -7 (% -20 13)) "modulo 2")
(assert (order< nil false true (assert (order< nil false true
(fiber.new (fn [x] x)) (fiber.new (fn [] 1))
1 1.0 "hi" 1 1.0 "hi"
(quote hello) (quote hello)
(array 1 2 3) (array 1 2 3)
@@ -154,9 +154,11 @@
# Fiber tests # Fiber tests
(def afiber (fiber.new (fn [x] (def afiber (fiber.new (fn []
(error (string "hello, " x))) :e)) (def x (yield))
(error (string "hello, " x))) :ye))
(resume afiber) # first resume to prime
(def afiber-result (resume afiber "world!")) (def afiber-result (resume afiber "world!"))
(assert (= afiber-result "hello, world!") "fiber error result") (assert (= afiber-result "hello, world!") "fiber error result")
@@ -214,7 +216,8 @@
# Merge sort # Merge sort
# Imperative merge sort merge # Imperative merge sort merge
(def merge (fn [xs ys] (defn merge
[xs ys]
(def ret @[]) (def ret @[])
(def xlen (length xs)) (def xlen (length xs))
(def ylen (length ys)) (def ylen (length ys))
@@ -237,7 +240,7 @@
(def yj (get ys j)) (def yj (get ys j))
(array.push ret yj) (array.push ret yj)
(:= j (+ j 1))) (:= j (+ j 1)))
ret)) ret)
(assert (apply <= (merge @[1 3 5] @[2 4 6])) "merge sort merge 1") (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") (assert (apply <= (merge @[1 2 3] @[4 5 6])) "merge sort merge 2")

3
test/suite1.janet
View File

@@ -169,7 +169,8 @@
(testmarsh (fn thing [x] (+ 11 x x 30)) "marshal function 3") (testmarsh (fn thing [x] (+ 11 x x 30)) "marshal function 3")
(testmarsh mapa "marshal function 4") (testmarsh mapa "marshal function 4")
(testmarsh reduce "marshal function 5") (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 # Large functions
(def manydefs (fora [i :range [0 300]] (tuple 'def (gensym) (string "value_" i)))) (def manydefs (fora [i :range [0 300]] (tuple 'def (gensym) (string "value_" i))))