hyung-hwan/hcl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

work in progress to add the hcl_purgeatdic() function

Browse Source
This commit is contained in:
hyung-hwan 2018-03-08 10:00:57 +00:00
parent 8cdd423a4e
commit 02b02865ac
6 changed files with 137 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lib/comp.c
View File

@ -32,7 +32,6 @@ enum
VAR_INDEXED
};
#define CODE_BUFFER_ALIGN 1024 /* TODO: set a bigger value */
#define TV_BUFFER_ALIGN 256
#define BLK_TMPRCNT_BUFFER_ALIGN 128
@ -64,7 +63,7 @@ static int add_literal (hcl_t* hcl, hcl_oop_t obj, hcl_oow_t* index)
hcl_oop_t tmp;
hcl_oow_t newcapa;
newcapa = capa + 20000; /* TODO: set a better resizing policy */
newcapa = HCL_ALIGN(capa + 1, HCL_LIT_BUFFER_ALIGN);
tmp = hcl_remakengcarray(hcl, (hcl_oop_t)hcl->code.lit.arr, newcapa);
if (!tmp) return -1;
@ -179,7 +178,7 @@ static int emit_byte_instruction (hcl_t* hcl, hcl_oob_t bc)
hcl_oop_t tmp;
hcl_oow_t newcapa;
newcapa = HCL_ALIGN (capa + 1, CODE_BUFFER_ALIGN);
newcapa = HCL_ALIGN(capa + 1, HCL_BC_BUFFER_ALIGN);
tmp = hcl_remakengcbytearray (hcl, (hcl_oop_t)hcl->code.bc.arr, newcapa);
if (!tmp) return -1;

92
lib/dic.c
View File

