making a useless commit

hcl/lib/comp.c

@@ -820,6 +820,52 @@ static void pop_cblk (hcl_t* hcl)
 	hcl->c->cblk.depth--;
 }
 
+
+static int push_clsblk (hcl_t* hcl, const hcl_ioloc_t* errloc, hcl_oow_t nivars, hcl_oow_t ncvars)
+{
+	hcl_oow_t new_depth;
+
+	HCL_ASSERT (hcl, hcl->c->clsblk.depth >= -1);
+
+	if (hcl->c->clsblk.depth == HCL_TYPE_MAX(hcl_ooi_t))
+	{
+		hcl_setsynerrbfmt (hcl, HCL_SYNERR_BLKDEPTH, errloc, HCL_NULL, "class block depth too deep"); 
+		return -1;
+	}
+
+	new_depth = hcl->c->clsblk.depth + 1;
+	if (hcl->c->clsblk.depth >= hcl->c->clsblk.info_capa)
+	{
+		hcl_clsblk_info_t* tmp;
+		hcl_oow_t newcapa;
+
+		newcapa = HCL_ALIGN(new_depth + 1, BLK_INFO_BUFFER_ALIGN);
+		tmp = (hcl_clsblk_info_t*)hcl_reallocmem(hcl, hcl->c->clsblk.info, newcapa * HCL_SIZEOF(*tmp));
+		if (HCL_UNLIKELY(!tmp)) return -1;
+		
+		hcl->c->clsblk.info_capa = newcapa;
+		hcl->c->clsblk.info = tmp;
+	}
+
+	HCL_MEMSET (&hcl->c->clsblk.info[new_depth], 0, HCL_SIZEOF(hcl->c->clsblk.info[new_depth]));
+	hcl->c->clsblk.info[new_depth].nivars = nivars;
+	hcl->c->clsblk.info[new_depth].ncvars = ncvars;
+
+	/* remember the function block depth before the class block is entered */
+	hcl->c->clsblk.info[new_depth].fnblk_base = hcl->c->fnblk.depth; 
+
+	hcl->c->clsblk.depth = new_depth;
+	return 0;
+}
+
+static void pop_clsblk (hcl_t* hcl)
+{
+	HCL_ASSERT (hcl, hcl->c->clsblk.depth >= 0);
+	
+	HCL_ASSERT (hcl, hcl->c->clsblk.depth - 1 >= hcl->c->clsblk.info[hcl->c->clsblk.depth].fnblk_base);
+	hcl->c->clsblk.depth--;
+}
+
 /* ========================================================================= */
 static HCL_INLINE int _insert_cframe (hcl_t* hcl, hcl_ooi_t index, int opcode, hcl_cnode_t* operand)
 {
@@ -1701,6 +1747,8 @@ printf ("22222222222\n");
 		obj = HCL_CNODE_CONS_CDR(obj);
 	}
 
+	if (push_clsblk(hcl, XXXX, 0, 0) <= -1) return -1;
+
 	/* TODO: emit make_class code...
 	*/
 
@@ -1719,9 +1767,9 @@ static HCL_INLINE int post_class (hcl_t* hcl)
 	cf = GET_TOP_CFRAME(hcl);
 	HCL_ASSERT (hcl, cf->opcode == COP_POST_CLASS);
 
-#if 0
+	pop_clsblk (hcl);
-	pop_fnblk (hcl); TODO: do pop class???
 
+#if 0
 	if (cf->operand)
 	{
 		/* (defun x()  ; this x refers to a variable in the outer scope.
@@ -4224,9 +4272,10 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj, int flags)
 		HCL_ASSERT (hcl, hcl->c->tv.s.len == 0);
 		HCL_ASSERT (hcl, hcl->c->tv.wcount == 0);
 
-/* TODO: HCL_TYPE_MAX(hcl_oow_t) as make_inst_pos is wrong for this top-level. fix it later ... 
+		/* keep a virtual function block for the top-level compilation.
- * fixing it is needed to support exception variable at the top-level... */
+		 * pass HCL_TYPE_MAX(hcl_oow_t) as make_inst_pos because there is 
-		/* keep a virtual function block for the top-level compilation */
+		 * no actual MAKE_BLOCK/MAKE_FUNCTION instruction which otherwise
+		 * would be patched in pop_fnblk(). */
 		if (push_fnblk(hcl, HCL_NULL, 0, 0, 0, hcl->c->tv.wcount, hcl->c->tv.wcount, hcl->c->tv.s.len, HCL_TYPE_MAX(hcl_oow_t), 0) <= -1) return -1;
 	}
 	top_fnblk_saved = hcl->c->fnblk.info[0];
