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

added hcl_walkdic

Browse Source 
fixed a bug of not printing the list closer properly in hcl_print().
enhanced error handling
This commit is contained in:
hyung-hwan 2018-02-12 16:51:38 +00:00
parent 4ddffc101d
commit 2201ee5a94
8 changed files with 815 additions and 748 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
lib/dic.c
View File

@ -268,7 +268,7 @@ hcl_oop_t hcl_makedic (hcl_t* hcl, hcl_oow_t inisize)
obj->tally = HCL_SMOOI_TO_OOP(0); obj->tally = HCL_SMOOI_TO_OOP(0);
hcl_pushtmp (hcl, (hcl_oop_t*)&obj); hcl_pushtmp (hcl, (hcl_oop_t*)&obj);
bucket = (hcl_oop_oop_t)hcl_makearray (hcl, inisize); bucket = (hcl_oop_oop_t)hcl_makearray(hcl, inisize);
hcl_poptmp (hcl); hcl_poptmp (hcl);
if (!bucket) obj = HCL_NULL; if (!bucket) obj = HCL_NULL;
@ -277,3 +277,20 @@ hcl_oop_t hcl_makedic (hcl_t* hcl, hcl_oow_t inisize)
return (hcl_oop_t)obj; return (hcl_oop_t)obj;
} }
int hcl_walkdic (hcl_t* hcl, hcl_oop_dic_t dic, hcl_dic_walker_t walker, void* ctx)
{
hcl_oow_t i;
hcl_pushtmp (hcl, (hcl_oop_t*)&dic);
for (i = 0; i < HCL_OBJ_GET_SIZE(dic->bucket); i++)
{
hcl_oop_t tmp = dic->bucket->slot[i];
if (HCL_IS_CONS(hcl, tmp) && walker(hcl, dic, (hcl_oop_cons_t)tmp, ctx) <= -1) return -1;
}
hcl_poptmp (hcl);
return 0;
}

6
lib/err.c
View File

