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

enhanced the compiler to emit the right instruction for super

Browse Source
This commit is contained in:
hyung-hwan 2022-02-19 17:26:26 +00:00
parent e482ce620f
commit f0b6ccdf42
4 changed files with 19 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
lib/comp.c
View File

@ -3521,10 +3521,9 @@ 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, car);
/* compile <receiver> */
rcv = car; /* remember the receiver node to to push it later */
SWITCH_TOP_CFRAME (hcl, COP_EMIT_SEND, rcv);
/* compile <operator> */
cdr = HCL_CNODE_CONS_CDR(obj);
@ -3606,6 +3605,7 @@ static int compile_cons_mlist_expression (hcl_t* hcl, hcl_cnode_t* obj, int nret
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_SEND);
cf->u.sendmsg.nargs = nargs;
cf->u.sendmsg.nrets = nrets;
cf->u.sendmsg.to_super = (HCL_CNODE_GET_TYPE(rcv) == HCL_CNODE_SUPER);
PUSH_CFRAME (hcl, COP_COMPILE_OBJECT, rcv);
return 0;
@ -4613,11 +4613,11 @@ static HCL_INLINE int emit_send (hcl_t* hcl)
if (cf->u.sendmsg.nrets > 0)
{
n = emit_double_param_instruction(hcl, HCL_CODE_SEND_R, cf->u.sendmsg.nargs, cf->u.sendmsg.nrets, HCL_CNODE_GET_LOC(cf->operand));
n = emit_double_param_instruction(hcl, (cf->u.sendmsg.to_super? HCL_CODE_SEND_TO_SUPER_R: 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_SEND_0, cf->u.sendmsg.nargs, HCL_CNODE_GET_LOC(cf->operand));
n = emit_single_param_instruction(hcl, (cf->u.sendmsg.to_super? HCL_CODE_SEND_TO_SUPER_0: HCL_CODE_SEND_0), cf->u.sendmsg.nargs, HCL_CNODE_GET_LOC(cf->operand));
}
POP_CFRAME (hcl);

3
lib/exec.c
View File

@ -3941,6 +3941,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
hcl_oop_t t;
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "push_cvar_m %zu", b1);
HCL_ASSERT (hcl, (hcl_oop_t)hcl->active_context->home != hcl->_nil);
t = hcl->active_context->home->owner;
if (HCL_UNLIKELY(!HCL_IS_CLASS(hcl, t)))
{
@ -3957,6 +3958,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
hcl_oop_t t;
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "store_into_cvar_m %zu", b1);
HCL_ASSERT (hcl, (hcl_oop_t)hcl->active_context->home != hcl->_nil);
t = hcl->active_context->home->owner;
if (HCL_UNLIKELY(!HCL_IS_CLASS(hcl, t)))
{
@ -3973,6 +3975,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
hcl_oop_t t;
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "pop_into_cvar_m %zu", b1);
HCL_ASSERT (hcl, (hcl_oop_t)hcl->active_context->home != hcl->_nil);
t = hcl->active_context->home->owner;
if (HCL_UNLIKELY(!HCL_IS_CLASS(hcl, t)))
{

1
lib/hcl-prv.h
View File

@ -321,6 +321,7 @@ struct hcl_cframe_t
{
hcl_ooi_t nargs;
hcl_ooi_t nrets;
int to_super;
} sendmsg;
/* COP_EMIT_SET */

11
t/ret-01.hcl Normal file
View File

@ -0,0 +1,11 @@
(defun ff() (return 999))
; test a normal block return
(set a (ff))
(if (/= a 999) (printf "ERROR: a must be 999\n"))
(printf "OK %d\n" a)
; return from top-level
(return 10)
(printf "ERROR: this line must not be printed\n")