rearranged the stack for the call operation by pushing a dummy receiver.

the rearrangement is done to make aa plain function call look the same as a message send

lib/comp.c

@@ -1258,7 +1258,9 @@ enum
 	COP_COMPILE_CLASS_P2,
 	COP_COMPILE_CLASS_P3,
 
+	COP_EMIT_PUSH_NIL,
 	COP_EMIT_CALL,
+	COP_EMIT_SEND_MESSAGE,
 
 	COP_EMIT_MAKE_ARRAY,
 	COP_EMIT_MAKE_BYTEARRAY,
@@ -2794,7 +2796,7 @@ static int compile_set_r (hcl_t* hcl, hcl_cnode_t* src)
 		return -1;
 	}
 
-	SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_R, val);
+	SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_R, val); /* special for set_r */
 	cf = GET_TOP_CFRAME(hcl);
 	cf->u.obj_r.nrets = nvars;
 
@@ -3359,7 +3361,9 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret
 				return -1;
 		}
 	}
-	else if (HCL_CNODE_IS_SYMBOL(car)  || HCL_CNODE_IS_DSYMBOL(car) || HCL_CNODE_IS_CONS_CONCODED(car, HCL_CONCODE_XLIST))
+	else if (HCL_CNODE_IS_SYMBOL(car)  || HCL_CNODE_IS_DSYMBOL(car) || 
+	         HCL_CNODE_IS_CONS_CONCODED(car, HCL_CONCODE_XLIST) ||
+	         HCL_CNODE_IS_CONS_CONCODED(car, HCL_CONCODE_MLIST))
 	{
 		/* normal function call 
 		 *  (<operator> <operand1> ...) */
@@ -3377,10 +3381,10 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret
 		oldtop = GET_TOP_CFRAME_INDEX(hcl); 
 		HCL_ASSERT (hcl, oldtop >= 0);
 
-		SWITCH_TOP_CFRAME (hcl, COP_EMIT_CALL, car);
+		SWITCH_TOP_CFRAME (hcl, COP_EMIT_CALL, car); /* <4> */
 
 		/* compile <operator> */
-		PUSH_CFRAME (hcl, COP_COMPILE_OBJECT, car);
+		PUSH_CFRAME (hcl, COP_COMPILE_OBJECT, car); /* <2> */
 
 		/* compile <operand1> ... etc */
 		cdr = HCL_CNODE_CONS_CDR(obj);
@@ -3430,13 +3434,16 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret
 		}
 
 		/* redundant cdr check is performed inside compile_object_list() */
-		PUSH_SUBCFRAME (hcl, COP_COMPILE_ARGUMENT_LIST, cdr);
+		PUSH_SUBCFRAME (hcl, COP_COMPILE_ARGUMENT_LIST, cdr); /* <3> */
 
 		/* patch the argument count in the operand field of the COP_EMIT_CALL frame */
 		cf = GET_CFRAME(hcl, oldtop);
 		HCL_ASSERT (hcl, cf->opcode == COP_EMIT_CALL);
 		cf->u.call.index = nargs;
 		cf->u.call.nrets = nrets;
