hyung-hwan/hcl
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 dbeac10a38
commit 4876d1775c
8 changed files with 109 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

7
lib/gc.c
View File

@ -321,11 +321,6 @@ void hcl_gc (hcl_t* hcl)
*(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);
@ -360,6 +355,8 @@ void hcl_gc (hcl_t* hcl)
if (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)
{
if (cb->gc) cb->gc (hcl);

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

38
lib/obj.c
View File

@ -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));
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)
{
@ -181,7 +194,6 @@ hcl_oop_t hcl_allocwordobj (hcl_t* hcl, int brand, const hcl_oow_t* ptr, hcl_oow
return alloc_numeric_array(hcl, brand, ptr, len, HCL_OBJ_TYPE_WORD, HCL_SIZEOF(hcl_oow_t), 0, 0);
}
/* ------------------------------------------------------------------------ *
* COMMON OBJECTS
* ------------------------------------------------------------------------ */
@ -240,7 +252,7 @@ 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);
}
@ -256,7 +268,6 @@ hcl_oop_t hcl_makestring (hcl_t* hcl, const hcl_ooch_t* ptr, hcl_oow_t len, int
return alloc_numeric_array(hcl, HCL_BRAND_STRING, ptr, len, HCL_OBJ_TYPE_CHAR, HCL_SIZEOF(hcl_ooch_t), 1, ngc);
}
/* ------------------------------------------------------------------------ *
* NGC HANDLING
* ------------------------------------------------------------------------ */
@ -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
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
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;