From a60bd0c898eb9efee7b73fd69847f540739aee27 Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Thu, 8 Mar 2018 14:18:30 +0000 Subject: [PATCH] renamed hcl_purgeatdic() to hcl_zapatdic() exposed hcl_moveoop() extended the meaning of the kernel bits in the object flags extended hcl_pfbase_t to include the type - one of HCL_PFBASE_FUNC, HCL_PFBASE_VAR, HCL_PFBASE_CONST. HCL_PFBASE_CONST not fully implemented yet --- lib/comp.c | 8 +++---- lib/dic.c | 42 +++++++++++++++++++++------------ lib/exec.c | 6 ++--- lib/gc.c | 1 + lib/hcl-prv.h | 9 -------- lib/hcl.c | 20 +++++++++------- lib/hcl.h | 64 ++++++++++++++++++++++++++++++++++++++++++--------- lib/main.c | 40 +++++++++++++++++++++++++++++++- lib/prim.c | 2 +- lib/read.c | 44 ++++++++++++++++++++++++++++------- mod/arr.c | 8 +++---- mod/dic.c | 8 +++---- mod/str.c | 3 ++- 13 files changed, 186 insertions(+), 69 deletions(-) diff --git a/lib/comp.c b/lib/comp.c index a17930f..5e117ba 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -868,7 +868,7 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src, int defun) return -1; } - if (HCL_OBJ_GET_FLAGS_SYNCODE(defun_name) || HCL_OBJ_GET_FLAGS_KERNEL(defun_name)) + if (HCL_OBJ_GET_FLAGS_SYNCODE(defun_name) || HCL_OBJ_GET_FLAGS_KERNEL(defun_name) >= 1) { hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDVARNAME, HCL_NULL, HCL_NULL, "special symbol not to be used as a defun name - %O", defun_name); /* TOOD: error location */ @@ -925,7 +925,7 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src, int defun) return -1; } - if (HCL_OBJ_GET_FLAGS_SYNCODE(arg) || HCL_OBJ_GET_FLAGS_KERNEL(arg)) + if (HCL_OBJ_GET_FLAGS_SYNCODE(arg) || HCL_OBJ_GET_FLAGS_KERNEL(arg) >= 2) { hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDARGNAME, HCL_NULL, HCL_NULL, "special symbol not to be declared as an argument - %O", arg); /* TOOD: error location */ @@ -986,7 +986,7 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src, int defun) for (i = 0; i < sz; i++) { if (HCL_OBJ_GET_FLAGS_SYNCODE(((hcl_oop_oop_t)dcl)->slot[i]) || - HCL_OBJ_GET_FLAGS_KERNEL(((hcl_oop_oop_t)dcl)->slot[i])) + HCL_OBJ_GET_FLAGS_KERNEL(((hcl_oop_oop_t)dcl)->slot[i]) >= 2) { hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDVARNAME, HCL_NULL, HCL_NULL, "special symbol not to be declared as a variable - %O", obj); /* TOOD: error location */ @@ -1135,7 +1135,7 @@ static int compile_set (hcl_t* hcl, hcl_oop_t src) return -1; } - if (HCL_OBJ_GET_FLAGS_SYNCODE(var) || HCL_OBJ_GET_FLAGS_KERNEL(var)) + if (HCL_OBJ_GET_FLAGS_SYNCODE(var) || HCL_OBJ_GET_FLAGS_KERNEL(var) >= 2) { hcl_setsynerrbfmt (hcl, HCL_SYNERR_BANNEDVARNAME, HCL_NULL, HCL_NULL, "special symbol not to be used as a variable name - %O", var); /* TOOD: error location */ return -1; diff --git a/lib/dic.c b/lib/dic.c index edd4b17..f0afcbf 100644 --- a/lib/dic.c +++ b/lib/dic.c @@ -92,7 +92,11 @@ static hcl_oop_oop_t expand_bucket (hcl_t* hcl, hcl_oop_oop_t oldbuc) return newbuc; } +#if defined(SYMBOL_ONLY_KEY) static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_char_t key, hcl_oop_t value) +#else +static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t key, hcl_oop_t value) +#endif { hcl_ooi_t tally; hcl_oow_t index; @@ -110,7 +114,7 @@ static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_cha #if defined(SYMBOL_ONLY_KEY) index = hcl_hashoochars(key->slot, HCL_OBJ_GET_SIZE(key)) % HCL_OBJ_GET_SIZE(dic->bucket); #else - if (hcl_hashobj(hcl, (hcl_oop_t)key, &index) <= -1) return HCL_NULL; + if (hcl_hashobj(hcl, key, &index) <= -1) return HCL_NULL; index %= HCL_OBJ_GET_SIZE(dic->bucket); #endif @@ -135,7 +139,7 @@ static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_cha 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); + n = hcl_equalobjs(hcl, key, ass->car); if (n <= -1) return HCL_NULL; if (n >= 1) { @@ -196,7 +200,7 @@ static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_cha /* recalculate the index for the expanded bucket */ index = hcl_hashoochars(key->slot, HCL_OBJ_GET_SIZE(key)) % HCL_OBJ_GET_SIZE(dic->bucket); #else - hcl_hashobj(hcl, (hcl_oop_t)key, &index); /* this must succeed as i know 'key' is hashable */ + hcl_hashobj(hcl, key, &index); /* this must succeed as i know 'key' is hashable */ index %= HCL_OBJ_GET_SIZE(dic->bucket); #endif @@ -206,7 +210,7 @@ static hcl_oop_cons_t find_or_upsert (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_cha /* create a new assocation of a key and a value since * the key isn't found in the root dictionary */ - ass = (hcl_oop_cons_t)hcl_makecons (hcl, (hcl_oop_t)key, (hcl_oop_t)value); + ass = (hcl_oop_cons_t)hcl_makecons (hcl, (hcl_oop_t)key, value); if (!ass) goto oops; /* the current tally must be less than the maximum value. otherwise, @@ -228,7 +232,7 @@ hcl_oop_cons_t hcl_putatsysdic (hcl_t* hcl, hcl_oop_t key, hcl_oop_t value) #if defined(SYMBOL_ONLY_KEY) HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,key)); #endif - return find_or_upsert (hcl, hcl->sysdic, (hcl_oop_char_t)key, value); + return find_or_upsert(hcl, hcl->sysdic, key, value); } hcl_oop_cons_t hcl_getatsysdic (hcl_t* hcl, hcl_oop_t key) @@ -236,7 +240,15 @@ hcl_oop_cons_t hcl_getatsysdic (hcl_t* hcl, hcl_oop_t key) #if defined(SYMBOL_ONLY_KEY) HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,key)); #endif - return find_or_upsert (hcl, hcl->sysdic, (hcl_oop_char_t)key, HCL_NULL); + return find_or_upsert(hcl, hcl->sysdic, key, HCL_NULL); +} + +int hcl_zapatsysdic (hcl_t* hcl, hcl_oop_t key) +{ +#if defined(SYMBOL_ONLY_KEY) + HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,key)); +#endif + return hcl_zapatdic(hcl, hcl->sysdic, key); } hcl_oop_cons_t hcl_putatdic (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t key, hcl_oop_t value) @@ -244,7 +256,7 @@ hcl_oop_cons_t hcl_putatdic (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t key, hcl_o #if defined(SYMBOL_ONLY_KEY) HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,key)); #endif - return find_or_upsert (hcl, dic, (hcl_oop_char_t)key, value); + return find_or_upsert(hcl, dic, key, value); } hcl_oop_cons_t hcl_getatdic (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t key) @@ -252,13 +264,13 @@ hcl_oop_cons_t hcl_getatdic (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t key) #if defined(SYMBOL_ONLY_KEY) HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl,key)); #endif - return find_or_upsert (hcl, dic, (hcl_oop_char_t)key, HCL_NULL); + return find_or_upsert(hcl, dic, key, HCL_NULL); } -int hcl_purgeatdic (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t key) +int hcl_zapatdic (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_oow_t index, bs, i, x, y, z; hcl_oop_cons_t ass; tally = HCL_OOP_TO_SMOOI(dic->tally); @@ -275,7 +287,7 @@ int hcl_purgeatdic (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t key) #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; + if (hcl_hashobj(hcl, key, &index) <= -1) return -1; index %= bs; #endif @@ -288,7 +300,7 @@ int hcl_purgeatdic (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t key) 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))) + hcl_equaloochars(HCL_OBJ_GET_CHAR_SLOT(key), HCL_OBJ_GET_CHAR_SLOT(ass->car), HCL_OBJ_GET_SIZE(key))) { /* the value of HCL_NULL indicates no insertion or update. */ goto found; @@ -304,7 +316,7 @@ int hcl_purgeatdic (hcl_t* hcl, hcl_oop_dic_t dic, hcl_oop_t key) if (n >= 1) goto found; #endif - index = (index + 1) % HCL_OBJ_GET_SIZE(dic->bucket); + index = (index + 1) % bs; } hcl_seterrnum (hcl, HCL_ENOENT); @@ -323,10 +335,10 @@ found: #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; + z = hcl_hashoochars(HCL_OBJ_GET_CHAR_SLOT(ass->car), HCL_OBJ_GET_SIZE(ass->car)) % bs; #else if (hcl_hashobj(hcl, ass->car, &z) <= -1) return -1; - index %= bs; + z %= bs; #endif /* move an element if necesary */ diff --git a/lib/exec.c b/lib/exec.c index 35a203a..a512c8a 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -1165,12 +1165,12 @@ static int execute (hcl_t* hcl) }*/ /* TODO: implement different process switching scheme - time-slice or clock based??? */ -#if defined(HCL_EXTERNAL_PROCESS_SWITCH) + #if defined(HCL_EXTERNAL_PROCESS_SWITCH) if (!hcl->proc_switched && hcl->switch_proc) { switch_to_next_runnable_process (hcl); } hcl->switch_proc = 0; -#else + #else if (!hcl->proc_switched) { switch_to_next_runnable_process (hcl); } -#endif + #endif hcl->proc_switched = 0; diff --git a/lib/gc.c b/lib/gc.c index 8d041d8..267ece8 100644 --- a/lib/gc.c +++ b/lib/gc.c @@ -539,5 +539,6 @@ int hcl_ignite (hcl_t* hcl) } hcl->p.e = hcl->_nil; + return 0; } diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index 474b1e1..d1c5a55 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -718,15 +718,6 @@ void* hcl_allocheapmem ( hcl_oow_t size ); - -/* ========================================================================= */ -/* gc.c */ -/* ========================================================================= */ -hcl_oop_t hcl_moveoop ( - hcl_t* hcl, - hcl_oop_t oop -); - /* ========================================================================= */ /* obj.c */ /* ========================================================================= */ diff --git a/lib/hcl.c b/lib/hcl.c index 39194e4..55ddfc8 100644 --- a/lib/hcl.c +++ b/lib/hcl.c @@ -286,25 +286,29 @@ void hcl_fini (hcl_t* hcl) } } -void hcl_clear (hcl_t* hcl) +void hcl_reset (hcl_t* hcl) { hcl_oop_t v; hcl_oow_t i; -#if 0 - /* clear global variables -> especially lambdas, because they refer to the byte codes? */ + /* delete all literals shown in the literal frame from the system dictionary + * excluding special kernel symbols. */ 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)) + v = ((hcl_oop_oop_t)hcl->code.lit.arr)->slot[i]; + if (HCL_IS_CONS(hcl, v)) { - hcl_delat + hcl_oop_t key = HCL_CONS_CAR(v); + if (!HCL_IS_SYMBOL(hcl,key) || !HCL_OBJ_GET_FLAGS_KERNEL(key)) + hcl_zapatsysdic (hcl, HCL_CONS_CAR(v)); } } -#endif - /* clear the byte code and literals */ + + /* zap the byte code buffer and the literal frame */ hcl->code.bc.len = 0; hcl->code.lit.len = 0; + + /* clean up object memory */ hcl_gc (hcl); } diff --git a/lib/hcl.h b/lib/hcl.h index b332140..2cf48af 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -375,9 +375,11 @@ typedef enum hcl_obj_type_t hcl_obj_type_t; * item than the value of the size field. used for a * terminating null in a variable-char object. internel * use only. - * kernel: 0 or 1. indicates that the object is a kernel object. - * VM disallows layout changes of a kernel object. - * internal use only. + * kernel: 0 - ordinary object. + * 1 - kernel object. can survive hcl_reset(). + * 2 - kernel object. can survive hcl_reset(). + * a symbol object with 2 in the kernel bits cannot be assigned a + * value with the 'set' special form. * moved: 0 or 1. used by GC. internal use only. * ngc: 0 or 1, used by GC. internal use only. * trailer: 0 or 1. indicates that there are trailing bytes @@ -857,22 +859,30 @@ typedef enum hcl_pfrc_t hcl_pfrc_t; typedef hcl_pfrc_t (*hcl_pfimpl_t) ( hcl_t* hcl, hcl_mod_t* mod, - hcl_ooi_t nargs); + hcl_ooi_t nargs +); +enum hcl_pfbase_type_t +{ + HCL_PFBASE_FUNC = 0, + HCL_PFBASE_VAR = 1, + HCL_PFBASE_CONST = 2 +}; +typedef enum hcl_pfbase_type_t hcl_pfbase_type_t; typedef struct hcl_pfbase_t hcl_pfbase_t; struct hcl_pfbase_t { - hcl_pfimpl_t handler; - hcl_oow_t minargs; - hcl_oow_t maxargs; + hcl_pfbase_type_t type; + hcl_pfimpl_t handler; + hcl_oow_t minargs; + hcl_oow_t maxargs; }; typedef struct hcl_pfinfo_t hcl_pfinfo_t; struct hcl_pfinfo_t { hcl_ooch_t mthname[32]; - int variadic; hcl_pfbase_t base; }; /* ========================================================================= @@ -1364,10 +1374,17 @@ HCL_EXPORT void hcl_fini ( hcl_t* hcl ); -/* -HCL_EXPORT void hcl_clear ( +/** + * The hcl_reset() function some internal states back to the initial state. + * The affected internal states include byte code buffer, literal frame, + * ordinary global variables. You should take extra precaution as it is + * a risky function. For instance, a global variable inserted manually + * with hcl_putatsysdic() gets deleted if the kernel bit is not set on + * the variable symbol. + */ +HCL_EXPORT void hcl_reset ( hcl_t* hcl -);*/ +); #if defined(HCL_HAVE_INLINE) static HCL_INLINE hcl_mmgr_t* hcl_getmmgr (hcl_t* hcl) { return hcl->mmgr; } @@ -1467,6 +1484,19 @@ HCL_EXPORT void hcl_gc ( hcl_t* hcl ); + +/** + * The hcl_moveoop() function is used to move a live object to a new + * location in hcl_gc(). When hcl_gc() invokes registered gc callbacks, + * you may call this function to protect extra objects you might have + * allocated manually. + */ +hcl_oop_t hcl_moveoop ( + hcl_t* hcl, + hcl_oop_t oop +); + + HCL_EXPORT hcl_oow_t hcl_getpayloadbytes ( hcl_t* hcl, hcl_oop_t oop @@ -1814,6 +1844,11 @@ HCL_EXPORT hcl_oop_cons_t hcl_getatsysdic ( hcl_oop_t key ); +HCL_EXPORT int hcl_zapatsysdic ( + hcl_t* hcl, + hcl_oop_t key +); + HCL_EXPORT hcl_oop_cons_t hcl_putatdic ( hcl_t* hcl, hcl_oop_dic_t dic, @@ -1827,6 +1862,13 @@ HCL_EXPORT hcl_oop_cons_t hcl_getatdic ( hcl_oop_t key ); + +HCL_EXPORT int hcl_zapatdic ( + hcl_t* hcl, + hcl_oop_dic_t dic, + hcl_oop_t key +); + HCL_EXPORT int hcl_walkdic ( hcl_t* hcl, hcl_oop_dic_t dic, diff --git a/lib/main.c b/lib/main.c index 2f27ab6..223e0c0 100644 --- a/lib/main.c +++ b/lib/main.c @@ -146,6 +146,8 @@ struct xtn_t int logfd_istty; int reader_istty; + + hcl_oop_t sym_errstr; }; /* ========================================================================= */ @@ -1216,6 +1218,12 @@ static void vm_sleep (hcl_t* hcl, const hcl_ntime_t* dur) /* ========================================================================= */ +static void gc_hcl (hcl_t* hcl) +{ + xtn_t* xtn = (xtn_t*)hcl_getxtn(hcl); + if (xtn->sym_errstr) xtn->sym_errstr = hcl_moveoop(hcl, xtn->sym_errstr); +} + static void fini_hcl (hcl_t* hcl) { xtn_t* xtn = (xtn_t*)hcl_getxtn(hcl); @@ -1629,6 +1637,7 @@ int main (int argc, char* argv[]) memset (&hclcb, 0, HCL_SIZEOF(hclcb)); hclcb.fini = fini_hcl; + hclcb.gc = gc_hcl; hcl_regcb (hcl, &hclcb); @@ -1676,14 +1685,31 @@ int main (int argc, char* argv[]) if (hcl_attachio(hcl, read_handler, print_handler) <= -1) { - hcl_logbfmt (hcl, HCL_LOG_STDERR, "ERROR: cannot attache input stream - [%d] %js\n", hcl_geterrnum(hcl), hcl_geterrmsg(hcl)); + hcl_logbfmt (hcl, HCL_LOG_STDERR, "ERROR: cannot attach input stream - [%d] %js\n", hcl_geterrnum(hcl), hcl_geterrmsg(hcl)); hcl_close (hcl); return -1; } + { + hcl_ooch_t errstr[] = { 'E', 'R', 'R', 'S', 'T', 'R' }; + xtn->sym_errstr = hcl_makesymbol(hcl, errstr, 6); + if (!xtn->sym_errstr) + { + hcl_logbfmt (hcl, HCL_LOG_STDERR, "ERROR: cannot create the ERRSTR symbol - [%d] %js\n", hcl_geterrnum(hcl), hcl_geterrmsg(hcl)); + hcl_close (hcl); + return -1; + } + HCL_OBJ_SET_FLAGS_KERNEL (xtn->sym_errstr, 1); + } + while (1) { hcl_oop_t obj; +/* +static int count = 0; +if (count %5 == 0) hcl_reset (hcl); +count++; +*/ obj = hcl_read(hcl); if (!obj) @@ -1747,6 +1773,17 @@ int main (int argc, char* argv[]) else { hcl_logbfmt (hcl, HCL_LOG_STDERR, "OK: EXITED WITH %O\n", retv); + + /* + * print the value of ERRSTR. + hcl_oop_cons_t cons = hcl_getatsysdic(hcl, xtn->sym_errstr); + if (cons) + { + HCL_ASSERT (hcl, HCL_IS_CONS(hcl, cons)); + HCL_ASSERT (hcl, HCL_CONS_CAR(cons) == xtn->sym_errstr); + hcl_print (hcl, HCL_CONS_CDR(cons)); + } + */ } //cancel_tick(); g_hcl = HCL_NULL; @@ -1774,6 +1811,7 @@ int main (int argc, char* argv[]) hcl_logbfmt (hcl, HCL_LOG_STDERR, "EXECUTION OK - EXITED WITH %O\n", retv); } + //cancel_tick(); g_hcl = HCL_NULL; /*hcl_dumpsymtab (hcl);*/ diff --git a/lib/prim.c b/lib/prim.c index 6ce86fa..181e575 100644 --- a/lib/prim.c +++ b/lib/prim.c @@ -488,7 +488,7 @@ int hcl_addbuiltinprims (hcl_t* hcl) /* turn on the kernel bit in the symbol associated with a primitive * function. 'set' prevents this symbol from being used as a variable * name */ - HCL_OBJ_SET_FLAGS_KERNEL (name, 1); + HCL_OBJ_SET_FLAGS_KERNEL (name, 2); } return 0; diff --git a/lib/read.c b/lib/read.c index d96e275..7015151 100644 --- a/lib/read.c +++ b/lib/read.c @@ -2091,31 +2091,59 @@ static int read_object (hcl_t* hcl) case HCL_IOTOK_IDENT_DOTTED: obj = hcl_makesymbol(hcl, TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl)); - if (obj) + if (obj && !hcl_getatsysdic(hcl, obj)) { + /* query the module for information if it is the first time + * when the dotted symbol is seen */ + hcl_pfbase_t* pfbase; hcl_mod_t* mod; - hcl_oop_t prim; - + hcl_oop_t val; + unsigned int kernel_bits; + pfbase = hcl_querymod(hcl, TOKEN_NAME_PTR(hcl), TOKEN_NAME_LEN(hcl), &mod); if (!pfbase) { /* TODO switch to syntax error */ return -1; } - + hcl_pushtmp (hcl, &obj); - prim = hcl_makeprim(hcl, pfbase->handler, pfbase->minargs, pfbase->maxargs, mod); + switch (pfbase->type) + { + case HCL_PFBASE_FUNC: + kernel_bits = 2; + val = hcl_makeprim(hcl, pfbase->handler, pfbase->minargs, pfbase->maxargs, mod); + break; - if (!prim || !hcl_putatsysdic(hcl, obj, prim)) + case HCL_PFBASE_VAR: + kernel_bits = 1; + val = hcl->_nil; + break; + + case HCL_PFBASE_CONST: + /* TODO: create a value from the pfbase information. it needs to get extended first + * can i make use of pfbase->handler type-cast to a differnt type? */ + kernel_bits = 2; + val = hcl->_nil; + break; + + default: + hcl_poptmp (hcl); + hcl_seterrbfmt (hcl, HCL_EINVAL, "invalid pfbase type - %d\n", pfbase->type); + return -1; + } + + if (!val || !hcl_putatsysdic(hcl, obj, val)) { hcl_poptmp (hcl); return -1; } - hcl_poptmp (hcl); - HCL_OBJ_SET_FLAGS_KERNEL (obj, 1); + /* make this dotted symbol special that it can't get changed + * to a different value */ + HCL_OBJ_SET_FLAGS_KERNEL (obj, kernel_bits); } break; } diff --git a/mod/arr.c b/mod/arr.c index 11786a5..fff0682 100644 --- a/mod/arr.c +++ b/mod/arr.c @@ -105,10 +105,10 @@ static hcl_pfrc_t pf_arr_size (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) static hcl_pfinfo_t pfinfos[] = { - { { 'g','e','t','\0' }, 0, { pf_arr_get, 2, 2 } }, -/* { { 'm','a','k','e','\0' }, 0, { pf_arr_make, 1, 1 } },*/ - { { 'p','u','t','\0' }, 0, { pf_arr_put, 3, 3 } }, - { { 's','i','z','e','\0' }, 0, { pf_arr_size, 1, 1 } }, + { { 'g','e','t','\0' }, { HCL_PFBASE_FUNC, pf_arr_get, 2, 2 } }, +/* { { 'm','a','k','e','\0' }, { HCL_PFBASE_FUNC, pf_arr_make, 1, 1 } },*/ + { { 'p','u','t','\0' }, { HCL_PFBASE_FUNC, pf_arr_put, 3, 3 } }, + { { 's','i','z','e','\0' }, { HCL_PFBASE_FUNC, pf_arr_size, 1, 1 } }, }; /* ------------------------------------------------------------------------ */ diff --git a/mod/dic.c b/mod/dic.c index ed84a75..86302f4 100644 --- a/mod/dic.c +++ b/mod/dic.c @@ -110,10 +110,10 @@ static hcl_pfrc_t pf_dic_walk (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) static hcl_pfinfo_t pfinfos[] = { - { { 'g','e','t','\0' }, 0, { pf_dic_get, 2, 2 } }, -/* { { 'm','a','k','e','\0' }, 0, { pf_dic_make, 1, 1 } }, */ - { { 'p','u','t','\0' }, 0, { pf_dic_put, 3, 3 } }, - { { 'w','a','l','k','\0' }, 0, { pf_dic_walk, 2, 2 } }, + { { 'g','e','t','\0' }, { HCL_PFBASE_FUNC, pf_dic_get, 2, 2 } }, +/* { { 'm','a','k','e','\0' }, { HCL_PFBASE_FUNC, pf_dic_make, 1, 1 } }, */ + { { 'p','u','t','\0' }, { HCL_PFBASE_FUNC, pf_dic_put, 3, 3 } }, + { { 'w','a','l','k','\0' }, { HCL_PFBASE_FUNC, pf_dic_walk, 2, 2 } }, }; /* ------------------------------------------------------------------------ */ diff --git a/mod/str.c b/mod/str.c index 4ceca9b..2bb9d8e 100644 --- a/mod/str.c +++ b/mod/str.c @@ -47,7 +47,8 @@ static hcl_pfrc_t pf_str_length (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs) static hcl_pfinfo_t pfinfos[] = { - { { 'l','e','n','g','t','h','\0' }, 0, { pf_str_length, 1, 1 } } + /*{ { 'V','A','R','\0' }, { HCL_PFBASE_VAR, HCL_NULL, 0, 0 } },*/ + { { 'l','e','n','g','t','h','\0' }, { HCL_PFBASE_FUNC, pf_str_length, 1, 1 } } }; /* ------------------------------------------------------------------------ */