more code added for message sending implementation

lib/dic.c

@@ -211,7 +211,7 @@ static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t k
 
 	/* create a new assocation of a key and a value since 
 	 * the key isn't found in the root dictionary */
-	ass = (hcl_oop_cons_t)hcl_makecons (hcl, (hcl_oop_t)key, value);
+	ass = (hcl_oop_cons_t)hcl_makecons(hcl, (hcl_oop_t)key, value);
 	if (!ass) goto oops;
 
 	/* the current tally must be less than the maximum value. otherwise,
@@ -274,6 +274,17 @@ static HCL_INLINE hcl_oop_cons_t lookupdic (hcl_t* hcl, hcl_oop_dic_t dic, const
 	return ass;
 }
 
+hcl_oop_cons_t hcl_lookupdicforsymbol_noseterr (hcl_t* hcl, hcl_oop_dic_t dic, const hcl_oocs_t* name)
+{
+	return lookupdic_noseterr(hcl, dic, name);
+}
+
+hcl_oop_cons_t hcl_lookupdicforsymbol (hcl_t* hcl, hcl_oop_dic_t dic, const hcl_oocs_t* name)
+{
+	return lookupdic(hcl, dic, name);
+}
+
+
 hcl_oop_cons_t hcl_putatsysdic (hcl_t* hcl, hcl_oop_t key, hcl_oop_t value)
 {
 #if defined(SYMBOL_ONLY_KEY)

lib/exec.c

@@ -1998,7 +1998,7 @@ static HCL_INLINE int activate_block (hcl_t* hcl, hcl_ooi_t nargs, hcl_ooi_t nrv
 
 /* ------------------------------------------------------------------------- */
 
-static int __activate_function (hcl_t* hcl, hcl_oop_function_t rcv_func, hcl_ooi_t nargs, hcl_oop_context_t* pnewctx)
+static int __activate_function (hcl_t* hcl, hcl_oop_function_t op_func, hcl_ooi_t nargs, hcl_oop_context_t* pnewctx)
 {
 	/* prepare a new block context for activation.
 	 * the receiver must be a block context which becomes the base
@@ -2018,9 +2018,9 @@ static int __activate_function (hcl_t* hcl, hcl_oop_function_t rcv_func, hcl_ooi
 	 */
 
 	/* the receiver must be a function */
-	HCL_ASSERT (hcl, HCL_IS_FUNCTION(hcl, rcv_func));
+	HCL_ASSERT (hcl, HCL_IS_FUNCTION(hcl, op_func));
 
-	tmpr_mask = HCL_OOP_TO_SMOOI(rcv_func->tmpr_mask);
+	tmpr_mask = HCL_OOP_TO_SMOOI(op_func->tmpr_mask);
 	nrvars = GET_BLKTMPR_MASK_NRVARS(tmpr_mask);
 	nlvars = GET_BLKTMPR_MASK_NLVARS(tmpr_mask);
 	fixed_nargs = GET_BLKTMPR_MASK_NARGS(tmpr_mask);
@@ -2031,22 +2031,22 @@ static int __activate_function (hcl_t* hcl, hcl_oop_function_t rcv_func, hcl_ooi
 	{
 		HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_ERROR, 
 			"Error - wrong number of arguments to a function %O - expecting %zd, got %zd\n",
-			rcv_func, fixed_nargs, nargs);
+			op_func, fixed_nargs, nargs);
 		hcl_seterrnum (hcl, HCL_ECALLARG);
 		return -1;
 	}
 
-	/* create a new block context to clone rcv_func */
+	/* create a new block context to clone op_func */
-	hcl_pushvolat (hcl, (hcl_oop_t*)&rcv_func);
+	hcl_pushvolat (hcl, (hcl_oop_t*)&op_func);
 	functx = make_context(hcl, fixed_nargs + nrvars + nlvars + excess_nargs); 
 	hcl_popvolat (hcl);
 	if (HCL_UNLIKELY(!functx)) return -1;
 
 	functx->ip = HCL_SMOOI_TO_OOP(0);
 	functx->req_nrets = HCL_SMOOI_TO_OOP(1);
