added hcl_getlastretv().

enhanced hcl_hashobj() to return hash values for nil, true, false
This commit is contained in:
2018-02-22 07:41:03 +00:00
parent dbeac10a38
commit 4876d1775c
8 changed files with 109 additions and 81 deletions

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: