added more code struct manipulation code

bin/main.c

@@ -474,10 +474,17 @@ static hcl_oop_t execute_in_batch_mode(hcl_t* hcl, int verbose)
 /* TESTING */
 #if 0
 {
+	hcl_code_t xcode;
+
+	memset (&xcode, 0, HCL_SIZEOF(xcode));
+
 	xxxlen = 0;
 	hcl_marshalcode(hcl, &hcl->code, clit_writer, HCL_NULL);
 	xxxpos = 0;
-	hcl_unmarshalcode(hcl, &hcl->code, clit_reader, HCL_NULL);
+	hcl_unmarshalcode(hcl, &xcode, clit_reader, HCL_NULL);
+
+	hcl_decode(hcl, &xcode, 0, xcode.bc.len);
+	hcl_purgecode (hcl, &xcode);
 }
 #endif
 /* END TESTING */

lib/comp.c

@@ -490,52 +490,11 @@ ok:
 
 /* ========================================================================= */
 
-static int add_literal (hcl_t* hcl, hcl_oop_t obj, hcl_oow_t* index)
+static HCL_INLINE int add_literal (hcl_t* hcl, hcl_oop_t obj, hcl_oow_t* index)
 {
-	hcl_oow_t capa, i, lfbase = 0;
+	hcl_oow_t lfbase;
-	hcl_oop_t tmp;
-
 	lfbase = (hcl->option.trait & HCL_TRAIT_INTERACTIVE)? hcl->c->fnblk.info[hcl->c->fnblk.depth].lfbase: 0;
-
+	return hcl_addliteral(hcl, &hcl->code, obj, lfbase, index);
-	/* TODO: speed up the following duplicate check loop */
-	for (i = lfbase; i < hcl->code.lit.len; i++)
-	{
-		tmp = ((hcl_oop_oop_t)hcl->code.lit.arr)->slot[i];
-
-		if (tmp == obj)
-		{
-			/* this removes redundancy of symbols, characters, and integers. */
-			if (index) *index = i - lfbase;
-			return 0;
-		}
-		else if (HCL_IS_STRING(hcl, obj) && HCL_IS_STRING(hcl, tmp) && hcl_equalobjs(hcl, obj, tmp))
-		{
-			/* a string object requires equality check. however, the string created to the literal frame
-			 * must be made immutable. non-immutable string literals are source of various problems */
-			if (index) *index = i - lfbase;
-			return 0;
-		}
-	}
-
-	capa = HCL_OBJ_GET_SIZE(hcl->code.lit.arr);
-	if (hcl->code.lit.len >= capa)
-	{
-		hcl_oop_t tmp;
-		hcl_oow_t newcapa;
-
-		newcapa = HCL_ALIGN(capa + 1, HCL_LIT_BUFFER_ALIGN);
-		tmp = hcl_remakengcarray(hcl, (hcl_oop_t)hcl->code.lit.arr, newcapa);
-		if (HCL_UNLIKELY(!tmp)) return -1;
-
-		hcl->code.lit.arr = (hcl_oop_oop_t)tmp;
-	}
-
-	if (index) *index = hcl->code.lit.len - lfbase;
-
-	((hcl_oop_oop_t)hcl->code.lit.arr)->slot[hcl->code.lit.len++] = obj;
-	/* TODO: RDONLY? */
-	/*if (HCL_IS_OOP_POINTER(obj)) HCL_OBJ_SET_FLAGS_RDONLY(obj, 1); */
-	return 0;
 }
 
 /* ========================================================================= */

lib/decode.c

@@ -58,6 +58,7 @@ int hcl_decode (hcl_t* hcl, const hcl_code_t* code, hcl_oow_t start, hcl_oow_t e
 	/* the instruction at the offset 'end' is not decoded.
 	 * decoding offset range is from start to end - 1. */
 
+	if (!code) code = &hcl->code;
 
 	HCL_ASSERT (hcl, start >= 0 && end >= 0);
 	HCL_ASSERT (hcl, code->bc.len < HCL_SMOOI_MAX); /* asserted by the compiler */

lib/gc.c

@@ -847,37 +847,8 @@ int hcl_ignite (hcl_t* hcl, hcl_oow_t heapsize)
 		hcl->sp = HCL_OOP_TO_SMOOI(hcl->processor->active->sp);
 	}
 
