fixed to use hcl-wide temporary buffers when converting an integer to a string

lib/bigint.c

@@ -3953,7 +3953,7 @@ hcl_oop_t hcl_inttostr (hcl_t* hcl, hcl_oop_t num, int radix, int ngc)
 	hcl_liw_t* a, * q, * r;
 	hcl_liw_t* t = HCL_NULL;
 	hcl_ooch_t* xbuf = HCL_NULL;
-	hcl_oow_t xlen = 0, seglen;
+	hcl_oow_t xlen = 0, seglen, reqcapa;
 	hcl_oop_t s;
 
 	HCL_ASSERT (hcl, radix >= 2 && radix <= 36);
@@ -3990,8 +3990,23 @@ hcl_oop_t hcl_inttostr (hcl_t* hcl, hcl_oop_t num, int radix, int ngc)
 		xlen = as * ((HCL_LIW_BITS + exp) / exp) + 1;
 		xpos = xlen;
 
+#if 0
 		xbuf = (hcl_ooch_t*)hcl_allocmem(hcl, HCL_SIZEOF(*xbuf) * xlen);
 		if (!xbuf) return HCL_NULL;
+#else
+		reqcapa = HCL_SIZEOF(*xbuf) * xlen; 
+		if (hcl->inttostr.xbuf.capa < reqcapa)
+		{
+			xbuf = (hcl_ooch_t*)hcl_reallocmem(hcl, hcl->inttostr.xbuf.ptr, reqcapa);
+			if (!xbuf) return HCL_NULL;
+			hcl->inttostr.xbuf.capa = reqcapa;
+			hcl->inttostr.xbuf.ptr = xbuf;
+		}
+		else
+		{
+			xbuf = hcl->inttostr.xbuf.ptr;
+		}
+#endif
 
 		acc = 0;
 		accbits = 0;
@@ -4024,13 +4039,16 @@ hcl_oop_t hcl_inttostr (hcl_t* hcl, hcl_oop_t num, int radix, int ngc)
 		if (HCL_IS_NBIGINT(hcl, num)) xbuf[--xpos] = '-';
 
 		s = hcl_makestring(hcl, &xbuf[xpos], xlen - xpos, ngc);
+#if 0
 		hcl_freemem (hcl, xbuf);
+#endif
 		return s;
 	}
 
 	/* Do it in a hard way for other cases */
 /* TODO: migrate these buffers into hcl_t? */
 /* TODO: find an optimial buffer size */
+#if 0
 	xbuf = (hcl_ooch_t*)hcl_allocmem (hcl, HCL_SIZEOF(*xbuf) * (as * HCL_LIW_BITS + 1));
 	if (!xbuf) return HCL_NULL;
 
@@ -4040,6 +4058,33 @@ hcl_oop_t hcl_inttostr (hcl_t* hcl, hcl_oop_t num, int radix, int ngc)
 		hcl_freemem (hcl, xbuf);
 		return HCL_NULL;
 	}
+#else
+	reqcapa = HCL_SIZEOF(*xbuf) * (as * HCL_LIW_BITS + 1); 
+	if (hcl->inttostr.xbuf.capa < reqcapa)
+	{
+		xbuf = (hcl_ooch_t*)hcl_reallocmem(hcl, hcl->inttostr.xbuf.ptr, reqcapa);
+		if (!xbuf) return HCL_NULL;
+		hcl->inttostr.xbuf.capa = reqcapa;
+		hcl->inttostr.xbuf.ptr = xbuf;
+	}
+	else
+	{
+		xbuf = hcl->inttostr.xbuf.ptr;
+	}
+
+	reqcapa = HCL_SIZEOF(*t) * as * 3;
+	if (hcl->inttostr.t.capa < reqcapa)
+	{
+		t = (hcl_liw_t*)hcl_reallocmem(hcl, hcl->inttostr.t.ptr, reqcapa);
+		if (!t) return HCL_NULL;
+		hcl->inttostr.t.capa = reqcapa;
+		hcl->inttostr.t.ptr = t;
+	}
+	else 
+	{
+		t = hcl->inttostr.t.ptr;
+	}
+#endif
 
 #if (HCL_LIW_BITS == HCL_OOW_BITS)
 	b[0] = hcl->bigint[radix].multiplier; /* block divisor */
