wrote more code to support classes

lib/comp.c

@@ -389,7 +389,6 @@ static int emit_single_param_instruction (hcl_t* hcl, int cmd, hcl_oow_t param_1
 		case HCL_CODE_PUSH_NEGINTLIT:
 		case HCL_CODE_PUSH_CHARLIT:
 
-
 		case HCL_CODE_MAKE_DIC: /* TODO: don't these need write_long2? */
 		case HCL_CODE_MAKE_ARRAY:
 		case HCL_CODE_MAKE_BYTEARRAY:
@@ -1057,12 +1056,21 @@ enum
 	COP_COMPILE_DIC_LIST,
 	COP_COMPILE_QLIST, /* compile data list */
 
-	COP_COMPILE_AND_EXPR,
-	COP_COMPILE_OR_EXPR,
 	COP_COMPILE_ELIF,
 	COP_COMPILE_ELSE,
 	COP_COMPILE_CATCH,
 	
+	COP_COMPILE_AND_P1,
+	COP_COMPILE_AND_P2,
+
+	COP_COMPILE_BREAK_P1,
+
+	COP_COMPILE_OR_P1,
+	COP_COMPILE_OR_P2,
+	
+	COP_COMPILE_CLASS_P1,
+	COP_COMPILE_CLASS_P2,
+
 	COP_EMIT_CALL,
 
 	COP_EMIT_MAKE_ARRAY,
@@ -1094,11 +1102,7 @@ enum
 	COP_POST_CATCH, 
 
 	COP_POST_LAMBDA,
-	COP_POST_CLASS,
-	COP_POST_AND_EXPR,
-	COP_POST_OR_EXPR,
 
-	COP_POST_BREAK
 };
 
 /* ========================================================================= */
@@ -1129,20 +1133,20 @@ static int compile_and (hcl_t* hcl, hcl_cnode_t* src)
 	obj = HCL_CNODE_CONS_CDR(obj);
 
 	SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */
-	if (obj) PUSH_SUBCFRAME (hcl, COP_COMPILE_AND_EXPR, obj); /* 2 */
+	if (obj) PUSH_SUBCFRAME (hcl, COP_COMPILE_AND_P1, obj); /* 2 */
 
 	return 0;
 }
 
 
-static HCL_INLINE int compile_and_expr (hcl_t* hcl)
+static HCL_INLINE int compile_and_p1 (hcl_t* hcl)
 {
 	hcl_cnode_t* obj, * expr;
 	hcl_cframe_t* cf;
 	hcl_ooi_t jump_inst_pos;
 	
 	cf = GET_TOP_CFRAME(hcl);
-	HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_AND_EXPR);
+	HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_AND_P1);
 	HCL_ASSERT (hcl, cf->operand != HCL_NULL);
 
 /* TODO: optimization - eat away all true expressions */
@@ -1156,37 +1160,38 @@ static HCL_INLINE int compile_and_expr (hcl_t* hcl)
 	HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
 	jump_inst_pos = hcl->code.bc.len;
 
+	/* this conditional jump make evaluation short-circuited. the actual jump point is to be patched in compile_and_p2() */
 	if (emit_single_param_instruction(hcl, HCL_CODE_JUMP_FORWARD_IF_FALSE, MAX_CODE_JUMP, HCL_CNODE_GET_LOC(obj)) <= -1) return -1;
 	if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_CNODE_GET_LOC(obj)) <= -1) return -1; 
 
 	expr = HCL_CNODE_CONS_CAR(obj);
 	obj = HCL_CNODE_CONS_CDR(obj);
 
-	SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */
+	SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 - compile the current part */
 	
-	PUSH_SUBCFRAME (hcl, COP_POST_AND_EXPR, expr); /* 3 */
+	PUSH_SUBCFRAME (hcl, COP_COMPILE_AND_P2, expr); /* 3 - patch the conditional jump instruction */
 	cf = GET_SUBCFRAME(hcl);
 	cf->u.post_and.jump_inst_pos = jump_inst_pos;
 
-	if (obj) PUSH_SUBCFRAME (hcl, COP_COMPILE_AND_EXPR, obj); /* 2 */
+	if (obj) PUSH_SUBCFRAME (hcl, COP_COMPILE_AND_P1, obj); /* 2 - recurse to compile remaining parts */
-
 	return 0;
 }
 
-static HCL_INLINE int post_and_expr (hcl_t* hcl)
+static HCL_INLINE int compile_and_p2 (hcl_t* hcl)
 {
 	hcl_cframe_t* cf;
 	hcl_ooi_t jip;
 	hcl_oow_t jump_offset;
 
 	cf = GET_TOP_CFRAME(hcl);
-	HCL_ASSERT (hcl, cf->opcode == COP_POST_AND_EXPR);
+	HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_AND_P2);
 	HCL_ASSERT (hcl, cf->operand != HCL_NULL);
 
 	HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
 	jip = cf->u.post_and.jump_inst_pos;
 
-	/* patch the jump insruction emitted after each expression inside the 'and' expression */
+	/* patch the jump insruction emitted after each expression inside the 'and' expression 
+	 * the jump make evaluation short-circuited. */
 	jump_offset = hcl->code.bc.len - jip - (HCL_CODE_LONG_PARAM_SIZE + 1);
 	patch_long_jump (hcl, jip, jump_offset);
 
@@ -1222,20 +1227,20 @@ static int compile_or (hcl_t* hcl, hcl_cnode_t* src)
 	obj = HCL_CNODE_CONS_CDR(obj);
 
 	SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */
