added some code for throw

hcl/lib/comp.c

@@ -817,6 +817,7 @@ enum
 	COP_EMIT_POP_STACKTOP,
 	COP_EMIT_RETURN,
 	COP_EMIT_SET,
+	COP_EMIT_THROW,
 
 	COP_POST_IF_COND,
 	COP_POST_IF_BODY,
@@ -1951,29 +1952,43 @@ static HCL_INLINE int post_catch (hcl_t* hcl)
 
 static int compile_throw (hcl_t* hcl, hcl_cnode_t* src)
 {
-	hcl_cnode_t* cmd, * obj;
+	hcl_cnode_t* obj, * val;
 	hcl_cframe_t* cf;
-	hcl_ooi_t jump_inst_pos;
 
 	HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
-
 	HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_THROW));
 
-	cmd = HCL_CNODE_CONS_CDR(src);
 	obj = HCL_CNODE_CONS_CDR(src);
 
 	if (!obj)
 	{
+/* TODO: should i allow (throw)? does it return the last value on the stack? */
 		/* no value */
-		hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(src), HCL_NULL, "no expression specified in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd)); 
+		hcl_cnode_t* tmp = HCL_CNODE_CONS_CAR(src);
+		hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(src), HCL_NULL, "no value specified in %.*js", HCL_CNODE_GET_TOKLEN(tmp), HCL_CNODE_GET_TOKPTR(tmp));
 		return -1;
 	}
 	else if (!HCL_CNODE_IS_CONS(obj))
 	{
-		hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
+		hcl_cnode_t* tmp = HCL_CNODE_CONS_CAR(src);
+		hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in %.*js", HCL_CNODE_GET_TOKLEN(tmp), HCL_CNODE_GET_TOKPTR(tmp));
 		return -1;
 	}
 
+	val = HCL_CNODE_CONS_CAR(obj);
+
+	obj = HCL_CNODE_CONS_CDR(obj);
+	if (obj)
+	{
+		hcl_cnode_t* tmp = HCL_CNODE_CONS_CAR(src);
+		hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "more than 1 argument in %.*js", HCL_CNODE_GET_TOKLEN(tmp), HCL_CNODE_GET_TOKPTR(tmp));
+		return -1;
+	}
+
+	SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, val);
+
+	PUSH_SUBCFRAME (hcl, COP_EMIT_THROW, src);
+	/*cf = GET_SUBCFRAME(hcl);*/
 	return 0;
 }
 
@@ -3466,6 +3481,22 @@ static HCL_INLINE int emit_set (hcl_t* hcl)
 	return 0;
 }
 
+
+static HCL_INLINE int emit_throw (hcl_t* hcl)
+{
+	hcl_cframe_t* cf;
+	int n;
+
+	cf = GET_TOP_CFRAME(hcl);
+	HCL_ASSERT (hcl, cf->opcode == COP_EMIT_THROW);
+	HCL_ASSERT (hcl, cf->operand != HCL_NULL);
+
+	n = emit_byte_instruction(hcl, HCL_CODE_THROW, HCL_CNODE_GET_LOC(cf->operand));
+
+	POP_CFRAME (hcl);
+	return n;
+}
+
 /* ========================================================================= */
 
 int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj)
@@ -3642,6 +3673,10 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj)
 				if (emit_set(hcl) <= -1) goto oops;
 				break;
 
+			case COP_EMIT_THROW:
+				if (emit_throw(hcl) <= -1) goto oops;
+				break;
+
 			case COP_POST_IF_COND:
 				if (post_if_cond(hcl) <= -1) goto oops;
 				break;

hcl/lib/decode.c

@@ -348,10 +348,15 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
 			handle_call:
 				LOG_INST_1 (hcl, "call %zu", b1);
 				break;
+
 			/* -------------------------------------------------------- */
 			case HCL_CODE_TRY_CATCH:
 				LOG_INST_0 (hcl, "try_catch");
 				break;
+
+			case HCL_CODE_THROW:
+				LOG_INST_0 (hcl, "throw");
+				break;
 			/* -------------------------------------------------------- */
 
 			case HCL_CODE_PUSH_CTXTEMPVAR_X:

hcl/lib/exec.c

@@ -1930,10 +1930,35 @@ static HCL_INLINE int call_try_catch (hcl_t* hcl)
 
 	HCL_STACK_POPS (hcl, nargs + 1); /* pop arguments and receiver */
 	newctx->sender = hcl->active_context;
+	newctx->flags = HCL_SMOOI_TO_OOP(1);
 
 	SWITCH_ACTIVE_CONTEXT (hcl, newctx);
 	return 0;
 }
+
+static HCL_INLINE int do_throw (hcl_t* hcl, hcl_oop_t val)
+{
+	hcl_oop_context_t ctx;
+	hcl_ooi_t flags;
+
+	ctx = hcl->active_context;
+	while ((hcl_oop_t)ctx != hcl->_nil)
+	{
+		flags = HCL_OOP_TO_SMOOI(ctx->flags);
+		if (flags &  1) /* TODO: use an enumerator instead of 1 */
+		{
+			printf ("found catch...\n");
+/* TODO: arrange to find the catch block and activate it... */
+			return;
+		}
+
+		ctx = ctx->sender;
+	}
+
+printf ("no catch found...\n");
+	return 0;
+}
+
 /* ------------------------------------------------------------------------- */
 
 
@@ -3043,6 +3068,13 @@ static int execute (hcl_t* hcl)
 					goto oops;
 				}
 				break;
+
+			case HCL_CODE_THROW:
+				LOG_INST_0 (hcl, "throw");
+				return_value = HCL_STACK_GETTOP(hcl);
+				HCL_STACK_POP (hcl);
+				do_throw (hcl, return_value);
+				break;
 			/* -------------------------------------------------------- */
 
 			case HCL_CODE_PUSH_CTXTEMPVAR_X:

hcl/lib/hcl-prv.h

@@ -753,7 +753,8 @@ enum hcl_bcode_t
 
 	HCL_CODE_CALL_X                   = 0xD4, /* 212 */
 	HCL_CODE_TRY_CATCH                = 0xD5, /* 213 */
-	/* UNUSED - 0xD6 - 0xD7 */
+	HCL_CODE_THROW                    = 0xD6, /* 214 */
+	/* UNUSED - 0xD7 */
 
 	HCL_CODE_STORE_INTO_CTXTEMPVAR_X  = 0xD8, /* 216 ## */
 	/* UNUSED - 0xD9 - 0xDB */