-	/* TODO: move code.bc.ptr creation to hcl_init? */
+	/* TODO: move this initialization to hcl_init? */
-	if (!hcl->code.bc.ptr)
+	if (hcl_brewcode(hcl, &hcl->code) <= -1) return -1;
-	{
-		hcl->code.bc.ptr = (hcl_oob_t*)hcl_allocmem(hcl, HCL_SIZEOF(*hcl->code.bc.ptr) * HCL_BC_BUFFER_INIT); /* TODO: set a proper intial size */
-		if (HCL_UNLIKELY(!hcl->code.bc.ptr)) return -1;
-		HCL_ASSERT (hcl, hcl->code.bc.len == 0);
-		hcl->code.bc.capa = HCL_BC_BUFFER_INIT;
-	}
-
-	if (!hcl->code.dbgi)
-	{
-		hcl->code.dbgi = (hcl_dbgi_t*)hcl_allocmem(hcl, HCL_SIZEOF(*hcl->code.dbgi) * HCL_BC_BUFFER_INIT);
-		if (HCL_UNLIKELY(!hcl->code.dbgi))
-		{
-			/* bc.ptr and dbgi go together. so free bc.ptr if dbgi allocation fails */
-			hcl_freemem (hcl, hcl->code.bc.ptr);
-			hcl->code.bc.ptr = HCL_NULL;
-			hcl->code.bc.capa = 0;
-			return -1;
-		}
-
-		HCL_MEMSET (hcl->code.dbgi, 0, HCL_SIZEOF(*hcl->code.dbgi) * HCL_BC_BUFFER_INIT);
-	}
-
-	/* TODO: move code.lit.arr creation to hcl_init() after swithching to hcl_allocmem? */
-	if (!hcl->code.lit.arr)
-	{
-		hcl->code.lit.arr = (hcl_oop_oop_t)hcl_makengcarray(hcl, HCL_LIT_BUFFER_INIT); /* TOOD: set a proper initial size */
-		if (HCL_UNLIKELY(!hcl->code.lit.arr)) return -1;
-		HCL_ASSERT (hcl, hcl->code.lit.len == 0);
-	}
 
 	hcl->p.e = hcl->_nil;
 	return 0;

lib/hcl.c

@@ -257,25 +257,7 @@ void hcl_fini (hcl_t* hcl)
 		hcl->proc_map_free_last = -1;
 	}
 