-	PUSH_SUBCFRAME (hcl, COP_COMPILE_OR_EXPR, obj); /* 2 */
+	PUSH_SUBCFRAME (hcl, COP_COMPILE_OR_P1, obj); /* 2 */
 
 	return 0;
 }
 
 
-static HCL_INLINE int compile_or_expr (hcl_t* hcl)
+static HCL_INLINE int compile_or_p1 (hcl_t* hcl)
 {
 	hcl_cnode_t* obj, * expr;
 	hcl_cframe_t* cf;
 	hcl_ooi_t jump_inst_pos;
 	
 	cf = GET_TOP_CFRAME(hcl);
-	HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_OR_EXPR);
+	HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_OR_P1);
 	HCL_ASSERT (hcl, cf->operand != HCL_NULL);
 
 /* TODO: optimization - eat away all false expressions */
@@ -1250,6 +1255,7 @@ static HCL_INLINE int compile_or_expr (hcl_t* hcl)
 	HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
 	jump_inst_pos = hcl->code.bc.len;
 
+	/* this conditional jump makes evaluation short-circuited. the actual jump point is to be patched in compile_or_p2() */
 	if (emit_single_param_instruction(hcl, HCL_CODE_JUMP_FORWARD_IF_TRUE, MAX_CODE_JUMP, HCL_CNODE_GET_LOC(obj)) <= -1) return -1;
 	if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_CNODE_GET_LOC(obj)) <= -1) return -1; 
 
@@ -1258,23 +1264,23 @@ static HCL_INLINE int compile_or_expr (hcl_t* hcl)
 
 	SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */
 
-	PUSH_SUBCFRAME (hcl, COP_POST_OR_EXPR, expr); /* 3 */
+	PUSH_SUBCFRAME (hcl, COP_COMPILE_OR_P2, expr); /* 3 */
 	cf = GET_SUBCFRAME(hcl);
 	cf->u.post_or.jump_inst_pos = jump_inst_pos;
 
-	if (obj) PUSH_SUBCFRAME (hcl, COP_COMPILE_OR_EXPR, obj); /* 2 */
+	if (obj) PUSH_SUBCFRAME (hcl, COP_COMPILE_OR_P1, obj); /* 2 */
 
 	return 0;
 }
 
-static HCL_INLINE int post_or_expr (hcl_t* hcl)
+static HCL_INLINE int compile_or_p2 (hcl_t* hcl)
 {
 	hcl_cframe_t* cf;
 	hcl_ooi_t jip;
 	hcl_oow_t jump_offset;
 
 	cf = GET_TOP_CFRAME(hcl);
-	HCL_ASSERT (hcl, cf->opcode == COP_POST_OR_EXPR);
+	HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_OR_P2);
 	HCL_ASSERT (hcl, cf->operand != HCL_NULL);
 
 	HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
@@ -1359,7 +1365,7 @@ inside_loop:
 			jump_inst_pos = hcl->code.bc.len;
 
 			if (emit_single_param_instruction(hcl, HCL_CODE_JUMP_FORWARD_0, MAX_CODE_JUMP, HCL_CNODE_GET_LOC(cmd)) <= -1) return -1;
-			INSERT_CFRAME (hcl, i, COP_POST_BREAK, cmd);
+			INSERT_CFRAME (hcl, i, COP_COMPILE_BREAK_P1, cmd);
 			cf = GET_CFRAME(hcl, i);
 			cf->u._break.jump_inst_pos = jump_inst_pos;
 
@@ -1374,13 +1380,13 @@ inside_loop:
 	return -1;
 }
 
-static int post_break (hcl_t* hcl)
+static int compile_break_p1 (hcl_t* hcl)
 {
 	hcl_cframe_t* cf;
 	hcl_ooi_t jip, jump_offset;
 
 	cf = GET_TOP_CFRAME(hcl);
-	HCL_ASSERT (hcl, cf->opcode == COP_POST_BREAK);
+	HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_BREAK_P1);
 	HCL_ASSERT (hcl, cf->operand != HCL_NULL);
 
 	jip = cf->u._break.jump_inst_pos;;
@@ -1702,6 +1708,7 @@ static int check_if_plain_cnode (hcl_t* hcl, hcl_cnode_t* obj, hcl_cnode_t* prev
 	return 0;
 }
 
