adding experimental changes for compiler enhancement

hcl/lib/comp.c

@@ -41,6 +41,103 @@ enum
 #define EMIT_SINGLE_PARAM_INSTRUCTION(hcl,code) \
 	do { if (emit_byte_instruction(hcl,code) <= -1) return -1; } while(0)
 
+/* --------------------------------------------
+
+// literal frame is not fully a stack
+// new literal frame => current litera count + 1
+// back one new literal frame => current literal frame index - 1
+
+                                                     <--- code/literal frame #0
+(defun plus(x y)                                     <--- code/literal frame #1
+	(printf "plus %d %d\n" x y)
+	(defun minus(x y)                               <--- code/literal frame #2
+		(printf "minus %d %d\n" x y)              
+		(- x y)
+	)
+	(+ x y)                                         <--- code/literal frame #1
+)
+                                                     <--- code/literal frame #0
+
+(defun dummy(q)                                      <--- code/literal frame #3
+	(printf "%s\n" q)
+)
+                                                     <--- code/literal frame #0
+
+(plus 10 20)
+    <---- minus is now available
+
+(minus 10 1)
+
+//
+// characeter 'A'
+// "string"
+// B"byte string"
+// array ---> #[   ] or [ ] ? constant or not?  dynamic???
+// hash table - dictionary  ---> #{   } or { } <--- ambuguity with blocks...
+// the rest must be manipulated with code...
+
+------------------------------ */
+
+static int acquire_ccl (hcl_t* hcl)
+{
+	hcl_ccl_t* ccl;
+
+	if (hcl->ccl.len >= hcl->ccl.capa)
+	{
+		hcl_ccl_t* tmp;
+
+		tmp = hcl_reallocmem(hcl, hcl->ccl.ptr, hcl->ccl.capa + 32);
+		if (HCL_UNLIKELY(!tmp)) return -1;
+
+		hcl->ccl.capa += 32;
+	}
+
+	ccl = &hcl->ccl.ptr[hcl->ccl.len];
+	HCL_MEMSET (ccl, 0, SIZEOF(*ccl));
+	ccl->pindex = hcl->ccl.index;
+	hcl->ccl.index = hcl->ccl.len++;
+	return 0;
+}
+
+static int release_ccl (hcl_t* hcl)
+{
+	hcl->ccl.index = hcl->ccl.ptr[hcl->ccl.index].pindex;
+}
+
+static void destroy_ccls (hcl_t* hcl)
+{
+	while (hcl->ccl.len > 0)
+	{
+		hcl_ccl_t* ccl = &hcl->ccl.ptr[--hcl->ccl.len];
+
+		if (ccl->bc.ptr) 
+		{
+			hcl_freemem (hcl, ccl->bc.ptr);
+			ccl->bc.ptr = HCL_NULL;
+			ccl->bc.capa = 0;
+			ccl->bc.len = 0;
+		}
+
+		if (ccl->lit.ptr)
+		{
+			while (ccl->lit.len > 0)
+			{
+				hcl_clv_t* clv = &ccl->lit.ptr[--ccl->lit.len];
+				hcl_freemem (hcl, clv);
+			}
+			hcl_freemem (hcl, ccl->lit.ptr);
+			ccl->lit.ptr = HCL_NULL;
+			ccl->lit.capa = 0;
+			ccl->lit.len = 0;
+		}
+	}
+
+	hcl_freemem (hcl, hcl->ccl.ptr);
+	hcl->ccl.ptr = HCL_NULL;
+	hcl->ccl.capa = 0;
+	hcl->ccl.len = 0;
+	hcl->ccl.index = 0;
+}
 
 static int add_literal (hcl_t* hcl, hcl_oop_t obj, hcl_oow_t* index)
 {
@@ -1582,6 +1679,7 @@ static HCL_INLINE int compile_symbol (hcl_t* hcl, hcl_oop_t obj)
 			if (!cons) return -1;
 		}
 
+		/* add the entire cons pair to the literal frame */
 		if (add_literal(hcl, cons, &index) <= -1 ||
 		    emit_single_param_instruction(hcl, HCL_CODE_PUSH_OBJECT_0, index) <= -1) return -1;
 

hcl/lib/hcl.c

@@ -93,42 +93,6 @@ static void free_heap (hcl_t* hcl, void* ptr)
 	hcl_freemem (hcl, ptr);
 }
 