+
+		/* arrange to push a dummy receiver to make the call look like a message send */
+		PUSH_CFRAME (hcl, COP_EMIT_PUSH_NIL, car); /* <1> this will be executed the COP_COMPILE_OBJECT car frame */
 	}
 	else
 	{
@@ -3450,14 +3457,109 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret
 static int compile_cons_mlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nrets)
 {
 	hcl_cnode_t* car;
+	hcl_ooi_t nargs;
+	hcl_ooi_t oldtop;
+	hcl_cframe_t* cf;
+	hcl_cnode_t* cdr;
 	int syncode; /* syntax code of the first element */
 
 	/* message sending 
-	 *  (: receiver message argument-list)
+	 *  (:<receiver> <operator> <operand1> ...)
 	 */
 	HCL_ASSERT (hcl, HCL_CNODE_IS_CONS_CONCODED(obj, HCL_CONCODE_MLIST));
 
 	car = HCL_CNODE_CONS_CAR(obj);
+	if (HCL_CNODE_IS_SYMBOL(car) && (syncode = HCL_CNODE_SYMBOL_SYNCODE(car)))
+	{
+		/* special symbols such as 'if' is not permitted here */
+		hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNED, HCL_CNODE_GET_LOC(car), HCL_CNODE_GET_TOK(car), "unpermitted message receiver");
+		return -1;
+	}
+
+	/* store the position of COP_EMIT_CALL to be produced with
+	 * SWITCH_TOP_CFRAME() in oldtop for argument count patching 
+	 * further down */
+	oldtop = GET_TOP_CFRAME_INDEX(hcl); 
+	HCL_ASSERT (hcl, oldtop >= 0);
+
+	SWITCH_TOP_CFRAME (hcl, COP_EMIT_SEND_MESSAGE, car);
+
+	/* compile <receiver> */
+	PUSH_CFRAME (hcl, COP_COMPILE_OBJECT, car);
+
+	/* compile <operator> */
+	cdr = HCL_CNODE_CONS_CDR(obj);
+	if (!cdr)
+	{
+		hcl_setsynerrbfmt (hcl, HCL_SYNERR_CALLABLE, HCL_CNODE_GET_LOC(car), HCL_CNODE_GET_TOK(car), "missing message");
+		return -1;
+	}
+	if (!HCL_CNODE_IS_CONS(cdr))
+	{
+		/* (<receiver> . 10) */
+		hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(cdr), HCL_CNODE_GET_TOK(cdr), "redundant cdr in message send");
+		return -1;
+	}
+	car = HCL_CNODE_CONS_CAR(cdr);
+	PUSH_CFRAME (hcl, COP_COMPILE_OBJECT, car);
+
+	/* compile <operand1> ... etc */
+	cdr = HCL_CNODE_CONS_CDR(cdr);
+	if (!cdr) 
+	{
+		nargs = 0;
+	}
+	else
+	{
+		if (!HCL_CNODE_IS_CONS(cdr))
+		{
+			/* (funname . 10) */
+			hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(cdr), HCL_CNODE_GET_TOK(cdr), "redundant cdr in function call");
+			return -1;
+		}
+
+		nargs = hcl_countcnodecons(hcl, cdr);
+		if (nargs > MAX_CODE_PARAM) 
+		{
+			hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_CNODE_GET_LOC(cdr), HCL_NULL, "too many(%zd) parameters in function call", nargs); 
+			return -1;
+		}
+	}
+
+#if 0
+	if (HCL_CNODE_IS_SYMBOL(car) || HCL_CNODE_IS_DSYMBOL(car))
+	{
+		hcl_oop_cons_t sdc;
+
+		/* only symbols are added to the system dictionary. 
+		 * perform this lookup only if car is a symbol */
+		sdc = hcl_lookupsysdicforsymbol_noseterr(hcl, HCL_CNODE_GET_TOK(car));
+		if (sdc)
+		{
+			hcl_oop_word_t sdv;
+			sdv = (hcl_oop_word_t)HCL_CONS_CDR(sdc);
+			if (HCL_IS_PRIM(hcl, sdv))
+			{
+				if (nargs < sdv->slot[1] || nargs > sdv->slot[2])
+				{
+					hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(car), HCL_NULL, 
+						"parameters count(%zd) mismatch in function call - %.*js - expecting %zu-%zu parameters", nargs, HCL_CNODE_GET_TOKLEN(car), HCL_CNODE_GET_TOKPTR(car), sdv->slot[1], sdv->slot[2]); 
+					return -1;
+				}
+			}
+		}
+	}
+#endif
+
+	/* redundant cdr check is performed inside compile_object_list() */
+	PUSH_SUBCFRAME (hcl, COP_COMPILE_ARGUMENT_LIST, cdr);
+
+	/* patch the argument count in the operand field of the COP_EMIT_CALL frame */
+	cf = GET_CFRAME(hcl, oldtop);
+	HCL_ASSERT (hcl, cf->opcode == COP_EMIT_SEND_MESSAGE);
+	cf->u.sendmsg.nargs = nargs;
+	cf->u.sendmsg.nrets = nrets;
+
 	return 0;
 }
 
@@ -4412,6 +4514,42 @@ static HCL_INLINE int emit_call (hcl_t* hcl)
 	return n;
 }
 