+#if 0
 static int compile_class (hcl_t* hcl, hcl_cnode_t* src)
 {
 	/*
@@ -1733,6 +1740,7 @@ static int compile_class (hcl_t* hcl, hcl_cnode_t* src)
 	*/
 	hcl_cnode_t* cmd, * obj, * tmp;
 	hcl_cnode_t* class_name, * superclass_name;
+	hcl_ooi_t nsuperclasses, nivars, ncvars;
 
 	cmd = HCL_CNODE_CONS_CAR(src);
 	obj = HCL_CNODE_CONS_CDR(src);
@@ -1758,11 +1766,30 @@ static int compile_class (hcl_t* hcl, hcl_cnode_t* src)
 	if (obj)
 	{
 		/* superclass */
+		
+		
+ 
+ 
 		tmp = HCL_CNODE_CONS_CAR(obj);
 		if (HCL_CNODE_IS_TRPCOLONS(tmp))
 		{
 			obj = HCL_CNODE_CONS_CDR(obj);
 
+/* TODO: this can actually be dynamic. so it doesn't have to be a symbol name,
+ *        even an expression is possible ... 
+ *  (defclass A 
+ *   ...
+ *  )
+ *  (defun get-your-class() A)
+ *  (defclass B ::: (get-your-class)
+ *    ....
+ *  )
+ * 
+ *  this code is wrong... 
+ */
+			
+ 
+#if 0
 			/* TODO: multiple subclasses? interfaces? */
 			if (check_if_plain_cnode(hcl, obj, tmp, cmd, HCL_SYNERR_VARNAME, "superclass name") <= -1) return -1;
 			superclass_name = HCL_CNODE_CONS_CAR(obj);
@@ -1780,10 +1807,31 @@ static int compile_class (hcl_t* hcl, hcl_cnode_t* src)
 				hcl_setsynerrbfmt (hcl, HCL_SYNERR_VARNAME, HCL_CNODE_GET_LOC(superclass_name), HCL_CNODE_GET_TOK(superclass_name), "non-symbol not to be used as a superclass name");
 				return -1;
 			}
+#else
+
+
+	SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */
+	
+	PUSH_SUBCFRAME (hcl, COP_COMPILE_AND_P2, expr); /* 3 */
+	cf = GET_SUBCFRAME(hcl);
+	cf->u.post_and.jump_inst_pos = jump_inst_pos;
+
+	if (obj) PUSH_SUBCFRAME (hcl, COP_COMPILE_AND_P1, obj); /* 2 */
+
+			SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, obj); /* 1 */
+#endif
+		}
+		else
+		{
+			SWITCH_TO_CFRAME (hcl, COP_EMIT_PUSH_NIL, obj); /* 1*/
 		}
 	}
 	
+	PUSH_SUBCFRAME (hcl, COP_CLASS_SUPERCLASS
+
+#if 0
 //HCL_DEBUG2 (hcl, ">>> [%js] [%js]\n", HCL_CNODE_GET_TOKPTR(class_name), HCL_CNODE_GET_TOKPTR(superclass_name));
+	nivars = ncvars = 0;
 	while (obj)
 	{
 		/* instance variables and/or class variables */
@@ -1793,15 +1841,44 @@ printf ("VLIST....\n");
 		vars = HCL_CNODE_CONS_CAR(obj);
 		if (!HCL_CNODE_IS_CONS_CONCODED(vars, HCL_CONCODE_VLIST)) break;
 
+// TODO increment nivars and ncvars
+// also remember actual variable names...
 printf ("22222222222\n");
 		obj = HCL_CNODE_CONS_CDR(obj);
 	}
 	
+#else
+	PUSH_SUBCFRAME (hcl, COP_COMPILE_CLASS_VARS, obj);
+#endif
 	
-	if (push_clsblk(hcl, HCL_CNODE_GET_LOC(cmd), 0, 0) <= -1) return -1;
+// superclass name? 
+// nivars and ncvars.. must include inherited ones...
+	if (push_clsblk(hcl, HCL_CNODE_GET_LOC(cmd), nivars, ncvars) <= -1) return -1;
+
+
+
+
+/* TODO: push the instance variables string and class variables string */
+// superclass name is an variable...
+
+	//if (emit_push_literal(hcl, tmp, HCL_CNODE_GET_LOC(cmd))
+	if (nivars > 0)
+	{
+		tmp = hcl_makestring(hcl, varg, len, 0);
+		if (HCL_UNLIKELY(!tmp)) return -1;
+		if (emit_push_literal(hcl, tmp, HCL_CNODE_GET_LOC(cmd)) <= -1) return-1;
+	}
+	
+	if (ncvars > 0)
+	{
+	
+	}
+
+	/* make_class nsuperclasses, nivars, ncvars - this will use the pushed literal */
+	if (emit_byte_instruction(hcl, HCL_CODE_MAKE_CLASS, HCL_CNODE_GET_LOC(cmd)) <= -1) return -1;
+	if (emit_long_param(hcl, nivars) <= -1) return -1;
+	if (emit_long_param(hcl, ncvars) <= -1) return -1;
 
-	/* TODO: emit make_class code...
-	*/
 	if (emit_byte_instruction(hcl, HCL_CODE_CLASS_ENTER, HCL_CNODE_GET_LOC(cmd)) <= -1) return -1;
 
 	SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj); /* 1 */
@@ -1809,14 +1886,146 @@ printf ("22222222222\n");
 
 	return 0;
 }