@@ -4114,8 +4159,10 @@ hcl_oop_t hcl_inttostr (hcl_t* hcl, hcl_oop_t num, int radix, int ngc)
 	reverse_string (xbuf, xlen);
 	s = hcl_makestring(hcl, xbuf, xlen, ngc);
 
+#if 0
 	hcl_freemem (hcl, t);
 	hcl_freemem (hcl, xbuf);
+#endif
 	return s;
 
 oops_einval:

lib/hcl-prv.h

@@ -1053,14 +1053,6 @@ int hcl_outfmtobj (
 );
 
 
-
-/* TODO: remove debugging functions */
-/* ========================================================================= */
-/* debug.c                                                                   */
-/* ========================================================================= */
-void dump_symbol_table (hcl_t* hcl);
-void dump_dictionary (hcl_t* hcl, hcl_oop_dic_t dic, const char* title);
-
 #if defined(__cplusplus)
 }
 #endif

lib/hcl.c

@@ -230,6 +230,20 @@ void hcl_fini (hcl_t* hcl)
 		hcl->log.capa = 0;
 		hcl->log.len = 0;
 	}
+
+	if (hcl->inttostr.xbuf.ptr)
+	{
+		hcl_freemem (hcl, hcl->inttostr.xbuf.ptr);
+		hcl->inttostr.xbuf.ptr = HCL_NULL;
+		hcl->inttostr.xbuf.capa = 0;
+	}
+
+	if (hcl->inttostr.t.ptr)
+	{
+		hcl_freemem (hcl, hcl->inttostr.t.ptr);
+		hcl->inttostr.t.ptr = HCL_NULL;
+		hcl->inttostr.t.capa = 0;
+	}
 }
 
 int hcl_setoption (hcl_t* hcl, hcl_option_t id, const void* value)

lib/hcl.h

@@ -1010,6 +1010,20 @@ struct hcl_t
 		int safe_ndigits;
 		hcl_oow_t multiplier;
 	} bigint[37];
+
+	struct
+	{
+		struct
+		{
+			hcl_uch_t* ptr;
+			hcl_oow_t capa;
+		} xbuf;
+		struct
+		{
+			hcl_liw_t* ptr;
+			hcl_oow_t capa;
+		} t;
+	} inttostr;
 	/* == END BIGINT CONVERSION == */
 
 	hcl_sbuf_t sbuf[64];
@@ -1165,7 +1179,7 @@ typedef enum hcl_log_mask_t hcl_log_mask_t;
 /* =========================================================================
  * HCL COMMON OBJECTS
  * ========================================================================= */
-enum 
+enum hcl_brand_t
 {
 	HCL_BRAND_NIL = 1,
 	HCL_BRAND_TRUE,
@@ -1190,8 +1204,9 @@ enum
 	HCL_BRAND_PROCESS_SCHEDULER,
 	HCL_BRAND_SEMAPHORE
 };
+typedef enum hcl_brand_t hcl_brand_t;
 
-enum
+enum hcl_syncode_t
 {
 	/* SYNCODE 0 means it's not a syncode object. so it begins with 1 */
 	HCL_SYNCODE_BREAK = 1,
@@ -1206,9 +1221,9 @@ enum
 	HCL_SYNCODE_UNTIL,
 	HCL_SYNCODE_WHILE
 };
+typedef enum hcl_syncode_t hcl_syncode_t;
 
-
+enum hcl_concode_t
-enum
 {
 	/* these can be set in the SYNCODE flags for cons cells */
 	HCL_CONCODE_XLIST = 0,  /* () - executable list */
@@ -1217,6 +1232,7 @@ enum
 	HCL_CONCODE_DIC,        /* #{} */
 	HCL_CONCODE_QLIST       /* '() - quoted list, data list */
 };
+typedef enum hcl_concode_t hcl_concode_t;
 
 #define HCL_IS_NIL(hcl,v) (v == (hcl)->_nil)
 #define HCL_IS_TRUE(hcl,v) (v == (hcl)->_true)