diff --git a/lib/dic.c b/lib/dic.c index e50216b..6ff2709 100644 --- a/lib/dic.c +++ b/lib/dic.c @@ -25,8 +25,8 @@ #include "hak-prv.h" /* The dictionary functions in this file are used for storing - * a dictionary object enclosed in {}. So putting a non-symbol - * key is allowed like { 1 2 3 4 } where 1 and 3 are keys. + * a dictionary object enclosed in #{}. So putting a non-symbol + * key is allowed like #{ 1 2 3 4 } where 1 and 3 are keys. * so SYMBOL_ONLY_KEY must not be defined */ /*#define SYMBOL_ONLY_KEY*/ @@ -95,7 +95,7 @@ static hak_oop_oop_t expand_bucket (hak_t* hak, hak_oop_oop_t oldbuc) return newbuc; } -static hak_oop_cons_t find_or_upsert (hak_t* hak, hak_oop_dic_t dic, hak_oop_t key, hak_oop_t value, int is_method) +static hak_oop_cons_t find_or_upsert (hak_t* hak, hak_oop_dic_t dic, hak_oop_t key, hak_oop_t value, int* method_types) { hak_ooi_t tally; hak_oow_t index; @@ -125,7 +125,6 @@ static hak_oop_cons_t find_or_upsert (hak_t* hak, hak_oop_dic_t dic, hak_oop_t k #else int n; #endif - ass = (hak_oop_cons_t)dic->bucket->slot[index]; HAK_ASSERT(hak, HAK_IS_CONS(hak,ass)); @@ -142,14 +141,30 @@ static hak_oop_cons_t find_or_upsert (hak_t* hak, hak_oop_dic_t dic, hak_oop_t k /* the value of HAK_NULL indicates no insertion or update. */ if (value) { - if (is_method) + if (method_types) { hak_oop_cons_t pair; + int mtype; + int mtype_redef; + pair = (hak_oop_cons_t)ass->cdr; /* once found, this must be a pair of method pointers */ HAK_ASSERT(hak, HAK_IS_CONS(hak, pair)); HAK_ASSERT(hak, HAK_IS_COMPILED_BLOCK(hak, value)); - if (is_method & 1) pair->car = value; /* class method */ - if (is_method & 2) pair->cdr = value; /* instance method */ + + mtype = *method_types; + mtype_redef = 0; + if (mtype & 1) + { + if (pair->car != hak->_nil) mtype_redef |= 1; + pair->car = value; /* class method */ + } + if (mtype & 2) + { + if (pair->cdr != hak->_nil) mtype_redef |= 2; + pair->cdr = value; /* instance method */ + } + + *method_types = mtype_redef; /* the class instantiation method goes to both cells. * you can't define a class method or an instance method with the name of * a class instantiation method */ @@ -217,13 +232,19 @@ static hak_oop_cons_t find_or_upsert (hak_t* hak, hak_oop_dic_t dic, hak_oop_t k index = (index + 1) % HAK_OBJ_GET_SIZE(dic->bucket); } - if (is_method) + if (method_types) { /* create a new pair that holds a class method at the first cell and an instance method at the second cell */ hak_oop_t pair; + int mtype; + HAK_ASSERT(hak, HAK_IS_COMPILED_BLOCK(hak, value)); + + mtype = *method_types; + *method_types = 0; /* nothing is redefined*/ + hak_pushvolat(hak, &key); - pair = hak_makecons(hak, (is_method & 1? value: hak->_nil), (is_method & 2? value: hak->_nil)); + pair = hak_makecons(hak, ((mtype & 1)? value: hak->_nil), ((mtype & 2)? value: hak->_nil)); hak_popvolat(hak); if (HAK_UNLIKELY(!pair)) goto oops; value = pair; @@ -310,7 +331,7 @@ hak_oop_cons_t hak_putatsysdic (hak_t* hak, hak_oop_t key, hak_oop_t value) #if defined(SYMBOL_ONLY_KEY) HAK_ASSERT(hak, HAK_IS_SYMBOL(hak,key)); #endif - return find_or_upsert(hak, hak->sysdic, key, value, 0); + return find_or_upsert(hak, hak->sysdic, key, value, HAK_NULL); } hak_oop_cons_t hak_getatsysdic (hak_t* hak, hak_oop_t key) @@ -318,7 +339,7 @@ hak_oop_cons_t hak_getatsysdic (hak_t* hak, hak_oop_t key) #if defined(SYMBOL_ONLY_KEY) HAK_ASSERT(hak, HAK_IS_SYMBOL(hak,key)); #endif - return find_or_upsert(hak, hak->sysdic, key, HAK_NULL, 0); + return find_or_upsert(hak, hak->sysdic, key, HAK_NULL, HAK_NULL); } hak_oop_cons_t hak_lookupsysdicforsymbol_noseterr (hak_t* hak, const hak_oocs_t* name) @@ -344,15 +365,15 @@ hak_oop_cons_t hak_putatdic (hak_t* hak, hak_oop_dic_t dic, hak_oop_t key, hak_o #if defined(SYMBOL_ONLY_KEY) HAK_ASSERT(hak, HAK_IS_SYMBOL(hak,key)); #endif - return find_or_upsert(hak, dic, key, value, 0); + return find_or_upsert(hak, dic, key, value, HAK_NULL); } -hak_oop_cons_t hak_putatdic_method (hak_t* hak, hak_oop_dic_t dic, hak_oop_t key, hak_oop_t value, int mtype) +hak_oop_cons_t hak_putatdic_method (hak_t* hak, hak_oop_dic_t dic, hak_oop_t key, hak_oop_t value, int* mtype_bits) { #if defined(SYMBOL_ONLY_KEY) HAK_ASSERT(hak, HAK_IS_SYMBOL(hak,key)); #endif - return find_or_upsert(hak, dic, key, value, mtype); + return find_or_upsert(hak, dic, key, value, mtype_bits); } hak_oop_cons_t hak_getatdic (hak_t* hak, hak_oop_dic_t dic, hak_oop_t key) diff --git a/lib/exec.c b/lib/exec.c index f94fd31..95db03d 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -22,7 +22,6 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ - #include "hak-prv.h" #define ENABLE_SYSCMD @@ -744,8 +743,8 @@ static HAK_INLINE void unchain_from_processor (hak_t* hak, hak_oop_process_t pro hak_ooi_t total_count; HAK_ASSERT(hak, proc->state == HAK_SMOOI_TO_OOP(HAK_PROCESS_STATE_RUNNING) || - proc->state == HAK_SMOOI_TO_OOP(HAK_PROCESS_STATE_RUNNABLE) || - proc->state == HAK_SMOOI_TO_OOP(HAK_PROCESS_STATE_SUSPENDED)); + proc->state == HAK_SMOOI_TO_OOP(HAK_PROCESS_STATE_RUNNABLE) || + proc->state == HAK_SMOOI_TO_OOP(HAK_PROCESS_STATE_SUSPENDED)); HAK_ASSERT(hak, proc->state != HAK_SMOOI_TO_OOP(new_state)); @@ -2071,10 +2070,10 @@ static int __activate_function (hak_t* hak, hak_oop_function_t op_func, hak_ooi_ hak_ooi_t nargs_offset = 0; /* - (defun sum (x) - (if (< x 2) 1 - else (+ x (sum (- x 1))))) - (printf ">>>> %d\n" (sum 10)) + fun sum (x) { + if (< x 2) 1 else { core.+ x (sum (- x 1)) } + } + printf ">>>> %d\n" (sum 10) */ HAK_ASSERT(hak, HAK_IS_FUNCTION(hak, op_func)); @@ -2338,10 +2337,9 @@ static HAK_INLINE int send_message (hak_t* hak, hak_oop_t rcv, hak_oop_t msg, in { _class = (hak_oop_class_t)rcv; mth_blk = find_cmethod_noseterr(hak, _class, msg, to_super, &ivaroff, &owner); - if (!mth_blk) goto msg_not_found; - if (GET_BLK_MASK_INSTA(HAK_OOP_TO_SMOOI(mth_blk->attr_mask))) + if (GET_BLK_MASK_INSTA(HAK_OOP_TO_SMOOI(mth_blk->attr_mask))) /* #ci method */ { hak_oop_t newrcv; @@ -2382,6 +2380,26 @@ static HAK_INLINE int send_message (hak_t* hak, hak_oop_t rcv, hak_oop_t msg, in /* ------------------------------------------------------------------------- */ +static int get_ip_dbgi (hak_t* hak, hak_oop_function_t f, hak_ooi_t ip, hak_dbgi_t* dbgi) +{ + HAK_ASSERT(hak, f != HAK_NULL); + HAK_MEMSET(dbgi, 0, HAK_SIZEOF(*dbgi)); + + if (f->dbgi != hak->_nil && ip >= 0 && ip < HAK_OBJ_GET_SIZE(f->dbgi) / HAK_SIZEOF(*dbgi)) + { + hak_dbgi_t* f_dbgi; + f_dbgi = (hak_dbgi_t*)HAK_OBJ_GET_BYTE_SLOT(f->dbgi); + + *dbgi = f_dbgi[ip]; + if (!dbgi->fname && hak->c) dbgi->fname = hak->c->cci_arg.name; + return 0; /* found */ + } + + return -1; /* not found */ +} + +/* ------------------------------------------------------------------------- */ + static HAK_INLINE int do_throw (hak_t* hak, hak_oop_t val, hak_ooi_t ip) { hak_oop_context_t catch_ctx; @@ -2390,30 +2408,29 @@ static HAK_INLINE int do_throw (hak_t* hak, hak_oop_t val, hak_ooi_t ip) if (HAK_EXSTACK_IS_EMPTY(hak)) { - hak_oop_function_t f; + hak_dbgi_t dbgi; /* the exception stack is empty. * clear the class stack if it is not empty */ while (!HAK_CLSTACK_IS_EMPTY(hak)) HAK_CLSTACK_POP(hak); - f = hak->active_function; - if (f->dbgi != hak->_nil && ip >= 0) + if (get_ip_dbgi(hak, hak->active_function, ip, &dbgi) <= -1) { - hak_dbgi_t* dbgi; - hak_loc_t loc; - - dbgi = (hak_dbgi_t*)HAK_OBJ_GET_BYTE_SLOT(f->dbgi); - HAK_LOG3(hak, HAK_LOG_IC | HAK_LOG_WARN, "Warning - exception not handled %js:%zu - %O\n", (dbgi[ip].fname? dbgi[ip].fname: oocstr_dash), dbgi[ip].sline, val); - HAK_MEMSET(&loc, 0, HAK_SIZEOF(loc)); - loc.file = dbgi[ip].fname; - loc.line = dbgi[ip].sline; - hak_seterrbfmtloc(hak, HAK_EEXCEPT, &loc, "exception not handled - %O", val); - /* column number is not available */ + HAK_LOG1(hak, HAK_LOG_IC | HAK_LOG_WARN, + "Warning - exception not handled - %O", val); + hak_seterrbfmt(hak, HAK_EEXCEPT, "exception not handled - %O", val); } else { - HAK_LOG1(hak, HAK_LOG_IC | HAK_LOG_WARN, "Warning - exception not handled - %O", val); - hak_seterrbfmt(hak, HAK_EEXCEPT, "exception not handled - %O", val); + hak_loc_t loc; + HAK_LOG3(hak, HAK_LOG_IC | HAK_LOG_WARN, + "Warning - exception not handled %js:%zu - %O\n", + (dbgi.fname? dbgi.fname: oocstr_dash), dbgi.sline, val); + HAK_MEMSET(&loc, 0, HAK_SIZEOF(loc)); + loc.file = dbgi.fname; + loc.line = dbgi.sline; + hak_seterrbfmtloc(hak, HAK_EEXCEPT, &loc, "exception not handled - %O", val); + /* column number is not available */ } /* output backtrace */ @@ -2421,22 +2438,15 @@ static HAK_INLINE int do_throw (hak_t* hak, hak_oop_t val, hak_ooi_t ip) c = hak->active_context; if ((hak_oop_t)c != hak->_nil && ip >= 0) { + hak_oop_function_t f; hak_ooi_t cip; cip = ip; /* use the given ip for the active context instead of the value from the ip field */ do { f = c->base; - if (f->dbgi != hak->_nil) + if (get_ip_dbgi(hak, f, cip, &dbgi) >= 0) { - hak_dbgi_t* dbgi; - const hak_ooch_t* fname; - - dbgi = (hak_dbgi_t*)HAK_OBJ_GET_BYTE_SLOT(f->dbgi); - - fname = dbgi[cip].fname; - if (!fname && hak->c) fname = hak->c->cci_arg.name; - /* TODO: include arguments? */ HAK_LOG7(hak, HAK_LOG_IC | HAK_LOG_INFO, " %.*js%js%.*js(%js:%zu)\n", (c->owner == hak->_nil? 0: HAK_OBJ_GET_SIZE(((hak_oop_class_t)c->owner)->name)), @@ -2444,8 +2454,9 @@ static HAK_INLINE int do_throw (hak_t* hak, hak_oop_t val, hak_ooi_t ip) (c->owner == hak->_nil? oocstr_none: oocstr_colon), (c->name == hak->_nil? 0: HAK_OBJ_GET_SIZE(((hak_oop_char_t)c->name))), (c->name == hak->_nil? oocstr_none: ((hak_oop_char_t)c->name)->slot), - (fname? fname: oocstr_dash), dbgi[cip].sline); + (dbgi.fname? dbgi.fname: oocstr_dash), dbgi.sline); } + c = c->sender; if ((hak_oop_t)c == hak->_nil) break; cip = HAK_OOP_TO_SMOOI(c->ip); @@ -2488,20 +2499,17 @@ static HAK_INLINE int do_throw (hak_t* hak, hak_oop_t val, hak_ooi_t ip) static void supplement_errmsg (hak_t* hak, hak_ooi_t ip) { - if (hak->active_function->dbgi != hak->_nil) + hak_dbgi_t dbgi; + + if (get_ip_dbgi(hak, hak->active_function, ip, &dbgi) >= 0) { - hak_dbgi_t* dbgi; hak_loc_t orgloc = hak->errloc; const hak_ooch_t* orgmsg = hak_backuperrmsg(hak); hak_errnum_t orgnum = HAK_ERRNUM(hak); - HAK_ASSERT(hak, HAK_IS_BYTEARRAY(hak, hak->active_function->dbgi)); - dbgi = (hak_dbgi_t*)HAK_OBJ_GET_BYTE_SLOT(hak->active_function->dbgi); - - orgloc.line = dbgi[ip].sline; /* update the line of the location at least */ - hak_seterrbfmtloc(hak, orgnum, &orgloc, "%js (%js:%zu)", orgmsg, - (dbgi[ip].fname? dbgi[ip].fname: oocstr_dash), dbgi[ip].sline); - + orgloc.line = dbgi.sline; /* update the line of the location at least */ + hak_seterrbfmtloc(hak, orgnum, &orgloc, "%js (%js:%zu)", + orgmsg, (dbgi.fname? dbgi.fname: oocstr_dash), dbgi.sline); /* no column info available */ } } @@ -3280,6 +3288,7 @@ static HAK_INLINE int do_return_from_home (hak_t* hak, hak_oop_t return_value, h else { hak_oop_context_t sender, home, ctx; + hak_dbgi_t dbgi; home = hak->active_context->home; sender = hak->active_context->home->sender; @@ -3292,15 +3301,15 @@ static HAK_INLINE int do_return_from_home (hak_t* hak, hak_oop_t return_value, h if (ctx == home) goto do_return; } - if (hak->active_function->dbgi != hak->_nil) - { - hak_dbgi_t* dbgi = (hak_dbgi_t*)HAK_OBJ_GET_BYTE_SLOT(hak->active_function->dbgi); - HAK_LOG2(hak, HAK_LOG_IC | HAK_LOG_ERROR, "Error - cannot return from dead context - throwing an exception (%js:%zu)\n", (dbgi[ip].fname? dbgi[ip].fname: oocstr_dash), dbgi[ip].sline); - } - else + if (get_ip_dbgi(hak, hak->active_function, ip, &dbgi) <= -1) { HAK_LOG0 (hak, HAK_LOG_IC | HAK_LOG_ERROR, "Error - cannot return from dead context - throwing an exception\n"); } + else + { + HAK_LOG2(hak, HAK_LOG_IC | HAK_LOG_ERROR, "Error - cannot return from dead context - throwing an exception (%js:%zu)\n", (dbgi.fname? dbgi.fname: oocstr_dash), dbgi.sline); + } + hak_seterrbfmt(hak, HAK_EINTERN, "unable to return from dead context"); /* TODO: can i make this error catchable at the hak level? */ return do_throw_with_internal_errmsg(hak, ip); @@ -4270,6 +4279,7 @@ hak_logbfmt(hak, HAK_LOG_STDERR, ">>>%O c->sc=%O sc=%O b2=%d b3=%d nivars=%d ncv int mtype; static const hak_bch_t* pfx[] = { "c", "i", "ci" }; + /* mtype => c: 1, i: 2, ci: (1 | 2) */ mtype = (bcode - HAK_CODE_CLASS_CMSTORE) + 1; HAK_ASSERT(hak, mtype >= 1 && mtype <= 3); FETCH_PARAM_CODE_TO(hak, b1); @@ -4297,7 +4307,38 @@ hak_logbfmt(hak, HAK_LOG_STDERR, ">>>%O c->sc=%O sc=%O b2=%d b3=%d nivars=%d ncv name = hak->active_function->literal_frame[b1]; /* method name */ /* put the code at method dictionary pass 1 for class method, 2 for instance method, 3 for class instantiation method */ - if (!hak_putatdic_method(hak, (hak_oop_dic_t)mdic, name, blk, mtype)) goto oops_with_errmsg_supplement; + if (!hak_putatdic_method(hak, (hak_oop_dic_t)mdic, name, blk, &mtype)) goto oops_with_errmsg_supplement; + if (mtype && HAK_LOG_ENABLED(hak, HAK_LOG_IC | HAK_LOG_WARN)) + { + hak_oop_t class_name; + hak_dbgi_t dbgi; + + class_name = ((hak_oop_class_t)_class)->name; + HAK_ASSERT(hak, HAK_OBJ_IS_CHAR_POINTER(class_name)); + + get_ip_dbgi(hak, hak->active_function, fetched_instruction_pointer, &dbgi); + + if (class_name != hak->_nil) + { + hak_logbfmt(hak, HAK_LOG_IC | HAK_LOG_WARN, "Warning - redefined method %.*js:%.*js at %js:%zu\n", + HAK_OBJ_GET_SIZE(class_name), + HAK_OBJ_GET_CHAR_SLOT(class_name), + HAK_OBJ_GET_SIZE(name), + HAK_OBJ_GET_CHAR_SLOT(name), + (dbgi.fname? dbgi.fname: oocstr_dash), + dbgi.sline + ); + } + else + { + hak_logbfmt(hak, HAK_LOG_IC | HAK_LOG_WARN, "Warning - redefined method %.*js for anonymous class at %js:%zu\n", + HAK_OBJ_GET_SIZE(name), + HAK_OBJ_GET_CHAR_SLOT(name), + (dbgi.fname? dbgi.fname: oocstr_dash), + dbgi.sline + ); + } + } break; } /* -------------------------------------------------------- */ @@ -5136,7 +5177,7 @@ hak_oop_t hak_execute (hak_t* hak) } /* create a virtual function object that holds the byte code generated plus the literal frame. - * when hcl_execute() is called repeatedly, especially in the interactive mode, functions and + * when hak_execute() is called repeatedly, especially in the interactive mode, functions and * methods defined in the previous call refers to data in the previous virtual function. the * instruction pointers and literal frame indicies, if such functions are called, don't reference * data in this new function. */ diff --git a/lib/hak-prv.h b/lib/hak-prv.h index 32a5e28..0752e59 100644 --- a/lib/hak-prv.h +++ b/lib/hak-prv.h @@ -1619,7 +1619,8 @@ hak_oop_cons_t hak_putatdic_method ( hak_oop_dic_t dic, hak_oop_t key, hak_oop_t value, - int mtype /* 1 for class method, 2 for instance method */ + int* mtype_flags /* [IN] 1 for class method, 2 for instance method, + [OUT] bit 0(1) or bit 1(2) set for each method type redefined */ ); /* ========================================================================= */ diff --git a/lib/hak.h b/lib/hak.h index f58613d..446df87 100644 --- a/lib/hak.h +++ b/lib/hak.h @@ -1560,11 +1560,11 @@ typedef struct hak_synerr_t hak_synerr_t; struct hak_synerr_t { hak_synerrnum_t num; - hak_loc_t loc; + hak_loc_t loc; struct { hak_ooch_t val[256]; - hak_oow_t len; + hak_oow_t len; } tgt; }; diff --git a/lib/print.c b/lib/print.c index 822fa13..d3e6fc2 100644 --- a/lib/print.c +++ b/lib/print.c @@ -1004,7 +1004,7 @@ void hak_dumpcnode (hak_t* hak, hak_cnode_t* cnode, int newline) } } - if (newline) hak_logbfmt(hak, HAK_LOG_FATAL, "\n"); + if (newline) hak_logbfmt(hak, HAK_LOG_FATAL, "\n"); } diff --git a/t/fun-01.hak b/t/fun-01.hak index 73004ff..374ec1b 100644 --- a/t/fun-01.hak +++ b/t/fun-01.hak @@ -145,3 +145,11 @@ fun dummy(q) { plus 10 20 ## minus is now available after plus is executed v := (minus 10 1) if (== v 9) { printf "OK - %d\n" v } else { printf "ERROR - %d, not 9\n" v } + + +## ---------------------------------------- +fun sum (x) { + if (< x 2) 1 else { core.+ x (sum (- x 1)) } +} +v := (sum 10) +if (== v 55) { printf "OK - %d\n" v } else { printf "ERROR - %d, not 55\n" v }