+#endif
+
+static int compile_class (hcl_t* hcl, hcl_cnode_t* src)
+{
+	hcl_cnode_t* cmd, * obj;
+	hcl_cnode_t* class_name;
+	hcl_cframe_t* cf;
+
+	cmd = HCL_CNODE_CONS_CAR(src);
+	obj = HCL_CNODE_CONS_CDR(src);
+
+	HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(cmd, HCL_SYNCODE_DEFCLASS));
+
+	class_name = HCL_NULL;
+
+	if (check_if_plain_cnode(hcl, obj, src, cmd, HCL_SYNERR_VARNAME, "class name") <= -1) return -1;
+	class_name = HCL_CNODE_CONS_CAR(obj);
+	if (HCL_CNODE_IS_SYMBOL(class_name))
+	{
+/* TODO: make the classname optional? */
+		/* defclass followed by a class name */
+		if (HCL_CNODE_SYMBOL_SYNCODE(class_name)) /*|| HCL_OBJ_GET_FLAGS_KERNEL(class_name) >= 1) */
+		{
+			hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDVARNAME, HCL_CNODE_GET_LOC(class_name), HCL_CNODE_GET_TOK(class_name), "special symbol not to be used as a class name");
+			return -1;
+		}
+		obj = HCL_CNODE_CONS_CDR(obj);
+	}
+
+	if (obj)
+	{
+		hcl_cnode_t* tmp;
+
+		tmp = HCL_CNODE_CONS_CAR(obj);
+		if (!HCL_CNODE_IS_TRPCOLONS(tmp)) goto no_superclass;
+		{
+			obj = HCL_CNODE_CONS_CDR(obj);
+
+			/* superclass part */
+			SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, obj); /* 1 */
+
+			PUSH_SUBCFRAME (hcl, COP_COMPILE_CLASS_P2, class_name); /* 3 */
+			cf = GET_SUBCFRAME(hcl);
+			cf->u._class.nsuperclasses = 0; /* unsed for CLASS_P2 */
+			cf->u._class.start_loc = *HCL_CNODE_GET_LOC(src); /* TODO: use *HCL_CNODE_GET_LOC(cmd) instead? */
+			
+			obj = HCL_CNODE_CONS_CDR(obj);
+			PUSH_SUBCFRAME (hcl, COP_COMPILE_CLASS_P1, obj); /* 2 */
+			cf = GET_SUBCFRAME(hcl);
+			cf->u._class.nsuperclasses = 1; /* this one needs to change if we support multiple superclasses... */
+		}
+	}
+	else
+	{
+	no_superclass:
+		SWITCH_TOP_CFRAME(hcl, COP_COMPILE_CLASS_P1, obj); /* 1 */
+		cf = GET_TOP_CFRAME(hcl);
+		cf->u._class.nsuperclasses = 0; /* this one needs to change if we support multiple superclasses... */
+		cf->u._class.start_loc = *HCL_CNODE_GET_LOC(src); /* TODO: use *HCL_CNODE_GET_LOC(cmd) instead? */
+
+		PUSH_SUBCFRAME (hcl, COP_COMPILE_CLASS_P2, class_name); /* 2 */
+		cf = GET_SUBCFRAME(hcl);
+		cf->u._class.nsuperclasses = 0; /* unsed for CLASS_P2 */
+		cf->u._class.start_loc = *HCL_CNODE_GET_LOC(src); /* TODO: use *HCL_CNODE_GET_LOC(cmd) instead? */
+	}
+
+	return 0;
+}
+
+static HCL_INLINE int compile_class_p1 (hcl_t* hcl)
+{
+	/* collect information about declared variables */
+	hcl_cframe_t* cf;
+	hcl_ooi_t nivars, ncvars;
+	hcl_cnode_t* obj;
+	hcl_oop_t tmp;
+
+	cf = GET_TOP_CFRAME(hcl);
+	obj = cf->operand;
+
+	nivars = ncvars = 0;
+	while (obj)
+	{
+		/* instance variables and/or class variables */
+		hcl_cnode_t* vars;
+
+		HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(obj)); /* must not get CDR. the reader must ensure this */
+
+printf ("VLIST....\n");
+		vars = HCL_CNODE_CONS_CAR(obj);
+		if (!HCL_CNODE_IS_CONS_CONCODED(vars, HCL_CONCODE_VLIST)) break;
+
+// TODO increment nivars and ncvars
+// also remember actual variable names...
+printf ("22222222222\n");
+		obj = HCL_CNODE_CONS_CDR(obj);
+	}
+	
+	/* TODO: push the instance variables string and class variables string */
+// superclass name is an variable...
+
+	//if (emit_push_literal(hcl, tmp, HCL_CNODE_GET_LOC(cmd))
+	if (nivars > 0)
+	{
+		//tmp = hcl_makestring(hcl, varg, len, 0);
+		tmp = hcl_makestring(hcl, HCL_NULL, 0, 0);
+		if (HCL_UNLIKELY(!tmp)) return -1;
+		if (emit_push_literal(hcl, tmp, &cf->u._class.start_loc) <= -1) return-1;
+	}
+	
+	if (ncvars > 0)
+	{
+		tmp = hcl_makestring(hcl, HCL_NULL, 0, 0);
+		if (HCL_UNLIKELY(!tmp)) return -1;
+		if (emit_push_literal(hcl, tmp, &cf->u._class.start_loc) <= -1) return-1;
+	}
+	
+	if (push_clsblk(hcl, &cf->u._class.start_loc, nivars, ncvars) <= -1) return -1;
+
+	/* make_class nsuperclasses, nivars, ncvars - this will use the pushed literal */
+	if (emit_byte_instruction(hcl, HCL_CODE_MAKE_CLASS, &cf->u._class.start_loc) <= -1) return -1;
+	if (emit_long_param(hcl, cf->u._class.nsuperclasses) <= -1) return -1;
+	if (emit_long_param(hcl, nivars) <= -1) return -1;
+	if (emit_long_param(hcl, ncvars) <= -1) return -1;
+
+	if (emit_byte_instruction(hcl, HCL_CODE_CLASS_ENTER, &cf->u._class.start_loc) <= -1) return -1; // TODO: do i need this separater instruction?
+
+	SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj); /* 1 */
 	
 
-static HCL_INLINE int post_class (hcl_t* hcl)
+	return 0;
+}
+
+
+static HCL_INLINE int compile_class_p2 (hcl_t* hcl)
 {
 	hcl_cframe_t* cf;
 
 	cf = GET_TOP_CFRAME(hcl);
-	HCL_ASSERT (hcl, cf->opcode == COP_POST_CLASS);
+	HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_CLASS_P2);
 
 	pop_clsblk (hcl);
 
