mort
/
lang2
Sledovat 1
Oblíbit 0
Rozštěpit 0
Zdrojový kód Úkoly 0 Požadavky na natažení 0 Vydání 0 Wiki Aktivita
Procházet zdrojové kódy

more robust continuations, and implement 'loop' function

master
Martin Dørum před 4 roky
rodič
a52e2312b5
revize
9ffc6c5f80
5 změnil soubory, kde provedl 152 přidání a 55 odebrání
Rozdělené zobrazení Ukázat statistiku rozdílových dat
  1. 1
    0
      include/lang2/builtins.x.h
  2. 11
    4
      include/lang2/vm/vm.h
  3. 45
    4
      lib/vm/builtins.c
  4. 29
    29
      lib/vm/print.c
  5. 66
    18
      lib/vm/vm.c

+ 1
- 0
include/lang2/builtins.x.h Zobrazit soubor

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

+ 11
- 4
include/lang2/vm/vm.h Zobrazit soubor

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

+ 45
- 4
lib/vm/builtins.c Zobrazit soubor

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

+ 29
- 29
lib/vm/print.c Zobrazit soubor

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

+ 66
- 18
lib/vm/vm.c Zobrazit soubor

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


Zapsat Náhled
Načítá se…
Zrušit
Uložit