+static HCL_INLINE int emit_push_nil (hcl_t* hcl)
+{
+	hcl_cframe_t* cf;
+	int n;
+
+	cf = GET_TOP_CFRAME(hcl);
+	HCL_ASSERT (hcl, cf->opcode == COP_EMIT_PUSH_NIL);
+	HCL_ASSERT (hcl, cf->operand != HCL_NULL);
+
+	n = emit_byte_instruction(hcl, HCL_CODE_PUSH_NIL, HCL_CNODE_GET_LOC(cf->operand));
+	POP_CFRAME (hcl);
+	return n;
+}
+
+static HCL_INLINE int emit_send_message (hcl_t* hcl)
+{
+	hcl_cframe_t* cf;
+	int n;
+
+	cf = GET_TOP_CFRAME(hcl);
+	HCL_ASSERT (hcl, cf->opcode == COP_EMIT_SEND_MESSAGE);
+	HCL_ASSERT (hcl, cf->operand != HCL_NULL);
+
+	if (cf->u.sendmsg.nrets > 0)
+	{
+		//n = emit_double_param_instruction(hcl, HCL_CODE_CALL_R, cf->u.sendmsg.nargs, cf->u.sendmsg.nrets, HCL_CNODE_GET_LOC(cf->operand));
+	}
+	else
+	{
+		//n = emit_single_param_instruction(hcl, HCL_CODE_CALL_0, cf->u.sendmsg.nargs, HCL_CNODE_GET_LOC(cf->operand));
+	}
+
+	POP_CFRAME (hcl);
+	return n;
+}
+
 /* ========================================================================= */
 
 static HCL_INLINE int emit_make_array (hcl_t* hcl)
@@ -4914,11 +5052,18 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags)
 				if (compile_or_p2(hcl) <= -1) goto oops;
 				break;
 
-
 			case COP_EMIT_CALL:
 				if (emit_call(hcl) <= -1) goto oops;
 				break;
 
+			case COP_EMIT_PUSH_NIL:
+				if (emit_push_nil(hcl) <= -1) goto oops;
+				break;
+
+			case COP_EMIT_SEND_MESSAGE:
+				if (emit_send_message(hcl) <= -1) goto oops;
+				break;
+
 			case COP_EMIT_MAKE_ARRAY:
 				if (emit_make_array(hcl) <= -1) goto oops;
 				break;

lib/exec.c