@@ -1858,6 +2067,7 @@ static HCL_INLINE int post_class (hcl_t* hcl)
 	}
 #else
 /* should i make the assignment in POST?  or after variable declarations immediately? */
+/* TODO: emit instruction to store into the class name...? */
 	if (emit_byte_instruction(hcl, HCL_CODE_CLASS_EXIT, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1;
 	printf ("end of CLASS DEFINITION\n");
 	POP_CFRAME (hcl);
@@ -4409,14 +4619,37 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags)
 				if (compile_catch(hcl) <= -1) goto oops;
 				break;
 
-			case COP_COMPILE_AND_EXPR:
+
-				if (compile_and_expr(hcl) <= -1) goto oops;
+
+			case COP_COMPILE_AND_P1:
+				if (compile_and_p1(hcl) <= -1) goto oops;
 				break;
 
-			case COP_COMPILE_OR_EXPR:
+			case COP_COMPILE_AND_P2:
-				if (compile_or_expr(hcl) <= -1) goto oops;
+				if (compile_and_p2(hcl) <= -1) goto oops;
 				break;
 
+			case COP_COMPILE_BREAK_P1:
+				if (compile_break_p1(hcl) <= -1) goto oops;
+				break;
+
+			case COP_COMPILE_CLASS_P1:
+				if (compile_class_p1(hcl) <= -1) goto oops;
+				break;
+
+			case COP_COMPILE_CLASS_P2:
+				if (compile_class_p2(hcl) <= -1) goto oops;
+				break;
+
+			case COP_COMPILE_OR_P1:
+				if (compile_or_p1(hcl) <= -1) goto oops;
+				break;
+
+			case COP_COMPILE_OR_P2:
+				if (compile_or_p2(hcl) <= -1) goto oops;
+				break;
+
+
 			case COP_EMIT_CALL:
 				if (emit_call(hcl) <= -1) goto oops;
 				break;
@@ -4510,22 +4743,6 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags)
 				if (post_lambda(hcl) <= -1) goto oops;
 				break;
 
-			case COP_POST_CLASS:
-				if (post_class(hcl) <= -1) goto oops;
-				break;
-
-			case COP_POST_AND_EXPR:
-				if (post_and_expr(hcl) <= -1) goto oops;
-				break;
-				
-			case COP_POST_OR_EXPR:
-				if (post_or_expr(hcl) <= -1) goto oops;
-				break;
-
-			case COP_POST_BREAK:
-				if (post_break(hcl) <= -1) goto oops;
-				break;
-
 			default:
 				HCL_DEBUG1 (hcl, "Internal error - invalid compiler opcode %d\n", cf->opcode);
 				hcl_seterrbfmt (hcl, HCL_EINTERN, "invalid compiler opcode %d", cf->opcode);

lib/decode.c

@@ -603,8 +603,16 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
 			/* -------------------------------------------------------- */
 
 			case HCL_CODE_MAKE_CLASS:
-				LOG_INST_0 (hcl, "make_class");
+			{
+				hcl_oow_t b3;
+				
+				FETCH_PARAM_CODE_TO (hcl, b1);
+				FETCH_PARAM_CODE_TO (hcl, b2);
+				FETCH_PARAM_CODE_TO (hcl, b3);
+				LOG_INST_3 (hcl, "make_class %zu %zu %zu", b1, b2, b3);
+			
 				break;
+			}
 
 			/* -------------------------------------------------------- */
 			case HCL_CODE_DUP_STACKTOP:

lib/exec.c

@@ -144,14 +144,13 @@ static void terminate_all_processes (hcl_t* hcl);
 	do { \
 		hcl_oop_process_t ap = (hcl)->processor->active; \
 		hcl_ooi_t exsp = HCL_OOP_TO_SMOOI(ap->exsp); \
-		hcl_ooi_t ss = HCL_OOP_TO_SMOOI(ap->ss); \
+		if (exsp >= HCL_OOP_TO_SMOOI(ap->exst) - 1) \
-		if (exsp >= HCL_OOP_TO_SMOOI(ap->exss) - 2) \
 		{ \
 			hcl_seterrbfmt (hcl, HCL_EOOMEM, "process exception stack overflow"); \
 			(hcl)->abort_req = -1; \
 		} \
-		exsp++; ap->slot[ss + exsp] = (ctx); \
+		exsp++; ap->slot[exsp] = (ctx); \
-		exsp++; ap->slot[ss + exsp] = HCL_SMOOI_TO_OOP(ip); \
+		exsp++; ap->slot[exsp] = HCL_SMOOI_TO_OOP(ip); \
 		ap->exsp = HCL_SMOOI_TO_OOP(exsp); \
 	} while (0)
 		
@@ -167,13 +166,46 @@ static void terminate_all_processes (hcl_t* hcl);
 	do { \
 		hcl_oop_process_t ap = (hcl)->processor->active; \
 		hcl_ooi_t exsp = HCL_OOP_TO_SMOOI(ap->exsp); \
-		hcl_ooi_t ss = HCL_OOP_TO_SMOOI(ap->ss); \
+		ip = HCL_OOP_TO_SMOOI(ap->slot[exsp]); exsp--; \
-		ip = HCL_OOP_TO_SMOOI(ap->slot[ss + exsp]); exsp--; \
+		ctx = ap->slot[exsp]; exsp--; \
-		ctx = ap->slot[ss + exsp]; exsp--; \
 		ap->exsp = HCL_SMOOI_TO_OOP(exsp); \
 	} while (0)
 		