-	if (hcl->code.dbgi)
+	hcl_purgecode (hcl, &hcl->code);
-	{
-		hcl_freemem (hcl, hcl->code.dbgi);
-		hcl->code.dbgi = HCL_NULL;
-	}
-
-	if (hcl->code.bc.ptr)
-	{
-		hcl_freemem (hcl, hcl->code.bc.ptr);
-		hcl->code.bc.ptr = HCL_NULL;
-		hcl->code.bc.len = 0;
-	}
-
-	if (hcl->code.lit.arr)
-	{
-		hcl_freengcobj (hcl, (hcl_oop_t)hcl->code.lit.arr);
-		hcl->code.lit.arr = HCL_NULL;
-		hcl->code.lit.len = 0;
-	}
 
 	if (hcl->p.s.ptr)
 	{

lib/hcl.h

@@ -2357,6 +2357,28 @@ HCL_EXPORT int hcl_compile (
 );
 #endif
 
+int hcl_addliteral (
+	hcl_t*        hcl,
+	hcl_code_t*   code,
+	hcl_oop_t     obj,
+	hcl_oow_t     lfbase,
+	hcl_oow_t*    index
+);
+
+int hcl_brewcode (
+	hcl_t*      hcl,
+	hcl_code_t* code
+);
+
+/**
+ * The hcl_purgecode() function cleans up the data held in memory
+ * pointed to by \a code.
+ */
+HCL_EXPORT int hcl_purgecode (
+	hcl_t*       hcl,
+	hcl_code_t*  code
+);
+
 /**
  * The hcl_decode() function decodes instructions from the position
  * \a start to the position \a end - 1, and prints the decoded instructions

lib/xchg.c

@@ -260,8 +260,7 @@ int hcl_unmarshalcode (hcl_t* hcl, hcl_code_t* code, hcl_xchg_reader_t rdr, void
 	 *  to avoid this issue.
 	 */
 
-	//TODO: code->lit.len = 0; or lfbase??/
+	if (hcl_brewcode(hcl, code) <= -1) goto oops;
-
 
 	n = rdr(hcl, &h, HCL_SIZEOF(h), ctx);
 	if (n <= -1)
@@ -376,10 +375,10 @@ int hcl_unmarshalcode (hcl_t* hcl, hcl_code_t* code, hcl_xchg_reader_t rdr, void
 						goto oops;
 					}
 
-		HCL_DEBUG4(hcl, "333 nchars %d nbytes %d bcslen %d ucslen %d\n", (int)nchars, (int)nbytes, (int)bcslen, (int)ucslen);
 					HCL_ASSERT(hcl, ucspos < nchars);
 					bcsres = bcslen;
 					ucslen = nchars - ucspos;
+		HCL_DEBUG4(hcl, "333 nchars %d nbytes %d bcslen %d ucslen %d\n", (int)nchars, (int)nbytes, (int)bcslen, (int)ucslen);
 					if (hcl_convbtouchars(hcl, bcsbuf, &bcslen, HCL_OBJ_GET_CHAR_PTR(ns, ucspos), &ucslen) <= -1 && bcslen <= 0)
 					{
 		HCL_DEBUG0(hcl, "EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE\n");
@@ -406,8 +405,7 @@ HCL_DEBUG1(hcl, "RESTORED=>[[%js]]\n", HCL_OBJ_GET_CHAR_SLOT(ns));
 					ns = nc;
 				}
 
-				/* TODO: set ns to the internal literal frame... */
+				if (hcl_addliteral(hcl, code, ns, 0, HCL_NULL) <= -1) goto oops;
-/* TODO: ... add_literal(hcl, code, ns, &) */
 				break;
 			}
 
@@ -446,6 +444,7 @@ HCL_DEBUG1(hcl, "RESTORED=>[[%js]]\n", HCL_OBJ_GET_CHAR_SLOT(ns));
 				}
 
 HCL_DEBUG1(hcl, "RESTORED BIGINT... [%O]\n", ns);
+				if (hcl_addliteral(hcl, code, ns, 0, HCL_NULL) <= -1) goto oops;
 				break;
 			}
 
@@ -513,6 +512,7 @@ HCL_DEBUG1(hcl, "RESTORED v... [%O]\n", v);
 					if (HCL_UNLIKELY(!ns)) goto oops;
 				}
 HCL_DEBUG1(hcl, "RESTORED FPDEC... [%O]\n", ns);
+				if (hcl_addliteral(hcl, code, ns, 0, HCL_NULL) <= -1) goto oops;
 				break;
 			}
 
@@ -527,3 +527,112 @@ HCL_DEBUG1(hcl, "RESTORED FPDEC... [%O]\n", ns);
 oops:
 	return -1;
 }
