diff --git a/bin/main.c b/bin/main.c index cc84b54..14e6f92 100644 --- a/bin/main.c +++ b/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 */ diff --git a/lib/comp.c b/lib/comp.c index cda08b7..07b0098 100644 --- a/lib/comp.c +++ b/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_oop_t tmp; - + hcl_oow_t lfbase; lfbase = (hcl->option.trait & HCL_TRAIT_INTERACTIVE)? hcl->c->fnblk.info[hcl->c->fnblk.depth].lfbase: 0; - - /* 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; + return hcl_addliteral(hcl, &hcl->code, obj, lfbase, index); } /* ========================================================================= */ diff --git a/lib/decode.c b/lib/decode.c index 58ed0f9..eea30d0 100644 --- a/lib/decode.c +++ b/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 */ diff --git a/lib/gc.c b/lib/gc.c index 03476d9..aab2215 100644 --- a/lib/gc.c +++ b/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? */ - if (!hcl->code.bc.ptr) - { - 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); - } + /* TODO: move this initialization to hcl_init? */ + if (hcl_brewcode(hcl, &hcl->code) <= -1) return -1; hcl->p.e = hcl->_nil; return 0; diff --git a/lib/hcl.c b/lib/hcl.c index 99eb4bf..ef5e6e5 100644 --- a/lib/hcl.c +++ b/lib/hcl.c @@ -257,25 +257,7 @@ void hcl_fini (hcl_t* hcl) hcl->proc_map_free_last = -1; } - if (hcl->code.dbgi) - { - 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; - } + hcl_purgecode (hcl, &hcl->code); if (hcl->p.s.ptr) { diff --git a/lib/hcl.h b/lib/hcl.h index 1240e47..a442e01 100644 --- a/lib/hcl.h +++ b/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 diff --git a/lib/xchg.c b/lib/xchg.c index 4a401cd..141f2b9 100644 --- a/lib/xchg.c +++ b/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... */ -/* TODO: ... add_literal(hcl, code, ns, &) */ + if (hcl_addliteral(hcl, code, ns, 0, HCL_NULL) <= -1) goto oops; 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; +}