-#define HCL_EXSTACK_ISEMPTY(hcl) (HCL_OOP_TO_SMOOI(((hcl)->processor->active)->exsp) <= -1)
+#define HCL_EXSTACK_ISEMPTY(hcl) (HCL_OOP_TO_SMOOI(((hcl)->processor->active)->exsp) <= HCL_OOP_TO_SMOOI(((hcl)->processor->active)->st))
+
+
+/* ------------------------------------------------------------------------- */
+
+#define HCL_CLSTACK_PUSH(hcl, v) \
+	do { \
+		hcl_oop_process_t ap = (hcl)->processor->active; \
+		hcl_ooi_t clsp = HCL_OOP_TO_SMOOI(ap->clsp); \
+		if (clsp >= HCL_OOP_TO_SMOOI(ap->clst)) \
+		{ \
+			hcl_seterrbfmt (hcl, HCL_EOOMEM, "process class stack overflow"); \
+			(hcl)->abort_req = -1; \
+		} \
+		clsp++; ap->slot[clsp] = (v); \
+		ap->clsp = HCL_SMOOI_TO_OOP(clsp); \
+	} while (0)
+		
+#define HCL_CLSTACK_POP(hcl) \
+	do { \
+		hcl_oop_process_t ap = (hcl)->processor->active; \
+		hcl_ooi_t clsp = HCL_OOP_TO_SMOOI(ap->clsp); \
+		clsp--; \
+		ap->clsp = HCL_SMOOI_TO_OOP(clsp); \
+	} while (0)
+
+#define HCL_CLSTACK_POP_TO(hcl, v) \
+	do { \
+		hcl_oop_process_t ap = (hcl)->processor->active; \
+		hcl_ooi_t clsp = HCL_OOP_TO_SMOOI(ap->clsp); \
+		v = ap->slot[clsp]; clsp--; \
+		ap->clsp = HCL_SMOOI_TO_OOP(clsp); \
+	} while (0)
+		
+#define HCL_CLSTACK_ISEMPTY(hcl) (HCL_OOP_TO_SMOOI(((hcl)->processor->active)->clsp) <= HCL_OOP_TO_SMOOI(((hcl)->processor->active)->exst))
 
 /* ------------------------------------------------------------------------- */
 
@@ -462,7 +494,7 @@ static HCL_INLINE void free_pid (hcl_t* hcl, hcl_oop_process_t proc)
 static hcl_oop_process_t make_process (hcl_t* hcl, hcl_oop_context_t c)
 {
 	hcl_oop_process_t proc;
-	hcl_oow_t stksize, exstksize;
+	hcl_oow_t stksize, exstksize, clstksize, maxsize;
 	hcl_ooi_t total_count;
 	hcl_ooi_t suspended_count;
 
@@ -478,24 +510,23 @@ static hcl_oop_process_t make_process (hcl_t* hcl, hcl_oop_context_t c)
 
 	if (hcl->proc_map_free_first <= -1 && prepare_to_alloc_pid(hcl) <= -1) return HCL_NULL;
 
-	stksize = hcl->option.dfl_procstk_size;
+	stksize = hcl->option.dfl_procstk_size; /* stack */
 	exstksize = 128; /* exception stack size */ /* TODO: make it configurable */
+	clstksize = 64; /* class stack size */ /* TODO: make it configurable too */
 	
-#if 0	
+	maxsize = (HCL_TYPE_MAX(hcl_ooi_t) - HCL_PROCESS_NAMED_INSTVARS) / 3;
-	if (stksize > HCL_TYPE_MAX(hcl_ooi_t) - HCL_PROCESS_NAMED_INSTVARS)
+
-		stksize = HCL_TYPE_MAX(hcl_ooi_t) - HCL_PROCESS_NAMED_INSTVARS;
+	if (stksize > maxsize) stksize = maxsize;
-	else if (stksize < 128) stksize = 128;
+	else if (stksize < 192) stksize = 192;
-#else
+
-	if (stksize > (HCL_TYPE_MAX(hcl_ooi_t) - HCL_PROCESS_NAMED_INSTVARS) / 2)
+	if (exstksize > maxsize) exstksize = maxsize;
-		stksize = (HCL_TYPE_MAX(hcl_ooi_t) - HCL_PROCESS_NAMED_INSTVARS) / 2;
-	else if (stksize < 128) stksize = 128;
-	if (exstksize > (HCL_TYPE_MAX(hcl_ooi_t) - HCL_PROCESS_NAMED_INSTVARS) / 2)
-		exstksize = (HCL_TYPE_MAX(hcl_ooi_t) - HCL_PROCESS_NAMED_INSTVARS) / 2;
 	else if (exstksize < 128) exstksize = 128;
-#endif
+
+	if (clstksize > maxsize) clstksize = maxsize;
+	else if (clstksize < 32) clstksize = 32;
 
 	hcl_pushvolat (hcl, (hcl_oop_t*)&c);
-	proc = (hcl_oop_process_t)hcl_allocoopobj(hcl, HCL_BRAND_PROCESS, HCL_PROCESS_NAMED_INSTVARS + stksize + exstksize);
+	proc = (hcl_oop_process_t)hcl_allocoopobj(hcl, HCL_BRAND_PROCESS, HCL_PROCESS_NAMED_INSTVARS + stksize + exstksize + clstksize);
 	hcl_popvolat (hcl);
 	if (HCL_UNLIKELY(!proc)) return HCL_NULL;
 
@@ -512,10 +543,18 @@ static hcl_oop_process_t make_process (hcl_t* hcl, hcl_oop_context_t c)
 
 	proc->initial_context = c;
 	proc->current_context = c;
-	proc->sp = HCL_SMOOI_TO_OOP(-1);
+
-	proc->ss = HCL_SMOOI_TO_OOP(stksize);
+	/* stack */
-	proc->exsp = HCL_SMOOI_TO_OOP(-1);
+	proc->sp = HCL_SMOOI_TO_OOP(-1); /* no item */
-	proc->exss = HCL_SMOOI_TO_OOP(exstksize);
+	proc->st = HCL_SMOOI_TO_OOP(stksize);
+
+	/* exception stack */
+	proc->exsp = proc->st; /* no item pushed yet*/
+	proc->exst = HCL_SMOOI_TO_OOP(stksize + exstksize - 1);
+
+	/* class stack */
+	proc->clsp = proc->exst; /* no item pushed yet */
+	proc->clst = HCL_SMOOI_TO_OOP(stksize + exstksize + clstksize - 1);
 
 	HCL_ASSERT (hcl, (hcl_oop_t)c->sender == hcl->_nil);
 
@@ -3264,7 +3303,6 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
 				LOG_INST_0 (hcl, "throw");
 				return_value = HCL_STACK_GETTOP(hcl);
 				HCL_STACK_POP (hcl);
-
 				if (do_throw(hcl, return_value, fetched_instruction_pointer) <= -1) goto oops;
 				break;
 			/* -------------------------------------------------------- */
@@ -3274,15 +3312,15 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
 
 				/* the class_enter instruct must follow the class_make instruction... */
 				LOG_INST_0 (hcl, "class_enter");
-				c = HCL_STACK_GETTOP(hcl); /* the class object */
+				c = HCL_STACK_GETTOP(hcl); /* the class object created with make_class */
-				//HCL_CLSTACK_PUSH (hcl, c);
+				HCL_CLSTACK_PUSH (hcl, c);
 				break;
 			}
 			
 			case HCL_CODE_CLASS_EXIT:
 				LOG_INST_0 (hcl, "class_exit");
 				/* TODO: stack underflow check? */