+
+int hcl_brewcode (hcl_t* hcl, hcl_code_t* code)
+{
+	if (!code->bc.ptr)
+	{
+		code->bc.ptr = (hcl_oob_t*)hcl_allocmem(hcl, HCL_SIZEOF(*code->bc.ptr) * HCL_BC_BUFFER_INIT); /* TODO: set a proper intial size */
+		if (HCL_UNLIKELY(!code->bc.ptr)) return -1;
+		HCL_ASSERT (hcl, code->bc.len == 0);
+		code->bc.capa = HCL_BC_BUFFER_INIT;
+	}
+
+	if (!code->dbgi)
+	{
+		code->dbgi = (hcl_dbgi_t*)hcl_allocmem(hcl, HCL_SIZEOF(*code->dbgi) * HCL_BC_BUFFER_INIT);
+		if (HCL_UNLIKELY(!code->dbgi))
+		{
+			/* bc.ptr and dbgi go together. so free bc.ptr if dbgi allocation fails */
+			hcl_freemem (hcl, code->bc.ptr);
+			code->bc.ptr = HCL_NULL;
+			code->bc.len = 0;
+			code->bc.capa = 0;
+			return -1;
+		}
+
+		HCL_MEMSET (code->dbgi, 0, HCL_SIZEOF(*code->dbgi) * HCL_BC_BUFFER_INIT);
+	}
+
+	/* TODO: move code.lit.arr creation to hcl_init() after swithching to hcl_allocmem? */
+        if (!code->lit.arr)
+        {
+                code->lit.arr = (hcl_oop_oop_t)hcl_makengcarray(hcl, HCL_LIT_BUFFER_INIT); /* TOOD: set a proper initial size */
+                if (HCL_UNLIKELY(!code->lit.arr)) return -1;
+                HCL_ASSERT (hcl, code->lit.len == 0);
+        }
+
+	return 0;
+}
+
+int hcl_purgecode (hcl_t* hcl, hcl_code_t* code)
+{
+	if (code->dbgi)
+        {
+		hcl_freemem (hcl, code->dbgi);
+		code->dbgi = HCL_NULL;
+        }
+
+	if (code->bc.ptr)
+	{
+		hcl_freemem (hcl, code->bc.ptr);
+		code->bc.ptr = HCL_NULL;
+		code->bc.len = 0;
+		code->bc.capa = 0;
+	}
+
+	if (code->lit.arr)
+	{
+		hcl_freengcobj (hcl, (hcl_oop_t)code->lit.arr);
+		code->lit.arr = HCL_NULL;
+		code->lit.len = 0;
+	}
+
+	HCL_MEMSET (&code, 0, HCL_SIZEOF(code));
+}
+
+int hcl_addliteral (hcl_t* hcl, hcl_code_t* code, hcl_oop_t obj, hcl_oow_t lfbase, hcl_oow_t* index)
+{
+	hcl_oow_t capa, i;
+	hcl_oop_t tmp;
+
+	/* TODO: speed up the following duplicate check loop */
+	for (i = lfbase; i < code->lit.len; i++)
+	{
+		tmp = ((hcl_oop_oop_t)code->lit.arr)->slot[i];
+
+		if (tmp == obj)
+		{
+			/* this removes redundancy of symbols, characters, and integers. */
+			if (index) *index = i - lfbase;
+			return 0;
+		}
+		else if (HCL_IS_STRING(hcl, obj) && HCL_IS_STRING(hcl, tmp) && hcl_equalobjs(hcl, obj, tmp))
+		{
+			/* a string object requires equality check. however, the string created to the literal frame
+			 * must be made immutable. non-immutable string literals are source of various problems */
+			if (index) *index = i - lfbase;
+			return 0;
+		}
+	}
+
+	capa = HCL_OBJ_GET_SIZE(code->lit.arr);
+	if (code->lit.len >= capa)
+	{
+		hcl_oop_t tmp;
+		hcl_oow_t newcapa;
+
+		newcapa = HCL_ALIGN(capa + 1, HCL_LIT_BUFFER_ALIGN);
+		tmp = hcl_remakengcarray(hcl, (hcl_oop_t)code->lit.arr, newcapa);
+		if (HCL_UNLIKELY(!tmp)) return -1;
+
+		code->lit.arr = (hcl_oop_oop_t)tmp;
+	}
+
+	if (index) *index = code->lit.len - lfbase;
+
+	((hcl_oop_oop_t)code->lit.arr)->slot[code->lit.len++] = obj;
+	/* TODO: RDONLY? */
+	/*if (HCL_IS_OOP_POINTER(obj)) HCL_OBJ_SET_FLAGS_RDONLY(obj, 1); */
+	return 0;
+}