added hcl_getlastretv().
enhanced hcl_hashobj() to return hash values for nil, true, false
This commit is contained in:
parent
dbeac10a38
commit
4876d1775c
@ -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
lib/exec.c
21
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;
|
||||
|
||||
33
lib/gc.c
33
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)
|
||||
{
|
||||
|
||||
27
lib/hcl.h
27
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 (
|
||||
|
||||
@ -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
lib/obj.c
88
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:
|
||||
|
||||
@ -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... */
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user