some implementation updates to the CLASS_LOAD instruction

lib/comp.c

@@ -2314,7 +2314,7 @@ static HCL_INLINE int compile_else (hcl_t* hcl)
 /*
 	(defclass A
 		| x y | ; instance variables
-		::: | x y z | ; class variables <--- how to initialize the class variables???
+		:: | x y z | ; class variables <--- how to initialize the class variables???
 
 		; everything inside defclass after the variable declarations are normal expressions.
 		; however, the resolution of some variables will fall under the enclosing class.
@@ -2331,7 +2331,7 @@ static HCL_INLINE int compile_else (hcl_t* hcl)
 		)
 	)
 
-	(defclass B ::: A ; A is a parent class
+	(defclass B :: A ; A is a parent class
 		| p q |
 		....
 	)
@@ -2661,7 +2661,7 @@ static HCL_INLINE int compile_class_p2 (hcl_t* hcl)
 	pop_cblk (hcl);
 	pop_clsblk (hcl);  /* end of the class block */
 
-	if (emit_byte_instruction(hcl, HCL_CODE_CLASS_PEXIT, &class_loc) <= -1) return -1;
+	if (emit_byte_instruction(hcl, HCL_CODE_CLASS_PEXIT, &class_loc) <= -1) return -1; /* pop + exit */
 
 	if (class_name) /* defclass requires a name. but class doesn't */
 	{
@@ -4498,8 +4498,8 @@ redo:
 
 		case HCL_CNODE_SELF:
 		case HCL_CNODE_SUPER:
-			/* if super is not sent a message, super represents the receiver
+			/* if super is not sent a message, super represents the receiver just like self does */
-			 * just like self does */
+/* TODO: SELF and SUPER must be limited to methods or is it ok if it just pushes the fake receiver in a normal function call?? */
 			if (emit_byte_instruction(hcl, HCL_CODE_PUSH_RECEIVER, HCL_CNODE_GET_LOC(oprnd)) <= -1) return -1;
 			goto done;
 
@@ -5645,12 +5645,34 @@ static HCL_INLINE int post_lambda (hcl_t* hcl)
 
 			#else
 				hcl_oow_t index;
-				hcl_oop_t lit;
+				hcl_oop_t lit, cons;
 
 /* TODO: CLASS_LOAD_X must be emited before the defun method code instruction is  emitted ? */
+				/* treat this like a global variable for now */
 				lit = hcl_makesymbol(hcl, HCL_CNODE_GET_TOKPTR(class_name), HCL_CNODE_GET_TOKLEN(class_name));
 				if (HCL_UNLIKELY(!lit)) return -1;
-				if (add_literal(hcl, lit, &index) <= -1) return -1;
+				cons = (hcl_oop_t)hcl_getatsysdic(hcl, lit);
+				if (!cons)
+				{
+					cons = (hcl_oop_t)hcl_putatsysdic(hcl, lit, hcl->_undef);
+					if (HCL_UNLIKELY(!cons)) return -1;
+				}
+/*
+2024-04-01 23:39:21 +0900 0000000041 make_lambda 0 0 0 0 0
+2024-04-01 23:39:21 +0900 0000000046 jump_forward 6
+2024-04-01 23:39:21 +0900 0000000055 store_into_object @4
+2024-04-01 23:39:21 +0900 0000000058 return_from_block
+
+
+2024-04-01 23:40:11 +0900 0000000041 make_lambda 0 0 0 0 0
+2024-04-01 23:40:11 +0900 0000000046 jump_forward 6
+2024-04-01 23:40:11 +0900 0000000055 class_load @2
+2024-04-01 23:40:11 +0900 0000000058 class_imstore 4
+2024-04-01 23:40:11 +0900 0000000061 class_exit
+2024-04-01 23:40:11 +0900 0000000062 return_from_block
+*/
+
+				if (add_literal(hcl, cons, &index) <= -1) return -1;
 				if (emit_single_param_instruction(hcl, HCL_CODE_CLASS_LOAD_X, index, HCL_CNODE_GET_LOC(class_name)) <= -1) return -1;
 
 				lit = hcl_makesymbol(hcl, HCL_CNODE_GET_TOKPTR(defun_name), HCL_CNODE_GET_TOKLEN(defun_name));

lib/decode.c

@@ -407,17 +407,17 @@ int hcl_decode (hcl_t* hcl, const hcl_code_t* code, hcl_oow_t start, hcl_oow_t e
 
 			case HCL_CODE_CLASS_CMSTORE:
 				FETCH_PARAM_CODE_TO (hcl, b1);
-				LOG_INST_1 (hcl, "class_cmstore %zu", b1);
+				LOG_INST_1 (hcl, "class_cmstore @%zu", b1);
 				break;
 
 			case HCL_CODE_CLASS_CIMSTORE:
 				FETCH_PARAM_CODE_TO (hcl, b1);
-				LOG_INST_1 (hcl, "class_cimstore %zu", b1);
+				LOG_INST_1 (hcl, "class_cimstore @%zu", b1);
 				break;
 
 			case HCL_CODE_CLASS_IMSTORE:
 				FETCH_PARAM_CODE_TO (hcl, b1);
-				LOG_INST_1 (hcl, "class_imstore %zu", b1);
+				LOG_INST_1 (hcl, "class_imstore @%zu", b1);
 				break;
 			/* -------------------------------------------------------- */
 

lib/exec.c

@@ -3811,12 +3811,18 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
 				/* push the class indiciated by the literal at the given literal frame index
 				 * to the class stack */
 				LOG_INST_1 (hcl, "class_load @%zu", b1);
-				/* this literal must be a symbol. find a class with the symbol and push it */
+
 				t = (hcl_oop_cons_t)hcl->active_function->literal_frame[b1];
-				HCL_ASSERT (hcl, HCL_IS_CONS(hcl, t));
+				if (!HCL_IS_CONS(hcl,t))
+				{
+					/* this is an uncatchable internal error that must not happen - is the bytecode compromised?  */
+					hcl_seterrbfmt(hcl, HCL_EINTERN, "internal error - invalid operand to CLASS_LOAD");
+					goto oops_with_errmsg_supplement;
+				}
+
 				if (!HCL_IS_CLASS(hcl, t->cdr))
 				{
-					hcl_seterrbfmt(hcl, HCL_EUNDEFVAR, "%.js is not class", HCL_OBJ_GET_SIZE(t->car), HCL_OBJ_GET_CHAR_SLOT(t->car));
+					hcl_seterrbfmt(hcl, HCL_EUNDEFVAR, "%.*js is not class", HCL_OBJ_GET_SIZE(t->car), HCL_OBJ_GET_CHAR_SLOT(t->car));
 					if (do_throw_with_internal_errmsg(hcl, fetched_instruction_pointer) >= 0) break;
 					goto oops_with_errmsg_supplement;
 				}
@@ -3857,7 +3863,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
 
 				if (b1 > 0)
 				{
-					HCL_STACK_POP_TO (hcl, sc); /* TODO: support more than 1 later when the compiler supports more */
+					HCL_STACK_POP_TO (hcl, sc); /* TODO: support more than 1 superclass later when the compiler supports more */
 					if (!HCL_IS_CLASS(hcl, sc))
 					{
 						hcl_seterrbfmt (hcl, HCL_ECALL, "invalid superclass %O", sc);
@@ -3887,7 +3893,7 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
 				break;
 			}
 
-			case HCL_CODE_CLASS_PEXIT:
+			case HCL_CODE_CLASS_PEXIT: /* pop + exit */
 			{
 				hcl_oop_t c;
 

lib/gc.c

@@ -903,7 +903,7 @@ void hcl_gc (hcl_t* hcl, int full)
 
 	if (!full && hcl->gci.lazy_sweep)
 	{
-		/* set the lazy sweeping point to the head of the allocated blocks.
+		/* set the lazy sweeping pointer to the head of the allocated blocks.
 		 * hawk_allocbytes() updates hcl->gci.ls.prev if it is called while
 		 * hcl->gci.ls.curr stays at hcl->gci.b */
 		hcl->gci.ls.prev = HCL_NULL;
@@ -1042,8 +1042,8 @@ void hcl_gc (hcl_t* hcl)
 	}
 
 	/* scan the new heap to move referenced objects */
-	ptr = (hcl_uint8_t*) HCL_ALIGN ((hcl_uintptr_t)hcl->newheap->base, HCL_SIZEOF(hcl_oop_t));
+	ptr = (hcl_uint8_t*)HCL_ALIGN((hcl_uintptr_t)hcl->newheap->base, HCL_SIZEOF(hcl_oop_t));
-	ptr = scan_new_heap (hcl, ptr);
+	ptr = scan_new_heap(hcl, ptr);
 
 	/* traverse the symbol table for unreferenced symbols.
 	 * if the symbol has not moved to the new heap, the symbol
@@ -1381,16 +1381,17 @@ oops:
 	return -1;
 }
 
-#if 0
 static int ignite_3 (hcl_t* hcl)
 {
 	/* Register kernel classes manually created so far to the system dictionary */
+#if 0
 	static hcl_ooch_t str_processor[] = { 'P', 'r', 'o', 'c', 'e', 's', 's', 'o', 'r' };
 	static hcl_ooch_t str_dicnew[] = { 'n', 'e', 'w', ':' };
 	static hcl_ooch_t str_dicputassoc[] = { '_','_','p', 'u', 't', '_', 'a', 's', 's', 'o', 'c', ':' };
 	static hcl_ooch_t str_does_not_understand[] = { 'd', 'o', 'e', 's', 'N', 'o', 't', 'U', 'n', 'd', 'e', 'r', 's', 't', 'a', 'n', 'd', ':' };
 	static hcl_ooch_t str_primitive_failed[] = {  'p', 'r', 'i', 'm', 'i', 't', 'i', 'v', 'e', 'F', 'a', 'i', 'l', 'e', 'd' };
 	static hcl_ooch_t str_unwindto_return[] = { 'u', 'n', 'w', 'i', 'n', 'd', 'T', 'o', ':', 'r', 'e', 't', 'u', 'r', 'n', ':' };
+#endif
 
 	hcl_oow_t i;
 	hcl_oop_t sym;
@@ -1398,16 +1399,19 @@ static int ignite_3 (hcl_t* hcl)
 
 	for (i = 0; i < HCL_COUNTOF(kernel_classes); i++)
 	{
-		sym = hcl_makesymbol(hcl, kernel_classes[i].name, kernel_classes[i].len);
+		sym = hcl_makesymbol(hcl, kernel_classes[i].name, hcl_count_oocstr(kernel_classes[i].name));
-		if (!sym) return -1;
+		if (HCL_UNLIKELY(!sym)) return -1;
 
 		cls = *(hcl_oop_class_t*)((hcl_uint8_t*)hcl + kernel_classes[i].offset);
+#if 0
 		HCL_STORE_OOP (hcl, (hcl_oop_t*)&cls->name, sym);
 		HCL_STORE_OOP (hcl, (hcl_oop_t*)&cls->nsup, (hcl_oop_t)hcl->sysdic);
+#endif
 
 		if (!hcl_putatsysdic(hcl, sym, (hcl_oop_t)cls)) return -1;
 	}
 
+#if 0
 	/* Attach the system dictionary to the nsdic field of the System class */
 	HCL_STORE_OOP (hcl, (hcl_oop_t*)&hcl->_system->nsdic, (hcl_oop_t)hcl->sysdic);
 	/* Set the name field of the system dictionary */
@@ -1439,11 +1443,11 @@ static int ignite_3 (hcl_t* hcl)
 	sym = hcl_makesymbol(hcl, str_unwindto_return, HCL_COUNTOF(str_unwindto_return));
 	if (!sym) return -1;
 	hcl->unwindto_return_sym = (hcl_oop_char_t)sym;
+#endif
 
 	return 0;
 }
 
-#endif
 
 static int make_kernel_objs (hcl_t* hcl)
 {
@@ -1476,9 +1480,9 @@ static int make_kernel_objs (hcl_t* hcl)
 
 	if (ignite_2(hcl) <= -1) goto oops;
 
-#if 0
 	if (ignite_3(hcl) <= -1) goto oops;
 
+#if 0
 	hcl->igniting = 0;
 #endif
 	return 0;

lib/print.c

@@ -101,10 +101,10 @@ static struct
 	hcl_ooch_t ptr[20];
 } word[] =
 {
-	{  8,  { '#', '<', 'U', 'N', 'D', 'D', 'F', '>' } },
+	{  8,  { '#','<','U','N','D','E','F','>' } },
-	{  4,  { 'n', 'u', 'l', 'l' } },
+	{  4,  { 'n','u','l','l' } },
-	{  4,  { 't', 'r', 'u', 'e' } },
+	{  4,  { 't','r','u','e' } },
-	{  5,  { 'f', 'a', 'l', 's', 'e' } },
+	{  5,  { 'f','a','l','s','e' } },
 
 	{  6,  { '#','<','S','E','T','>' } },
 	{  7,  { '#','<','P','R','I','M','>' } },

lib/read.c

@@ -1550,8 +1550,8 @@ static int feed_process_token (hcl_t* hcl)
 					hcl_setsynerrbfmt (hcl, HCL_SYNERR_SEMICOLON, TOKEN_LOC(hcl), TOKEN_NAME(hcl), "semicolon expected");
 					goto oops;
 				#else
-					/* if the expression inside {} is an auto-forged xlist expression and there is no semiclon provided,
+					/* if the expression inside {} is an auto-forged xlist expression and there is no semicolon provided,
-					 * treat it as if the semiclon is placed before }. e.g. { printf "hello\n" } */
+					 * treat it as if the semicolon is placed before }. e.g. { printf "hello\n" } */
 					rbrace_again = 1;
 					goto semicolon;
 				#endif