@ -59,13 +59,17 @@ static hcl_ooch_t errstr_29[] = {'d','i','v','i','d','e',' ','b','y',' ','z','e'
static hcl_ooch_t errstr_30[] = {'I','/','O',' ','e','r','r','o','r','\0'}; static hcl_ooch_t errstr_30[] = {'I','/','O',' ','e','r','r','o','r','\0'};
static hcl_ooch_t errstr_31[] = {'e','n','c','o','d','i','n','g',' ','c','o','n','v','e','r','s','i','o','n',' ','e','r','r','o','r','\0'}; static hcl_ooch_t errstr_31[] = {'e','n','c','o','d','i','n','g',' ','c','o','n','v','e','r','s','i','o','n',' ','e','r','r','o','r','\0'};
static hcl_ooch_t errstr_32[] = {'b','u','f','f','e','r',' ','f','u','l','l','\0'}; static hcl_ooch_t errstr_32[] = {'b','u','f','f','e','r',' ','f','u','l','l','\0'};
static hcl_ooch_t errstr_33[] = {'s','y','n','t','a','x',' ','e','r','r','o','r','\0'};
static hcl_ooch_t errstr_34[] = {'c','a','l','l',' ','e','r','r','o','r','\0'};
static hcl_ooch_t errstr_35[] = {'r','e','c','a','l','l',' ','p','r','o','h','i','b','i','t','e','d','\0'};
static hcl_ooch_t errstr_36[] = {'a','r','g','u','m','e','n','t',' ','n','u','m','b','e','r',' ','e','r','r','o','r','\0'};
static hcl_ooch_t* errstr[] = static hcl_ooch_t* errstr[] =
{ {
errstr_0, errstr_1, errstr_2, errstr_3, errstr_4, errstr_5, errstr_6, errstr_7, errstr_0, errstr_1, errstr_2, errstr_3, errstr_4, errstr_5, errstr_6, errstr_7,
errstr_8, errstr_9, errstr_10, errstr_11, errstr_12, errstr_13, errstr_14, errstr_15, errstr_8, errstr_9, errstr_10, errstr_11, errstr_12, errstr_13, errstr_14, errstr_15,
errstr_16, errstr_17, errstr_18, errstr_19, errstr_20, errstr_21, errstr_22, errstr_23, errstr_16, errstr_17, errstr_18, errstr_19, errstr_20, errstr_21, errstr_22, errstr_23,
errstr_24, errstr_25, errstr_26, errstr_27, errstr_28, errstr_29, errstr_30, errstr_31, errstr_24, errstr_25, errstr_26, errstr_27, errstr_28, errstr_29, errstr_30, errstr_31,
errstr_32 errstr_32, errstr_33, errstr_34, errstr_35, errstr_36
}; };

36
lib/hcl-prv.h
View File

@ -888,33 +888,6 @@ hcl_oop_t hcl_findsymbol (
); );
/* ========================================================================= */
/* dic.c */
/* ========================================================================= */
hcl_oop_cons_t hcl_putatsysdic (
hcl_t* hcl,
hcl_oop_t key,
hcl_oop_t value
);
hcl_oop_cons_t hcl_getatsysdic (
hcl_t* hcl,
hcl_oop_t key
);
hcl_oop_cons_t hcl_putatdic (
hcl_t* hcl,
hcl_oop_dic_t dic,
hcl_oop_t key,
hcl_oop_t value
);
hcl_oop_cons_t hcl_getatdic (
hcl_t* hcl,
hcl_oop_dic_t dic,
hcl_oop_t key
);
/* ========================================================================= */ /* ========================================================================= */
/* proc.c */ /* proc.c */
/* ========================================================================= */ /* ========================================================================= */
@ -1139,8 +1112,7 @@ HCL_EXPORT int hcl_compile (
hcl_mod_data_t* hcl_openmod ( hcl_mod_data_t* hcl_openmod (
hcl_t* hcl, hcl_t* hcl,
const hcl_ooch_t* name, const hcl_ooch_t* name,
hcl_oow_t namelen, hcl_oow_t namelen
int hints /* 0 or bitwise-ORed of hcl_mod_hint_t enumerators */
); );
void hcl_closemod ( void hcl_closemod (
@ -1148,12 +1120,6 @@ void hcl_closemod (
hcl_mod_data_t* mdp hcl_mod_data_t* mdp
); );
int hcl_importmod (
hcl_t* hcl,
const hcl_ooch_t* name,
hcl_oow_t len
);
/* /*
* The hcl_querymod() function finds a primitive function in modules * The hcl_querymod() function finds a primitive function in modules
* with a full primitive identifier. * with a full primitive identifier.

149
lib/hcl.c
View File

@ -200,14 +200,14 @@ void hcl_fini (hcl_t* hcl)
if (hcl->code.bc.arr) if (hcl->code.bc.arr)
{ {
hcl_freengcobj (hcl, hcl->code.bc.arr); hcl_freengcobj (hcl, (hcl_oop_t)hcl->code.bc.arr);
hcl->code.bc.arr = HCL_NULL; hcl->code.bc.arr = HCL_NULL;
hcl->code.bc.len = 0; hcl->code.bc.len = 0;
} }
if (hcl->code.lit.arr) if (hcl->code.lit.arr)
{ {
hcl_freengcobj (hcl, hcl->code.lit.arr); hcl_freengcobj (hcl, (hcl_oop_t)hcl->code.lit.arr);
hcl->code.lit.arr = HCL_NULL; hcl->code.lit.arr = HCL_NULL;
hcl->code.lit.len = 0; hcl->code.lit.len = 0;
} }
@ -396,19 +396,13 @@ void hcl_freemem (hcl_t* hcl, void* ptr)
#if defined(HCL_ENABLE_STATIC_MODULE) #if defined(HCL_ENABLE_STATIC_MODULE)
#if defined(HCL_ENABLE_MOD_CON) /*#include "../mod/_array.h"*/
# include "../mod/_con.h"
#endif static int hcl_mod_fake (hcl_t* hcl, hcl_mod_t* mod)
#if defined(HCL_ENABLE_MOD_FFI) {
# include "../mod/_ffi.h" hcl_seterrbfmt (hcl, HCL_EPERM, "not allowed to load ___fake___ module");
#endif return -1;
#if defined(HCL_ENABLE_MOD_SCK) }
# include "../mod/_sck.h"
#endif
#include "../mod/_stdio.h"
#if defined(HCL_ENABLE_MOD_X11)
# include "../mod/_x11.h"
#endif
static struct static struct
{ {
@ -417,25 +411,11 @@ static struct
} }
static_modtab[] = static_modtab[] =
{ {
#if defined(HCL_ENABLE_MOD_CON) { "___fake___", hcl_mod_fake },
{ "con", hcl_mod_con },
#endif
#if defined(HCL_ENABLE_MOD_FFI)
{ "ffi", hcl_mod_ffi },
#endif
#if defined(HCL_ENABLE_MOD_SCK)
{ "sck", hcl_mod_sck },
{ "sck.addr", hcl_mod_sck_addr },
#endif
{ "stdio", hcl_mod_stdio },
#if defined(HCL_ENABLE_MOD_X11)
{ "x11", hcl_mod_x11 },
/*{ "x11.win", hcl_mod_x11_win },*/
#endif
}; };
#endif #endif
hcl_mod_data_t* hcl_openmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t namelen, int hints) hcl_mod_data_t* hcl_openmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t namelen)
{ {
hcl_rbt_pair_t* pair; hcl_rbt_pair_t* pair;
hcl_mod_data_t* mdp; hcl_mod_data_t* mdp;
@ -473,7 +453,7 @@ hcl_mod_data_t* hcl_openmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t namel
/* TODO: binary search ... */ /* TODO: binary search ... */
for (n = 0; n < HCL_COUNTOF(static_modtab); n++) for (n = 0; n < HCL_COUNTOF(static_modtab); n++)
{ {
if (hcl_compoocharsbcstr (name, namelen, static_modtab[n].modname) == 0) if (hcl_compoocharsbcstr(name, namelen, static_modtab[n].modname) == 0)
{ {
load = static_modtab[n].modload; load = static_modtab[n].modload;
break; break;
@ -490,7 +470,7 @@ hcl_mod_data_t* hcl_openmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t namel
/* i copy-insert 'md' into the table before calling 'load'. /* i copy-insert 'md' into the table before calling 'load'.
* to pass the same address to load(), query(), etc */ * to pass the same address to load(), query(), etc */
pair = hcl_rbt_insert (&hcl->modtab, (hcl_ooch_t*)name, namelen, &md, HCL_SIZEOF(md)); pair = hcl_rbt_insert(&hcl->modtab, (hcl_ooch_t*)name, namelen, &md, HCL_SIZEOF(md));
if (pair == HCL_NULL) if (pair == HCL_NULL)
{ {
hcl_seterrnum (hcl, HCL_ESYSMEM); hcl_seterrnum (hcl, HCL_ESYSMEM);
@ -499,8 +479,7 @@ hcl_mod_data_t* hcl_openmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t namel
mdp = (hcl_mod_data_t*)HCL_RBT_VPTR(pair); mdp = (hcl_mod_data_t*)HCL_RBT_VPTR(pair);
HCL_ASSERT (hcl, HCL_SIZEOF(mdp->mod.hints) == HCL_SIZEOF(int)); HCL_ASSERT (hcl, HCL_SIZEOF(mdp->mod.hints) == HCL_SIZEOF(int));
mdp->mod.hints = hints; if (load(hcl, &mdp->mod) <= -1)
if (load (hcl, &mdp->mod) <= -1)
{ {
hcl_rbt_delete (&hcl->modtab, (hcl_ooch_t*)name, namelen); hcl_rbt_delete (&hcl->modtab, (hcl_ooch_t*)name, namelen);
return HCL_NULL; return HCL_NULL;
@ -529,10 +508,10 @@ hcl_mod_data_t* hcl_openmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t namel
/* attempt to find a dynamic external module */ /* attempt to find a dynamic external module */
HCL_MEMSET (&md, 0, HCL_SIZEOF(md)); HCL_MEMSET (&md, 0, HCL_SIZEOF(md));
hcl_copyoochars ((hcl_ooch_t*)md.mod.name, name, namelen); hcl_copyoochars((hcl_ooch_t*)md.mod.name, name, namelen);
if (hcl->vmprim.dl_open && hcl->vmprim.dl_getsym && hcl->vmprim.dl_close) if (hcl->vmprim.dl_open && hcl->vmprim.dl_getsym && hcl->vmprim.dl_close)
{ {
md.handle = hcl->vmprim.dl_open (hcl, &buf[MOD_PREFIX_LEN], HCL_VMPRIM_OPENDL_PFMOD); md.handle = hcl->vmprim.dl_open(hcl, &buf[MOD_PREFIX_LEN], HCL_VMPRIM_OPENDL_PFMOD);
} }
if (md.handle == HCL_NULL) if (md.handle == HCL_NULL)
@ -543,11 +522,10 @@ hcl_mod_data_t* hcl_openmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t namel
} }
/* attempt to get hcl_mod_xxx where xxx is the module name*/ /* attempt to get hcl_mod_xxx where xxx is the module name*/
load = hcl->vmprim.dl_getsym (hcl, md.handle, buf); load = hcl->vmprim.dl_getsym(hcl, md.handle, buf);
if (!load) if (!load)
{ {
const hcl_ooch_t* oldmsg = hcl_backuperrmsg (hcl); hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "unable to get module symbol [%js] in [%.*js]", buf, namelen, name);
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "unable to get module symbol [%js] in [%.*js] - %js", buf, namelen, name, oldmsg);
HCL_DEBUG3 (hcl, "Cannot get a module symbol [%js] in [%.*js]\n", buf, namelen, name); HCL_DEBUG3 (hcl, "Cannot get a module symbol [%js] in [%.*js]\n", buf, namelen, name);
hcl->vmprim.dl_close (hcl, md.handle); hcl->vmprim.dl_close (hcl, md.handle);
return HCL_NULL; return HCL_NULL;
@ -555,7 +533,7 @@ hcl_mod_data_t* hcl_openmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t namel
/* i copy-insert 'md' into the table before calling 'load'. /* i copy-insert 'md' into the table before calling 'load'.
* to pass the same address to load(), query(), etc */ * to pass the same address to load(), query(), etc */
pair = hcl_rbt_insert (&hcl->modtab, (void*)name, namelen, &md, HCL_SIZEOF(md)); pair = hcl_rbt_insert(&hcl->modtab, (void*)name, namelen, &md, HCL_SIZEOF(md));
if (pair == HCL_NULL) if (pair == HCL_NULL)
{ {
HCL_DEBUG2 (hcl, "Cannot register a module [%.*js]\n", namelen, name); HCL_DEBUG2 (hcl, "Cannot register a module [%.*js]\n", namelen, name);
@ -566,8 +544,7 @@ hcl_mod_data_t* hcl_openmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t namel
mdp = (hcl_mod_data_t*)HCL_RBT_VPTR(pair); mdp = (hcl_mod_data_t*)HCL_RBT_VPTR(pair);
HCL_ASSERT (hcl, HCL_SIZEOF(mdp->mod.hints) == HCL_SIZEOF(int)); HCL_ASSERT (hcl, HCL_SIZEOF(mdp->mod.hints) == HCL_SIZEOF(int));
mdp->mod.hints = hints; if (load(hcl, &mdp->mod) <= -1)
if (load (hcl, &mdp->mod) <= -1)
{ {
const hcl_ooch_t* oldmsg = hcl_backuperrmsg (hcl); const hcl_ooch_t* oldmsg = hcl_backuperrmsg (hcl);
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "module initializer [%js] returned failure in [%.*js] - %js", buf, namelen, name, oldmsg); hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "module initializer [%js] returned failure in [%.*js] - %js", buf, namelen, name, oldmsg);
@ -609,53 +586,6 @@ void hcl_closemod (hcl_t* hcl, hcl_mod_data_t* mdp)
} }
} }
int hcl_importmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t len)
{
hcl_rbt_pair_t* pair;
hcl_mod_data_t* mdp;
int r = -1;
pair = hcl_rbt_search (&hcl->modtab, name, len);
if (pair)
{
mdp = (hcl_mod_data_t*)HCL_RBT_VPTR(pair);
HCL_ASSERT (hcl, mdp != HCL_NULL);
HCL_DEBUG1 (hcl, "Cannot import module [%js] - already active\n", mdp->mod.name);
hcl_seterrbfmt (hcl, HCL_EPERM, "unable to import module [%js] - already active", mdp->mod.name);
goto done2;
}
mdp = hcl_openmod (hcl, name, len, HCL_MOD_LOAD_FOR_IMPORT);
if (!mdp) goto done2;
if (!mdp->mod.import)
{
HCL_DEBUG1 (hcl, "Cannot import module [%js] - importing not supported by the module\n", mdp->mod.name);
hcl_seterrbfmt (hcl, HCL_ENOIMPL, "unable to import module [%js] - not supported by the module", mdp->mod.name);
goto done;
}
if (mdp->mod.import (hcl, &mdp->mod) <= -1)
{
HCL_DEBUG1 (hcl, "Cannot import module [%js] - module's import() returned failure\n", mdp->mod.name);
goto done;
}
r = 0; /* everything successful */
done:
/* close the module opened above.
* [NOTE] if the import callback calls the hcl_querymod(), the returned
* function pointers will get all invalidated here. so never do
* anything like that */
hcl_closemod (hcl, mdp);
done2:
return r;
}
hcl_pfbase_t* hcl_querymod (hcl_t* hcl, const hcl_ooch_t* pfid, hcl_oow_t pfidlen) hcl_pfbase_t* hcl_querymod (hcl_t* hcl, const hcl_ooch_t* pfid, hcl_oow_t pfidlen)
{ {
/* primitive function identifier /* primitive function identifier
@ -696,7 +626,7 @@ hcl_pfbase_t* hcl_querymod (hcl_t* hcl, const hcl_ooch_t* pfid, hcl_oow_t pfidle
else else
{ {
/* open a module using the part before the last period */ /* open a module using the part before the last period */
mdp = hcl_openmod (hcl, pfid, mod_name_len, 0); mdp = hcl_openmod (hcl, pfid, mod_name_len);
if (!mdp) return HCL_NULL; if (!mdp) return HCL_NULL;
} }
@ -713,3 +643,40 @@ hcl_pfbase_t* hcl_querymod (hcl_t* hcl, const hcl_ooch_t* pfid, hcl_oow_t pfidle
return pfbase; return pfbase;
} }
hcl_pfbase_t* hcl_findpfbase (hcl_t* hcl, hcl_pfinfo_t* pfinfo, hcl_oow_t pfcount, const hcl_ooch_t* name, hcl_oow_t namelen)
{
int n;
/* binary search */
#if 0
/* [NOTE] this algorithm is NOT underflow safe with hcl_oow_t types */
int left, right, mid;
for (left = 0, right = pfcount - 1; left <= right; )
{
/*mid = (left + right) / 2;*/
mid = left + ((right - left) / 2);
n = hcl_compoocharsoocstr (name, namelen, pfinfo[mid].mthname);
if (n < 0) right = mid - 1; /* this substraction can make right negative. so i can't use hcl_oow_t for the variable */
else if (n > 0) left = mid + 1;
else return &pfinfo[mid].base;
}
#else
/* [NOTE] this algorithm is underflow safe with hcl_oow_t types */
hcl_oow_t base, mid, lim;
for (base = 0, lim = pfcount; lim > 0; lim >>= 1)
{
mid = base + (lim >> 1);
n = hcl_compoocharsoocstr (name, namelen, pfinfo[mid].mthname);
if (n == 0) return &pfinfo[mid].base;
if (n > 0) { base = mid + 1; lim--; }
}
#endif
hcl_seterrnum (hcl, HCL_ENOENT);
return HCL_NULL;
}

1268
lib/hcl.h
View File

File diff suppressed because it is too large Load Diff

27
lib/main.c
View File

@ -504,8 +504,11 @@ static void* dl_open (hcl_t* hcl, const hcl_ooch_t* name, int flags)
if (!handle) if (!handle)
{ {
hcl_bch_t* dash; hcl_bch_t* dash;
hcl_seterrbfmt (hcl, HCL_ESYSERR, "unable to open(ext) DL %js - %hs", name, sys_dl_error()); const hcl_bch_t* dl_errstr;
HCL_DEBUG3 (hcl, "Failed to open(ext) DL %hs[%js] - %hs\n", &bufptr[len], name, sys_dl_error()); dl_errstr = sys_dl_error();
HCL_DEBUG3 (hcl, "Failed to open(ext) DL %hs[%js] - %hs\n", &bufptr[len], name, dl_errstr);
hcl_seterrbfmt (hcl, HCL_ESYSERR, "unable to open(ext) DL %js - %hs", name, dl_errstr);
dash = hcl_rfindbchar(bufptr, hcl_countbcstr(bufptr), '-'); dash = hcl_rfindbchar(bufptr, hcl_countbcstr(bufptr), '-');
if (dash) if (dash)
{ {
@ -537,13 +540,15 @@ static void* dl_open (hcl_t* hcl, const hcl_ooch_t* name, int flags)
bcslen = hcl_copybcstr(bufptr, bufcapa, name); bcslen = hcl_copybcstr(bufptr, bufcapa, name);
#endif #endif
if (hcl_findbchar (bufptr, bcslen, '.')) if (hcl_findbchar(bufptr, bcslen, '.'))
{ {
handle = sys_dl_open(bufptr); handle = sys_dl_open(bufptr);
if (!handle) if (!handle)
{ {
hcl_seterrbfmt (hcl, HCL_ESYSERR, "unable to open DL %js - %hs", name, sys_dl_error()); const hcl_bch_t* dl_errstr;
HCL_DEBUG2 (hcl, "Failed to open DL %hs - %hs\n", bufptr, sys_dl_error()); dl_errstr = sys_dl_error();
HCL_DEBUG2 (hcl, "Failed to open DL %hs - %hs\n", bufptr, dl_errstr);
hcl_seterrbfmt (hcl, HCL_ESYSERR, "unable to open DL %js - %hs", name, dl_errstr);
} }
else HCL_DEBUG2 (hcl, "Opened DL %hs handle %p\n", bufptr, handle); else HCL_DEBUG2 (hcl, "Opened DL %hs handle %p\n", bufptr, handle);
} }
@ -552,8 +557,10 @@ static void* dl_open (hcl_t* hcl, const hcl_ooch_t* name, int flags)
handle = sys_dl_openext(bufptr); handle = sys_dl_openext(bufptr);
if (!handle) if (!handle)
{ {
hcl_seterrbfmt (hcl, HCL_ESYSERR, "unable to open(ext) DL %js - %hs", name, sys_dl_error()); const hcl_bch_t* dl_errstr;
HCL_DEBUG2 (hcl, "Failed to open(ext) DL %hs - %s\n", bufptr, sys_dl_error()); dl_errstr = sys_dl_error();
HCL_DEBUG2 (hcl, "Failed to open(ext) DL %hs - %s\n", bufptr, dl_errstr);
hcl_seterrbfmt (hcl, HCL_ESYSERR, "unable to open(ext) DL %js - %hs", name, dl_errstr);
} }
else HCL_DEBUG2 (hcl, "Opened(ext) DL %hs handle %p\n", bufptr, handle); else HCL_DEBUG2 (hcl, "Opened(ext) DL %hs handle %p\n", bufptr, handle);
} }
@ -642,7 +649,11 @@ static void* dl_getsym (hcl_t* hcl, void* handle, const hcl_ooch_t* name)
sym = sys_dl_getsym(handle, symname); sym = sys_dl_getsym(handle, symname);
if (!sym) if (!sym)
{ {
hcl_seterrbfmt (hcl, HCL_ENOENT, "unable to get module symbol %hs", symname); const hcl_bch_t* dl_errstr;
dl_errstr = sys_dl_error();
HCL_DEBUG3 (hcl, "Failed to get module symbol %js from handle %p - %hs\n", name, handle, dl_errstr);
hcl_seterrbfmt (hcl, HCL_ENOENT, "unable to get module symbol %hs - %hs", symname, dl_errstr);
} }
} }
} }

56
lib/prim.c
View File

@ -487,3 +487,59 @@ int hcl_addbuiltinprims (hcl_t* hcl)
return 0; return 0;
} }
/* ------------------------------------------------------------------------- */
static hcl_pfrc_t pf_hello (hcl_t* hcl, hcl_ooi_t nargs)
{
return prim_log(hcl, nargs);
}
static int walker (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_cons_t pair, void* ctx)
{
HCL_DEBUG2 (hcl, "walker ===> %O =====> %O\n", HCL_CONS_CAR(pair), HCL_CONS_CDR(pair));
return 0;
}
static hcl_pfrc_t pf_walk (hcl_t* hcl, hcl_ooi_t nargs)
{
hcl_oop_t arg;
arg = HCL_STACK_GETARG(hcl, nargs, 0);
if (!HCL_IS_DIC(hcl,arg))
{
hcl_seterrbfmt (hcl, HCL_EINVAL, "parameter not a dictionary - %O", arg);
return HCL_PF_FAILURE;
}
hcl_walkdic (hcl, (hcl_oop_dic_t)arg, walker, HCL_NULL);
HCL_STACK_SETRET (hcl, nargs, hcl->_true);
return HCL_PF_SUCCESS;
}
static hcl_pfinfo_t pfinfos[] =
{
{ { 'h','e','l','l','o','\0' }, 0, { pf_hello, 1, 1 } },
{ { 'w','a','l','k','\0' }, 0, { pf_walk, 1, 1 } }
};
/* ------------------------------------------------------------------------ */
static hcl_pfbase_t* query (hcl_t* hcl, hcl_mod_t* mod, const hcl_ooch_t* name, hcl_oow_t namelen)
{
return hcl_findpfbase (hcl, pfinfos, HCL_COUNTOF(pfinfos), name, namelen);
}
static void unload (hcl_t* hcl, hcl_mod_t* mod)
{
}
int hcl_mod_test (hcl_t* hcl, hcl_mod_t* mod)
{
mod->query = query;
mod->unload = unload;
mod->ctx = HCL_NULL;
return 0;
}

2
lib/print.c
View File

@ -296,6 +296,7 @@ next:
* the variable p is */ * the variable p is */
ps.type = PRINT_STACK_CONS; ps.type = PRINT_STACK_CONS;
ps.obj = HCL_CONS_CDR(cur); ps.obj = HCL_CONS_CDR(cur);
ps.idx = concode; /* this is not an index but use this field to restore concode */
x = push (hcl, &ps); x = push (hcl, &ps);
if (x <= -1) return -1; if (x <= -1) return -1;
@ -309,6 +310,7 @@ next:
resume_cons: resume_cons:
HCL_ASSERT (hcl, ps.type == PRINT_STACK_CONS); HCL_ASSERT (hcl, ps.type == PRINT_STACK_CONS);
cur = ps.obj; /* Get back the CDR pushed */ cur = ps.obj; /* Get back the CDR pushed */
concode = ps.idx; /* restore the concode */
if (HCL_IS_NIL(hcl,cur)) if (HCL_IS_NIL(hcl,cur))
{ {
/* The CDR part points to a NIL object, which /* The CDR part points to a NIL object, which