@@ -20,4 +20,5 @@ X(">=", l2_builtin_gteq) | |||
X("print", l2_builtin_print) | |||
X("len", l2_builtin_len) | |||
X("if", l2_builtin_if) | |||
X("loop", l2_builtin_loop) | |||
#endif |
@@ -10,6 +10,9 @@ | |||
struct l2_vm; | |||
struct l2_vm_array; | |||
typedef l2_word (*l2_vm_cfunction)(struct l2_vm *vm, l2_word argc, l2_word *argv); | |||
typedef l2_word (*l2_vm_contcallback)(struct l2_vm *vm, l2_word retval, l2_word cont); | |||
typedef void (*l2_vm_gcmarker)( | |||
struct l2_vm *vm, void *data, void (*mark)(struct l2_vm *vm, l2_word id)); | |||
enum l2_value_type { | |||
L2_VAL_TYPE_NONE, | |||
@@ -29,6 +32,12 @@ const char *l2_value_type_name(enum l2_value_type typ); | |||
enum l2_value_flags { | |||
L2_VAL_MARKED = 1 << 6, | |||
L2_VAL_CONST = 1 << 7, | |||
L2_VAL_CONT_CALLBACK = 1 << 7, // Re-use the const bit | |||
}; | |||
struct l2_vm_contcontext { | |||
l2_vm_contcallback callback; | |||
l2_vm_gcmarker marker; | |||
}; | |||
// The smallest size an l2_vm_value can be is 16 bytes on common platforms. | |||
@@ -39,6 +48,7 @@ struct l2_vm_value { | |||
// Byte 0: 4 bytes | |||
union { | |||
l2_word ns_parent; | |||
l2_word cont_call; | |||
} extra; | |||
// Byte 4: 1 byte, 3 bytes padding | |||
@@ -56,10 +66,7 @@ struct l2_vm_value { | |||
l2_word ns; | |||
} func; | |||
l2_vm_cfunction cfunc; | |||
struct { | |||
l2_word call; | |||
l2_word arg; | |||
} cont; | |||
struct l2_vm_contcontext *cont; | |||
char *error; | |||
}; | |||
}; |
@@ -312,16 +312,57 @@ l2_word l2_builtin_if(struct l2_vm *vm, l2_word argc, l2_word *argv) { | |||
cond->atom == vm->values[vm->ktrue].atom) { | |||
l2_word ret_id = l2_vm_alloc(vm, L2_VAL_TYPE_CONTINUATION, 0); | |||
struct l2_vm_value *ret = &vm->values[ret_id]; | |||
ret->cont.call = argv[1]; | |||
ret->cont.arg = 0; | |||
ret->extra.cont_call = argv[1]; | |||
return ret_id; | |||
} else if (argc == 3) { | |||
l2_word ret_id = l2_vm_alloc(vm, L2_VAL_TYPE_CONTINUATION, 0); | |||
struct l2_vm_value *ret = &vm->values[ret_id]; | |||
ret->cont.call = argv[2]; | |||
ret->cont.arg = 0; | |||
ret->extra.cont_call = argv[2]; | |||
return ret_id; | |||
} else { | |||
return 0; | |||
} | |||
} | |||
struct loop_context { | |||
struct l2_vm_contcontext base; | |||
l2_word cond; | |||
}; | |||
static l2_word loop_callback(struct l2_vm *vm, l2_word retval, l2_word cont) { | |||
struct l2_vm_value *ret = &vm->values[retval]; | |||
if ( | |||
l2_vm_value_type(ret) == L2_VAL_TYPE_ATOM && | |||
ret->atom == vm->values[vm->ktrue].atom) { | |||
return cont; | |||
} | |||
return retval; | |||
} | |||
static void loop_marker( | |||
struct l2_vm *vm, void *data, void (*mark)(struct l2_vm *vm, l2_word id)) { | |||
struct loop_context *ctx = data; | |||
mark(vm, ctx->cond); | |||
} | |||
l2_word l2_builtin_loop(struct l2_vm *vm, l2_word argc, l2_word *argv) { | |||
if (argc != 1 && argc != 2) { | |||
return l2_vm_error(vm, "Expected 1 or 2 arguments"); | |||
} | |||
struct loop_context *ctx = malloc(sizeof(*ctx)); | |||
if (ctx == NULL) { | |||
return l2_vm_error(vm, "Allocation failure"); | |||
} | |||
ctx->base.callback = loop_callback; | |||
ctx->base.marker = loop_marker; | |||
ctx->cond = argv[0]; | |||
l2_word cont_id = l2_vm_alloc(vm, L2_VAL_TYPE_CONTINUATION, 0); | |||
struct l2_vm_value *cont = &vm->values[cont_id]; | |||
cont->extra.cont_call = argv[0]; | |||
cont->cont = &ctx->base; | |||
return cont_id; | |||
} |
@@ -102,7 +102,7 @@ void l2_vm_print_val(struct l2_vm_value *val) { | |||
case L2_VAL_TYPE_CFUNCTION: | |||
// ISO C doesn't let you cast a function pointer to void*. | |||
printf("C FUNCTION, %jx\n", (uintmax_t)val->cfunc); | |||
printf("C FUNCTION, %8jx\n", (uintmax_t)val->cfunc); | |||
break; | |||
case L2_VAL_TYPE_ERROR: | |||
@@ -110,7 +110,7 @@ void l2_vm_print_val(struct l2_vm_value *val) { | |||
break; | |||
case L2_VAL_TYPE_CONTINUATION: | |||
printf("CONTINUATION, call %u, cont %jx\n", | |||
printf("CONTINUATION, call %u, cont %08jx\n", | |||
val->extra.cont_call, (uintmax_t)val->cont); | |||
break; | |||
} | |||
@@ -175,10 +175,10 @@ void l2_vm_print_op(unsigned char *ops, size_t opcount, size_t *ptr) { | |||
return; | |||
case L2_OP_FUNC_CALL_U4: | |||
printf("FUNC_CALL %08x\n", read_u4le(ops, ptr)); | |||
printf("FUNC_CALL %u\n", read_u4le(ops, ptr)); | |||
return; | |||
case L2_OP_FUNC_CALL_U1: | |||
printf("FUNC_CALL %02x\n", read_u1le(ops, ptr)); | |||
printf("FUNC_CALL %u\n", read_u1le(ops, ptr)); | |||
return; | |||
case L2_OP_FUNC_CALL_INFIX: | |||
@@ -186,31 +186,31 @@ void l2_vm_print_op(unsigned char *ops, size_t opcount, size_t *ptr) { | |||
return; | |||
case L2_OP_RJMP_U4: | |||
printf("RJMP %08x\n", read_u4le(ops, ptr)); | |||
printf("RJMP %u\n", read_u4le(ops, ptr)); | |||
return; | |||
case L2_OP_RJMP_U1: | |||
printf("RJMP %02x\n", read_u1le(ops, ptr)); | |||
printf("RJMP %u\n", read_u1le(ops, ptr)); | |||
return; | |||
case L2_OP_STACK_FRAME_LOOKUP_U4: | |||
printf("STACK_FRAME_LOOKUP %08x\n", read_u4le(ops, ptr)); | |||
printf("STACK_FRAME_LOOKUP %u\n", read_u4le(ops, ptr)); | |||
return; | |||
case L2_OP_STACK_FRAME_LOOKUP_U1: | |||
printf("STACK_FRAME_LOOKUP %02x\n", read_u1le(ops, ptr)); | |||
printf("STACK_FRAME_LOOKUP %u\n", read_u1le(ops, ptr)); | |||
return; | |||
case L2_OP_STACK_FRAME_SET_U4: | |||
printf("STACK_FRAME_SET %08x\n", read_u4le(ops, ptr)); | |||
printf("STACK_FRAME_SET %u\n", read_u4le(ops, ptr)); | |||
return; | |||
case L2_OP_STACK_FRAME_SET_U1: | |||
printf("STACK_FRAME_SET %02x\n", read_u1le(ops, ptr)); | |||
printf("STACK_FRAME_SET %u\n", read_u1le(ops, ptr)); | |||
return; | |||
case L2_OP_STACK_FRAME_REPLACE_U4: | |||
printf("STACK_FRAME_REPLACE %08x\n", read_u4le(ops, ptr)); | |||
printf("STACK_FRAME_REPLACE %u\n", read_u4le(ops, ptr)); | |||
return; | |||
case L2_OP_STACK_FRAME_REPLACE_U1: | |||
printf("STACK_FRAME_REPLACE %02x\n", read_u1le(ops, ptr)); | |||
printf("STACK_FRAME_REPLACE %u\n", read_u1le(ops, ptr)); | |||
return; | |||
case L2_OP_RET: | |||
@@ -222,10 +222,10 @@ void l2_vm_print_op(unsigned char *ops, size_t opcount, size_t *ptr) { | |||
return; | |||
case L2_OP_ALLOC_ATOM_U4: | |||
printf("ALLOC_ATOM %08x\n", read_u4le(ops, ptr)); | |||
printf("ALLOC_ATOM %u\n", read_u4le(ops, ptr)); | |||
return; | |||
case L2_OP_ALLOC_ATOM_U1: | |||
printf("ALLOC_ATOM %02x\n", read_u1le(ops, ptr)); | |||
printf("ALLOC_ATOM %u\n", read_u1le(ops, ptr)); | |||
return; | |||
case L2_OP_ALLOC_REAL_D8: | |||
@@ -236,22 +236,22 @@ void l2_vm_print_op(unsigned char *ops, size_t opcount, size_t *ptr) { | |||
{ | |||
l2_word w1 = read_u4le(ops, ptr); | |||
l2_word w2 = read_u4le(ops, ptr);; | |||
printf("ALLOC_BUFFER_STATIC %08x %08x\n", w1, w2); | |||
printf("ALLOC_BUFFER_STATIC %u %u\n", w1, w2); | |||
} | |||
return; | |||
case L2_OP_ALLOC_BUFFER_STATIC_U1: | |||
{ | |||
l2_word w1 = read_u1le(ops, ptr); | |||
l2_word w2 = read_u1le(ops, ptr);; | |||
printf("ALLOC_BUFFER_STATIC %02x %02x\n", w1, w2); | |||
printf("ALLOC_BUFFER_STATIC %u %u\n", w1, w2); | |||
} | |||
return; | |||
case L2_OP_ALLOC_ARRAY_U4: | |||
printf("ALLOC_ARRAY %08x\n", read_u4le(ops, ptr)); | |||
printf("ALLOC_ARRAY %u\n", read_u4le(ops, ptr)); | |||
return; | |||
case L2_OP_ALLOC_ARRAY_U1: | |||
printf("ALLOC_ARRAY %02x\n", read_u1le(ops, ptr)); | |||
printf("ALLOC_ARRAY %u\n", read_u1le(ops, ptr)); | |||
return; | |||
case L2_OP_ALLOC_NAMESPACE: | |||
@@ -259,38 +259,38 @@ void l2_vm_print_op(unsigned char *ops, size_t opcount, size_t *ptr) { | |||
return; | |||
case L2_OP_ALLOC_FUNCTION_U4: | |||
printf("ALLOC_FUNCTION %08x\n", read_u4le(ops, ptr)); | |||
printf("ALLOC_FUNCTION %u\n", read_u4le(ops, ptr)); | |||
return; | |||
case L2_OP_ALLOC_FUNCTION_U1: | |||
printf("ALLOC_FUNCTION %02x\n", read_u1le(ops, ptr)); | |||
printf("ALLOC_FUNCTION %u\n", read_u1le(ops, ptr)); | |||
return; | |||
case L2_OP_NAMESPACE_SET_U4: | |||
printf("NAMESPACE_SET %08x\n", read_u4le(ops, ptr)); | |||
printf("NAMESPACE_SET %u\n", read_u4le(ops, ptr)); | |||
return; | |||
case L2_OP_NAMESPACE_SET_U1: | |||
printf("NAMESPACE_SET %02x\n", read_u1le(ops, ptr)); | |||
printf("NAMESPACE_SET %u\n", read_u1le(ops, ptr)); | |||
return; | |||
case L2_OP_NAMESPACE_LOOKUP_U4: | |||
printf("NAMESPACE_LOOKUP %08x\n", read_u4le(ops, ptr)); | |||
printf("NAMESPACE_LOOKUP %u\n", read_u4le(ops, ptr)); | |||
return; | |||
case L2_OP_NAMESPACE_LOOKUP_U1: | |||
printf("NAMESPACE_LOOKUP %02x\n", read_u1le(ops, ptr)); | |||
printf("NAMESPACE_LOOKUP %u\n", read_u1le(ops, ptr)); | |||
return; | |||
case L2_OP_ARRAY_LOOKUP_U4: | |||
printf("ARRAY_LOOKUP %08x\n", read_u4le(ops, ptr)); | |||
printf("ARRAY_LOOKUP %u\n", read_u4le(ops, ptr)); | |||
return; | |||
case L2_OP_ARRAY_LOOKUP_U1: | |||
printf("ARRAY_LOOKUP %02x\n", read_u1le(ops, ptr)); | |||
printf("ARRAY_LOOKUP %u\n", read_u1le(ops, ptr)); | |||
return; | |||
case L2_OP_ARRAY_SET_U4: | |||
printf("ARRAY_SET %08x\n", read_u4le(ops, ptr)); | |||
printf("ARRAY_SET %u\n", read_u4le(ops, ptr)); | |||
return; | |||
case L2_OP_ARRAY_SET_U1: | |||
printf("ARRAY_SET %02x\n", read_u1le(ops, ptr)); | |||
printf("ARRAY_SET %u\n", read_u1le(ops, ptr)); | |||
return; | |||
case L2_OP_DYNAMIC_LOOKUP: | |||
@@ -306,7 +306,7 @@ void l2_vm_print_op(unsigned char *ops, size_t opcount, size_t *ptr) { | |||
return; | |||
} | |||
printf("? %02x\n", opcode); | |||
printf("? 0x%02x\n", opcode); | |||
} | |||
void l2_vm_print_bytecode(unsigned char *ops, size_t opcount) { |
@@ -49,6 +49,10 @@ static void gc_mark(struct l2_vm *vm, l2_word id) { | |||
gc_mark_namespace(vm, val); | |||
} else if (typ == L2_VAL_TYPE_FUNCTION) { | |||
gc_mark(vm, val->func.ns); | |||
} else if ( | |||
typ == L2_VAL_TYPE_CONTINUATION && | |||
val->cont != NULL && val->cont->marker != NULL) { | |||
val->cont->marker(vm, val->cont, gc_mark); | |||
} | |||
} | |||
@@ -96,6 +100,8 @@ static void gc_free(struct l2_vm *vm, l2_word id) { | |||
free(val->ns); | |||
} else if (typ == L2_VAL_TYPE_ERROR) { | |||
free(val->error); | |||
} else if (typ == L2_VAL_TYPE_CONTINUATION) { | |||
free(val->cont); | |||
} | |||
} | |||
@@ -178,6 +184,7 @@ void l2_vm_init(struct l2_vm *vm, unsigned char *ops, size_t opslen) { | |||
vm->values[builtins].flags = L2_VAL_TYPE_NAMESPACE; | |||
vm->fstack[vm->fsptr].ns = builtins; | |||
vm->fstack[vm->fsptr].retptr = 0; | |||
vm->fstack[vm->fsptr].sptr = 0; | |||
vm->fsptr += 1; | |||
// Need to allocate a root namespace | |||
@@ -187,6 +194,7 @@ void l2_vm_init(struct l2_vm *vm, unsigned char *ops, size_t opslen) { | |||
vm->values[root].flags = L2_VAL_TYPE_NAMESPACE; | |||
vm->fstack[vm->fsptr].ns = root; | |||
vm->fstack[vm->fsptr].retptr = 0; | |||
vm->fstack[vm->fsptr].sptr = 0; | |||
vm->fsptr += 1; | |||
// Define a C function variable for every builtin | |||
@@ -307,31 +315,38 @@ static void call_func( | |||
// make the call stack depth unbounded | |||
vm->stack[vm->sptr++] = func->cfunc(vm, argc, argv); | |||
while (1) { | |||
struct l2_vm_value *val = &vm->values[vm->stack[vm->sptr - 1]]; | |||
if (l2_vm_value_type(val) != L2_VAL_TYPE_CONTINUATION) { | |||
l2_word cont_id = vm->stack[vm->sptr - 1]; | |||
struct l2_vm_value *cont = &vm->values[cont_id]; | |||
if (l2_vm_value_type(cont) != L2_VAL_TYPE_CONTINUATION) { | |||
break; | |||
} | |||
l2_word cont_id = val->cont.call; | |||
struct l2_vm_value *cont = &vm->values[cont_id]; | |||
l2_word new_argc; | |||
l2_word new_argv[1]; | |||
if (val->cont.arg == 0) { | |||
new_argc = 0; | |||
} else { | |||
new_argc = 1; | |||
new_argv[0] = val->cont.arg; | |||
// If there's no callback it's easy, just call the function | |||
// it wants us to call | |||
l2_word call_id = cont->extra.cont_call; | |||
if (cont->cont == NULL) { | |||
vm->sptr -= 1; | |||
call_func(vm, call_id, 0, NULL); | |||
break; | |||
} | |||
if (l2_vm_value_type(cont) == L2_VAL_TYPE_CFUNCTION) { | |||
vm->stack[vm->sptr - 1] = cont->cfunc(vm, new_argc, new_argv); | |||
} else { | |||
vm->sptr -= 1; | |||
call_func(vm, cont_id, new_argc, new_argv); | |||
struct l2_vm_value *call = &vm->values[call_id]; | |||
if (l2_vm_value_type(call) == L2_VAL_TYPE_CFUNCTION) { | |||
l2_word retval = call->cfunc(vm, 0, NULL); | |||
vm->stack[vm->sptr - 1] = cont->cont->callback(vm, retval, cont_id); | |||
} else if (l2_vm_value_type(call) == L2_VAL_TYPE_FUNCTION) { | |||
// Leave the continuation on the stack, | |||
// let the L2_OP_RET code deal with it | |||
cont->flags |= L2_VAL_CONT_CALLBACK; | |||
call_func(vm, call_id, 0, NULL); | |||
break; | |||
} else { | |||
l2_word err = l2_vm_type_error(vm, call); | |||
vm->stack[vm->sptr - 1] = cont->cont->callback(vm, err, cont_id); | |||
} | |||
} | |||
return; | |||
} | |||
@@ -484,8 +499,41 @@ void l2_vm_step(struct l2_vm *vm) { | |||
l2_word sptr = vm->fstack[vm->fsptr - 1].sptr; | |||
vm->fsptr -= 1; | |||
vm->sptr = sptr; | |||
vm->stack[vm->sptr++] = retval; | |||
vm->iptr = retptr; | |||
l2_word cont_id; | |||
struct l2_vm_value *cont = NULL; | |||
if (vm->sptr > 0) { | |||
cont_id = vm->stack[vm->sptr - 1]; | |||
cont = &vm->values[cont_id]; | |||
} | |||
int iscont = | |||
cont != NULL && l2_vm_value_type(cont) == L2_VAL_TYPE_CONTINUATION; | |||
int nocallback = | |||
!iscont || (cont->flags & L2_VAL_CONT_CALLBACK && cont->cont == NULL); | |||
if (nocallback) { | |||
if (iscont) { | |||
vm->stack[vm->sptr - 1] = retval; | |||
} else { | |||
vm->stack[vm->sptr++] = retval; | |||
} | |||
break; | |||
} | |||
if (cont->flags & L2_VAL_CONT_CALLBACK) { | |||
retval = cont->cont->callback(vm, retval, cont_id); | |||
cont_id = retval; | |||
cont = &vm->values[cont_id]; | |||
if (l2_vm_value_type(cont) != L2_VAL_TYPE_CONTINUATION) { | |||
vm->stack[vm->sptr - 1] = retval; | |||
break; | |||
} | |||
} | |||
cont->flags |= L2_VAL_CONT_CALLBACK; | |||
call_func(vm, cont->extra.cont_call, 0, NULL); | |||
} | |||
break; | |||