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

added hcl_getlastretv().

Browse Source 
enhanced hcl_hashobj() to return hash values for nil, true, false
This commit is contained in:
hyung-hwan
2018-02-22 07:41:03 +00:00
parent 20cf176de8
commit a7fcf50a89
8 changed files with 109 additions and 81 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
hcl/lib/dic.c
View File

@ -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;

21
hcl/lib/exec.c
View File

@ -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;

33
hcl/lib/gc.c
View File

@ -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)
{

27
hcl/lib/hcl.h
View File

@ -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 (

9
hcl/lib/main.c
View File

@ -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;

88
hcl/lib/obj.c
View File

@ -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:

6
hcl/lib/read.c
View File

@ -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... */

2
hcl/lib/sym.c
View File

@ -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;