hyung-hwan/hcl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

implementing message sending

Browse Source
This commit is contained in:
hyung-hwan 2022-01-23 16:46:13 +00:00
parent 7ad9b2d499
commit 6cdbc457a0
4 changed files with 162 additions and 88 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
lib/comp.c
View File

@ -519,6 +519,8 @@ static int emit_single_param_instruction (hcl_t* hcl, int cmd, hcl_oow_t param_1
case HCL_CODE_JUMP_FORWARD_0:
case HCL_CODE_JUMP_BACKWARD_0:
case HCL_CODE_CALL_0:
case HCL_CODE_SEND_0:
case HCL_CODE_SEND_TO_SUPER_0:
if (param_1 < 4)
{
/* low 2 bits to hold the parameter */
@ -620,8 +622,6 @@ static int emit_double_param_instruction (hcl_t* hcl, int cmd, hcl_oow_t param_1
case HCL_CODE_PUSH_OBJVAR_0:
case HCL_CODE_STORE_INTO_OBJVAR_0:
case HCL_CODE_POP_INTO_OBJVAR_0:
case HCL_CODE_SEND_MESSAGE_0:
case HCL_CODE_SEND_MESSAGE_TO_SUPER_0:
if (param_1 < 4 && param_2 < 0xFF)
{
/* low 2 bits of the instruction code is the first parameter */
@ -1260,7 +1260,7 @@ enum
COP_EMIT_PUSH_NIL,
COP_EMIT_CALL,
COP_EMIT_SEND_MESSAGE,
COP_EMIT_SEND,
COP_EMIT_MAKE_ARRAY,
COP_EMIT_MAKE_BYTEARRAY,
@ -3456,11 +3456,10 @@ 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_cnode_t* car, * cdr, * rcv;
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
@ -3482,10 +3481,10 @@ static int compile_cons_mlist_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_SEND_MESSAGE, car);
SWITCH_TOP_CFRAME (hcl, COP_EMIT_SEND, car);
/* compile <receiver> */
PUSH_CFRAME (hcl, COP_COMPILE_OBJECT, car);
rcv = car; /* remember the receiver node to to push it later */
/* compile <operator> */
cdr = HCL_CNODE_CONS_CDR(obj);
@ -3501,6 +3500,9 @@ static int compile_cons_mlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret
return -1;
}
car = HCL_CNODE_CONS_CAR(cdr);
/* TODO: if car is a normal symbol, it is a method name of the receiver's class.
* don't evalutate it.
* however, if it's enclosed in another () or (:), evaluate it... */
PUSH_CFRAME (hcl, COP_COMPILE_OBJECT, car);
/* compile <operand1> ... etc */
@ -3556,10 +3558,11 @@ static int compile_cons_mlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret
/* 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);
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_SEND);
cf->u.sendmsg.nargs = nargs;
cf->u.sendmsg.nrets = nrets;
PUSH_CFRAME (hcl, COP_COMPILE_OBJECT, rcv);
return 0;
}
@ -4528,22 +4531,22 @@ static HCL_INLINE int emit_push_nil (hcl_t* hcl)
return n;
}
static HCL_INLINE int emit_send_message (hcl_t* hcl)
static HCL_INLINE int emit_send (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->opcode == COP_EMIT_SEND);
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));
n = emit_double_param_instruction(hcl, HCL_CODE_SEND_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));
n = emit_single_param_instruction(hcl, HCL_CODE_SEND_0, cf->u.sendmsg.nargs, HCL_CNODE_GET_LOC(cf->operand));
}
POP_CFRAME (hcl);
@ -5060,8 +5063,8 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags)
if (emit_push_nil(hcl) <= -1) goto oops;
break;
case COP_EMIT_SEND_MESSAGE:
if (emit_send_message(hcl) <= -1) goto oops;
case COP_EMIT_SEND:
if (emit_send(hcl) <= -1) goto oops;
break;
case COP_EMIT_MAKE_ARRAY:

42
lib/decode.c
View File

@ -476,27 +476,35 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
break;
/* -------------------------------------------------------- */
case HCL_CODE_SEND_MESSAGE_X:
case HCL_CODE_SEND_MESSAGE_TO_SUPER_X:
/* b1 -> number of arguments
* b2 -> selector index stored in the literal frame */
case HCL_CODE_SEND_R:
FETCH_PARAM_CODE_TO (hcl, b1); /* nargs */
FETCH_PARAM_CODE_TO (hcl, b2); /* nrvars */
LOG_INST_2 (hcl, "send_r %zu %zu", b1, b2);
break;
case HCL_CODE_SEND_TO_SUPER_R:
FETCH_PARAM_CODE_TO (hcl, b1); /* nargs */
FETCH_PARAM_CODE_TO (hcl, b2); /* nrvars */
LOG_INST_2 (hcl, "send_to_super_r %zu %zu", b1, b2);
break;
case HCL_CODE_SEND_X:
case HCL_CODE_SEND_TO_SUPER_X:
FETCH_PARAM_CODE_TO (hcl, b1);
FETCH_PARAM_CODE_TO (hcl, b2);
goto handle_send_message;
goto handle_send;
case HCL_CODE_SEND_MESSAGE_0:
case HCL_CODE_SEND_MESSAGE_1:
case HCL_CODE_SEND_MESSAGE_2:
case HCL_CODE_SEND_MESSAGE_3:
case HCL_CODE_SEND_MESSAGE_TO_SUPER_0:
case HCL_CODE_SEND_MESSAGE_TO_SUPER_1:
case HCL_CODE_SEND_MESSAGE_TO_SUPER_2:
case HCL_CODE_SEND_MESSAGE_TO_SUPER_3:
case HCL_CODE_SEND_0:
case HCL_CODE_SEND_1:
case HCL_CODE_SEND_2:
case HCL_CODE_SEND_3:
case HCL_CODE_SEND_TO_SUPER_0:
case HCL_CODE_SEND_TO_SUPER_1:
case HCL_CODE_SEND_TO_SUPER_2:
case HCL_CODE_SEND_TO_SUPER_3:
b1 = bcode & 0x3; /* low 2 bits */
FETCH_BYTE_CODE_TO (hcl, b2);
handle_send_message:
LOG_INST_3 (hcl, "send_message%hs %zu @%zu", (((bcode >> 2) & 1)? "_to_super": ""), b1, b2);
handle_send:
LOG_INST_2 (hcl, "send%hs %zu", (((bcode >> 2) & 1)? "_to_super": ""), b1);
break;
/* -------------------------------------------------------- */

108
lib/exec.c
View File

@ -2125,13 +2125,13 @@ static HCL_INLINE int do_throw (hcl_t* hcl, hcl_oop_t val, hcl_ooi_t ip)
{
hcl_dbgi_t* dbgi;
dbgi = (hcl_dbgi_t*)HCL_OBJ_GET_BYTE_SLOT(hcl->active_function->dbgi);
HCL_LOG2 (hcl, HCL_LOG_IC | HCL_LOG_WARN, "Warning - exception not handled %js:%zu", (dbgi[ip].fname? dbgi[ip].fname: oocstr_dash), dbgi[ip].sline);
hcl_seterrbfmt (hcl, HCL_EEXCEPT, "exception not handled in %js:%zu", (dbgi[ip].fname? dbgi[ip].fname: oocstr_dash), dbgi[ip].sline);
HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_WARN, "Warning - exception not handled %js:%zu- %O", (dbgi[ip].fname? dbgi[ip].fname: oocstr_dash), dbgi[ip].sline, val);
hcl_seterrbfmt (hcl, HCL_EEXCEPT, "exception not handled in %js:%zu - %O", (dbgi[ip].fname? dbgi[ip].fname: oocstr_dash), dbgi[ip].sline, val);
}
else
{
HCL_LOG0 (hcl, HCL_LOG_IC | HCL_LOG_WARN, "Warning - exception not handled");
hcl_seterrbfmt (hcl, HCL_EEXCEPT, "exception not handled");
HCL_LOG1 (hcl, HCL_LOG_IC | HCL_LOG_WARN, "Warning - exception not handled - %O", val);
hcl_seterrbfmt (hcl, HCL_EEXCEPT, "exception not handled - %O", val);
}
/* exception not handled. terminate the active process */
@ -3308,16 +3308,19 @@ static int execute (hcl_t* hcl)
case HCL_CODE_CALL_2:
case HCL_CODE_CALL_3:
{
hcl_oop_t rcv;
hcl_oop_t op;
b1 = bcode & 0x3; /* low 2 bits */
handle_call:
LOG_INST_1 (hcl, "call %zu", b1);
rcv = HCL_STACK_GETOP(hcl, b1);
if (HCL_OOP_IS_POINTER(rcv))
/* TODO: check if the rcv is the dummy receiver
rcv = HCL_STACK_GETRCV(hcl, b1);
* */
op = HCL_STACK_GETOP(hcl, b1);
if (HCL_OOP_IS_POINTER(op))
{
switch (HCL_OBJ_GET_FLAGS_BRAND(rcv))
switch (HCL_OBJ_GET_FLAGS_BRAND(op))
{
case HCL_BRAND_FUNCTION:
if (activate_function(hcl, b1) <= -1) goto call_failed;
@ -3346,7 +3349,8 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
{
cannot_call:
/* run time error */
hcl_seterrbfmt (hcl, HCL_ECALL, "cannot call %O", rcv);
hcl_seterrbfmt (hcl, HCL_ECALL, "cannot call %O", op);
if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) >= 0) break;
call_failed:
supplement_errmsg (hcl, fetched_instruction_pointer);
goto oops;
@ -3611,25 +3615,38 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
/* -------------------------------------------------------- */
#if 0
case HCL_CODE_SEND_MESSAGE_X:
case HCL_CODE_SEND_MESSAGE_TO_SUPER_X:
case HCL_CODE_SEND_R:
case HCL_CODE_SEND_TO_SUPER_R:
/* TODO ........ */
break;
#endif
case HCL_CODE_SEND_X:
case HCL_CODE_SEND_TO_SUPER_X:
#if 0
/* b1 -> number of arguments
* b2 -> selector index stored in the literal frame */
FETCH_PARAM_CODE_TO (hcl, b1);
FETCH_PARAM_CODE_TO (hcl, b2);
goto handle_send_message;
#else
FETCH_PARAM_CODE_TO (hcl, b1);
goto handle_send;
#endif
case HCL_CODE_SEND_MESSAGE_0:
case HCL_CODE_SEND_MESSAGE_1:
case HCL_CODE_SEND_MESSAGE_2:
case HCL_CODE_SEND_MESSAGE_3:
case HCL_CODE_SEND_MESSAGE_TO_SUPER_0:
case HCL_CODE_SEND_MESSAGE_TO_SUPER_1:
case HCL_CODE_SEND_MESSAGE_TO_SUPER_2:
case HCL_CODE_SEND_MESSAGE_TO_SUPER_3:
case HCL_CODE_SEND_0:
case HCL_CODE_SEND_1:
case HCL_CODE_SEND_2:
case HCL_CODE_SEND_3:
case HCL_CODE_SEND_TO_SUPER_0:
case HCL_CODE_SEND_TO_SUPER_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);
@ -3637,12 +3654,59 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
/* get the selector from the literal frame */
selector = (hcl_oop_char_t)hcl->active_method->slot[b2];
LOG_INST_3 (hcl, "send_message%hs %zu @%zu", (((bcode >> 2) & 1)? "_to_super": ""), b1, 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; /* CMD_SEND_MESSAGE */
break;
#else
hcl_oop_t rcv, op;
b1 = bcode & 0x3; /* low 2 bits */
handle_send:
LOG_INST_2 (hcl, "send%hs %zu", (((bcode >> 2) & 1)? "_to_super": ""), b1);
rcv = HCL_STACK_GETRCV(hcl, b1);
op = HCL_STACK_GETOP(hcl, b1);
if (HCL_OOP_IS_POINTER(op))
{
switch (HCL_OBJ_GET_FLAGS_BRAND(op))
{
case HCL_BRAND_FUNCTION:
if (activate_function(hcl, b1) <= -1) goto call_failed;
break;
case HCL_BRAND_BLOCK:
if (activate_block(hcl, b1, 0) <= -1) goto call_failed;
break;
case HCL_BRAND_PRIM:
if (call_primitive(hcl, b1) <= -1)
{
/*
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(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
*/
goto call_failed;
}
break;
default:
goto cannot_send;
}
}
else
{
cannot_send:
hcl_seterrbfmt (hcl, HCL_ECALL, "cannot send %O to %O", op, rcv); /* TODO: change to HCL_ESEND?? */
if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) >= 0) break;
send_failed:
supplement_errmsg (hcl, fetched_instruction_pointer);
goto oops;
}
break;
#endif
}
#endif
/* -------------------------------------------------------- */
case HCL_CODE_PUSH_CLSVAR_I_X:
{

69
lib/hcl-prv.h
View File

@ -676,8 +676,8 @@ SHORT INSTRUCTION CODE LONG INSTRUCTION C
# XXXth instance variable of YYYYYYYY object
v
112-115 0111 00XX YYYYYYYY SEND_MESSAGE 240 1111 0000 XXXXXXXX YYYYYYYY SEND_MESSAGE_X (bit 2 off)
116-119 0111 01XX YYYYYYYY SEND_MESSAGE_TO_SUPER 244 1111 0100 XXXXXXXX YYYYYYYY SEND_MESSAGE_TO_SUPER_X (bit 2 on)
112-115 0111 00XX YYYYYYYY SEND_MESSAGE 240 1111 0000 XXXXXXXX YYYYYYYY SEND_X (bit 2 off)
116-119 0111 01XX YYYYYYYY SEND_TO_SUPER 244 1111 0100 XXXXXXXX YYYYYYYY SEND_TO_SUPER_X (bit 2 on)
# XXX args, YYYYYYYY message
120 0111 1000 YYYYYYYY PUSH_CLSVAR_I_X
@ -833,29 +833,27 @@ enum hcl_bcode_t
HCL_CODE_POP_INTO_OBJVAR_2 = 0x6E,
HCL_CODE_POP_INTO_OBJVAR_3 = 0x6F,
HCL_CODE_SEND_MESSAGE_0 = 0x70, /* 112 */
HCL_CODE_SEND_MESSAGE_1 = 0x71, /* 113 */
HCL_CODE_SEND_MESSAGE_2 = 0x72, /* 114 */
HCL_CODE_SEND_MESSAGE_3 = 0x73, /* 115 */
HCL_CODE_SEND_0 = 0x70, /* 112 */
HCL_CODE_SEND_1 = 0x71, /* 113 */
HCL_CODE_SEND_2 = 0x72, /* 114 */
HCL_CODE_SEND_3 = 0x73, /* 115 */
HCL_CODE_SEND_MESSAGE_TO_SUPER_0 = 0x74, /* 116 */
HCL_CODE_SEND_MESSAGE_TO_SUPER_1 = 0x75, /* 117 */
HCL_CODE_SEND_MESSAGE_TO_SUPER_2 = 0x76, /* 118 */
HCL_CODE_SEND_MESSAGE_TO_SUPER_3 = 0x77, /* 119 */
HCL_CODE_SEND_TO_SUPER_0 = 0x74, /* 116 */
HCL_CODE_SEND_TO_SUPER_1 = 0x75, /* 117 */
HCL_CODE_SEND_TO_SUPER_2 = 0x76, /* 118 */
HCL_CODE_SEND_TO_SUPER_3 = 0x77, /* 119 */
HCL_CODE_PUSH_CLSVAR_I_X = 0x78, /* 120 */
HCL_CODE_STORE_INTO_CLSVAR_I_X = 0x79, /* 121 */
HCL_CODE_POP_INTO_CLSVAR_I_X = 0x7A, /* 122 */
HCL_CODE_PUSH_CLSVAR_I_X = 0x78, /* 120 */
HCL_CODE_STORE_INTO_CLSVAR_I_X = 0x79, /* 121 */
HCL_CODE_POP_INTO_CLSVAR_I_X = 0x7A, /* 122 */
HCL_CODE_PUSH_CLSVAR_M_X = 0x7B, /* 123 */
HCL_CODE_STORE_INTO_CLSVAR_M_X = 0x7C, /* 124 */
HCL_CODE_POP_INTO_CLSVAR_M_X = 0x7D, /* 125 */
HCL_CODE_PUSH_CLSVAR_M_X = 0x7B, /* 123 */
HCL_CODE_STORE_INTO_CLSVAR_M_X = 0x7C, /* 124 */
HCL_CODE_POP_INTO_CLSVAR_M_X = 0x7D, /* 125 */
/* UNUSED 0x7E - 0x7F */
HCL_CODE_STORE_INTO_INSTVAR_X = 0x80, /* 128 */
HCL_CODE_PUSH_RECEIVER = 0x81, /* 129 */
HCL_CODE_PUSH_NIL = 0x82, /* 130 */
HCL_CODE_PUSH_TRUE = 0x83, /* 131 */
@ -915,7 +913,6 @@ enum hcl_bcode_t
HCL_CODE_CALL_R = 0xD5, /* 213 ## ##*/
HCL_CODE_PUSH_RETURN_R = 0xD6, /* 214 */
HCL_CODE_TRY_ENTER = 0xD7, /* 215 ## */
HCL_CODE_STORE_INTO_CTXTEMPVAR_X = 0xD8, /* 216 ## */
HCL_CODE_TRY_ENTER2 = 0xD9, /* 217 ## */
@ -943,25 +940,27 @@ enum hcl_bcode_t
HCL_CODE_POP_INTO_BYTEARRAY = 0xEE, /* 238 ## */
HCL_CODE_POP_INTO_DIC = 0xEF, /* 239 */
HCL_CODE_SEND_MESSAGE_X = 0xF0, /* 240 ## */
HCL_CODE_MAKE_CONS = 0xF1, /* 241 */
HCL_CODE_POP_INTO_CONS = 0xF2, /* 242 */
HCL_CODE_POP_INTO_CONS_END = 0xF3, /* 243 */
HCL_CODE_SEND_X = 0xF0, /* 240 ## */
HCL_CODE_SEND_R = 0xF1, /* 241 ## ## */
HCL_CODE_SEND_MESSAGE_TO_SUPER_X = 0xF4, /* 244 ## */
HCL_CODE_POP_INTO_CONS_CDR = 0xF5, /* 245 */
HCL_CODE_MAKE_CONS = 0xF2, /* 242 */
HCL_CODE_POP_INTO_CONS = 0xF3, /* 243 */
HCL_CODE_SEND_TO_SUPER_X = 0xF4, /* 244 ## */
HCL_CODE_SEND_TO_SUPER_R = 0xF5, /* 245 ## ## */
HCL_CODE_POP_INTO_CONS_END = 0xF6, /* 246 */
HCL_CODE_POP_INTO_CONS_CDR = 0xF7, /* 247 */
/* -------------------------------------- */
/* UNUSED - 0xF6 */
HCL_CODE_DUP_STACKTOP = 0xF7, /* 247 */
HCL_CODE_POP_STACKTOP = 0xF8, /* 248 */
HCL_CODE_RETURN_STACKTOP = 0xF9, /* 249 */
HCL_CODE_RETURN_RECEIVER = 0xFA, /* 250 */
HCL_CODE_RETURN_FROM_BLOCK = 0xFB, /* 251, return the stack top from a block */
HCL_CODE_DUP_STACKTOP = 0xF8, /* 248 */
HCL_CODE_POP_STACKTOP = 0xF9, /* 249 */
HCL_CODE_RETURN_STACKTOP = 0xFA, /* 250 */
HCL_CODE_RETURN_RECEIVER = 0xFB, /* 251 */
HCL_CODE_RETURN_FROM_BLOCK = 0xFC, /* 252, return the stack top from a block */
HCL_CODE_MAKE_FUNCTION = 0xFC, /* 252 */
HCL_CODE_MAKE_BLOCK = 0xFD, /* 253 */
/* UNUSED 254 */
HCL_CODE_MAKE_FUNCTION = 0xFD, /* 253 */
HCL_CODE_MAKE_BLOCK = 0xFE, /* 254 */
HCL_CODE_NOOP = 0xFF /* 255 */
};