@@ -4445,6 +4494,7 @@ oops:
 	hcl->c->tv.s.len = 0;
 	hcl->c->tv.wcount = 0;
 	hcl->c->cblk.depth = -1;
+	hcl->c->clsblk.depth = -1;
 
 	/*hcl->c->fnblk.depth = -1;*/
 	if (hcl->c->fnblk.depth > 0) 

hcl/lib/hcl-prv.h

@@ -391,14 +391,14 @@ enum hcl_cblk_type_t
 };
 typedef enum hcl_cblk_type_t hcl_cblk_type_t;
 
-/* control block information */
+/* control block information for the compiler */
 struct hcl_cblk_info_t
 {
 	hcl_cblk_type_t _type;
 };
 typedef struct hcl_cblk_info_t hcl_cblk_info_t;
 
-/* function block information */
+/* function block information for the compiler */
 struct hcl_fnblk_info_t
 {
 	hcl_oow_t tmprlen; /* accumulated length of the temporaries string including outer blocks */
@@ -419,8 +419,22 @@ struct hcl_fnblk_info_t
 };
 typedef struct hcl_fnblk_info_t hcl_fnblk_info_t;
 
+/* class block information for the compiler */
+
+struct hcl_clsblk_info_t
+{
+	hcl_oow_t nivars;
+	hcl_oow_t ncvars;
+	hcl_oow_t spec; /* TODO: byte indexed, word indexed? */
+
+	hcl_ooi_t fnblk_base;
+};
+typedef struct hcl_clsblk_info_t hcl_clsblk_info_t;
+
+
+/* reader stack for list reading */
 typedef struct hcl_rstl_t hcl_rstl_t;
-struct hcl_rstl_t /* reader stack for list reading */
+struct hcl_rstl_t 
 {
 	hcl_cnode_t* head;
 	hcl_cnode_t* tail;
@@ -430,6 +444,7 @@ struct hcl_rstl_t /* reader stack for list reading */
 	hcl_rstl_t* prev;
 };
 
+
 struct hcl_compiler_t
 {
 	/* output handler */
@@ -504,6 +519,13 @@ struct hcl_compiler_t
 		hcl_fnblk_info_t* info;
 		hcl_oow_t  info_capa;
 	} fnblk; /* lambda/function block */
+
+	struct
+	{
+		hcl_ooi_t depth; /* signed because it starts with -1 */
+		hcl_clsblk_info_t* info;
+		hcl_oow_t info_capa;
+	} clsblk; /* class block */
 };
 #endif
 

hcl/lib/read.c

@@ -2205,6 +2205,15 @@ static void fini_compiler (hcl_t* hcl)
 			hcl->c->cblk.info_capa = 0;
 			hcl->c->cblk.depth = -1;
 		}
+
+		if (hcl->c->clsblk.info)
+		{
+			hcl_freemem (hcl, hcl->c->clsblk.info);
+			hcl->c->clsblk.info = HCL_NULL;
+			hcl->c->clsblk.info_capa = 0;
+			hcl->c->clsblk.depth = -1;
+		}
+
 		if (hcl->c->fnblk.info)
 		{
 			hcl_freemem (hcl, hcl->c->fnblk.info);
@@ -2259,6 +2268,7 @@ int hcl_attachio (hcl_t* hcl, hcl_ioimpl_t reader, hcl_ioimpl_t printer)
 
 		hcl->c->cfs.top = -1;
 		hcl->c->cblk.depth = -1;
+		hcl->c->clsblk.depth = -1;
 		hcl->c->fnblk.depth = -1;
 	}
 	else if (hcl->c->reader || hcl->c->printer)