diff --git a/lib/comp.c b/lib/comp.c index 23150ba..7e3b213 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -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 */ - PUSH_CFRAME (hcl, COP_COMPILE_OBJECT, car); + rcv = car; /* remember the receiver node to to push it later */ /* compile */ 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 ... 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: diff --git a/lib/decode.c b/lib/decode.c index 7c5641a..76f650d 100644 --- a/lib/decode.c +++ b/lib/decode.c @@ -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; /* -------------------------------------------------------- */ diff --git a/lib/exec.c b/lib/exec.c index 78d5030..b3909a7 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -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: { diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index dc5d390..15aa7e1 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -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 */ };