-	functx->tmpr_mask = rcv_func->tmpr_mask;
+	functx->tmpr_mask = op_func->tmpr_mask;
-	functx->receiver_or_base = (hcl_oop_t)rcv_func;
+	functx->receiver_or_base = (hcl_oop_t)op_func;
-	functx->home = rcv_func->home;
+	functx->home = op_func->home;
 	functx->origin = functx; /* the origin of the context over a function should be itself */
 
 	/* copy the fixed arguments to the beginning of the variable part of the context block */
@@ -2073,13 +2073,13 @@ static int __activate_function (hcl_t* hcl, hcl_oop_function_t rcv_func, hcl_ooi
 static HCL_INLINE int activate_function (hcl_t* hcl, hcl_ooi_t nargs)
 {
 	int x;
-	hcl_oop_function_t rcv;
+	hcl_oop_function_t op;
 	hcl_oop_context_t newctx;
 
-	rcv = (hcl_oop_function_t)HCL_STACK_GETOP(hcl, nargs);
+	op = (hcl_oop_function_t)HCL_STACK_GETOP(hcl, nargs);
-	HCL_ASSERT (hcl, HCL_IS_FUNCTION(hcl, rcv));
+	HCL_ASSERT (hcl, HCL_IS_FUNCTION(hcl, op));
 
-	x = __activate_function(hcl, rcv, nargs, &newctx);
+	x = __activate_function(hcl, op, nargs, &newctx);
 	if (HCL_UNLIKELY(x <= -1)) return -1;
 
 	SWITCH_ACTIVE_CONTEXT (hcl, newctx);
@@ -2109,12 +2109,60 @@ static HCL_INLINE int call_primitive (hcl_t* hcl, hcl_ooi_t nargs)
 }
 
 /* ------------------------------------------------------------------------- */
+
+static hcl_oop_function_t find_method_noseterr (hcl_t* hcl, hcl_oop_class_t class_, hcl_oop_t op)
+{
+	hcl_oocs_t name;
+
+	HCL_ASSERT (hcl, HCL_IS_CLASS(hcl, class_));
+	HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, op));
+
+	name.ptr = HCL_OBJ_GET_CHAR_SLOT(op);
+	name.len = HCL_OBJ_GET_SIZE(op);
+
+	do
+	{
+		hcl_oop_cons_t ass;
+
+		ass = (hcl_oop_cons_t)hcl_lookupdicforsymbol_noseterr(hcl, class_->memdic, &name );
+		if (!ass)
+		{
+			hcl_oop_t val;
+			val = HCL_CONS_CDR(ass);
+			if (HCL_IS_FUNCTION(hcl, val))
+			{
+				/* TODO: futher check if it's a method */
+				return (hcl_oop_function_t)val;
+			}
+		}
+		class_ = (hcl_oop_class_t)class_->superclass;
+	}
+	while (HCL_IS_CLASS(hcl, class_));
+
+	return HCL_NULL;
+}
+
 static HCL_INLINE int send_message (hcl_t* hcl, hcl_oop_t rcv, hcl_oop_t op, int to_super, hcl_ooi_t nargs)
 {
+	hcl_oop_function_t mth;
+	hcl_oop_context_t newctx;
+	int x;
+
 	HCL_ASSERT (hcl, HCL_IS_INSTANCE(hcl, rcv));
 	HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, op));
 
+	HCL_ASSERT (hcl, HCL_IS_CLASS(hcl, rcv->_class));
+	mth = find_method_noseterr(hcl, (hcl_oop_class_t)rcv->_class, op);
+	if (!mth)
+	{
+		/* TODO: error message?, do throw?? */
+		return -1;
+	}
 
+	x = __activate_function(hcl, mth, nargs, &newctx);
+	if (HCL_UNLIKELY(x <= -1)) return -1;
+
+	SWITCH_ACTIVE_CONTEXT (hcl, newctx);
 	return 0;
 }
 