-static int push_code_container (hcl_t* hcl)
-{
-	hcl_code_container_t* cc;
-
-	cc = hcl_callocmem(hcl, HCL_SIZEOF(*cc));
-	if (HCL_UNLIKELY(!cc)) return -1;
-
-	cc->_par = hcl->ccstk;
-	hcl->ccstk = cc;
-
-	return 0;
-}
-
-static void pop_code_container (hcl_t* hcl)
-{
-	hcl_code_container_t* cc = hcl->ccstk;
-
-	if (cc->bc.arr)
-	{
-		hcl_freengcobj (hcl, (hcl_oop_t)cc->bc.arr);
-		cc->bc.arr = HCL_NULL;
-		cc->bc.len = 0;
-	}
-
-	if (cc->lit.arr)
-	{
-		hcl_freengcobj (hcl, (hcl_oop_t)cc->lit.arr);
-		cc->lit.arr = HCL_NULL;
-		cc->lit.len = 0;
-	}
-
-	hcl->ccstk = cc->_par;
-	hcl_freemem (hcl, cc);
-}
-
-
 int hcl_init (hcl_t* hcl, hcl_mmgr_t* mmgr, hcl_oow_t heapsz, const hcl_vmprim_t* vmprim)
 {
 	int modtab_inited = 0;
@@ -196,14 +160,10 @@ int hcl_init (hcl_t* hcl, hcl_mmgr_t* mmgr, hcl_oow_t heapsz, const hcl_vmprim_t
 	hcl->newheap = hcl_makeheap(hcl, heapsz);
 	if (HCL_UNLIKELY(!hcl->newheap)) goto oops;
 
-	n = push_code_container(hcl);
-	if (HCL_UNLIKELY(n <= -1)) goto oops;
-
 	if (hcl->vmprim.dl_startup) hcl->vmprim.dl_startup (hcl);
 	return 0;
 
 oops:
-	if (hcl->ccstk) pop_code_container(hcl);
 	if (hcl->newheap) hcl_killheap (hcl, hcl->newheap);
 	if (hcl->curheap) hcl_killheap (hcl, hcl->curheap);
 	if (hcl->permheap) hcl_killheap (hcl, hcl->permheap);
@@ -295,8 +255,6 @@ void hcl_fini (hcl_t* hcl)
 		hcl->code.lit.len = 0;
 	}
 
-	while (hcl->ccstk) pop_code_container(hcl);
-
 	if (hcl->p.s.ptr)
 	{
 		hcl_freemem (hcl, hcl->p.s.ptr);
@@ -364,12 +322,6 @@ void hcl_reset (hcl_t* hcl)
 	hcl->code.bc.len = 0;
 	hcl->code.lit.len = 0;
 
-	/* keep the base container */
-	HCL_ASSERT (hcl, hcl->ccstk != HCL_NULL);
-	while (hcl->ccstk->_par) pop_code_container(hcl);
-	hcl->ccstk->bc.len = 0;
-	hcl->ccstk->lit.len = 0;
-
 	/* clean up object memory */
 	hcl_gc (hcl);
 }

hcl/lib/hcl.h

@@ -1091,25 +1091,35 @@ typedef struct hcl_compiler_t hcl_compiler_t;
 
 #define HCL_ERRMSG_CAPA (2048)
 
-typedef struct hcl_code_container_t hcl_code_container_t;
+typedef struct hcl_clv_t hcl_clv_t;
-struct hcl_code_container_t
+struct hcl_clv_t /* literal value in compiler */
+{
+
+	int       type; /* int, string, byte string, character, etc */
+	hcl_oow_t size;
+	/* data is placed here */
+};
+
+typedef struct hcl_ccl_t hcl_ccl_t;
+struct hcl_ccl_t /* code and literal in compiler */
 {
 	struct
 	{
-		hcl_oop_byte_t arr; /* byte code array - not part of object memory */
+		hcl_uint8_t* ptr;
+		hcl_oow_t capa;
 		hcl_oow_t len;
 	} bc;
 
 	struct
 	{
-		hcl_oop_oop_t arr; /* literal array - not part of object memory */
+		hcl_clv_t* ptr;
+		hcl_oow_t capa;
 		hcl_oow_t len;
 	} lit;
 
-	hcl_code_container_t* _par;
+	hcl_oow_t pindex;
 };
 
-
 struct hcl_t
 {
 	hcl_oow_t    _instsize;
@@ -1260,8 +1270,28 @@ struct hcl_t
 		} xbuf; /* buffer to support sprintf */
 	} sprintf;
 
-	hcl_code_container_t* ccstk; /* byte-code container stack */
+	struct
-	hcl_code_container_t code; /* byte-code structure generated by compilers */
+	{
+		hcl_ccl_t* ptr;
+		hcl_oow_t capa;
+		hcl_oow_t len;
+		hcl_oow_t index;
+	} ccl;
+
+	struct
+	{
+		struct
+		{
+			hcl_oop_byte_t arr; /* byte code array - not part of object memory */
+			hcl_oow_t len;
+		} bc;
+
+		struct
+		{
+			hcl_oop_oop_t arr; /* literal array - not part of object memory */
+			hcl_oow_t len;
+		} lit;
+	} code;
 
 	/* == PRINTER == */
 	struct