simplified code a bit

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))
+	obj = collect_local_vardcl(hcl, obj, tv_dup_start, &ntmprs);
-	{
+	if (!obj) return -1;
-		hcl_cnode_t* dcl;
 
-		dcl = HCL_CNODE_CONS_CAR(obj);
+	ntmprs += nargs; /* ntmprs: number of temporary variables including arguments */
-		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 */
 	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);

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 < 0) goto oops;
-		if (hcl->abort_req && !hcl->no_proc_switch && switch_process_if_needed(hcl) == 0) break;
+		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;