@@ -3653,22 +3701,6 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
 			case HCL_CODE_SEND_TO_SUPER_2:
 			case HCL_CODE_SEND_TO_SUPER_3:
 			{
-			#if 0
-				hcl_oop_char_t selector;
-
-			
-				b1 = bcode & 0x3; /* low 2 bits */
-				FETCH_BYTE_CODE_TO (hcl, b2);
-
-			handle_send_message:
-				/* get the selector from the literal frame */
-				selector = (hcl_oop_char_t)hcl->active_method->slot[b2];
-
-				LOG_INST_3 (hcl, "send%hs %zu @%zu", (((bcode >> 2) & 1)? "_to_super": ""), b1, b2);
-
-				if (send_message(hcl, selector, ((bcode >> 2) & 1), b1) <= -1) goto oops;
-				break;
-			#else
 				hcl_oop_t rcv, op;
 
 				b1 = bcode & 0x3; /* low 2 bits */
@@ -3681,6 +3713,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
 				{
 					if (send_message(hcl, rcv, op, ((bcode >> 2) & 1), b1) <= -1) goto send_failed;
 				}
+				/* TODO: support non-symbol op? */
 				else
 				{
 				cannot_send:
@@ -3691,7 +3724,6 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
 					goto oops;
 				}
 				break;
-			#endif
 			}
 
 			/* -------------------------------------------------------- */

lib/hcl.h

@@ -840,18 +840,14 @@ struct hcl_process_scheduler_t
 };
 
 
-#define HCL_CLASS_NAMED_INSTVARS 7
+#define HCL_CLASS_NAMED_INSTVARS 6
 typedef struct hcl_class_t hcl_class_t;
 typedef struct hcl_class_t* hcl_oop_class_t;
 struct hcl_class_t
 {
 	HCL_OBJ_HEADER;
 
-	/* === the following five fields must be in sync with hcl_methowner_t === */
+	hcl_oop_dic_t memdic; /* dictionary of named elements including methods and variables */
-	/* [0] - instance methods, MethodDictionary
-	 * [1] - class methods, MethodDictionary */
-	hcl_oop_dic_t  mthdic[2];      
-	/* ===================================================================== */
 
 	hcl_oop_t superclass;
 	hcl_oop_t nivars; /* smooi. */
@@ -860,7 +856,7 @@ struct hcl_class_t
 	hcl_oop_char_t ivarnames;
 	hcl_oop_char_t cvarnames;
 
-	/* indexed part afterwards */
+	/* indexed part afterwards - not included in HCL_CLASS_NAMED_INSTVARS */
 	hcl_oop_t      cvar[1];   /* class variables. */
 };
 
@@ -2620,12 +2616,12 @@ HCL_EXPORT hcl_oop_cons_t hcl_getatsysdic (
 	hcl_oop_t  key
 );
 
-hcl_oop_cons_t hcl_lookupsysdicforsymbol (
+HCL_EXPORT hcl_oop_cons_t hcl_lookupsysdicforsymbol (
 	hcl_t*            hcl,
 	const hcl_oocs_t* name
 );
 
-hcl_oop_cons_t hcl_lookupsysdicforsymbol_noseterr (
+HCL_EXPORT hcl_oop_cons_t hcl_lookupsysdicforsymbol_noseterr (
 	hcl_t*            hcl,
 	const hcl_oocs_t* name
 );
@@ -2635,6 +2631,18 @@ HCL_EXPORT int hcl_zapatsysdic (
 	hcl_oop_t  key
 );
 
+HCL_EXPORT hcl_oop_cons_t hcl_lookupdicforsymbol (
+	hcl_t*            hcl,
+	hcl_oop_dic_t     dic,
+	const hcl_oocs_t* name
+);
+
+HCL_EXPORT hcl_oop_cons_t hcl_lookupdicforsymbol_noseterr (
+	hcl_t*            hcl,
+	hcl_oop_dic_t     dic,
+	const hcl_oocs_t* name
+);
+
 HCL_EXPORT hcl_oop_cons_t hcl_putatdic (
 	hcl_t*        hcl,
 	hcl_oop_dic_t dic,