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

Add tran keyword to allow for continuations.

Browse Source
This commit is contained in:
Calvin Rose 2017-05-09 19:21:30 -04:00
parent 0e29b52d96
commit fd72219a2a
10 changed files with 99 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
core/compile.c
View File

@ -878,6 +878,25 @@ static Slot compile_apply(GstCompiler *c, FormOptions opts, const GstValue *form
}
}
/* Transfer special */
static Slot compile_tran(GstCompiler *c, FormOptions opts, const GstValue *form) {
GstBuffer *buffer = c->buffer;
Slot t, v, r;
if (gst_tuple_length(form) != 3 && gst_tuple_length(form) != 2)
c_error(c, "tran expects 2 or 3 arguments");
t = compiler_realize_slot(c, compile_value(c, form_options_default(), form[1]));
if (gst_tuple_length(form) == 3)
v = compiler_realize_slot(c, compile_value(c, form_options_default(), form[2]));
else
v = compile_value(c, form_options_default(), gst_wrap_nil());
r = compiler_get_target(c, opts);
gst_buffer_push_u16(c->vm, buffer, GST_OP_TRN);
gst_buffer_push_u16(c->vm, buffer, r.index);
gst_buffer_push_u16(c->vm, buffer, t.index);
gst_buffer_push_u16(c->vm, buffer, v.index);
return r;
}
/* Define a function type for Special Form helpers */
typedef Slot (*SpecialFormHelper) (GstCompiler *c, FormOptions opts, const GstValue *form);
@ -946,6 +965,15 @@ static SpecialFormHelper get_special(const GstValue *form) {
}
}
break;
case 't':
{
if (gst_string_length(name) == 4 &&
name[1] == 'r' &&
name[2] == 'a' &&
name[3] == 'n') {
return compile_tran;
}
}
case 'w':
{
if (gst_string_length(name) == 5 &&

2
core/disasm.c
View File

@ -186,6 +186,8 @@ void gst_dasm(FILE * out, uint16_t *byteCode, uint32_t len) {
case GST_OP_TCL:
current += dasm_fixed_op(out, current, "tailCall", 1);
break;
case GST_OP_TRN:
current += dasm_fixed_op(out, current, "transfer", 3);
}
fprintf(out, "\n");
}

4
core/ds.c
View File

@ -38,10 +38,10 @@ GstBuffer *gst_buffer(Gst *vm, uint32_t capacity) {
/* Ensure that the buffer has enough internal capacity */
void gst_buffer_ensure(Gst *vm, GstBuffer *buffer, uint32_t capacity) {
uint8_t * newData;
uint8_t *newData;
if (capacity <= buffer->capacity) return;
newData = gst_alloc(vm, capacity * sizeof(uint8_t));
gst_memcpy(newData, buffer->data, buffer->count * sizeof(uint8_t));
gst_memcpy(newData, buffer->data, buffer->capacity * sizeof(uint8_t));
buffer->data = newData;
buffer->capacity = capacity;
}

2
core/gc.c
View File

@ -145,6 +145,8 @@ void gst_mark(Gst *vm, GstValueUnion x, GstType type) {
gc_header(thread->data)->color = vm->black;
while (frame <= end)
frame = gst_mark_stackframe(vm, frame);
if (x.thread->parent)
gst_mark_value(vm, gst_wrap_thread(x.thread->parent));
}
break;

2
core/parse.c
View File

@ -553,6 +553,8 @@ static int gst_stl_parser_consume(Gst *vm) {
GstParser *p = gst_check_userdata(vm, 0, &gst_stl_parsetype);
if (p == NULL)
gst_c_throwc(vm, "expected parser");
if (p->status == GST_PARSER_ERROR)
gst_c_return(vm, gst_string_cv(vm, p->error));
if (!gst_parse_hasvalue(p))
gst_c_throwc(vm, "parser has no pending value");
gst_c_return(vm, gst_parse_consume(p));

19
core/stl.c
View File

@ -406,27 +406,9 @@ int gst_stl_thread(Gst *vm) {
if (callee.type != GST_FUNCTION && callee.type != GST_CFUNCTION)
gst_c_throwc(vm, "expected function");
t = gst_thread(vm, callee, 10);
t->parent = vm->thread;
gst_c_return(vm, gst_wrap_thread(t));
}
/* Transfer to a new thread */
int gst_stl_transfer(Gst *vm) {
GstThread *t;
GstValue ret = gst_arg(vm, 1);
if (!gst_check_thread(vm, 0, &t))
gst_c_throwc(vm, "expected thread");
if (t->status == GST_THREAD_DEAD)
gst_c_throwc(vm, "cannot transfer to dead thread");
if (t->status == GST_THREAD_ALIVE)
gst_c_throwc(vm, "cannot transfer to current thread");
gst_thread_beginframe(vm, t, gst_wrap_nil(), 0);
vm->thread->status = GST_THREAD_PENDING;
t->status = GST_THREAD_ALIVE;
vm->thread = t;
gst_c_return(vm, ret);
}
/* Get current thread */
int gst_stl_current(Gst *vm) {
gst_c_return(vm, gst_wrap_thread(vm->thread));
@ -879,7 +861,6 @@ static const GstModuleItem const std_module[] = {
{"buffer", gst_stl_buffer},
{"string", gst_stl_string},
{"thread", gst_stl_thread},
{"transfer", gst_stl_transfer},
{"status", gst_stl_status},
{"current", gst_stl_current},
{"parent", gst_stl_parent},

3
core/thread.c
View File

@ -32,6 +32,7 @@ GstThread *gst_thread(Gst *vm, GstValue callee, uint32_t capacity) {
thread->count = GST_FRAME_SIZE;
thread->data = data;
thread->status = GST_THREAD_PENDING;
thread->retindex = 0;
stack = data + GST_FRAME_SIZE;
gst_frame_size(stack) = 0;
gst_frame_prevsize(stack) = 0;
@ -41,7 +42,7 @@ GstThread *gst_thread(Gst *vm, GstValue callee, uint32_t capacity) {
gst_frame_env(stack) = NULL;
gst_frame_callee(stack) = callee;
gst_thread_endframe(vm, thread);
thread->parent = NULL;
thread->parent = vm->thread;
return thread;
}

89
core/vm.c
View File

@ -29,9 +29,11 @@ static const char GST_EXPECTED_FUNCTION[] = "expected function";
int gst_continue(Gst *vm) {
/* VM state */
GstValue *stack;
GstValue temp, v1, v2;
uint16_t *pc;
/* Some temporary values */
GstValue temp, v1, v2;
#define gst_exit(vm, r) return ((vm)->ret = (r), GST_RETURN_OK)
#define gst_error(vm, e) do { (vm)->ret = gst_string_cv((vm), (e)); goto vm_error; } while (0)
#define gst_crash(vm, e) return ((vm)->crash = (e), GST_RETURN_CRASH)
@ -184,27 +186,12 @@ int gst_continue(Gst *vm) {
break;
case GST_OP_RTN: /* Return nil */
stack = gst_thread_popframe(vm, vm->thread);
if (vm->thread->count < GST_FRAME_SIZE) {
vm->thread->status = GST_THREAD_DEAD;
vm->ret.type = GST_NIL;
return GST_RETURN_OK;
}
pc = gst_frame_pc(stack);
stack[gst_frame_ret(stack)].type = GST_NIL;
continue;
temp.type = GST_NIL;
goto vm_return;
case GST_OP_RET: /* Return */
temp = stack[pc[1]];
stack = gst_thread_popframe(vm, vm->thread);
if (vm->thread->count < GST_FRAME_SIZE) {
vm->thread->status = GST_THREAD_DEAD;
vm->ret = temp;
return GST_RETURN_OK;
}
pc = gst_frame_pc(stack);
stack[gst_frame_ret(stack)] = temp;
continue;
goto vm_return;
case GST_OP_PSK: /* Push stack */
{
@ -302,16 +289,11 @@ int gst_continue(Gst *vm) {
int status;
vm->ret.type = GST_NIL;
status = temp.data.cfunction(vm);
stack = gst_thread_popframe(vm, vm->thread);
if (status == GST_RETURN_OK) {
if (vm->thread->count < GST_FRAME_SIZE) {
vm->thread->status = GST_THREAD_DEAD;
return status;
} else {
stack[gst_frame_ret(stack)] = vm->ret;
pc = gst_frame_pc(stack);
}
temp = vm->ret;
goto vm_return;
} else {
stack = gst_thread_popframe(vm, vm->thread);
goto vm_error;
}
} else {
@ -366,24 +348,55 @@ int gst_continue(Gst *vm) {
}
break;
case GST_OP_YLD: /* Yield to new thread */
temp = stack[pc[1]];
v1 = stack[pc[2]];
gst_assert(vm, v1.type == GST_THREAD, "expected thread");
gst_assert(vm, v1.data.thread->status != GST_THREAD_DEAD, "cannot rejoin dead thread");
gst_frame_pc(stack) = pc + 3;
vm->thread = v1.data.thread;
vm->thread->status = GST_THREAD_ALIVE;
stack = vm->thread->data + vm->thread->count;
case GST_OP_TRN: /* Transfer */
temp = stack[pc[2]]; /* The thread */
v1 = stack[pc[3]]; /* The value to pass in */
if (temp.type != GST_THREAD)
gst_error(vm, "expected thread");
if (temp.data.thread->status == GST_THREAD_DEAD ||
temp.data.thread->status == GST_THREAD_ERROR)
gst_error(vm, "cannot enter dead thread");
gst_frame_ret(stack) = pc[1];
vm->thread->status = GST_THREAD_PENDING;
gst_frame_pc(stack) = pc + 4;
temp.data.thread->status = GST_THREAD_ALIVE;
vm->thread = temp.data.thread;
stack = gst_thread_stack(temp.data.thread);
stack[gst_frame_ret(stack)] = v1;
pc = gst_frame_pc(stack);
continue;
/* Handle returning from stack frame. Expect return value in temp. */
vm_return:
stack = gst_thread_popframe(vm, vm->thread);
while (vm->thread->count < GST_FRAME_SIZE) {
vm->thread->status = GST_THREAD_DEAD;
if (vm->thread->parent) {
vm->thread = vm->thread->parent;
stack = vm->thread->data + vm->thread->count;
} else {
vm->ret = temp;
return GST_RETURN_OK;
}
}
pc = gst_frame_pc(stack);
stack[gst_frame_ret(stack)] = temp;
continue;
/* Handle errors from c functions and vm opcodes */
vm_error:
if (stack == NULL || vm->thread->parent == NULL)
return GST_RETURN_ERROR;
vm->thread->status = GST_THREAD_ERROR;
if (vm->thread->parent == NULL)
return GST_RETURN_ERROR;
vm->thread = vm->thread->parent;
while (vm->thread->count < GST_FRAME_SIZE) {
if (vm->thread->parent) {
vm->thread->status = GST_THREAD_DEAD;
vm->thread = vm->thread->parent;
} else {
return GST_RETURN_ERROR;
}
}
stack = vm->thread->data + vm->thread->count;
pc = gst_frame_pc(stack);
continue;

3
include/gst/gst.h
View File

@ -204,6 +204,7 @@ struct GstValue {
struct GstThread {
uint32_t count;
uint32_t capacity;
uint32_t retindex;
GstValue *data;
GstThread *parent;
enum {
@ -333,7 +334,7 @@ enum GstOpCode {
GST_OP_PAR, /* Push array or tuple */
GST_OP_CAL, /* Call function */
GST_OP_TCL, /* Tail call */
GST_OP_YLD /* Yield from function */
GST_OP_TRN, /* Transfer to new thread */
};
/****/

14
libs/repl.gst
View File

@ -19,9 +19,11 @@
"Run a simple repl. Does not handle errors and other
such details."
(while 1
(write stdout ">> ")
(: line (readline))
(while line
(: line (parse-charseq p line))
(if (parse-hasvalue p)
(print ((compile (parse-consume p)))))))
(: t (thread (fn []
(write stdout ">> ")
(: line (readline))
(while line
(: line (parse-charseq p line))
(if (parse-hasvalue p)
((compile (parse-consume p))))))))
(transfer t))