added the str.atPut primitive

lib/exec.c

@@ -2239,7 +2239,7 @@ static HCL_INLINE int send_message (hcl_t* hcl, hcl_oop_t rcv, hcl_oop_t msg, in
 {
 	hcl_oop_lambda_t mth_blk;
 	hcl_oop_context_t newctx;
-	hcl_oop_class_t class_, owner;
+	hcl_oop_class_t _class, owner;
 	hcl_ooi_t ivaroff;
 	int x;
 
@@ -2251,8 +2251,8 @@ static HCL_INLINE int send_message (hcl_t* hcl, hcl_oop_t rcv, hcl_oop_t msg, in
 /* ============================= */
 	if (HCL_IS_CLASS(hcl, rcv))
 	{
-		class_ = (hcl_oop_class_t)rcv;
+		_class = (hcl_oop_class_t)rcv;
-		mth_blk = find_cmethod_noseterr(hcl, class_, msg, to_super, &ivaroff, &owner);
+		mth_blk = find_cmethod_noseterr(hcl, _class, msg, to_super, &ivaroff, &owner);
 
 		if (!mth_blk) goto msg_not_found;
 
@@ -2263,7 +2263,7 @@ static HCL_INLINE int send_message (hcl_t* hcl, hcl_oop_t rcv, hcl_oop_t msg, in
 			hcl_pushvolat (hcl, (hcl_oop_t*)&mth_blk);
 			hcl_pushvolat (hcl, &msg);
 			hcl_pushvolat (hcl, &rcv);
-			newrcv = hcl_instantiate(hcl, (hcl_oop_class_t)class_, HCL_NULL, 0);
+			newrcv = hcl_instantiate(hcl, (hcl_oop_class_t)_class, HCL_NULL, 0);
 			hcl_popvolats (hcl, 3);
 			if (HCL_UNLIKELY(!newrcv)) return -1;
 
@@ -2273,13 +2273,14 @@ static HCL_INLINE int send_message (hcl_t* hcl, hcl_oop_t rcv, hcl_oop_t msg, in
 	else
 	{
 		/*HCL_ASSERT (hcl, HCL_IS_INSTANCE(hcl, rcv));*/
-		HCL_ASSERT (hcl, HCL_IS_CLASS(hcl, rcv->_class));
+		_class = (hcl_oop_class_t)HCL_CLASSOF(hcl, rcv);
-		class_ = (hcl_oop_class_t)rcv->_class;
+		HCL_ASSERT (hcl, _class != HCL_NULL);
-		mth_blk = find_imethod_noseterr(hcl, class_, msg, to_super, &ivaroff, &owner);
+		HCL_ASSERT (hcl, HCL_IS_CLASS(hcl, _class));
+		mth_blk = find_imethod_noseterr(hcl, _class, msg, to_super, &ivaroff, &owner);
 		if (!mth_blk)
 		{
 		msg_not_found:
-			hcl_seterrbfmt (hcl, HCL_ENOENT, "'%.*js' not found in %O", HCL_OBJ_GET_SIZE(msg), HCL_OBJ_GET_CHAR_SLOT(msg), class_);
+			hcl_seterrbfmt (hcl, HCL_ENOENT, "'%.*js' not found in %O", HCL_OBJ_GET_SIZE(msg), HCL_OBJ_GET_CHAR_SLOT(msg), _class);
 			return -1;
 		}
 	}
@@ -3737,10 +3738,8 @@ static int execute (hcl_t* hcl)
 						case HCL_BRAND_PRIM:
 							if (call_primitive(hcl, b1) <= -1)
 							{
-/*
+							/* TODO: do i have tell a catchable exception from a fatal error? */
-TODO: translate a certain primitive failure to a catchable exception. this seems to work . i need to capture the throw value instead of hcl->_nil .
+								if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) >= 0) break;
-if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
-*/
 								goto call_failed;
 							}
 							break;

mod/str.c

@@ -27,6 +27,83 @@
 
 #include "_str.h"
 
+static hcl_pfrc_t pf_str_at (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
+{
+	hcl_oop_t str, pos;
+	hcl_ooch_t cv;
+	hcl_ooi_t size;
+	hcl_ooi_t idx;
+
+	str = HCL_STACK_GETARG(hcl, nargs, 0);
+	pos = HCL_STACK_GETARG(hcl, nargs, 1);
+
+	if (!HCL_IS_STRING(hcl, str))
+	{
+		hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not string - %O", str);
+		return HCL_PF_FAILURE;
+	}
+
+	if (!HCL_OOP_IS_SMOOI(pos))
+	{
+		hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not smooi - %O", pos);
+		return HCL_PF_FAILURE;
+	}
+
+	idx = HCL_OOP_TO_SMOOI(pos);
+	size = HCL_OBJ_GET_SIZE(str);
+	if (idx <= -1 || idx >= size)
+	{
+		hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter out of range - %O", pos);
+		return HCL_PF_FAILURE;
+	}
+	cv = HCL_OBJ_GET_CHAR_VAL(str, idx);
+	HCL_STACK_SETRET (hcl, nargs, HCL_CHAR_TO_OOP(cv));
+	return HCL_PF_SUCCESS;
+}
+
+static hcl_pfrc_t pf_str_at_put (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
+{
+	hcl_oop_t str, pos, val;
+	hcl_ooch_t cv;
+	hcl_ooi_t size;
+	hcl_ooi_t idx;
+
+	str = HCL_STACK_GETARG(hcl, nargs, 0);
+	pos = HCL_STACK_GETARG(hcl, nargs, 1);
+	val = HCL_STACK_GETARG(hcl, nargs, 2);
+
+	if (!HCL_IS_STRING(hcl, str))
+	{
+		hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not string - %O", str);
+		return HCL_PF_FAILURE;
+	}
+
+	if (!HCL_OOP_IS_SMOOI(pos))
+	{
+		hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not integer - %O", pos);
+		return HCL_PF_FAILURE;
+	}
+
+	if (!HCL_OOP_IS_CHAR(val))
+	{
+		hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not character - %O", pos);
+		return HCL_PF_FAILURE;
+	}
+
+	idx = HCL_OOP_TO_SMOOI(pos);
+	size = HCL_OBJ_GET_SIZE(str);
+	if (idx <= -1 || idx >= size)
+	{
+		hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter out of range - %O", pos);
+		return HCL_PF_FAILURE;
+	}
+
+	cv = HCL_OOP_TO_CHAR(val);
+	HCL_OBJ_SET_CHAR_VAL(str, idx, cv);
+	HCL_STACK_SETRET (hcl, nargs, val);
+	return HCL_PF_SUCCESS;
+}
+
 static hcl_pfrc_t pf_str_length (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
 {
 	hcl_oop_t str;
@@ -36,7 +113,7 @@ static hcl_pfrc_t pf_str_length (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
 
 	if (!HCL_IS_STRING(hcl, str))
 	{
-		hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not a string - %O", str);
+		hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not string - %O", str);
 		return HCL_PF_FAILURE;
 	}
 
@@ -48,6 +125,8 @@ static hcl_pfrc_t pf_str_length (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
 static hcl_pfinfo_t pfinfos[] =
 {
 	/*{ { 'V','A','R','\0' },                  { HCL_PFBASE_VAR,  HCL_NULL,           0,  0 } },*/
+	{ { 'a','t','\0' },                      { HCL_PFBASE_FUNC,  pf_str_at,         2,  2 } },
+	{ { 'a','t','P','u','t','\0' },          { HCL_PFBASE_FUNC,  pf_str_at_put,     3,  3 } },
 	{ { 'l','e','n','g','t','h','\0' },      { HCL_PFBASE_FUNC,  pf_str_length,     1,  1 } }
 };
 

t/call-5001.err

@@ -1,3 +1,11 @@
 ## the expression begins with a dictionary expression. 
 ## it is not a function name and can'be be invoked.
 #{100:1, 200: 3}; ##ERROR: syntax error - invalid callable
+
+---
+
+try {
+	throw "excetion message"
+} catch (e a) { ##ERROR: syntax error - not proper exception variable
+	printf "EXCEPTION - %s\n" e
+}