wip - fixing bootstrapping issues related to objects and classes

lib/exec.c

@@ -2272,7 +2272,7 @@ static HCL_INLINE int send_message (hcl_t* hcl, hcl_oop_t rcv, hcl_oop_t msg, in
 	}
 	else
 	{
-		HCL_ASSERT (hcl, HCL_IS_INSTANCE(hcl, rcv));
+		/*HCL_ASSERT (hcl, HCL_IS_INSTANCE(hcl, rcv));*/
 		HCL_ASSERT (hcl, HCL_IS_CLASS(hcl, rcv->_class));
 		class_ = (hcl_oop_class_t)rcv->_class;
 		mth_blk = find_imethod_noseterr(hcl, class_, msg, to_super, &ivaroff, &owner);
@@ -4127,8 +4127,9 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
 					hcl_seterrbfmt (hcl, HCL_ECALL, "unable to send %O to %O - invalid message", op, rcv); /* TODO: change to HCL_ESEND?? */
 					goto cannot_send;
 				}
-				else if (HCL_IS_CLASS(hcl, rcv) || HCL_IS_INSTANCE(hcl, rcv))
+				else if (HCL_IS_CLASS(hcl, rcv) || HCL_IS_INSTANCE(hcl, rcv) || HCL_IS_CLASS(hcl, rcv->_class)) /* TOIDO: revisit this condition */
 				{
+				send_message:
 					if (send_message(hcl, rcv, op, ((bcode >> 2) & 1) /* to_super */, b1 /* nargs */, b2 /* nrvars */) <= -1)
 					{
 						const hcl_ooch_t* msg = hcl_backuperrmsg(hcl);
@@ -4139,7 +4140,12 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
 				/* TODO: support non-symbol op? */
 				else
 				{
+				#if 0
 					hcl_seterrbfmt (hcl, HCL_ECALL, "unable to send %O to %O - invalid receiver", op, rcv); /* TODO: change to HCL_ESEND?? */
+				#else
+					goto send_message;
+				#endif
+
 				cannot_send:
 					if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) >= 0) break;
 					goto oops_with_errmsg_supplement;

lib/gc.c

@@ -1265,7 +1265,7 @@ static int ignite_2 (hcl_t* hcl)
 	}
 
 #if 0
-	/* Prevent the object instations in the permspace.
+	/* Prevent the object instantions in the permspace.
 	 *
 	 * 1. The symbol table is big and it may resize after ignition.
 	 *    the resizing operation will migrate the obejct out of the
@@ -1399,7 +1399,7 @@ static int ignite_3 (hcl_t* hcl)
 
 	for (i = 0; i < HCL_COUNTOF(kernel_classes); i++)
 	{
-		sym = hcl_makesymbol(hcl, kernel_classes[i].name, hcl_count_oocstr(kernel_classes[i].name));
+		sym = hcl_makesymbolwithbcstr(hcl, kernel_classes[i].name);
 		if (HCL_UNLIKELY(!sym)) return -1;
 
 		cls = *(hcl_oop_class_t*)((hcl_uint8_t*)hcl + kernel_classes[i].offset);
@@ -1462,13 +1462,13 @@ static int make_kernel_objs (hcl_t* hcl)
 #endif
 	if (HCL_LIKELY(!hcl->_undef))
 	{ /* TODO: create it as nogc */
-		hcl->_undef = hcl_makeundef(hcl);
+		hcl->_undef = hcl_hatchundef(hcl);
 		if (HCL_UNLIKELY(!hcl->_undef)) goto oops;
 	}
 
 	if (HCL_LIKELY(!hcl->_nil))
 	{ /* TODO: create it as nogc? */
-		hcl->_nil = hcl_makenil(hcl);
+		hcl->_nil = hcl_hatchnil(hcl);
 		if (HCL_UNLIKELY(!hcl->_nil)) goto oops;
 	}
 
@@ -1482,6 +1482,8 @@ static int make_kernel_objs (hcl_t* hcl)
 
 	if (ignite_3(hcl) <= -1) goto oops;
 