-				//HCL_CLSTACK_POP (hcl);
+				HCL_CLSTACK_POP (hcl);
 				break;
 			/* -------------------------------------------------------- */
 
@@ -3753,23 +3791,26 @@ if (do_throw(hcl, hcl->_nil, fetched_instruction_pointer) <= -1)
 
 			case HCL_CODE_MAKE_CLASS:
 			{
-				/* push nivars
+				/* push superclass
-				   push ncvars
+				   push ivars
-				   push superclass
+				   push cvars
-				   //push ivarnames
-				   //push cvarnames
 				   make_classs
 				 */
 				hcl_oop_t t, sc, nivars, ncvars;
+				hcl_oow_t b3;
 				
-				LOG_INST_0 (hcl, "make_class");
+				FETCH_PARAM_CODE_TO (hcl, b1); /* nsuperclasses */
+				FETCH_PARAM_CODE_TO (hcl, b2); /* nivars */
+				FETCH_PARAM_CODE_TO (hcl, b3); /* ncvars */
 				
-				sc = HCL_STACK_GETTOP(hcl); HCL_STACK_POP(hcl);
+				LOG_INST_3 (hcl, "make_class %zu %zu %zu", b1, b2, b3);
-				ncvars = HCL_STACK_GETTOP(hcl); HCL_STACK_POP(hcl);
+
-				nivars = HCL_STACK_GETTOP(hcl); HCL_STACK_POP(hcl);
+			/* TODO: get extra information from the stack according to b1, b2, b3*/
-				HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(ncvars));
+				/* critical error if the superclass is not a class ...
-				HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(nivars));
+				 * critical error if ivars is not a string...
-				t = hcl_makeclass(hcl, sc, HCL_OOP_TO_SMOOI(nivars), HCL_OOP_TO_SMOOI(ncvars));
+				 * critical errro if cvars is not a string ....
+				 */
+				t = hcl_makeclass(hcl, hcl->_nil, b2, b3); // TOOD: pass variable information... 
 
 				if (HCL_UNLIKELY(!t)) 
 				{
@@ -3980,7 +4021,7 @@ hcl_oop_t hcl_execute (hcl_t* hcl)
 	#endif
 	}
 
-	/* create a virtual function object that hold the bytes codes generated */
+	/* create a virtual function object that hold the bytes codes generated plus the literal frame */
 	func = make_function(hcl, hcl->code.lit.len, hcl->code.bc.ptr, hcl->code.bc.len, hcl->code.dbgi);
 	if (HCL_UNLIKELY(!func)) return HCL_NULL;
 

lib/gc.c

