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

17
lib/dic.c
View File

@ -277,3 +277,20 @@ hcl_oop_t hcl_makedic (hcl_t* hcl, hcl_oow_t inisize)
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_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_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[] =
{
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_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_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 */
/* ========================================================================= */
@ -1139,8 +1112,7 @@ HCL_EXPORT int hcl_compile (
hcl_mod_data_t* hcl_openmod (
hcl_t* hcl,
const hcl_ooch_t* name,
hcl_oow_t namelen,
int hints /* 0 or bitwise-ORed of hcl_mod_hint_t enumerators */
hcl_oow_t namelen
);
void hcl_closemod (
@ -1148,12 +1120,6 @@ void hcl_closemod (
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
* with a full primitive identifier.

133
lib/hcl.c
View File

@ -200,14 +200,14 @@ void hcl_fini (hcl_t* hcl)
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.len = 0;
}
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.len = 0;
}
@ -396,19 +396,13 @@ void hcl_freemem (hcl_t* hcl, void* ptr)
#if defined(HCL_ENABLE_STATIC_MODULE)
#if defined(HCL_ENABLE_MOD_CON)
# include "../mod/_con.h"
#endif
#if defined(HCL_ENABLE_MOD_FFI)
# include "../mod/_ffi.h"
#endif
#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
/*#include "../mod/_array.h"*/
static int hcl_mod_fake (hcl_t* hcl, hcl_mod_t* mod)
{
hcl_seterrbfmt (hcl, HCL_EPERM, "not allowed to load ___fake___ module");
return -1;
}
static struct
{
@ -417,25 +411,11 @@ static struct
}
static_modtab[] =
{
#if defined(HCL_ENABLE_MOD_CON)
{ "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
{ "___fake___", hcl_mod_fake },
};
#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_mod_data_t* mdp;
@ -499,7 +479,6 @@ 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);
HCL_ASSERT (hcl, HCL_SIZEOF(mdp->mod.hints) == HCL_SIZEOF(int));
mdp->mod.hints = hints;
if (load(hcl, &mdp->mod) <= -1)
{
hcl_rbt_delete (&hcl->modtab, (hcl_ooch_t*)name, namelen);
@ -546,8 +525,7 @@ hcl_mod_data_t* hcl_openmod (hcl_t* hcl, const hcl_ooch_t* name, hcl_oow_t namel
load = hcl->vmprim.dl_getsym(hcl, md.handle, buf);
if (!load)
{
const hcl_ooch_t* oldmsg = hcl_backuperrmsg (hcl);
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "unable to get module symbol [%js] in [%.*js] - %js", buf, namelen, name, oldmsg);
hcl_seterrbfmt (hcl, hcl_geterrnum(hcl), "unable to get module symbol [%js] in [%.*js]", 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);
return HCL_NULL;
@ -566,7 +544,6 @@ 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);
HCL_ASSERT (hcl, HCL_SIZEOF(mdp->mod.hints) == HCL_SIZEOF(int));
mdp->mod.hints = hints;
if (load(hcl, &mdp->mod) <= -1)
{
const hcl_ooch_t* oldmsg = hcl_backuperrmsg (hcl);
@ -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)
{
/* 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
{
/* 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;
}
@ -713,3 +643,40 @@ hcl_pfbase_t* hcl_querymod (hcl_t* hcl, const hcl_ooch_t* pfid, hcl_oow_t pfidle
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

25
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)
{
hcl_bch_t* dash;
hcl_seterrbfmt (hcl, HCL_ESYSERR, "unable to open(ext) DL %js - %hs", name, sys_dl_error());
HCL_DEBUG3 (hcl, "Failed to open(ext) DL %hs[%js] - %hs\n", &bufptr[len], name, sys_dl_error());
const hcl_bch_t* dl_errstr;
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), '-');
if (dash)
{
@ -542,8 +545,10 @@ static void* dl_open (hcl_t* hcl, const hcl_ooch_t* name, int flags)
handle = sys_dl_open(bufptr);
if (!handle)
{
hcl_seterrbfmt (hcl, HCL_ESYSERR, "unable to open DL %js - %hs", name, sys_dl_error());
HCL_DEBUG2 (hcl, "Failed to open DL %hs - %hs\n", bufptr, sys_dl_error());
const hcl_bch_t* dl_errstr;
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);
}
@ -552,8 +557,10 @@ static void* dl_open (hcl_t* hcl, const hcl_ooch_t* name, int flags)
handle = sys_dl_openext(bufptr);
if (!handle)
{
hcl_seterrbfmt (hcl, HCL_ESYSERR, "unable to open(ext) DL %js - %hs", name, sys_dl_error());
HCL_DEBUG2 (hcl, "Failed to open(ext) DL %hs - %s\n", bufptr, sys_dl_error());
const hcl_bch_t* dl_errstr;
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);
}
@ -642,7 +649,11 @@ static void* dl_getsym (hcl_t* hcl, void* handle, const hcl_ooch_t* name)
sym = sys_dl_getsym(handle, symname);
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;
}
/* ------------------------------------------------------------------------- */
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 */
ps.type = PRINT_STACK_CONS;
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);
if (x <= -1) return -1;
@ -309,6 +310,7 @@ next:
resume_cons:
HCL_ASSERT (hcl, ps.type == PRINT_STACK_CONS);
cur = ps.obj; /* Get back the CDR pushed */
concode = ps.idx; /* restore the concode */
if (HCL_IS_NIL(hcl,cur))
{
/* The CDR part points to a NIL object, which