From 4876d1775c5fb9a44cd2df3f51db586ad7169c32 Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Thu, 22 Feb 2018 07:41:03 +0000 Subject: [PATCH] added hcl_getlastretv(). enhanced hcl_hashobj() to return hash values for nil, true, false --- lib/dic.c | 4 +-- lib/exec.c | 21 +++++++++---- lib/gc.c | 33 ++++++++++---------- lib/hcl.h | 27 +++++------------ lib/main.c | 9 +++++- lib/obj.c | 88 +++++++++++++++++++++++++++++++++++------------------- lib/read.c | 6 ++-- lib/sym.c | 2 +- 8 files changed, 109 insertions(+), 81 deletions(-) diff --git a/lib/dic.c b/lib/dic.c index ea532f1..00ddad4 100644 --- a/lib/dic.c +++ b/lib/dic.c @@ -64,7 +64,7 @@ static hcl_oop_oop_t expand_bucket (hcl_t* hcl, hcl_oop_oop_t oldbuc) } hcl_pushtmp (hcl, (hcl_oop_t*)&oldbuc); - newbuc = (hcl_oop_oop_t)hcl_makearray (hcl, newsz); + newbuc = (hcl_oop_oop_t)hcl_makearray (hcl, newsz, 0); hcl_poptmp (hcl); if (!newbuc) return HCL_NULL; @@ -268,7 +268,7 @@ hcl_oop_t hcl_makedic (hcl_t* hcl, hcl_oow_t inisize) obj->tally = HCL_SMOOI_TO_OOP(0); 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, 0); hcl_poptmp (hcl); if (!bucket) obj = HCL_NULL; diff --git a/lib/exec.c b/lib/exec.c index f4f5c43..e3f92b1 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -1798,7 +1798,7 @@ static int execute (hcl_t* hcl) LOG_INST_1 (hcl, "make_array %zu", b1); /* create an empty array */ - t = hcl_makearray (hcl, b1); + t = hcl_makearray (hcl, b1, 0); if (!t) goto oops; HCL_STACK_PUSH (hcl, t); /* push the array created */ @@ -1894,6 +1894,12 @@ static int execute (hcl_t* hcl) case HCL_CODE_POP_STACKTOP: LOG_INST_0 (hcl, "pop_stacktop"); HCL_ASSERT (hcl, !HCL_STACK_ISEMPTY(hcl)); + + /* at the top level, the value is just popped off the stack + * after evaluation of an expressio. so it's likely the + * return value of the last expression unless explicit + * returning is performed */ + hcl->last_retv = HCL_STACK_GETTOP(hcl); HCL_STACK_POP (hcl); break; @@ -1917,7 +1923,6 @@ static int execute (hcl_t* hcl) /* decrement the instruction pointer back to the return instruction. * even if the context is reentered, it will just return. *hcl->ip--;*/ - terminate_process (hcl, hcl->processor->active); } else @@ -2009,6 +2014,7 @@ static int execute (hcl_t* hcl) LOG_INST_0 (hcl, "return_from_block"); HCL_ASSERT(hcl, HCL_IS_CONTEXT(hcl, hcl->active_context)); + hcl->last_retv = HCL_STACK_GETTOP(hcl); if (hcl->active_context == hcl->processor->active->initial_context) { /* the active context to return from is an initial context of @@ -2183,7 +2189,7 @@ static int execute (hcl_t* hcl) done: vm_cleanup (hcl); #if defined(HCL_PROFILE_VM) - HCL_LOG1 (hcl, HCL_LOG_IC | HCL_LOG_INFO, "TOTAL_INST_COUTNER = %zu\n", inst_counter); + HCL_LOG1 (hcl, HCL_LOG_IC | HCL_LOG_INFO, "TOTAL INST COUTNER = %zu\n", inst_counter); #endif return 0; @@ -2191,7 +2197,7 @@ oops: /* TODO: anything to do here? */ if (hcl->processor->active != hcl->nil_process) { -HCL_LOG1 (hcl, HCL_LOG_IC | HCL_LOG_INFO, "TERMINATING ACTIVE PROCESS ... = %zd\n", HCL_OOP_TO_SMOOI(hcl->processor->active->id)); + HCL_LOG1 (hcl, HCL_LOG_IC | HCL_LOG_INFO, "TERMINATING ACTIVE PROCESS %zd for execution error\n", HCL_OOP_TO_SMOOI(hcl->processor->active->id)); terminate_process (hcl, hcl->processor->active); } return -1; @@ -2199,8 +2205,7 @@ HCL_LOG1 (hcl, HCL_LOG_IC | HCL_LOG_INFO, "TERMINATING ACTIVE PROCESS ... = %zd\ int hcl_executefromip (hcl_t* hcl, hcl_ooi_t initial_ip) { - int n; - int log_default_type_mask; + int n, log_default_type_mask; log_default_type_mask = hcl->log.default_type_mask; hcl->log.default_type_mask |= HCL_LOG_VM; @@ -2208,11 +2213,15 @@ int hcl_executefromip (hcl_t* hcl, hcl_ooi_t initial_ip) HCL_ASSERT (hcl, hcl->initial_context == HCL_NULL); HCL_ASSERT (hcl, hcl->active_context == HCL_NULL); + hcl->last_retv = hcl->_nil; + if (start_initial_process_and_context(hcl, initial_ip) <= -1) return -1; hcl->initial_context = hcl->processor->active->initial_context; n = execute (hcl); + HCL_INFO1 (hcl, "RETURNED VALUE - %O\n", hcl->last_retv); + /* TODO: reset processor fields. set processor->tally to zero. processor->active to nil_process... */ hcl->initial_context = HCL_NULL; hcl->active_context = HCL_NULL; diff --git a/lib/gc.c b/lib/gc.c index be8269a..8861484 100644 --- a/lib/gc.c +++ b/lib/gc.c @@ -309,56 +309,53 @@ void hcl_gc (hcl_t* hcl) old_nil = hcl->_nil; /* move _nil and the root object table */ - hcl->_nil = hcl_moveoop (hcl, hcl->_nil); - hcl->_true = hcl_moveoop (hcl, hcl->_true); - hcl->_false = hcl_moveoop (hcl, hcl->_false); + hcl->_nil = hcl_moveoop(hcl, hcl->_nil); + hcl->_true = hcl_moveoop(hcl, hcl->_true); + hcl->_false = hcl_moveoop(hcl, hcl->_false); for (i = 0; i < HCL_COUNTOF(syminfo); i++) { hcl_oop_t tmp; tmp = *(hcl_oop_t*)((hcl_uint8_t*)hcl + syminfo[i].offset); - tmp = hcl_moveoop (hcl, tmp); + tmp = hcl_moveoop(hcl, tmp); *(hcl_oop_t*)((hcl_uint8_t*)hcl + syminfo[i].offset) = tmp; } - hcl->_character = hcl_moveoop (hcl, hcl->_character); - hcl->_small_integer = hcl_moveoop (hcl, hcl->_small_integer); - hcl->_large_positive_integer = hcl_moveoop (hcl, hcl->_large_positive_integer); - hcl->_large_negative_integer = hcl_moveoop (hcl, hcl->_large_negative_integer); - - hcl->sysdic = (hcl_oop_dic_t) hcl_moveoop (hcl, (hcl_oop_t)hcl->sysdic); - hcl->processor = (hcl_oop_process_scheduler_t) hcl_moveoop (hcl, (hcl_oop_t)hcl->processor); - hcl->nil_process = (hcl_oop_process_t) hcl_moveoop (hcl, (hcl_oop_t)hcl->nil_process); + hcl->sysdic = (hcl_oop_dic_t)hcl_moveoop(hcl, (hcl_oop_t)hcl->sysdic); + hcl->processor = (hcl_oop_process_scheduler_t)hcl_moveoop(hcl, (hcl_oop_t)hcl->processor); + hcl->nil_process = (hcl_oop_process_t)hcl_moveoop(hcl, (hcl_oop_t)hcl->nil_process); for (i = 0; i < hcl->code.lit.len; i++) { /* the literal array ia a NGC object. but the literal objects * pointed by the elements of this array must be gabage-collected. */ ((hcl_oop_oop_t)hcl->code.lit.arr)->slot[i] = - hcl_moveoop (hcl, ((hcl_oop_oop_t)hcl->code.lit.arr)->slot[i]); + hcl_moveoop(hcl, ((hcl_oop_oop_t)hcl->code.lit.arr)->slot[i]); } hcl->p.e = hcl_moveoop (hcl, hcl->p.e); for (i = 0; i < hcl->sem_list_count; i++) { - hcl->sem_list[i] = (hcl_oop_semaphore_t)hcl_moveoop (hcl, (hcl_oop_t)hcl->sem_list[i]); + hcl->sem_list[i] = (hcl_oop_semaphore_t)hcl_moveoop(hcl, (hcl_oop_t)hcl->sem_list[i]); } for (i = 0; i < hcl->sem_heap_count; i++) { - hcl->sem_heap[i] = (hcl_oop_semaphore_t)hcl_moveoop (hcl, (hcl_oop_t)hcl->sem_heap[i]); + hcl->sem_heap[i] = (hcl_oop_semaphore_t)hcl_moveoop(hcl, (hcl_oop_t)hcl->sem_heap[i]); } for (i = 0; i < hcl->tmp_count; i++) { - *hcl->tmp_stack[i] = hcl_moveoop (hcl, *hcl->tmp_stack[i]); + *hcl->tmp_stack[i] = hcl_moveoop(hcl, *hcl->tmp_stack[i]); } if (hcl->initial_context) - hcl->initial_context = (hcl_oop_context_t)hcl_moveoop (hcl, (hcl_oop_t)hcl->initial_context); + hcl->initial_context = (hcl_oop_context_t)hcl_moveoop(hcl, (hcl_oop_t)hcl->initial_context); if (hcl->active_context) - hcl->active_context = (hcl_oop_context_t)hcl_moveoop (hcl, (hcl_oop_t)hcl->active_context); + hcl->active_context = (hcl_oop_context_t)hcl_moveoop(hcl, (hcl_oop_t)hcl->active_context); + + if (hcl->last_retv) hcl->last_retv = hcl_moveoop(hcl, hcl->last_retv); for (cb = hcl->cblist; cb; cb = cb->next) { diff --git a/lib/hcl.h b/lib/hcl.h index c8f9a2e..28a9518 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -1007,14 +1007,6 @@ struct hcl_t hcl_oop_t _until; /* symbol */ hcl_oop_t _while; /* symbol */ - /* == NEVER CHANGE THE ORDER OF FIELDS BELOW == */ - /* hcl_ignite() assumes this order. make sure to update symnames in ignite_3() */ - hcl_oop_t _character; - hcl_oop_t _small_integer; /* SmallInteger */ - hcl_oop_t _large_positive_integer; /* LargePositiveInteger */ - hcl_oop_t _large_negative_integer; /* LargeNegativeInteger */ - /* == NEVER CHANGE THE ORDER OF FIELDS ABOVE == */ - hcl_oop_dic_t symtab; /* system-wide symbol table. */ hcl_oop_dic_t sysdic; /* system dictionary. */ hcl_oop_process_scheduler_t processor; /* instance of ProcessScheduler */ @@ -1045,6 +1037,7 @@ struct hcl_t hcl_ooi_t ip; int proc_switched; /* TODO: this is temporary. implement something else to skip immediate context switching */ int switch_proc; + hcl_oop_t last_retv; hcl_ntime_t exec_start_time; hcl_ntime_t exec_end_time; @@ -1466,16 +1459,11 @@ HCL_EXPORT int hcl_executefromip ( hcl_ooi_t initial_ip ); -/** - * The hcl_invoke() function sends a message named \a mthname to an object - * named \a objname. - */ -HCL_EXPORT int hcl_invoke ( - hcl_t* hcl, - const hcl_oocs_t* objname, - const hcl_oocs_t* mthname -); - +#if defined(HCL_HAVE_INLINE) + static HCL_INLINE hcl_oop_t hcl_getlastretv (hcl_t* hcl) { return hcl->last_retv; } +#else +# define hcl_getlastretv(hcl) ((hcl)->last_retv) +#endif HCL_EXPORT int hcl_attachio ( hcl_t* hcl, @@ -1646,7 +1634,8 @@ HCL_EXPORT hcl_oop_t hcl_makecons ( HCL_EXPORT hcl_oop_t hcl_makearray ( hcl_t* hcl, - hcl_oow_t size + hcl_oow_t size, + int ngc ); HCL_EXPORT hcl_oop_t hcl_makebytearray ( diff --git a/lib/main.c b/lib/main.c index 44b34c6..985dafe 100644 --- a/lib/main.c +++ b/lib/main.c @@ -1663,6 +1663,10 @@ int main (int argc, char* argv[]) { hcl_logbfmt (hcl, HCL_LOG_STDERR, "ERROR: cannot execute - [%d] %js\n", hcl_geterrnum(hcl), hcl_geterrmsg(hcl)); } + else + { + hcl_logbfmt (hcl, HCL_LOG_STDERR, "OK: EXITED WITH %O\n", hcl_getlastretv(hcl)); + } //cancel_tick(); g_hcl = HCL_NULL; } @@ -1680,12 +1684,15 @@ int main (int argc, char* argv[]) { hcl_logbfmt (hcl, HCL_LOG_STDERR, "ERROR: cannot execute - [%d] %js\n", hcl_geterrnum(hcl), hcl_geterrmsg(hcl)); } + else + { + hcl_logbfmt (hcl, HCL_LOG_STDERR, "OK: EXITED WITH %O\n", hcl_getlastretv(hcl)); + } //cancel_tick(); g_hcl = HCL_NULL; /*hcl_dumpsymtab (hcl);*/ } - hcl_close (hcl); return 0; diff --git a/lib/obj.c b/lib/obj.c index 49c0bcf..392fdef 100644 --- a/lib/obj.c +++ b/lib/obj.c @@ -35,7 +35,7 @@ void* hcl_allocbytes (hcl_t* hcl, hcl_oow_t size) if ((hcl->option.trait & HCL_DEBUG_GC) && !(hcl->option.trait & HCL_NOGC)) hcl_gc (hcl); #endif - ptr = hcl_allocheapmem (hcl, hcl->curheap, size); + ptr = hcl_allocheapmem(hcl, hcl->curheap, size); if (!ptr && hcl->errnum == HCL_EOOMEM && !(hcl->option.trait & HCL_NOGC)) { hcl_gc (hcl); @@ -52,7 +52,7 @@ void* hcl_allocbytes (hcl_t* hcl, hcl_oow_t size) return ptr; } -hcl_oop_t hcl_allocoopobj (hcl_t* hcl, int brand, hcl_oow_t size) +static HCL_INLINE hcl_oop_t alloc_oop_array (hcl_t* hcl, int brand, hcl_oow_t size, int ngc) { hcl_oop_oop_t hdr; hcl_oow_t nbytes, nbytes_aligned; @@ -63,14 +63,21 @@ hcl_oop_t hcl_allocoopobj (hcl_t* hcl, int brand, hcl_oow_t size) * aligned already. */ nbytes_aligned = HCL_ALIGN(nbytes, HCL_SIZEOF(hcl_oop_t)); - /* making the number of bytes to allocate a multiple of - * HCL_SIZEOF(hcl_oop_t) will guarantee the starting address - * of the allocated space to be an even number. - * see HCL_OOP_IS_NUMERIC() and HCL_OOP_IS_POINTER() */ - hdr = hcl_allocbytes (hcl, HCL_SIZEOF(hcl_obj_t) + nbytes_aligned); + if (HCL_UNLIKELY(ngc)) + { + hdr = hcl_callocmem(hcl, HCL_SIZEOF(hcl_obj_t) + nbytes_aligned); + } + else + { + /* making the number of bytes to allocate a multiple of + * HCL_SIZEOF(hcl_oop_t) will guarantee the starting address + * of the allocated space to be an even number. + * see HCL_OOP_IS_NUMERIC() and HCL_OOP_IS_POINTER() */ + hdr = hcl_allocbytes(hcl, HCL_SIZEOF(hcl_obj_t) + nbytes_aligned); + } if (!hdr) return HCL_NULL; - hdr->_flags = HCL_OBJ_MAKE_FLAGS(HCL_OBJ_TYPE_OOP, HCL_SIZEOF(hcl_oop_t), 0, 0, 0, 0, 0, 0); + hdr->_flags = HCL_OBJ_MAKE_FLAGS(HCL_OBJ_TYPE_OOP, HCL_SIZEOF(hcl_oop_t), 0, 0, 0, ngc, 0, 0); HCL_OBJ_SET_SIZE (hdr, size); HCL_OBJ_SET_CLASS (hdr, hcl->_nil); HCL_OBJ_SET_FLAGS_BRAND (hdr, brand); @@ -80,6 +87,12 @@ hcl_oop_t hcl_allocoopobj (hcl_t* hcl, int brand, hcl_oow_t size) return (hcl_oop_t)hdr; } + +hcl_oop_t hcl_allocoopobj (hcl_t* hcl, int brand, hcl_oow_t size) +{ + return alloc_oop_array (hcl, brand, size, 0); +} + #if defined(HCL_USE_OBJECT_TRAILER) hcl_oop_t hcl_allocoopobjwithtrailer (hcl_t* hcl, hcl_oow_t size, const hcl_oob_t* bptr, hcl_oow_t blen) { @@ -91,7 +104,7 @@ hcl_oop_t hcl_allocoopobjwithtrailer (hcl_t* hcl, hcl_oow_t size, const hcl_oob_ nbytes = (size + 1) * HCL_SIZEOF(hcl_oop_t) + blen; nbytes_aligned = HCL_ALIGN(nbytes, HCL_SIZEOF(hcl_oop_t)); - hdr = hcl_allocbytes (hcl, HCL_SIZEOF(hcl_obj_t) + nbytes_aligned); + hdr = hcl_allocbytes(hcl, HCL_SIZEOF(hcl_obj_t) + nbytes_aligned); if (!hdr) return HCL_NULL; hdr->_flags = HCL_OBJ_MAKE_FLAGS(HCL_OBJ_TYPE_OOP, HCL_SIZEOF(hcl_oop_t), 0, 0, 0, 0, 1, 0); @@ -116,7 +129,7 @@ hcl_oop_t hcl_allocoopobjwithtrailer (hcl_t* hcl, hcl_oow_t size, const hcl_oob_ } #endif -static HCL_INLINE hcl_oop_t alloc_numeric_array (hcl_t* hcl, int brand, const void* ptr, hcl_oow_t len, hcl_obj_type_t type, hcl_oow_t unit, int extra, int ngc) +static HCL_INLINE hcl_oop_t alloc_numeric_array (hcl_t* hcl, int brand, const void* ptr, hcl_oow_t len, hcl_obj_type_t type, hcl_oow_t unit, int extra, int ngc) { /* allocate a variable object */ @@ -135,9 +148,9 @@ static HCL_INLINE hcl_oop_t alloc_numeric_array (hcl_t* hcl, int brand, const v * of the allocated space to be an even number. * see HCL_OOP_IS_NUMERIC() and HCL_OOP_IS_POINTER() */ if (HCL_UNLIKELY(ngc)) - hdr = hcl_callocmem (hcl, HCL_SIZEOF(hcl_obj_t) + nbytes_aligned); + hdr = hcl_callocmem(hcl, HCL_SIZEOF(hcl_obj_t) + nbytes_aligned); else - hdr = hcl_allocbytes (hcl, HCL_SIZEOF(hcl_obj_t) + nbytes_aligned); + hdr = hcl_allocbytes(hcl, HCL_SIZEOF(hcl_obj_t) + nbytes_aligned); if (!hdr) return HCL_NULL; hdr->_flags = HCL_OBJ_MAKE_FLAGS(type, unit, extra, 0, 0, ngc, 0, 0); @@ -163,25 +176,24 @@ static HCL_INLINE hcl_oop_t alloc_numeric_array (hcl_t* hcl, int brand, const v hcl_oop_t hcl_alloccharobj (hcl_t* hcl, int brand, const hcl_ooch_t* ptr, hcl_oow_t len) { - return alloc_numeric_array (hcl, brand, ptr, len, HCL_OBJ_TYPE_CHAR, HCL_SIZEOF(hcl_ooch_t), 1, 0); + return alloc_numeric_array(hcl, brand, ptr, len, HCL_OBJ_TYPE_CHAR, HCL_SIZEOF(hcl_ooch_t), 1, 0); } hcl_oop_t hcl_allocbyteobj (hcl_t* hcl, int brand, const hcl_oob_t* ptr, hcl_oow_t len) { - return alloc_numeric_array (hcl, brand, ptr, len, HCL_OBJ_TYPE_BYTE, HCL_SIZEOF(hcl_oob_t), 0, 0); + return alloc_numeric_array(hcl, brand, ptr, len, HCL_OBJ_TYPE_BYTE, HCL_SIZEOF(hcl_oob_t), 0, 0); } hcl_oop_t hcl_allochalfwordobj (hcl_t* hcl, int brand, const hcl_oohw_t* ptr, hcl_oow_t len) { - return alloc_numeric_array (hcl, brand, ptr, len, HCL_OBJ_TYPE_HALFWORD, HCL_SIZEOF(hcl_oohw_t), 0, 0); + return alloc_numeric_array(hcl, brand, ptr, len, HCL_OBJ_TYPE_HALFWORD, HCL_SIZEOF(hcl_oohw_t), 0, 0); } hcl_oop_t hcl_allocwordobj (hcl_t* hcl, int brand, const hcl_oow_t* ptr, hcl_oow_t len) { - return alloc_numeric_array (hcl, brand, ptr, len, HCL_OBJ_TYPE_WORD, HCL_SIZEOF(hcl_oow_t), 0, 0); + return alloc_numeric_array(hcl, brand, ptr, len, HCL_OBJ_TYPE_WORD, HCL_SIZEOF(hcl_oow_t), 0, 0); } - /* ------------------------------------------------------------------------ * * COMMON OBJECTS * ------------------------------------------------------------------------ */ @@ -189,17 +201,17 @@ hcl_oop_t hcl_allocwordobj (hcl_t* hcl, int brand, const hcl_oow_t* ptr, hcl_oow hcl_oop_t hcl_makenil (hcl_t* hcl) { - return hcl_allocoopobj (hcl, HCL_BRAND_NIL, 0); + return hcl_allocoopobj(hcl, HCL_BRAND_NIL, 0); } hcl_oop_t hcl_maketrue (hcl_t* hcl) { - return hcl_allocoopobj (hcl, HCL_BRAND_TRUE, 0); + return hcl_allocoopobj(hcl, HCL_BRAND_TRUE, 0); } hcl_oop_t hcl_makefalse (hcl_t* hcl) { - return hcl_allocoopobj (hcl, HCL_BRAND_FALSE, 0); + return hcl_allocoopobj(hcl, HCL_BRAND_FALSE, 0); } hcl_oop_t hcl_makebigint (hcl_t* hcl, int brand, const hcl_liw_t* ptr, hcl_oow_t len) @@ -209,9 +221,9 @@ hcl_oop_t hcl_makebigint (hcl_t* hcl, int brand, const hcl_liw_t* ptr, hcl_oow_t HCL_ASSERT (hcl, brand == HCL_BRAND_PBIGINT || brand == HCL_BRAND_NBIGINT); #if (HCL_LIW_BITS == HCL_OOW_BITS) - oop = hcl_allocwordobj (hcl, brand, ptr, len); + oop = hcl_allocwordobj(hcl, brand, ptr, len); #elif (HCL_LIW_BITS == HCL_OOHW_BITS) - oop = hcl_allochalfwordobj (hcl, brand, ptr, len); + oop = hcl_allochalfwordobj(hcl, brand, ptr, len); #else # error UNSUPPORTED LIW BIT SIZE #endif @@ -228,7 +240,7 @@ hcl_oop_t hcl_makecons (hcl_t* hcl, hcl_oop_t car, hcl_oop_t cdr) hcl_pushtmp (hcl, &car); hcl_pushtmp (hcl, &cdr); - cons = (hcl_oop_cons_t)hcl_allocoopobj (hcl, HCL_BRAND_CONS, 2); + cons = (hcl_oop_cons_t)hcl_allocoopobj(hcl, HCL_BRAND_CONS, 2); if (cons) { cons->car = car; @@ -240,23 +252,22 @@ hcl_oop_t hcl_makecons (hcl_t* hcl, hcl_oop_t car, hcl_oop_t cdr) return (hcl_oop_t)cons; } -hcl_oop_t hcl_makearray (hcl_t* hcl, hcl_oow_t size) +hcl_oop_t hcl_makearray (hcl_t* hcl, hcl_oow_t size, int ngc) { - return hcl_allocoopobj (hcl, HCL_BRAND_ARRAY, size); + return hcl_allocoopobj(hcl, HCL_BRAND_ARRAY, size); } hcl_oop_t hcl_makebytearray (hcl_t* hcl, const hcl_oob_t* ptr, hcl_oow_t size) { - return hcl_allocbyteobj (hcl, HCL_BRAND_BYTE_ARRAY, ptr, size); + return hcl_allocbyteobj(hcl, HCL_BRAND_BYTE_ARRAY, ptr, size); } hcl_oop_t hcl_makestring (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len, int ngc) { - /*return hcl_alloccharobj (hcl, HCL_BRAND_STRING, ptr, len);*/ - return alloc_numeric_array (hcl, HCL_BRAND_STRING, ptr, len, HCL_OBJ_TYPE_CHAR, HCL_SIZEOF(hcl_ooch_t), 1, ngc); + /*return hcl_alloccharobj(hcl, HCL_BRAND_STRING, ptr, len);*/ + return alloc_numeric_array(hcl, HCL_BRAND_STRING, ptr, len, HCL_OBJ_TYPE_CHAR, HCL_SIZEOF(hcl_ooch_t), 1, ngc); } - /* ------------------------------------------------------------------------ * * NGC HANDLING * ------------------------------------------------------------------------ */ @@ -268,7 +279,7 @@ void hcl_freengcobj (hcl_t* hcl, hcl_oop_t obj) hcl_oop_t hcl_makengcbytearray (hcl_t* hcl, const hcl_oob_t* ptr, hcl_oow_t len) { - return alloc_numeric_array (hcl, HCL_BRAND_BYTE_ARRAY, ptr, len, HCL_OBJ_TYPE_BYTE, HCL_SIZEOF(hcl_oob_t), 0, 1); + return alloc_numeric_array(hcl, HCL_BRAND_BYTE_ARRAY, ptr, len, HCL_OBJ_TYPE_BYTE, HCL_SIZEOF(hcl_oob_t), 0, 1); } hcl_oop_t hcl_remakengcbytearray (hcl_t* hcl, hcl_oop_t obj, hcl_oow_t newsize) @@ -322,7 +333,6 @@ hcl_oop_t hcl_remakengcarray (hcl_t* hcl, hcl_oop_t obj, hcl_oow_t newsize) return tmp; } - /* ------------------------------------------------------------------------ * * CONS * ------------------------------------------------------------------------ */ @@ -389,6 +399,22 @@ int hcl_hashobj (hcl_t* hcl, hcl_oop_t obj, hcl_oow_t* xhv) { hcl_oow_t hv; + if (obj == hcl->_nil) + { + *xhv = 0; + return 0; + } + else if (obj == hcl->_true) + { + *xhv = 1; + return 0; + } + else if (obj == hcl->_false) + { + *xhv = 2; + return 0; + } + switch (HCL_OOP_GET_TAG(obj)) { case HCL_OOP_TAG_SMOOI: diff --git a/lib/read.c b/lib/read.c index 233ee04..dd6e378 100644 --- a/lib/read.c +++ b/lib/read.c @@ -1427,7 +1427,7 @@ static HCL_INLINE hcl_oop_t leave_list (hcl_t* hcl, int* flagv, int* oldflagv) } hcl_pushtmp (hcl, &head); - arr = (hcl_oop_oop_t)hcl_makearray(hcl, count); + arr = (hcl_oop_oop_t)hcl_makearray(hcl, count, 0); hcl_poptmp (hcl); if (!arr) return HCL_NULL; @@ -1468,7 +1468,7 @@ done: switch (concode) { case HCL_CONCODE_ARRAY: - return (hcl_oop_t)hcl_makearray(hcl, 0); + return (hcl_oop_t)hcl_makearray(hcl, 0, 0); case HCL_CONCODE_BYTEARRAY: return (hcl_oop_t)hcl_makebytearray(hcl, HCL_NULL, 0); case HCL_CONCODE_DIC: @@ -1711,7 +1711,7 @@ static int get_symbol_array_literal (hcl_t* hcl, hcl_oop_t* xlit) return -1; } - sa = hcl_makearray (hcl, hcl->c->r.salit.size); + sa = hcl_makearray(hcl, hcl->c->r.salit.size, 0); if (!sa) { hcl->c->r.salit.size = 0; /* reset literal count... */ diff --git a/lib/sym.c b/lib/sym.c index 23010bd..6dc61b8 100644 --- a/lib/sym.c +++ b/lib/sym.c @@ -61,7 +61,7 @@ static hcl_oop_oop_t expand_bucket (hcl_t* hcl, hcl_oop_oop_t oldbuc) } hcl_pushtmp (hcl, (hcl_oop_t*)&oldbuc); - newbuc = (hcl_oop_oop_t)hcl_makearray (hcl, newsz); + newbuc = (hcl_oop_oop_t)hcl_makearray(hcl, newsz, 0); hcl_poptmp (hcl); if (!newbuc) return HCL_NULL;