hyung-hwan/hak
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
Files
main
hak/lib/xchg.c
hyung-hwan 20d2db0e27 renamed hcl to hak
2025-09-02 23:58:15 +09:00

764 lines
20 KiB
C
Raw Permalink Blame History

/*
Copyright (c) 2016-2018 Chung, Hyung-Hwan. All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
#include "hak-prv.h"
/* compiler's literal representation */
#include <hak-pac1.h>
struct hak_xchg_hdr_t
{
hak_uint8_t ver;
hak_uint8_t oow_size;
};
typedef struct hak_xchg_hdr_t hak_xchg_hdr_t;
#include <hak-upac.h>
enum hak_xchg_type_t
{
/* byte code */
HAK_XCHG_BC = 0x00,
/* literals */
HAK_XCHG_STRING_U,
HAK_XCHG_STRING_B,
HAK_XCHG_SYMLIT_U, /* literal symbol */
HAK_XCHG_SYMLIT_B, /* literal symbol */
HAK_XCHG_SYMBOL_U, /* contained in a cons cell */
HAK_XCHG_SYMBOL_B, /* contained in a cons cell */
HAK_XCHG_SMOOI,
HAK_XCHG_PBIGINT,
HAK_XCHG_NBIGINT,
HAK_XCHG_FPDEC_1, /* smooi + smooi */
HAK_XCHG_FPDEC_2, /* pbigint + smooi */
HAK_XCHG_FPDEC_3, /* nbigint + smooi */
HAK_XCHG_PRIM,
/* end marker */
HAK_XCHG_END =0xFF /* end marker. not a real literal type */
};
typedef enum hak_xchg_type_t hak_xchg_type_t;
/* -------------------------------------------------------------------- */
int hak_marshalcode (hak_t* hak, const hak_code_t* code, hak_xchg_writer_t wrtr, void* ctx)
{
hak_oow_t i, lfbase = 0;
hak_oop_t tmp;
hak_oop_class_t _class;
int brand;
hak_oow_t tsize;
hak_uint8_t b;
hak_oow_t w;
hak_xchg_hdr_t h;
lfbase = (hak->option.trait & HAK_TRAIT_INTERACTIVE)? hak->c->funblk.info[hak->c->funblk.depth].lfbase: 0;
/* start with a header */
h.ver = 1;
h.oow_size = (hak_uint8_t)HAK_SIZEOF(hak_oow_t); /* the size must not exceed 256 */
if (wrtr(hak, &h, HAK_SIZEOF(h), ctx) <= -1) goto oops;
/* write the byte-code */
b = HAK_XCHG_BC;
if (wrtr(hak, &b, HAK_SIZEOF(b), ctx) <= -1) goto oops;
w = hak_htoleoow(code->bc.len);
if (wrtr(hak, &w, HAK_SIZEOF(w), ctx) <= -1) goto oops;
if (wrtr(hak, code->bc.ptr, code->bc.len, ctx) <= -1) goto oops;
/* write actual literals */
for (i = lfbase; i < code->lit.len; i++)
{
tmp = ((hak_oop_oop_t)code->lit.arr)->slot[i];
if (HAK_OOP_IS_SMOOI(tmp))
{
b = HAK_XCHG_SMOOI;
if (wrtr(hak, &b, HAK_SIZEOF(b), ctx) <= -1) goto oops;
w = hak_htoleoow((hak_oow_t)HAK_OOP_TO_SMOOI(tmp));
if (wrtr(hak, &w, HAK_SIZEOF(w), ctx) <= -1) goto oops;
continue;
}
_class = (hak_oop_class_t)HAK_CLASSOF(hak, tmp);
brand = HAK_OOP_TO_SMOOI(_class->ibrand);
tsize = HAK_OBJ_GET_SIZE(tmp);
switch (brand)
{
case HAK_BRAND_PBIGINT:
case HAK_BRAND_NBIGINT:
{
hak_oow_t nbytes;
hak_oow_t j;
hak_liw_t liw;
/* write the brand */
b = (brand == HAK_BRAND_PBIGINT ? HAK_XCHG_PBIGINT : HAK_XCHG_NBIGINT);
if (wrtr(hak, &b, HAK_SIZEOF(b), ctx) <= -1) goto oops;
bigint_body:
/* write the number of bytes in the little-endian */
nbytes = tsize * HAK_SIZEOF(hak_liw_t);
w = hak_htoleoow(nbytes);
if (wrtr(hak, &w, HAK_SIZEOF(w), ctx) <= -1) goto oops;
for (j = 0; j < tsize; j++)
{
liw = HAK_OBJ_GET_LIWORD_VAL(tmp, j);
liw = hak_htoleliw(liw);
if (wrtr(hak, &liw, HAK_SIZEOF(liw), ctx) <= -1) goto oops;
}
break;
}
case HAK_BRAND_FPDEC:
{
hak_oop_fpdec_t f;
f = (hak_oop_fpdec_t)tmp;
HAK_ASSERT (hak, HAK_OOP_IS_SMOOI(f->scale));
HAK_ASSERT(hak, HAK_OOP_IS_SMOOI(f->value) || HAK_OOP_IS_POINTER(f->value));
/* write 1-byte brand */
if (HAK_OOP_IS_SMOOI(f->value)) b = HAK_XCHG_FPDEC_1;
else if (HAK_IS_PBIGINT(hak, f->value)) b = HAK_XCHG_FPDEC_2;
else
{
HAK_ASSERT(hak, HAK_IS_NBIGINT(hak, f->value));
b = HAK_XCHG_FPDEC_2;
}
if (wrtr(hak, &b, HAK_SIZEOF(b), ctx) <= -1) goto oops;
/* cast the scale part from hak_ooi_t to hak_oow_t and write it */
w = hak_htoleoow((hak_oow_t)HAK_OOP_TO_SMOOI(f->scale));
if (wrtr(hak, &w, HAK_SIZEOF(w), ctx) <= -1) goto oops;
/* write the value part */
if (b == HAK_XCHG_FPDEC_1)
{
w = hak_htoleoow((hak_oow_t)HAK_OOP_TO_SMOOI(f->value));
if (wrtr(hak, &w, HAK_SIZEOF(w), ctx) <= -1) goto oops;
}
else
{
tmp = f->value;
tsize = HAK_OBJ_GET_SIZE(tmp);
goto bigint_body;
}
break;
}
case HAK_BRAND_CONS:
{
/* write 1-byte brand */
#if defined(HAK_OOCH_IS_UCH)
b = (hak_uint8_t)HAK_XCHG_SYMBOL_U;
#else
b = (hak_uint8_t)HAK_XCHG_SYMBOL_B;
#endif
if (wrtr(hak, &b, HAK_SIZEOF(b), ctx) <= -1) goto oops;
/* get the symbol at CAR and make it as if it is the current object processed.*/
tmp = HAK_CONS_CAR(tmp);
tsize = HAK_OBJ_GET_SIZE(tmp);
HAK_ASSERT(hak, HAK_CLASSOF(hak, tmp) == (hak_oop_t)hak->c_symbol);
goto string_body;
}
case HAK_BRAND_STRING:
case HAK_BRAND_SYMBOL:
{
#if defined(HAK_OOCH_IS_UCH)
hak_uch_t* ucsptr;
hak_oow_t ucspos, ucslen;
hak_bch_t bcsbuf[128];
hak_oow_t bcslen;
int n;
/* write 1-byte brand */
b = (hak_uint8_t)(brand == HAK_BRAND_STRING? HAK_XCHG_STRING_U: HAK_XCHG_SYMLIT_U);
if (wrtr(hak, &b, HAK_SIZEOF(b), ctx) <= -1) goto oops;
string_body:
ucsptr = HAK_OBJ_GET_CHAR_SLOT(tmp);
ucslen = tsize;
if (hak_convutobchars(hak, ucsptr, &ucslen, HAK_NULL, &bcslen) <= -1) goto oops;
/* write the number of characters in the little endian */
w = hak_htoleoow(tsize);
if (wrtr(hak, &w, HAK_SIZEOF(w), ctx) <= -1) goto oops;
/* write the number of bytes in the little endian */
w = hak_htoleoow(bcslen);
if (wrtr(hak, &w, HAK_SIZEOF(w), ctx) <= -1) goto oops;
/* write string in bytess and write to the callback.*/
ucspos = 0;
while (ucspos < tsize)
{
bcslen = HAK_COUNTOF(bcsbuf);
ucslen = tsize - ucspos;
n = hak_convutobchars(hak, &ucsptr[ucspos], &ucslen, bcsbuf, &bcslen);
if (n <= -1 && bcslen == 0) goto oops;
if (wrtr(hak, bcsbuf, bcslen, ctx) <= -1) goto oops;
ucspos += ucslen;
}
#else
/* write 1-byte brand */
if (wrtr(hak, &b, HAK_SIZEOF(b), ctx) <= -1) goto oops;
string_body:
w = hak_htoleoow(tsize);
if (wrtr(hak, &w, HAK_SIZEOF(w), ctx) <= -1) goto oops;
if (wrtr(hak, HAK_OBJ_GET_CHAR_SLOT(tmp), tsize, ctx) <= -1) goto oops;
#endif
break;
}
case HAK_BRAND_PRIM:
/* TODO: can't have resolved pointer... need module name and the functio name??? */
break;
}
}
b = HAK_XCHG_END;
if (wrtr(hak, &b, HAK_SIZEOF(b), ctx) <= -1) goto oops;
return 0;
oops:
return -1;
}
/* -------------------------------------------------------------------- */
static void set_rdr_ioerr (hak_t* hak, const hak_bch_t* msg)
{
const hak_ooch_t* orgmsg = hak_backuperrmsg(hak);
hak_seterrbfmt(hak, HAK_EIOERR, "%hs - %js", orgmsg);
}
int hak_unmarshalcode (hak_t* hak, hak_code_t* code, hak_xchg_reader_t rdr, void* ctx)
{
int n;
hak_xchg_hdr_t h;
hak_uint8_t b;
hak_oow_t w;
hak_uch_t* usym_buf = HAK_NULL;
hak_oow_t usym_buf_capa = 0;
/* [NOTE]
* this function may pollute the code data when it fails because it doesn't
* roll back changed made to the memory pointed to by 'code'. the caller side
* may use two code structs. and switch between them for each call to hak_unmarshalcode()
* to avoid this issue.
*/
if (hak_brewcode(hak, code) <= -1) goto oops;
n = rdr(hak, &h, HAK_SIZEOF(h), ctx);
if (n <= -1)
{
set_rdr_ioerr(hak, "erroneous or insufficient header");
goto oops;
}
if (h.ver != 1)
{
hak_seterrbfmt(hak, HAK_EIOERR, "unsupported header version %d", (int)h.ver);
goto oops;
}
if (h.oow_size != HAK_SIZEOF(hak_oow_t))
{
/* no support for cross-architecture exchange yet */
hak_seterrbfmt(hak, HAK_EIOERR, "unsupported word size %d", (int)h.oow_size);
goto oops;
}
while (1)
{
/* read 1-byte brand */
n = rdr(hak, &b, HAK_SIZEOF(b), ctx);
if (n <= -1)
{
set_rdr_ioerr(hak, "erroneous or insufficient record type");
goto oops;
}
if (b == HAK_XCHG_END) break;
switch (b)
{
case HAK_XCHG_BC:
{
hak_oow_t nbytes;
/* this must appear only once but never mind about multiple occurrences */
n = rdr(hak, &w, HAK_SIZEOF(w), ctx);
if (n <= -1)
{
set_rdr_ioerr(hak, "erroneous or insufficient record length");
goto oops;
}
nbytes = hak_leoowtoh(w);
if (nbytes > code->bc.capa)
{
/* grow the buffer */
hak_oow_t newcapa;
hak_oob_t* newptr;
newcapa = nbytes;
if (HAK_UNLIKELY(newcapa <= 0)) newcapa++;
newcapa = HAK_ALIGN(newcapa, HAK_BC_BUFFER_ALIGN);
newptr = (hak_oob_t*)hak_reallocmem(hak, code->bc.ptr, newcapa);
if (HAK_UNLIKELY(!newptr)) goto oops;
code->bc.ptr = newptr;
code->bc.capa = newcapa;
}
n = rdr(hak, code->bc.ptr, nbytes, ctx);
if (n <= -1) goto oops;
code->bc.len = nbytes;
break;
}
case HAK_XCHG_STRING_U:
case HAK_XCHG_SYMLIT_U:
case HAK_XCHG_SYMBOL_U:
{
hak_bch_t bcsbuf[64];
hak_uch_t* ucsptr;
hak_oow_t bcslen, bcsres, ucslen, ucspos;
hak_oow_t nbytes, nchars;
hak_oop_t ns;
n = rdr(hak, &w, HAK_SIZEOF(w), ctx);
if (n <= -1)
{
set_rdr_ioerr(hak, "erroneous or insufficient record length");
goto oops;
}
nchars = hak_leoowtoh(w);
n = rdr(hak, &w, HAK_SIZEOF(w), ctx);
if (n <= -1)
{
set_rdr_ioerr(hak, "erroneous or insufficient record length");
goto oops;
}
nbytes = hak_leoowtoh(w);
if (b == HAK_XCHG_STRING_U)
{
ns = hak_makestring(hak, HAK_NULL, nchars);
if (HAK_UNLIKELY(!ns)) goto oops;
ucsptr = HAK_OBJ_GET_CHAR_PTR(ns, 0);
}
else
{
if (nchars > usym_buf_capa)
{
usym_buf_capa = nchars * HAK_SIZEOF(usym_buf[0]);
usym_buf = (hak_uch_t*)hak_allocmem(hak, usym_buf_capa);
if (HAK_UNLIKELY(!usym_buf)) goto oops;
}
ucsptr = usym_buf;
}
ucspos = 0;
bcsres = 0;
while (nbytes > 0)
{
bcslen = nbytes <= HAK_SIZEOF(bcsbuf)? nbytes : HAK_SIZEOF(bcsbuf);
n = rdr(hak, &bcsbuf[bcsres], bcslen - bcsres, ctx);
if (n <= -1)
{
set_rdr_ioerr(hak, "erroneous or insufficient record data");
goto oops;
}
HAK_ASSERT(hak, ucspos < nchars);
bcsres = bcslen;
ucslen = nchars - ucspos;
if (hak_convbtouchars(hak, bcsbuf, &bcslen, &ucsptr[ucspos], &ucslen) <= -1 && bcslen <= 0)
{
goto oops;
}
ucspos += ucslen;
nbytes -= bcslen;
bcsres -= bcslen;
if (bcsres > 0) HAK_MEMMOVE(bcsbuf, &bcsbuf[bcslen], bcsres);
}
HAK_ASSERT(hak, ucspos == nchars);
if (b != HAK_XCHG_STRING_U)
{
ns = hak_makesymbol(hak, usym_buf, nchars);
if (HAK_UNLIKELY(!ns)) goto oops;
if (b == HAK_XCHG_SYMBOL_U)
{
/* form a cons cell */
hak_oop_t nc;
hak_pushvolat(hak, &ns);
nc = hak_makecons(hak, ns, hak->_nil);
hak_popvolat(hak);
if (HAK_UNLIKELY(!nc)) goto oops;
ns = nc;
}
}
if (hak_addliteraltocode(hak, code, ns, 0, HAK_NULL) <= -1) goto oops;
break;
}
case HAK_XCHG_STRING_B:
case HAK_XCHG_SYMBOL_B:
/* TODO */
break;
case HAK_XCHG_SMOOI:
{
hak_oop_t ns;
if (rdr(hak, &w, HAK_SIZEOF(w), ctx) <= -1) goto oops;
w = hak_leoowtoh(w);
ns = HAK_SMOOI_TO_OOP((hak_ooi_t)w);
if (hak_addliteraltocode(hak, code, ns, 0, HAK_NULL) <= -1) goto oops;
break;
}
case HAK_XCHG_PBIGINT:
case HAK_XCHG_NBIGINT:
{
hak_oow_t nbytes, nwords, j;
hak_liw_t liw;
hak_oop_t ns;
n = rdr(hak, &w, HAK_SIZEOF(w), ctx);
if (n <= -1)
{
set_rdr_ioerr(hak, "erroneous or insufficient bigint length");
goto oops;
}
nbytes = hak_leoowtoh(w);
if (nbytes % HAK_SIZEOF(hak_liw_t)) goto oops; /* not the right number of bytes */
nwords = nbytes / HAK_SIZEOF(hak_liw_t);
ns = hak_instantiate(hak, ((b == HAK_XCHG_PBIGINT)? hak->c_large_positive_integer: hak->c_large_negative_integer), HAK_NULL, nwords);
if (HAK_UNLIKELY(!ns)) goto oops;
for (j = 0; j < nwords; j ++)
{
if (rdr(hak, &liw, HAK_SIZEOF(liw), ctx) <= -1) goto oops;
liw = hak_leliwtoh(liw);
HAK_OBJ_SET_LIWORD_VAL(ns, j, liw);
}
if (hak_addliteraltocode(hak, code, ns, 0, HAK_NULL) <= -1) goto oops;
break;
}
case HAK_XCHG_FPDEC_1:
case HAK_XCHG_FPDEC_2:
case HAK_XCHG_FPDEC_3:
{
hak_ooi_t scale;
hak_oop_t ns;
/* read scale */
n = rdr(hak, &w, HAK_SIZEOF(w), ctx);
if (n <= -1)
{
set_rdr_ioerr(hak, "erroneous or insufficient record length");
goto oops;
}
scale = (hak_ooi_t)hak_leoowtoh(w);
if (b == HAK_XCHG_FPDEC_1)
{
hak_ooi_t value;
n = rdr(hak, &w, HAK_SIZEOF(w), ctx);
if (n <= -1)
{
set_rdr_ioerr(hak, "erroneous or insufficient record length");
goto oops;
}
value = (hak_ooi_t)hak_leoowtoh(w);
ns = hak_makefpdec(hak, HAK_SMOOI_TO_OOP(value), scale);
if (HAK_UNLIKELY(!ns)) goto oops;
}
else
{
hak_oow_t j, nbytes, nwords;
hak_liw_t liw;
hak_oop_t v;
n = rdr(hak, &w, HAK_SIZEOF(w), ctx);
if (n <= -1)
{
set_rdr_ioerr(hak, "erroneous or insufficient record length");
goto oops;
}
nbytes = hak_leoowtoh(w);
if (nbytes % HAK_SIZEOF(hak_liw_t)) goto oops; /* not the right number of bytes */
nwords = nbytes / HAK_SIZEOF(hak_liw_t);
v = hak_instantiate(hak, ((b == HAK_XCHG_FPDEC_2) ? hak->c_large_positive_integer : hak->c_large_negative_integer), HAK_NULL, nwords);
if (HAK_UNLIKELY(!v)) goto oops;
for (j = 0; j < nwords; j++)
{
if (rdr(hak, &liw, HAK_SIZEOF(liw), ctx) <= -1) goto oops;
liw = hak_leliwtoh(liw);
HAK_OBJ_SET_LIWORD_VAL(v, j, liw);
}
hak_pushvolat (hak, &v);
ns = hak_makefpdec(hak, v, scale);
hak_popvolat (hak);
if (HAK_UNLIKELY(!ns)) goto oops;
}
if (hak_addliteraltocode(hak, code, ns, 0, HAK_NULL) <= -1) goto oops;
break;
}
case HAK_XCHG_PRIM:
/* TODO: */
break;
}
}
return 0;
oops:
if (usym_buf) hak_freemem (hak, usym_buf);
return -1;
}
/* -------------------------------------------------------------------- */
static int mem_code_writer (hak_t* hak, const void* ptr, hak_oow_t len, void* ctx)
{
hak_ptlc_t* dst = (hak_ptlc_t*)ctx;
const hak_uint8_t* p = (const hak_uint8_t*)ptr;
const hak_uint8_t* e = p + len;
if (dst->capa - dst->len < len)
{
hak_oow_t newcapa;
hak_uint8_t* newptr;
newcapa = dst->len + len;
newcapa = HAK_ALIGN_POW2(newcapa, 64);
newptr = (hak_uint8_t*)hak_reallocmem(hak, dst->ptr, newcapa);
if (HAK_UNLIKELY(!newptr)) return -1;
dst->ptr = newptr;
dst->capa = newcapa;
}
while (p < e) ((hak_uint8_t*)dst->ptr)[dst->len++] = *p++;
return 0;
}
int hak_marshalcodetomem (hak_t* hak, const hak_code_t* code, hak_ptlc_t* dst)
{
return hak_marshalcode(hak, code, mem_code_writer, dst);
}
/* -------------------------------------------------------------------- */
struct cmr_t
{
const hak_ptl_t* src;
hak_oow_t pos;
};
static int mem_code_reader(hak_t* hak, void* ptr, hak_oow_t len, void* ctx)
{
struct cmr_t* cmr = (struct cmr_t*)ctx;
hak_uint8_t* p = (hak_uint8_t*)ptr;
hak_uint8_t* e = p + len;
HAK_ASSERT (hak, cmr->pos <= cmr->src->len);
if (cmr->src->len - cmr->pos < len)
{
hak_seterrbfmt (hak, HAK_ENOENT, "no more data");
return -1;
}
while (p < e) *p++ = ((const hak_uint8_t*)cmr->src->ptr)[cmr->pos++];
return 0;
}
int hak_unmarshalcodefrommem (hak_t* hak, hak_code_t* code, const hak_ptl_t* src)
{
struct cmr_t cmr;
cmr.src = src;
cmr.pos = 0;
return hak_unmarshalcode(hak, code, mem_code_reader, &cmr);
}
/* -------------------------------------------------------------------- */
int hak_brewcode (hak_t* hak, hak_code_t* code)
{
/* create space to hold byte code and debug information */
if (!code->bc.ptr)
{
code->bc.ptr = (hak_oob_t*)hak_allocmem(hak, HAK_SIZEOF(*code->bc.ptr) * HAK_BC_BUFFER_INIT); /* TODO: set a proper intial size */
if (HAK_UNLIKELY(!code->bc.ptr))
{
const hak_ooch_t* orgmsg = hak_backuperrmsg(hak);
hak_seterrbfmt (hak, HAK_ERRNUM(hak), "unable to allocate code buffer - %js", orgmsg);
return -1;
}
HAK_ASSERT (hak, code->bc.len == 0);
code->bc.capa = HAK_BC_BUFFER_INIT;
}
if (!code->dbgi)
{
code->dbgi = (hak_dbgi_t*)hak_allocmem(hak, HAK_SIZEOF(*code->dbgi) * HAK_BC_BUFFER_INIT);
if (HAK_UNLIKELY(!code->dbgi))
{
const hak_ooch_t* orgmsg = hak_backuperrmsg(hak);
hak_seterrbfmt (hak, HAK_ERRNUM(hak), "unable to allocate debug info buffer - %js", orgmsg);
/* bc.ptr and dbgi go together. so free bc.ptr if dbgi allocation fails */
hak_freemem (hak, code->bc.ptr);
code->bc.ptr = HAK_NULL;
code->bc.len = 0;
code->bc.capa = 0;
return -1;
}
HAK_MEMSET (code->dbgi, 0, HAK_SIZEOF(*code->dbgi) * HAK_BC_BUFFER_INIT);
}
/* TODO: move code.lit.arr creation to hak_init() after swithching to hak_allocmem? */
if (!code->lit.arr)
{
code->lit.arr = (hak_oop_oop_t)hak_makengcarray(hak, HAK_LIT_BUFFER_INIT); /* TOOD: set a proper initial size */
if (HAK_UNLIKELY(!code->lit.arr))
{
const hak_ooch_t* orgmsg = hak_backuperrmsg(hak);
hak_seterrbfmt (hak, HAK_ERRNUM(hak), "unable to allocate literal frame - %js", orgmsg);
return -1;
}
HAK_ASSERT (hak, code->lit.len == 0);
}
return 0;
}
void hak_purgecode (hak_t* hak, hak_code_t* code)
{
if (code->dbgi)
{
hak_freemem (hak, code->dbgi);
code->dbgi = HAK_NULL;
}
if (code->bc.ptr)
{
hak_freemem (hak, code->bc.ptr);
code->bc.ptr = HAK_NULL;
code->bc.len = 0;
code->bc.capa = 0;
}
if (code->lit.arr)
{
hak_freengcobj (hak, (hak_oop_t)code->lit.arr);
code->lit.arr = HAK_NULL;
code->lit.len = 0;
}
HAK_MEMSET (&code, 0, HAK_SIZEOF(code));
}
/* -------------------------------------------------------------------- */
int hak_addliteraltocode (hak_t* hak, hak_code_t* code, hak_oop_t obj, hak_oow_t lfbase, hak_oow_t* index)
{
hak_oow_t capa, i;
hak_oop_t tmp;
/* TODO: speed up the following duplicate check loop */
for (i = lfbase; i < code->lit.len; i++)
{
tmp = ((hak_oop_oop_t)code->lit.arr)->slot[i];
if (tmp == obj || hak_equalobjs(hak, obj, tmp))
{
/* this removes redundancy of symbols, characters, and integers.
* 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 = HAK_OBJ_GET_SIZE(code->lit.arr);
if (code->lit.len >= capa)
{
hak_oop_t tmp;
hak_oow_t newcapa;
newcapa = HAK_ALIGN(capa + 1, HAK_LIT_BUFFER_ALIGN);
tmp = hak_remakengcarray(hak, (hak_oop_t)code->lit.arr, newcapa);
if (HAK_UNLIKELY(!tmp))
{
const hak_ooch_t* orgmsg = hak_backuperrmsg(hak);
hak_seterrbfmt (hak, HAK_ERRNUM(hak), "unable to resize literal frame - %js", orgmsg);
return -1;
}
code->lit.arr = (hak_oop_oop_t)tmp;
}
if (index) *index = code->lit.len - lfbase;
((hak_oop_oop_t)code->lit.arr)->slot[code->lit.len++] = obj;
/* make read-only an object in the literal table.
* some immutable objects(e.g. literal symbol) don't need this part
* but we just execute it regardless */
if (HAK_OOP_IS_POINTER(obj)) HAK_OBJ_SET_FLAGS_RDONLY (obj, 1);
return 0;
}
Reference in New Issue View Git Blame Copy Permalink