| XFUNCTION("loop", l2_builtin_loop) | XFUNCTION("loop", l2_builtin_loop) | ||||
| XFUNCTION("while", l2_builtin_while) | XFUNCTION("while", l2_builtin_while) | ||||
| XFUNCTION("for", l2_builtin_for) | XFUNCTION("for", l2_builtin_for) | ||||
| XFUNCTION("guard", l2_builtin_guard) | |||||
| #endif | #endif |
| L2_VAL_TYPE_FUNCTION, | L2_VAL_TYPE_FUNCTION, | ||||
| L2_VAL_TYPE_CFUNCTION, | L2_VAL_TYPE_CFUNCTION, | ||||
| L2_VAL_TYPE_CONTINUATION, | L2_VAL_TYPE_CONTINUATION, | ||||
| L2_VAL_TYPE_RETURN, | |||||
| L2_VAL_TYPE_ERROR, | L2_VAL_TYPE_ERROR, | ||||
| }; | }; | ||||
| } func; | } func; | ||||
| l2_vm_cfunction cfunc; | l2_vm_cfunction cfunc; | ||||
| struct l2_vm_contcontext *cont; | struct l2_vm_contcontext *cont; | ||||
| l2_word ret; | |||||
| char *error; | char *error; | ||||
| }; | }; | ||||
| }; | }; |
| l2_io_printf(out, "(function)"); | l2_io_printf(out, "(function)"); | ||||
| break; | break; | ||||
| case L2_VAL_TYPE_ERROR: | |||||
| l2_io_printf(out, "(error: %s)", val->error); | |||||
| break; | |||||
| case L2_VAL_TYPE_CONTINUATION: | case L2_VAL_TYPE_CONTINUATION: | ||||
| l2_io_printf(out, "(continuation)"); | l2_io_printf(out, "(continuation)"); | ||||
| break; | break; | ||||
| case L2_VAL_TYPE_RETURN: | |||||
| l2_io_printf(out, "(return)"); | |||||
| break; | |||||
| case L2_VAL_TYPE_ERROR: | |||||
| l2_io_printf(out, "(error: %s)", val->error); | |||||
| break; | |||||
| } | } | ||||
| } | } | ||||
| case L2_VAL_TYPE_CFUNCTION: | case L2_VAL_TYPE_CFUNCTION: | ||||
| case L2_VAL_TYPE_ERROR: | case L2_VAL_TYPE_ERROR: | ||||
| case L2_VAL_TYPE_CONTINUATION: | case L2_VAL_TYPE_CONTINUATION: | ||||
| case L2_VAL_TYPE_RETURN: | |||||
| break; | break; | ||||
| case L2_VAL_TYPE_BUFFER: | case L2_VAL_TYPE_BUFFER: | ||||
| cont->cont = &ctx->base; | cont->cont = &ctx->base; | ||||
| return cont_id; | return cont_id; | ||||
| } | } | ||||
| static l2_word guard_callback(struct l2_vm *vm, l2_word retval, l2_word cont_id) { | |||||
| struct l2_vm_value *ret = &vm->values[cont_id]; | |||||
| free(ret->cont); | |||||
| ret->flags = L2_VAL_TYPE_RETURN; | |||||
| ret->ret = retval; | |||||
| return cont_id; | |||||
| } | |||||
| l2_word l2_builtin_guard(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 l2_vm_value *cond = &vm->values[argv[0]]; | |||||
| if (l2_value_get_type(cond) == L2_VAL_TYPE_ERROR) { | |||||
| return argv[0]; | |||||
| } | |||||
| if (argc == 1) { | |||||
| if (!l2_vm_val_is_true(vm, cond)) { | |||||
| return vm->knone; | |||||
| } | |||||
| l2_word ret_id = l2_vm_alloc(vm, L2_VAL_TYPE_RETURN, 0); | |||||
| vm->values[ret_id].ret = vm->knone; | |||||
| return ret_id; | |||||
| } | |||||
| struct l2_vm_value *body = &vm->values[argv[1]]; | |||||
| if (l2_value_get_type(body) == L2_VAL_TYPE_ERROR) { | |||||
| return argv[1]; | |||||
| } | |||||
| if (!l2_vm_val_is_true(vm, cond)) { | |||||
| return vm->knone; | |||||
| } | |||||
| struct l2_vm_contcontext *ctx = malloc(sizeof(*ctx)); | |||||
| if (ctx == NULL) { | |||||
| return l2_vm_error(vm, "Allocation failure"); | |||||
| } | |||||
| ctx->callback = guard_callback; | |||||
| ctx->marker = NULL; | |||||
| ctx->args = vm->knone; | |||||
| 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[1]; | |||||
| cont->cont = ctx; | |||||
| return cont_id; | |||||
| } |
| printf("C FUNCTION, %8jx\n", (uintmax_t)val->cfunc); | printf("C FUNCTION, %8jx\n", (uintmax_t)val->cfunc); | ||||
| break; | break; | ||||
| case L2_VAL_TYPE_ERROR: | |||||
| printf("ERROR, %s\n", val->error); | |||||
| break; | |||||
| case L2_VAL_TYPE_CONTINUATION: | case L2_VAL_TYPE_CONTINUATION: | ||||
| printf("CONTINUATION, call %u, cont %08jx\n", | printf("CONTINUATION, call %u, cont %08jx\n", | ||||
| val->extra.cont_call, (uintmax_t)val->cont); | val->extra.cont_call, (uintmax_t)val->cont); | ||||
| break; | break; | ||||
| case L2_VAL_TYPE_RETURN: | |||||
| printf("RETURN, ret %u\n", val->ret); | |||||
| break; | |||||
| case L2_VAL_TYPE_ERROR: | |||||
| printf("ERROR, %s\n", val->error); | |||||
| break; | |||||
| } | } | ||||
| } | } | ||||
| void l2_vm_print_fstack(struct l2_vm *vm) { | void l2_vm_print_fstack(struct l2_vm *vm) { | ||||
| for (l2_word i = 0; i < vm->fsptr; ++i) { | for (l2_word i = 0; i < vm->fsptr; ++i) { | ||||
| printf(" %i: %i, ret %i, stack base %i\n", | |||||
| i, vm->fstack[i].ns, vm->fstack[i].retptr, vm->fstack[i].sptr); | |||||
| printf(" %i: %i, ret %i, stack base %u\n", | |||||
| i, vm->fstack[i].ns, (int)vm->fstack[i].retptr, vm->fstack[i].sptr); | |||||
| } | } | ||||
| } | } | ||||
| case L2_VAL_TYPE_NAMESPACE: return "NAMESPACE"; | case L2_VAL_TYPE_NAMESPACE: return "NAMESPACE"; | ||||
| case L2_VAL_TYPE_FUNCTION: return "FUNCTION"; | case L2_VAL_TYPE_FUNCTION: return "FUNCTION"; | ||||
| case L2_VAL_TYPE_CFUNCTION: return "CFUNCTION"; | case L2_VAL_TYPE_CFUNCTION: return "CFUNCTION"; | ||||
| case L2_VAL_TYPE_ERROR: return "ERROR"; | |||||
| case L2_VAL_TYPE_CONTINUATION: return "CONTINUATION"; | case L2_VAL_TYPE_CONTINUATION: return "CONTINUATION"; | ||||
| case L2_VAL_TYPE_RETURN: return "RETURN"; | |||||
| case L2_VAL_TYPE_ERROR: return "ERROR"; | |||||
| } | } | ||||
| return "(unknown)"; | return "(unknown)"; | ||||
| vm->values[root].ns = NULL; | vm->values[root].ns = NULL; | ||||
| vm->values[root].flags = L2_VAL_TYPE_NAMESPACE; | vm->values[root].flags = L2_VAL_TYPE_NAMESPACE; | ||||
| vm->fstack[vm->fsptr].ns = root; | vm->fstack[vm->fsptr].ns = root; | ||||
| vm->fstack[vm->fsptr].retptr = 0; | |||||
| vm->fstack[vm->fsptr].retptr = ~(l2_word)0; | |||||
| vm->fstack[vm->fsptr].sptr = 0; | vm->fstack[vm->fsptr].sptr = 0; | ||||
| vm->fsptr += 1; | vm->fsptr += 1; | ||||
| static void after_cfunc_return(struct l2_vm *vm) { | static void after_cfunc_return(struct l2_vm *vm) { | ||||
| if ( | if ( | ||||
| l2_value_get_type(&vm->values[vm->stack[vm->sptr - 1]]) == | |||||
| L2_VAL_TYPE_RETURN || | |||||
| l2_value_get_type(&vm->values[vm->stack[vm->sptr - 1]]) == | l2_value_get_type(&vm->values[vm->stack[vm->sptr - 1]]) == | ||||
| L2_VAL_TYPE_CONTINUATION || | L2_VAL_TYPE_CONTINUATION || | ||||
| (vm->sptr >= 2 && | (vm->sptr >= 2 && | ||||
| static void after_func_return(struct l2_vm *vm) { | static void after_func_return(struct l2_vm *vm) { | ||||
| struct l2_vm_value *ret = &vm->values[vm->stack[vm->sptr - 1]]; | struct l2_vm_value *ret = &vm->values[vm->stack[vm->sptr - 1]]; | ||||
| if (l2_value_get_type(ret) == L2_VAL_TYPE_RETURN) { | |||||
| l2_word retval = ret->ret; | |||||
| l2_word retptr = vm->fstack[vm->fsptr - 1].retptr; | |||||
| l2_word sptr = vm->fstack[vm->fsptr - 1].sptr; | |||||
| if (retptr == ~(l2_word)0) { | |||||
| vm->halted = 1; | |||||
| return; | |||||
| } | |||||
| vm->fsptr -= 1; | |||||
| vm->sptr = sptr; | |||||
| vm->iptr = retptr; | |||||
| vm->stack[vm->sptr++] = retval; | |||||
| after_func_return(vm); | |||||
| return; | |||||
| } | |||||
| // If the function returns a continuation, we leave that continuation | // If the function returns a continuation, we leave that continuation | ||||
| // on the stack to be handled later, then call the function | // on the stack to be handled later, then call the function | ||||
| if (l2_value_get_type(ret) == L2_VAL_TYPE_CONTINUATION) { | if (l2_value_get_type(ret) == L2_VAL_TYPE_CONTINUATION) { |
| (none) | (none) | ||||
| (true) (false) (atom 25) | |||||
| (true) (false) (atom 26) | |||||
| 100 | 100 | ||||
| 100.5 | 100.5 | ||||
| 255 | 255 | ||||
| Hello World | Hello World | ||||
| [(none) (true) (false) (atom 25) 100.1 Nope (namespace) (function)] | |||||
| [(none) (true) (false) (atom 26) 100.1 Nope (namespace) (function)] | |||||
| (namespace) (namespace) | (namespace) (namespace) | ||||
| len | len |