@@ -233,31 +233,45 @@ static HCL_INLINE void gc_ms_scan_stack (hcl_t* hcl)
 	{
 		oop = hcl->gci.stack.ptr[--hcl->gci.stack.len];
 
-		/*gc_ms_mark_object (hcl, (hcl_oop_t)HCL_OBJ_GET_CLASS(oop));*/
+		gc_ms_mark_object (hcl, (hcl_oop_t)HCL_OBJ_GET_CLASS(oop));
 
 		if (HCL_OBJ_GET_FLAGS_TYPE(oop) == HCL_OBJ_TYPE_OOP)
 		{
-			hcl_oow_t size, i;
+			hcl_ooi_t i, ll;
 
 			/* is it really better to use a flag bit in the header to
 			 * determine that it is an instance of process? */
 			/* if (HCL_UNLIKELY(HCL_OBJ_GET_FLAGS_PROC(oop))) */
 			if (HCL_OBJ_GET_FLAGS_BRAND(oop) == HCL_BRAND_PROCESS)
 			{
+				hcl_oop_process_t proc;
+				
 				/* the stack in a process object doesn't need to be 
 				 * scanned in full. the slots above the stack pointer 
 				 * are garbages. */
-				size = HCL_PROCESS_NAMED_INSTVARS + HCL_OOP_TO_SMOOI(((hcl_oop_process_t)oop)->sp) + 1;
+				proc = (hcl_oop_process_t)oop;
-				HCL_ASSERT (hcl, size <= HCL_OBJ_GET_SIZE(oop));
+
+				/* the fixed part */
+				ll = HCL_PROCESS_NAMED_INSTVARS;
+				for (i = 0; i < ll; i++) gc_ms_mark_object (hcl, HCL_OBJ_GET_OOP_VAL(oop, i));
+
+				/* stack */
+				ll = HCL_OOP_TO_SMOOI(proc->sp);
+				HCL_ASSERT (hcl, ll < (hcl_ooi_t)(HCL_OBJ_GET_SIZE(oop) - HCL_PROCESS_NAMED_INSTVARS));
+				for (i = 0; i <= ll; i++) gc_ms_mark_object (hcl, proc->slot[i]);
+				/* exception stack */
+				ll = HCL_OOP_TO_SMOOI(proc->exsp);
+				HCL_ASSERT (hcl, ll < (hcl_ooi_t)(HCL_OBJ_GET_SIZE(oop) - HCL_PROCESS_NAMED_INSTVARS));
+				for (i = HCL_OOP_TO_SMOOI(proc->st) + 1; i <= ll; i++) gc_ms_mark_object (hcl, proc->slot[i]);
+				/* class stack */
+				ll = HCL_OOP_TO_SMOOI(proc->clsp);
+				HCL_ASSERT (hcl, ll < (hcl_ooi_t)(HCL_OBJ_GET_SIZE(oop) - HCL_PROCESS_NAMED_INSTVARS));
+				for (i = HCL_OOP_TO_SMOOI(proc->exst) + 1; i <= ll; i++) gc_ms_mark_object (hcl, proc->slot[i]);
 			}
 			else
 			{
-				size = HCL_OBJ_GET_SIZE(oop);
+				ll = HCL_OBJ_GET_SIZE(oop);
-			}
+				for (i = 0; i < ll; i++) gc_ms_mark_object (hcl, HCL_OBJ_GET_OOP_VAL(oop, i));
-
-			for (i = 0; i < size; i++)
-			{
-				gc_ms_mark_object (hcl, HCL_OBJ_GET_OOP_VAL(oop, i));
 			}
 		}
 	}

lib/hcl-prv.h

@@ -380,6 +380,13 @@ struct hcl_cframe_t
 		{
 			hcl_ooi_t jump_inst_pos;
 		} _break;
+
+		/* COP_COMPILE_CLASS_P1, COP_COMPILE_CLASS_P2 */
+		struct 
+		{
+			hcl_ooi_t nsuperclasses;
+			hcl_ioloc_t start_loc;
+		} _class;
 	} u;
 };
 typedef struct hcl_cframe_t hcl_cframe_t;
@@ -448,7 +455,6 @@ struct hcl_rstl_t
 	hcl_rstl_t* prev;
 };
 
-
 struct hcl_compiler_t
 {
 	/* output handler */

lib/hcl.h

@@ -646,7 +646,7 @@ struct hcl_context_t
 	hcl_oop_t          slot[1]; /* arguments, return variables, local variables, other arguments, etc */
 };
 
-#define HCL_PROCESS_NAMED_INSTVARS 13
+#define HCL_PROCESS_NAMED_INSTVARS 15
 typedef struct hcl_process_t hcl_process_t;
 typedef struct hcl_process_t* hcl_oop_process_t;
 
@@ -666,10 +666,15 @@ struct hcl_process_t
 
 	hcl_oop_t         id; /* SmallInteger */
 	hcl_oop_t         state; /* SmallInteger */
+
 	hcl_oop_t         sp;    /* stack pointer. SmallInteger */
-	hcl_oop_t         ss;    /* process stack size. SmallInteger */
+	hcl_oop_t         st;   /* stack top */
+
 	hcl_oop_t         exsp;  /* exception stack pointer. SmallInteger */
-	hcl_oop_t         exss;  /* exception stack size. SmallInteger */
+	hcl_oop_t         exst; /* exception stack top */
+
+	hcl_oop_t         clsp; /* class stack pointer */
+	hcl_oop_t         clst; /* class stack  top */
 
 	struct
 	{
@@ -1690,7 +1695,7 @@ struct hcl_t
 /* TODO: stack bound check when pushing */
 #define HCL_STACK_PUSH(hcl,v) \
 	do { \
-		if ((hcl)->sp >= HCL_OOP_TO_SMOOI((hcl)->processor->active->ss) - 1) \
+		if ((hcl)->sp >= HCL_OOP_TO_SMOOI((hcl)->processor->active->st)) \
 		{ \
 			hcl_seterrbfmt (hcl, HCL_EOOMEM, "process stack overflow"); \
 			(hcl)->abort_req = -1; \