simplified how to retrieve dbgi a bit

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
+ * a dictionary object enclosed in #{}. So putting a non-symbol
- * key is allowed like { 1 2 3 4 } where 1 and 3 are keys.
+ * 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)

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_RUNNABLE) ||
-	                 proc->state == HAK_SMOOI_TO_OOP(HAK_PROCESS_STATE_SUSPENDED));
+	                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)
+	  fun sum (x) {
-	      (if (< x 2) 1
+	    if (< x 2) 1 else { core.+ x (sum (- x 1)) }
-	       else (+ x (sum (- x 1)))))
+	  }
-	  (printf ">>>> %d\n" (sum 10))
+	  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 (get_ip_dbgi(hak, hak->active_function, ip, &dbgi) <= -1)
-		if (f->dbgi != hak->_nil && ip >= 0)
 		{
-			hak_dbgi_t* dbgi;
+			HAK_LOG1(hak, HAK_LOG_IC | HAK_LOG_WARN,
-			hak_loc_t loc;
+				"Warning - exception not handled - %O", val);
-
+			hak_seterrbfmt(hak, HAK_EEXCEPT, "exception not handled - %O", val);
-			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 */
 		}
 		else
 		{
-			HAK_LOG1(hak, HAK_LOG_IC | HAK_LOG_WARN, "Warning - exception not handled - %O", val);
+			hak_loc_t loc;
-			hak_seterrbfmt(hak, HAK_EEXCEPT, "exception not handled - %O", val);
+			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));
+		orgloc.line = dbgi.sline; /* update the line of the location at least */
-		dbgi = (hak_dbgi_t*)HAK_OBJ_GET_BYTE_SLOT(hak->active_function->dbgi);
+		hak_seterrbfmtloc(hak, orgnum, &orgloc, "%js (%js:%zu)",
-
+			orgmsg, (dbgi.fname? dbgi.fname: oocstr_dash), dbgi.sline);
-		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);
-
 		/* 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)
+		if (get_ip_dbgi(hak, hak->active_function, ip, &dbgi) <= -1)
-		{
-			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
 		{
 			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. */

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 */
 );
 
 /* ========================================================================= */

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;
 };
 

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");
 }
 
 

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 }