@ -33,7 +33,6 @@ static hcl_oop_oop_t expand_bucket (hcl_t* hcl, hcl_oop_oop_t oldbuc)
hcl_oop_oop_t newbuc;
hcl_oow_t oldsz, newsz, index;
hcl_oop_cons_t ass;
hcl_oop_char_t key;
oldsz = HCL_OBJ_GET_SIZE(oldbuc);
@ -256,6 +255,97 @@ hcl_oop_cons_t hcl_getatdic (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t key)
return find_or_upsert (hcl, dic, (hcl_oop_char_t)key, HCL_NULL);
}
int hcl_purgeatdic (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t key)
{
hcl_ooi_t tally;
hcl_oow_t hv, index, bs, i, x, y, z;
hcl_oop_cons_t ass;
tally = HCL_OOP_TO_SMOOI(dic->tally);
bs = HCL_OBJ_GET_SIZE(dic->bucket);
/* the system dictionary is not a generic dictionary.
* it accepts only a symbol as a key. */
#if defined(SYMBOL_ONLY_KEY)
HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,key));
#endif
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(dic->tally));
HCL_ASSERT (hcl, HCL_IS_ARRAY(hcl,dic->bucket));
#if defined(SYMBOL_ONLY_KEY)
index = hcl_hashoochars(key->slot, HCL_OBJ_GET_SIZE(key)) % bs;
#else
if (hcl_hashobj(hcl, (hcl_oop_t)key, &index) <= -1) return -1;
index %= bs;
#endif
/* find */
while (dic->bucket->slot[index] != hcl->_nil)
{
#if defined(SYMBOL_ONLY_KEY)
ass = (hcl_oop_cons_t)dic->bucket->slot[index];
HCL_ASSERT (hcl, HCL_IS_CONS(hcl,ass));
HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,ass->car));
if (HCL_OBJ_GET_SIZE(key) == HCL_OBJ_GET_SIZE(ass->car) &&
hcl_equaloochars(key->slot, ((hcl_oop_char_t)ass->car)->slot, HCL_OBJ_GET_SIZE(key)))
{
/* the value of HCL_NULL indicates no insertion or update. */
goto found;
}
#else
int n;
ass = (hcl_oop_cons_t)dic->bucket->slot[index];
HCL_ASSERT (hcl, HCL_IS_CONS(hcl,ass));
n = hcl_equalobjs(hcl, (hcl_oop_t)key, ass->car);
if (n <= -1) return -1;
if (n >= 1) goto found;
#endif
index = (index + 1) % HCL_OBJ_GET_SIZE(dic->bucket);
}
hcl_seterrnum (hcl, HCL_ENOENT);
return -1;
found:
/* compact the cluster */
for (i = 0, x = index, y = index; i < tally; i++)
{
y = (y + 1) % bs;
/* done if the slot at the current index is empty */
if (dic->bucket->slot[y] == hcl->_nil) break;
ass = (hcl_oop_cons_t)dic->bucket->slot[y];
#if defined(SYMBOL_ONLY_KEY)
/* get the natural hash index for the data in the slot at
* the current hash index */
z = hcl_hashoochars(((hcl_oop_char_t)ass->key)->slot, HCL_OBJ_GET_SIZE(ass->key)) % bs;
#else
if (hcl_hashobj(hcl, ass->car, &z) <= -1) return -1;
index %= bs;
#endif
/* move an element if necesary */
if ((y > x && (z <= x || z > y)) ||
(y < x && (z <= x && z > y)))
{
dic->bucket->slot[x] = dic->bucket->slot[y];
x = y;
}
}
dic->bucket->slot[x] = hcl->_nil;
tally--;
dic->tally = HCL_SMOOI_TO_OOP(tally);
return 0;
}
hcl_oop_t hcl_makedic (hcl_t* hcl, hcl_oow_t inisize)
{
hcl_oop_dic_t obj;

6
lib/gc.c
View File

@ -526,14 +526,16 @@ int hcl_ignite (hcl_t* hcl)
if (!hcl->code.bc.arr)
{
hcl->code.bc.arr = (hcl_oop_byte_t)hcl_makengcbytearray (hcl, HCL_NULL, 20000); /* TODO: set a proper intial size */
hcl->code.bc.arr = (hcl_oop_byte_t)hcl_makengcbytearray(hcl, HCL_NULL, HCL_BC_BUFFER_INIT); /* TODO: set a proper intial size */
if (!hcl->code.bc.arr) return -1;
HCL_ASSERT (hcl, hcl->code.bc.len == 0);
}
if (!hcl->code.lit.arr)
{
hcl->code.lit.arr = (hcl_oop_oop_t)hcl_makengcarray (hcl, 20000); /* TOOD: set a proper initial size */
hcl->code.lit.arr = (hcl_oop_oop_t)hcl_makengcarray(hcl, HCL_LIT_BUFFER_INIT); /* TOOD: set a proper initial size */
if (!hcl->code.lit.arr) return -1;
HCL_ASSERT (hcl, hcl->code.lit.len == 0);
}
hcl->p.e = hcl->_nil;

7
lib/hcl-prv.h
View File

@ -75,6 +75,13 @@
*/
#define HCL_LIMIT_OBJ_SIZE
#define HCL_BC_BUFFER_INIT 10240
#define HCL_BC_BUFFER_ALIGN 10240
#define HCL_LIT_BUFFER_INIT 1024
#define HCL_LIT_BUFFER_ALIGN 1024
#if defined(__has_builtin)
# if (!__has_builtin(__builtin_memset) || !__has_builtin(__builtin_memcpy) || !__has_builtin(__builtin_memmove) || !__has_builtin(__builtin_memcmp))

21
lib/hcl.c
View File

@ -286,9 +286,26 @@ void hcl_fini (hcl_t* hcl)
}
}
void hcl_clear (hcl_t* hcl, int flags)
void hcl_clear (hcl_t* hcl)
{
/* TODO */
hcl_oop_t v;
hcl_oow_t i;
#if 0
/* clear global variables -> especially lambdas, because they refer to the byte codes? */
for (i = 0; i < hcl->code.lit.len; i++)
{
v = ((hcl_oop_oop_t)hcl->code.lit.arr)->slot[ip]);
if (HCL_IS_CONS(v))
{
hcl_delat
}
}
#endif
/* clear the byte code and literals */
hcl->code.bc.len = 0;
hcl->code.lit.len = 0;
hcl_gc (hcl);
}
int hcl_setoption (hcl_t* hcl, hcl_option_t id, const void* value)

8
lib/hcl.h
View File

@ -1354,16 +1354,20 @@ HCL_EXPORT void hcl_close (
);
HCL_EXPORT int hcl_init (
hcl_t* vm,
hcl_t* hcl,
hcl_mmgr_t* mmgr,
hcl_oow_t heapsize,
const hcl_vmprim_t* vmprim
);
HCL_EXPORT void hcl_fini (
hcl_t* vm
hcl_t* hcl
);
/*
HCL_EXPORT void hcl_clear (
hcl_t* hcl
);*/
#if defined(HCL_HAVE_INLINE)
static HCL_INLINE hcl_mmgr_t* hcl_getmmgr (hcl_t* hcl) { return hcl->mmgr; }