From d72baec0a9619084eefc2f23f3290d87803e5969 Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Tue, 25 Jan 2022 07:54:11 +0000 Subject: [PATCH] more code added for message sending implementation --- lib/dic.c | 13 +++++++- lib/exec.c | 92 ++++++++++++++++++++++++++++++++++++------------------ lib/hcl.h | 26 +++++++++------ 3 files changed, 91 insertions(+), 40 deletions(-) diff --git a/lib/dic.c b/lib/dic.c index 6b852e6..c30ccf6 100644 --- a/lib/dic.c +++ b/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) diff --git a/lib/exec.c b/lib/exec.c index 77f9a51..5506e44 100644 --- a/lib/exec.c +++ b/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 */ - hcl_pushvolat (hcl, (hcl_oop_t*)&rcv_func); + /* create a new block context to clone op_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->receiver_or_base = (hcl_oop_t)rcv_func; - functx->home = rcv_func->home; + functx->tmpr_mask = op_func->tmpr_mask; + functx->receiver_or_base = (hcl_oop_t)op_func; + 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); - HCL_ASSERT (hcl, HCL_IS_FUNCTION(hcl, rcv)); + op = (hcl_oop_function_t)HCL_STACK_GETOP(hcl, nargs); + 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 } /* -------------------------------------------------------- */ diff --git a/lib/hcl.h b/lib/hcl.h index e12b8e4..7d1cc16 100644 --- a/lib/hcl.h +++ b/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 === */ - /* [0] - instance methods, MethodDictionary - * [1] - class methods, MethodDictionary */ - hcl_oop_dic_t mthdic[2]; - /* ===================================================================== */ + hcl_oop_dic_t memdic; /* dictionary of named elements including methods and variables */ 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,