+/* TODO: scan the heap. and fix the class of objects using brand if the class is NULL */
+
 #if 0
 	hcl->igniting = 0;
 #endif
@@ -1506,16 +1508,8 @@ int hcl_ignite (hcl_t* hcl, hcl_oow_t heapsize)
 
 	if (make_kernel_objs(hcl) <= -1) return -1;
 
-	if (!hcl->_true)
-	{
-		hcl->_true = hcl_maketrue(hcl);
-		if (HCL_UNLIKELY(!hcl->_true)) goto oops;
-	}
-	if (!hcl->_false)
-	{
-		hcl->_false = hcl_makefalse(hcl);
-		if (HCL_UNLIKELY(!hcl->_false)) goto oops;
-	}
+	HCL_ASSERT (hcl, hcl->_true != HCL_NULL);
+	HCL_ASSERT (hcl, hcl->_false != HCL_NULL);
 
 	if (!hcl->symtab)
 	{

lib/hcl.h

@@ -2772,23 +2772,14 @@ HCL_EXPORT hcl_oow_t hcl_fmttobcstr (
 /* =========================================================================
  * OBJECT MANAGEMENT
  * ========================================================================= */
-HCL_EXPORT hcl_oop_t hcl_makeundef (
+HCL_EXPORT hcl_oop_t hcl_hatchundef (
 	hcl_t*     hcl
 );
 
-HCL_EXPORT hcl_oop_t hcl_makenil (
+HCL_EXPORT hcl_oop_t hcl_hatchnil (
 	hcl_t*     hcl
 );
 
-HCL_EXPORT hcl_oop_t hcl_maketrue (
-	hcl_t*     hcl
-);
-
-HCL_EXPORT hcl_oop_t hcl_makefalse (
-	hcl_t*     hcl
-);
-
-
 HCL_EXPORT hcl_oop_t hcl_makecons (
 	hcl_t*     hcl,
 	hcl_oop_t  car,

lib/obj.c

@@ -254,8 +254,11 @@ hcl_oop_t hcl_allocwordobj (hcl_t* hcl, int brand, const hcl_oow_t* ptr, hcl_oow
  * COMMON OBJECTS
  * ------------------------------------------------------------------------ */
 
-hcl_oop_t hcl_makeundef (hcl_t* hcl)
+hcl_oop_t hcl_hatchundef (hcl_t* hcl)
 {
+	/* create the undef object for bootstrapping.
+	 * this function doesn't set the class field */
+
 	hcl_oop_t o;
 	o = hcl_allocoopobj(hcl, HCL_BRAND_UNDEF, 0);
 	if (HCL_LIKELY(o))
@@ -270,8 +273,11 @@ hcl_oop_t hcl_makeundef (hcl_t* hcl)
 	return o;
 }
 
-hcl_oop_t hcl_makenil (hcl_t* hcl)
+hcl_oop_t hcl_hatchnil (hcl_t* hcl)
 {
+	/* create the nil object for bootstrapping.
+	 * this function doesn't set the class field */
+
 	hcl_oop_t o;
 	o = hcl_allocoopobj(hcl, HCL_BRAND_NIL, 0);
 	if (HCL_LIKELY(o))
@@ -286,16 +292,6 @@ hcl_oop_t hcl_makenil (hcl_t* hcl)
 	return o;
 }
 
-hcl_oop_t hcl_maketrue (hcl_t* hcl)
-{
-	return hcl_allocoopobj(hcl, HCL_BRAND_TRUE, 0);
-}
-
-hcl_oop_t hcl_makefalse (hcl_t* hcl)
-{
-	return hcl_allocoopobj(hcl, HCL_BRAND_FALSE, 0);
-}
-
 hcl_oop_t hcl_makebigint (hcl_t* hcl, int brand, const hcl_liw_t* ptr, hcl_oow_t len)
 {
 	hcl_oop_t oop;
@@ -327,6 +323,7 @@ hcl_oop_t hcl_makecons (hcl_t* hcl, hcl_oop_t car, hcl_oop_t cdr)
 	{
 		cons->car = car;
 		cons->cdr = cdr;
+		HCL_OBJ_SET_CLASS (cons, (hcl_oop_t)hcl->c_cons);
 	}
 
 	hcl_popvolats (hcl, 2);
@@ -336,12 +333,18 @@ hcl_oop_t hcl_makecons (hcl_t* hcl, hcl_oop_t car, hcl_oop_t cdr)
 
 hcl_oop_t hcl_makearray (hcl_t* hcl, hcl_oow_t size, int ngc)
 {
-	return hcl_allocoopobj(hcl, HCL_BRAND_ARRAY, size);
+	hcl_oop_t v;
+	v = hcl_allocoopobj(hcl, HCL_BRAND_ARRAY, size);
+	if (HCL_LIKELY(v)) HCL_OBJ_SET_CLASS (v, (hcl_oop_t)hcl->c_array);
+	return v;
 }
 
 hcl_oop_t hcl_makebytearray (hcl_t* hcl, const hcl_oob_t* ptr, hcl_oow_t size)
 {
-	return hcl_allocbyteobj(hcl, HCL_BRAND_BYTE_ARRAY, ptr, size);
+	hcl_oop_t v;
+	v = hcl_allocbyteobj(hcl, HCL_BRAND_BYTE_ARRAY, ptr, size);
+	if (HCL_LIKELY(v)) HCL_OBJ_SET_CLASS (v, (hcl_oop_t)hcl->c_byte_array);
+	return v;
 }
 
 hcl_oop_t hcl_makebytestringwithbytes (hcl_t* hcl, const hcl_oob_t* ptr, hcl_oow_t len, int ngc)
@@ -373,6 +376,8 @@ hcl_oop_t hcl_makebytestring (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len,
 			v = ptr[i] & 0xFF;
 			HCL_OBJ_SET_BYTE_VAL(b, i, v);
 		}
+
+		HCL_OBJ_SET_CLASS (b, (hcl_oop_t)hcl->c_byte_array);
 	}
 
 	return (hcl_oop_t)b;
@@ -388,6 +393,10 @@ hcl_oop_t hcl_makestring (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len, int
 		const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
 		hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make string - %js", orgmsg);
 	}
+	else
+	{
+		HCL_OBJ_SET_CLASS (c, (hcl_oop_t)hcl->c_string);
+	}
 	return (hcl_oop_t)c;
 }
 
@@ -413,11 +422,13 @@ hcl_oop_t hcl_makefpdec (hcl_t* hcl, hcl_oop_t value, hcl_ooi_t scale)
 	{
 		const hcl_ooch_t* orgmsg = hcl_backuperrmsg(hcl);
 		hcl_seterrbfmt (hcl, HCL_ERRNUM(hcl), "unable to make fpdec - %js", orgmsg);
-		return HCL_NULL;
 	}
-
+	else
+	{
 		f->value = value;
 		f->scale = HCL_SMOOI_TO_OOP(scale);
+		HCL_OBJ_SET_CLASS (f, (hcl_oop_t)hcl->c_fixed_point_decimal);
+	}
 
 	return (hcl_oop_t)f;
 }

lib/sym.c

@@ -183,3 +183,20 @@ hcl_oop_t hcl_findsymbol (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len)
 {
 	return find_or_make_symbol(hcl, ptr, len, 0);
 }
+
+hcl_oop_t hcl_makesymbolwithbcstr (hcl_t* hcl, const hcl_ooch_t* ptr)
+{
+#if defined(HCL_OOCH_IS_UCH)
+	hcl_uch_t* ucsptr;
+	hcl_oow_t ucslen;
+	hcl_oop_t v;
+/* TODO: no duplication? */
+	ucsptr = hcl_dupbtoucstr(hcl, ptr, &ucslen);
+	if (HCL_UNLIKELY(!ucsptr)) return HCL_NULL;
+	v = hcl_makesymbol(hcl, ucsptr, ucslen);
+	hcl_freemem (hcl, ucsptr);
+	return v;
+#else
+	return hcl_makesymbol(hcl, ptr, hcl_count_bcstr(ptr));
+#endif
+}