diff --git a/lib/comp.c b/lib/comp.c index aaf6f91..f9fbaac 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -1499,6 +1499,68 @@ static HCL_INLINE int compile_else (hcl_t* hcl) /* ========================================================================= */ +static hcl_cnode_t* collect_local_vardcl (hcl_t* hcl, hcl_cnode_t* obj, hcl_oow_t tv_dup_check_start, hcl_oow_t* nvardcls) +{ + hcl_oow_t ndcls = 0; + + while (obj && HCL_CNODE_IS_CONS(obj)) + { + hcl_cnode_t* dcl; + + dcl = HCL_CNODE_CONS_CAR(obj); + if (HCL_CNODE_IS_CONS_CONCODED(dcl, HCL_CONCODE_VLIST)) + { + hcl_cnode_t* var; + do + { + var = HCL_CNODE_CONS_CAR(dcl); + #if 0 + if (!HCL_CNODE_IS_SYMBOL(var)) + { + hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAME, HCL_CNODE_GET_LOC(var), HCL_CNODE_GET_TOK(var), "local variable not a symbol"); + return HCL_NULL; + } + + if (HCL_CNODE_IS_SYMBOL(var) && HCL_CNODE_SYMBOL_SYNCODE(var) /* || HCL_OBJ_GET_FLAGS_KERNEL(var) >= 2 */) + { + hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDARGNAME, HCL_CNODE_GET_LOC(var), HCL_CNODE_GET_TOK(var), "special symbol not to be declared as a local variable"); + return HCL_NULL; + } + #else + /* the above checks are not needed as the reader guarantees the followings */ + HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL(var) && !HCL_CNODE_SYMBOL_SYNCODE(var)); + #endif + + if (add_temporary_variable(hcl, HCL_CNODE_GET_TOK(var), tv_dup_check_start) <= -1) + { + if (hcl->errnum == HCL_EEXIST) + { + hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAMEDUP, HCL_CNODE_GET_LOC(var), HCL_CNODE_GET_TOK(var), "duplicate local variable"); + } + return HCL_NULL; + } + ndcls++; + + dcl = HCL_CNODE_CONS_CDR(dcl); + if (!dcl) break; + + if (!HCL_CNODE_IS_CONS(dcl)) + { + hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(dcl), HCL_CNODE_GET_TOK(dcl), "redundant cdr in local variable list"); + return HCL_NULL; + } + } + while (1); + + obj = HCL_CNODE_CONS_CDR(obj); + } + else break; + } + + *nvardcls = ndcls; + return obj; +} + static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun) { hcl_cnode_t* cmd, * obj, * args; @@ -1565,7 +1627,7 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun) HCL_ASSERT (hcl, args != HCL_NULL); if (HCL_CNODE_IS_ELIST_CONCODED(args, HCL_CONCODE_XLIST)) { - /* no argument - (lambda () (+ 10 20)) */ + /* empty list - no argument - (lambda () (+ 10 20)) */ nargs = 0; } else if (!HCL_CNODE_IS_CONS(args)) @@ -1628,65 +1690,12 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun) return -1; } - ntmprs = nargs; obj = HCL_CNODE_CONS_CDR(obj); - tv_dup_start = hcl->c->tv.s.len; - while (obj && HCL_CNODE_IS_CONS(obj)) - { - hcl_cnode_t* dcl; + obj = collect_local_vardcl(hcl, obj, tv_dup_start, &ntmprs); + if (!obj) return -1; - dcl = HCL_CNODE_CONS_CAR(obj); - if (HCL_CNODE_IS_CONS_CONCODED(dcl, HCL_CONCODE_VLIST)) - { - hcl_cnode_t* var; - do - { - var = HCL_CNODE_CONS_CAR(dcl); - #if 0 - if (!HCL_CNODE_IS_SYMBOL(var)) - { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAME, HCL_CNODE_GET_LOC(var), HCL_CNODE_GET_TOK(var), "local variable not a symbol"); - return -1; - } - - if (HCL_CNODE_IS_SYMBOL(var) && HCL_CNODE_SYMBOL_SYNCODE(var) /* || HCL_OBJ_GET_FLAGS_KERNEL(var) >= 2 */) - { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDARGNAME, HCL_CNODE_GET_LOC(var), HCL_CNODE_GET_TOK(var), "special symbol not to be declared as a local variable"); - return -1; - } - #else - /* the above checks are not needed as the reader guarantees the followings */ - HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL(var) && !HCL_CNODE_SYMBOL_SYNCODE(var)); - #endif - - if (add_temporary_variable(hcl, HCL_CNODE_GET_TOK(var), tv_dup_start) <= -1) - { - if (hcl->errnum == HCL_EEXIST) - { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGNAMEDUP, HCL_CNODE_GET_LOC(var), HCL_CNODE_GET_TOK(var), "duplicate local variable"); - } - return -1; - } - ntmprs++; - - dcl = HCL_CNODE_CONS_CDR(dcl); - if (!dcl) break; - - if (!HCL_CNODE_IS_CONS(dcl)) - { - hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(dcl), HCL_CNODE_GET_TOK(dcl), "redundant cdr in local variable list"); - return -1; - } - } - while (1); - - obj = HCL_CNODE_CONS_CDR(obj); - } - else break; - } - - /* ntmprs: number of temporary variables including arguments */ + ntmprs += nargs; /* ntmprs: number of temporary variables including arguments */ HCL_ASSERT (hcl, ntmprs == hcl->c->tv.wcount - saved_tv_wcount); if (ntmprs > MAX_CODE_NBLKTMPRS) { @@ -1996,11 +2005,12 @@ static HCL_INLINE int compile_catch (hcl_t* hcl) return -1; } - patch_nearest_post_try (hcl, &jump_inst_pos); + /* jump_inst_pos hold the instruction pointer that skips the catch block at the end of the try block */ + patch_nearest_post_try (hcl, &jump_inst_pos); /* TODO: HCL_TRAIT_INTERACTIVE??? */ /* TODO: nargs -> 1 ntmprs -> 1 */ - + SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj); PUSH_SUBCFRAME (hcl, COP_POST_CATCH, cmd); diff --git a/lib/exec.c b/lib/exec.c index 4612309..6c7f7f0 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -2124,16 +2124,13 @@ static HCL_INLINE int do_throw (hcl_t* hcl, hcl_oop_t val, hcl_ooi_t ip) /* exception not handled. terminate the active process */ /*terminate_process (hcl, hcl->processor->active); <- the vm cleanup code will do this */ - - - + return -1; } - // must rewind context.... + /* must rewind context */ HCL_EXSTACK_POP_TO(hcl, catch_ctx, catch_ip); - /* the below code is similar to do_return_from_block() */ hcl->ip = -1; /* mark context dead. saved into hcl->active_context->ip in SWITCH_ACTIVE_CONTEXT */ SWITCH_ACTIVE_CONTEXT (hcl, catch_ctx); @@ -2848,8 +2845,8 @@ static int execute (hcl_t* hcl) while (1) { /* stop requested or no more runnable process */ - if (hcl->abort_req <= -1) goto oops; - if (hcl->abort_req && !hcl->no_proc_switch && switch_process_if_needed(hcl) == 0) break; + if (hcl->abort_req < 0) goto oops; + if (hcl->abort_req > 0 || (!hcl->no_proc_switch && switch_process_if_needed(hcl) == 0)) break; if (HCL_UNLIKELY(hcl->ip >= HCL_FUNCTION_GET_CODE_SIZE(hcl->active_function))) { @@ -3788,6 +3785,7 @@ static int execute (hcl_t* hcl) HCL_ASSERT(hcl, HCL_IS_CONTEXT(hcl, hcl->active_context)); hcl->last_retv = HCL_STACK_GETTOP(hcl); /* get the stack top */ do_return_from_block (hcl); + do_return_from_block (hcl); break;