@@ -1976,7 +1976,7 @@ static HCL_INLINE int activate_block (hcl_t* hcl, hcl_ooi_t nargs, hcl_ooi_t nrv
 	hcl_oop_block_t rcv;
 	hcl_oop_context_t newctx;
 
-	rcv = (hcl_oop_block_t)HCL_STACK_GETRCV(hcl, nargs);
+	rcv = (hcl_oop_block_t)HCL_STACK_GETOP(hcl, nargs);
 	HCL_ASSERT (hcl, HCL_IS_BLOCK(hcl, rcv));
 
 	x = prepare_new_context(
@@ -1989,7 +1989,7 @@ static HCL_INLINE int activate_block (hcl_t* hcl, hcl_ooi_t nargs, hcl_ooi_t nrv
 		&newctx);
 	if (HCL_UNLIKELY(x <= -1)) return -1;
 
-	HCL_STACK_POPS (hcl, nargs + 1); /* pop arguments and receiver */
+	HCL_STACK_POPS (hcl, nargs + 2); /* pop arguments, called block/function/method, and receiver */
 	newctx->sender = hcl->active_context;
 
 	SWITCH_ACTIVE_CONTEXT (hcl, newctx);
@@ -2061,7 +2061,7 @@ static int __activate_function (hcl_t* hcl, hcl_oop_function_t rcv_func, hcl_ooi
 		functx->slot[i] = HCL_STACK_GETARG(hcl, nargs, j);
 	}
 
-	HCL_STACK_POPS (hcl, nargs + 1); /* pop arguments and receiver */
+	HCL_STACK_POPS (hcl, nargs + 2); /* pop arguments, called function/block/method, and receiver */
 
 	HCL_ASSERT (hcl, (hcl_oop_t)functx->home != hcl->_nil);
 	functx->sender = hcl->active_context;
@@ -2076,7 +2076,7 @@ static HCL_INLINE int activate_function (hcl_t* hcl, hcl_ooi_t nargs)
 	hcl_oop_function_t rcv;
 	hcl_oop_context_t newctx;
 
-	rcv = (hcl_oop_function_t)HCL_STACK_GETRCV(hcl, nargs);
+	rcv = (hcl_oop_function_t)HCL_STACK_GETOP(hcl, nargs);
 	HCL_ASSERT (hcl, HCL_IS_FUNCTION(hcl, rcv));
 
 	x = __activate_function(hcl, rcv, nargs, &newctx);
@@ -2091,7 +2091,7 @@ static HCL_INLINE int call_primitive (hcl_t* hcl, hcl_ooi_t nargs)
 {
 	hcl_oop_prim_t rcv;
 
-	rcv = (hcl_oop_prim_t)HCL_STACK_GETRCV(hcl, nargs);
+	rcv = (hcl_oop_prim_t)HCL_STACK_GETOP(hcl, nargs);
 	HCL_ASSERT (hcl, HCL_IS_PRIM(hcl, rcv));
 	HCL_ASSERT (hcl, HCL_OBJ_GET_SIZE(rcv) == HCL_PRIM_NUM_WORDS);
 
@@ -2284,7 +2284,7 @@ static HCL_INLINE int exec_syscmd (hcl_t* hcl, hcl_ooi_t nargs)
 	hcl_bch_t* cmd = HCL_NULL;
 	hcl_bch_t* xcmd = HCL_NULL;
 
-	rcv = (hcl_oop_word_t)HCL_STACK_GETRCV(hcl, nargs);
+	rcv = (hcl_oop_word_t)HCL_STACK_GETOP(hcl, nargs);
 	/*HCL_ASSERT (hcl, HCL_IS_STRING(hcl, rcv) || HCL_IS_SYMBOL(hcl, rcv));*/
 	HCL_ASSERT (hcl, HCL_OBJ_IS_CHAR_POINTER(rcv));
 
@@ -3283,7 +3283,7 @@ static int execute (hcl_t* hcl)
 				FETCH_PARAM_CODE_TO (hcl, b2); /* nrvars */
 				LOG_INST_2 (hcl, "call %zu %zu", b1, b2);
 
-				rcv = HCL_STACK_GETRCV(hcl, b1);
+				rcv = HCL_STACK_GETOP(hcl, b1);
 				if (HCL_IS_BLOCK(hcl, rcv))
 				{
 					if (activate_block(hcl, b1, b2) <= -1) goto call2_failed;
@@ -3314,7 +3314,7 @@ static int execute (hcl_t* hcl)
 			handle_call:
 				LOG_INST_1 (hcl, "call %zu", b1);
 
-				rcv = HCL_STACK_GETRCV(hcl, b1);
+				rcv = HCL_STACK_GETOP(hcl, b1);
 				if (HCL_OOP_IS_POINTER(rcv))
 				{
 					switch (HCL_OBJ_GET_FLAGS_BRAND(rcv))

lib/fmt.c

@@ -2842,8 +2842,6 @@ int hcl_logfmtcallstack (hcl_t* hcl, hcl_ooi_t nargs)
 	return format_stack_args(&fo, nargs, 0);
 }
 
-
-
 /* --------------------------------------------------------------------------
  * DYNAMIC STRING FORMATTING
  * -------------------------------------------------------------------------- */

lib/hcl-prv.h

@@ -312,6 +312,13 @@ struct hcl_cframe_t
 			hcl_ooi_t nrets;
 		} call;
 
+		/* COP_EMIT_SEND_MESSAGE */
+		struct
+		{
+			hcl_ooi_t nargs;
+			hcl_ooi_t nrets;
+		} sendmsg;
+
 		/* COP_EMIT_SET */
 		struct
 		{

lib/hcl.h

@@ -1749,15 +1749,24 @@ struct hcl_t
 /* get the argument at the given index */
 #define HCL_STACK_GETARG(hcl,nargs,idx) HCL_STACK_GET(hcl, (hcl)->sp - ((nargs) - (idx) - 1))
 /* get the receiver of a message */
-#define HCL_STACK_GETRCV(hcl,nargs) HCL_STACK_GET(hcl, (hcl)->sp - nargs)
+#define HCL_STACK_GETRCV(hcl,nargs) HCL_STACK_GET(hcl, (hcl)->sp - nargs - 1)
+/* get the operator such as the called function/block/method */
+#define HCL_STACK_GETOP(hcl,nargs) HCL_STACK_GET(hcl, (hcl)->sp - nargs)
 
+/* 
+ * .....
+ * argument 1
+ * argument 0
+ * operator
+ * receiver
+ */
 
 /* you can't access arguments and receiver after this macro.
  * also you must not call this macro more than once */
 
 #define HCL_STACK_SETRET(hcl,nargs,retv) \
 	do { \
-		HCL_STACK_POPS(hcl, nargs); \
+		HCL_STACK_POPS(hcl, nargs + 1); \
 		HCL_STACK_SETTOP(hcl, (retv)); \
 	} while(0)