fixing code to implement exception handling
This commit is contained in:
parent
cb917ff44b
commit
cfa019a16d
23
lib/comp.c
23
lib/comp.c
@ -219,6 +219,7 @@ static int push_fnblk (hcl_t* hcl, const hcl_ioloc_t* errloc, hcl_oow_t tmpr_cou
|
||||
hcl->c->fnblk.info[new_depth].tmprlen = tmpr_len;
|
||||
hcl->c->fnblk.info[new_depth].tmprcnt = tmpr_count;
|
||||
|
||||
|
||||
/* remember the control block depth before the function block is entered */
|
||||
hcl->c->fnblk.info[new_depth].cblk_base = hcl->c->cblk.depth;
|
||||
|
||||
@ -230,18 +231,25 @@ static int push_fnblk (hcl_t* hcl, const hcl_ioloc_t* errloc, hcl_oow_t tmpr_cou
|
||||
static void pop_fnblk (hcl_t* hcl)
|
||||
{
|
||||
HCL_ASSERT (hcl, hcl->c->fnblk.depth >= 0);
|
||||
/* if pop_cblk() has been called properly, the following assertion must be true
|
||||
* and the assignment on the next line isn't necessary */
|
||||
|
||||
HCL_ASSERT (hcl, hcl->c->cblk.depth == hcl->c->fnblk.info[hcl->c->fnblk.depth].cblk_base);
|
||||
hcl->c->cblk.depth = hcl->c->fnblk.info[hcl->c->fnblk.depth].cblk_base;
|
||||
/* keep hcl->code.lit.len without restoration */
|
||||
|
||||
hcl->c->fnblk.depth--;
|
||||
|
||||
if (hcl->c->fnblk.depth >= 0)
|
||||
{
|
||||
hcl->c->tv.s.len = hcl->c->fnblk.info[hcl->c->fnblk.depth].tmprlen;
|
||||
hcl->c->tv.wcount = hcl->c->fnblk.info[hcl->c->fnblk.depth].tmprcnt;
|
||||
|
||||
/* if pop_cblk() has been called properly, the following assertion must be true
|
||||
* and the assignment on the next line isn't necessary */
|
||||
HCL_ASSERT (hcl, hcl->c->cblk.depth == hcl->c->fnblk.info[hcl->c->fnblk.depth].cblk_base);
|
||||
hcl->c->cblk.depth = hcl->c->fnblk.info[hcl->c->fnblk.depth].cblk_base;
|
||||
|
||||
/* keep hcl->code.lit.len without restoration */
|
||||
}
|
||||
else
|
||||
{
|
||||
hcl->c->tv.s.len = 0;
|
||||
hcl->c->tv.wcount = 0;
|
||||
}
|
||||
}
|
||||
|
||||
@ -286,7 +294,6 @@ static void pop_cblk (hcl_t* hcl)
|
||||
* of the owning function block */
|
||||
HCL_ASSERT (hcl, hcl->c->cblk.depth - 1 >= hcl->c->fnblk.info[hcl->c->fnblk.depth].cblk_base);
|
||||
hcl->c->cblk.depth--;
|
||||
|
||||
}
|
||||
/* ========================================================================= */
|
||||
|
||||
@ -2081,6 +2088,8 @@ static int compile_throw (hcl_t* hcl, hcl_cnode_t* src)
|
||||
return -1;
|
||||
}
|
||||
|
||||
/* throw can be located anywhere, however,
|
||||
* if there is no outer try-catch, it ends up with a fatal runtime error */
|
||||
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, val);
|
||||
|
||||
PUSH_SUBCFRAME (hcl, COP_EMIT_THROW, src);
|
||||
|
@ -75,6 +75,7 @@ static hcl_ooch_t errstr_34[] = {'c','a','l','l',' ','e','r','r','o','r','\0'};
|
||||
|
||||
static hcl_ooch_t errstr_35[] = {'a','r','g','u','m','e','n','t',' ','n','u','m','b','e','r',' ','e','r','r','o','r','\0'};
|
||||
static hcl_ooch_t errstr_36[] = {'t','o','o',' ','m','a','n','y',' ','s','e','m','a','p','h','o','r','e','s','\0'};
|
||||
static hcl_ooch_t errstr_37[] = {'e','x','c','e','p','a','i','o','n',' ','n','o','t',' ','h','a','n','d','l','e','d','\0'};
|
||||
|
||||
static hcl_ooch_t* errstr[] =
|
||||
{
|
||||
@ -82,7 +83,7 @@ static hcl_ooch_t* errstr[] =
|
||||
errstr_8, errstr_9, errstr_10, errstr_11, errstr_12, errstr_13, errstr_14, errstr_15,
|
||||
errstr_16, errstr_17, errstr_18, errstr_19, errstr_20, errstr_21, errstr_22, errstr_23,
|
||||
errstr_24, errstr_25, errstr_26, errstr_27, errstr_28, errstr_29, errstr_30, errstr_31,
|
||||
errstr_32, errstr_33, errstr_34, errstr_35, errstr_36
|
||||
errstr_32, errstr_33, errstr_34, errstr_35, errstr_36, errstr_37
|
||||
};
|
||||
|
||||
|
||||
|
208
lib/exec.c
208
lib/exec.c
@ -132,6 +132,44 @@ static hcl_ooch_t oocstr_dash[] = { '-', '\0' };
|
||||
|
||||
static int delete_sem_from_sem_io_tuple (hcl_t* hcl, hcl_oop_semaphore_t sem, int force);
|
||||
static void signal_io_semaphore (hcl_t* hcl, hcl_ooi_t io_handle, hcl_ooi_t mask);
|
||||
static void terminate_all_processes (hcl_t* hcl);
|
||||
|
||||
/* ------------------------------------------------------------------------- */
|
||||
|
||||
#define HCL_EXSTACK_PUSH(hcl, ctx, ip) \
|
||||
do { \
|
||||
hcl_oop_process_t ap = (hcl)->processor->active; \
|
||||
hcl_ooi_t exsp = HCL_OOP_TO_SMOOI(ap->exsp); \
|
||||
hcl_ooi_t ss = HCL_OOP_TO_SMOOI(ap->ss); \
|
||||
if (exsp >= HCL_OOP_TO_SMOOI(ap->exss) - 2) \
|
||||
{ \
|
||||
hcl_seterrbfmt (hcl, HCL_EOOMEM, "process exception stack overflow"); \
|
||||
(hcl)->abort_req = -1; \
|
||||
} \
|
||||
exsp++; ap->slot[ss + exsp] = (ctx); \
|
||||
exsp++; ap->slot[ss + exsp] = HCL_SMOOI_TO_OOP(ip); \
|
||||
ap->exsp = HCL_SMOOI_TO_OOP(exsp); \
|
||||
} while (0)
|
||||
|
||||
#define HCL_EXSTACK_POP(hcl) \
|
||||
do { \
|
||||
hcl_oop_process_t ap = (hcl)->processor->active; \
|
||||
hcl_ooi_t exsp = HCL_OOP_TO_SMOOI(ap->exsp); \
|
||||
exsp -= 2; \
|
||||
ap->exsp = HCL_SMOOI_TO_OOP(exsp); \
|
||||
} while (0)
|
||||
|
||||
#define HCL_EXSTACK_POP_TO(hcl, ctx, ip) \
|
||||
do { \
|
||||
hcl_oop_process_t ap = (hcl)->processor->active; \
|
||||
hcl_ooi_t exsp = HCL_OOP_TO_SMOOI(ap->exsp); \
|
||||
hcl_ooi_t ss = HCL_OOP_TO_SMOOI(ap->ss); \
|
||||
ip = HCL_OOP_TO_SMOOI(ap->slot[ss + exsp]); exsp--; \
|
||||
ctx = ap->slot[ss + exsp]; exsp--; \
|
||||
ap->exsp = HCL_SMOOI_TO_OOP(exsp); \
|
||||
} while (0)
|
||||
|
||||
#define HCL_EXSTACK_ISEMPTY(hcl) (HCL_OOP_TO_SMOOI(((hcl)->processor->active)->exsp) <= -1)
|
||||
|
||||
/* ------------------------------------------------------------------------- */
|
||||
|
||||
@ -174,6 +212,23 @@ static void vm_cleanup (hcl_t* hcl)
|
||||
hcl_cb_t* cb;
|
||||
hcl_oow_t i;
|
||||
|
||||
if (hcl->processor->total_count != HCL_SMOOI_TO_OOP(0))
|
||||
{
|
||||
/* if there is a suspended process, your program is probably wrong */
|
||||
HCL_LOG3 (hcl, HCL_LOG_WARN, "Warning - non-zero number of processes upon VM clean-up - total: %zd runnable: %zd suspended: %zd\n",
|
||||
(hcl_ooi_t)HCL_OOP_TO_SMOOI(hcl->processor->total_count),
|
||||
(hcl_ooi_t)HCL_OOP_TO_SMOOI(hcl->processor->runnable.count),
|
||||
(hcl_ooi_t)HCL_OOP_TO_SMOOI(hcl->processor->suspended.count));
|
||||
|
||||
HCL_LOG0 (hcl, HCL_LOG_WARN, "Warning - terminating all residue processes\n");
|
||||
terminate_all_processes (hcl);
|
||||
}
|
||||
|
||||
HCL_ASSERT (hcl, hcl->processor->active == hcl->nil_process);
|
||||
HCL_ASSERT (hcl, HCL_OOP_TO_SMOOI(hcl->processor->total_count) == 0);
|
||||
HCL_ASSERT (hcl, HCL_OOP_TO_SMOOI(hcl->processor->runnable.count) == 0);
|
||||
HCL_ASSERT (hcl, HCL_OOP_TO_SMOOI(hcl->processor->suspended.count) == 0);
|
||||
|
||||
for (i = 0; i < hcl->sem_io_map_capa;)
|
||||
{
|
||||
hcl_ooi_t sem_io_index;
|
||||
@ -409,7 +464,7 @@ static HCL_INLINE void free_pid (hcl_t* hcl, hcl_oop_process_t proc)
|
||||
static hcl_oop_process_t make_process (hcl_t* hcl, hcl_oop_context_t c)
|
||||
{
|
||||
hcl_oop_process_t proc;
|
||||
hcl_oow_t stksize;
|
||||
hcl_oow_t stksize, exstksize;
|
||||
hcl_ooi_t total_count;
|
||||
hcl_ooi_t suspended_count;
|
||||
|
||||
@ -426,11 +481,23 @@ static hcl_oop_process_t make_process (hcl_t* hcl, hcl_oop_context_t c)
|
||||
if (hcl->proc_map_free_first <= -1 && prepare_to_alloc_pid(hcl) <= -1) return HCL_NULL;
|
||||
|
||||
stksize = hcl->option.dfl_procstk_size;
|
||||
if (stksize > HCL_TYPE_MAX(hcl_oow_t) - HCL_PROCESS_NAMED_INSTVARS)
|
||||
stksize = HCL_TYPE_MAX(hcl_oow_t) - HCL_PROCESS_NAMED_INSTVARS;
|
||||
exstksize = 128; /* exception stack size */ /* TODO: make it configurable */
|
||||
|
||||
#if 0
|
||||
if (stksize > HCL_TYPE_MAX(hcl_ooi_t) - HCL_PROCESS_NAMED_INSTVARS)
|
||||
stksize = HCL_TYPE_MAX(hcl_ooi_t) - HCL_PROCESS_NAMED_INSTVARS;
|
||||
else if (stksize < 128) stksize = 128;
|
||||
#else
|
||||
if (stksize > (HCL_TYPE_MAX(hcl_ooi_t) - HCL_PROCESS_NAMED_INSTVARS) / 2)
|
||||
stksize = (HCL_TYPE_MAX(hcl_ooi_t) - HCL_PROCESS_NAMED_INSTVARS) / 2;
|
||||
else if (stksize < 128) stksize = 128;
|
||||
if (exstksize > (HCL_TYPE_MAX(hcl_ooi_t) - HCL_PROCESS_NAMED_INSTVARS) / 2)
|
||||
exstksize = (HCL_TYPE_MAX(hcl_ooi_t) - HCL_PROCESS_NAMED_INSTVARS) / 2;
|
||||
else if (exstksize < 128) exstksize = 128;
|
||||
#endif
|
||||
|
||||
hcl_pushvolat (hcl, (hcl_oop_t*)&c);
|
||||
proc = (hcl_oop_process_t)hcl_allocoopobj(hcl, HCL_BRAND_PROCESS, HCL_PROCESS_NAMED_INSTVARS + stksize);
|
||||
proc = (hcl_oop_process_t)hcl_allocoopobj(hcl, HCL_BRAND_PROCESS, HCL_PROCESS_NAMED_INSTVARS + stksize + exstksize);
|
||||
hcl_popvolat (hcl);
|
||||
if (HCL_UNLIKELY(!proc)) return HCL_NULL;
|
||||
|
||||
@ -439,6 +506,7 @@ static hcl_oop_process_t make_process (hcl_t* hcl, hcl_oop_context_t c)
|
||||
//// HCL_OBJ_SET_FLAGS_PROC (proc, proc_flags); /* a special flag to indicate an object is a process instance */
|
||||
////////////////////
|
||||
#endif
|
||||
|
||||
proc->state = HCL_SMOOI_TO_OOP(PROC_STATE_SUSPENDED);
|
||||
|
||||
/* assign a process id to the process */
|
||||
@ -447,6 +515,9 @@ static hcl_oop_process_t make_process (hcl_t* hcl, hcl_oop_context_t c)
|
||||
proc->initial_context = c;
|
||||
proc->current_context = c;
|
||||
proc->sp = HCL_SMOOI_TO_OOP(-1);
|
||||
proc->ss = HCL_SMOOI_TO_OOP(stksize);
|
||||
proc->exsp = HCL_SMOOI_TO_OOP(-1);
|
||||
proc->exss = HCL_SMOOI_TO_OOP(exstksize);
|
||||
|
||||
HCL_ASSERT (hcl, (hcl_oop_t)c->sender == hcl->_nil);
|
||||
|
||||
@ -875,6 +946,22 @@ static void terminate_process (hcl_t* hcl, hcl_oop_process_t proc)
|
||||
#endif
|
||||
}
|
||||
|
||||
static void terminate_all_processes (hcl_t* hcl)
|
||||
{
|
||||
while (HCL_OOP_TO_SMOOI(hcl->processor->suspended.count) > 0)
|
||||
{
|
||||
terminate_process (hcl, hcl->processor->suspended.first);
|
||||
}
|
||||
|
||||
while (HCL_OOP_TO_SMOOI(hcl->processor->runnable.count) > 0)
|
||||
{
|
||||
terminate_process (hcl, hcl->processor->runnable.first);
|
||||
}
|
||||
|
||||
HCL_ASSERT (hcl, HCL_OOP_TO_SMOOI(hcl->processor->total_count) == 0);
|
||||
HCL_ASSERT (hcl, hcl->processor->active == hcl->nil_process);
|
||||
}
|
||||
|
||||
static void resume_process (hcl_t* hcl, hcl_oop_process_t proc)
|
||||
{
|
||||
if (proc->state == HCL_SMOOI_TO_OOP(PROC_STATE_SUSPENDED))
|
||||
@ -1986,7 +2073,10 @@ static HCL_INLINE int activate_block_for_throw_catch (hcl_t* hcl, hcl_oop_block_
|
||||
|
||||
static HCL_INLINE int do_throw (hcl_t* hcl, hcl_oop_t val, hcl_ooi_t ip)
|
||||
{
|
||||
hcl_oop_context_t ctx;
|
||||
hcl_oop_context_t catch_ctx;
|
||||
hcl_ooi_t catch_ip;
|
||||
|
||||
#if 0
|
||||
hcl_ooi_t flags;
|
||||
|
||||
ctx = hcl->active_context;
|
||||
@ -2002,7 +2092,6 @@ static HCL_INLINE int do_throw (hcl_t* hcl, hcl_oop_t val, hcl_ooi_t ip)
|
||||
ctx = ctx->sender;
|
||||
}
|
||||
|
||||
|
||||
if (hcl->active_function->dbgi != hcl->_nil)
|
||||
{
|
||||
hcl_dbgi_t* dbgi;
|
||||
@ -2017,6 +2106,40 @@ static HCL_INLINE int do_throw (hcl_t* hcl, hcl_oop_t val, hcl_ooi_t ip)
|
||||
/* exception not handled. terminate the active process */
|
||||
terminate_process (hcl, hcl->processor->active);
|
||||
return 0;
|
||||
#else
|
||||
if (HCL_EXSTACK_ISEMPTY(hcl))
|
||||
{
|
||||
if (hcl->active_function->dbgi != hcl->_nil)
|
||||
{
|
||||
hcl_dbgi_t* dbgi;
|
||||
dbgi = (hcl_dbgi_t*)HCL_OBJ_GET_BYTE_SLOT(hcl->active_function->dbgi);
|
||||
HCL_LOG2 (hcl, HCL_LOG_IC | HCL_LOG_WARN, "Warning - exception not handled %js:%zu", (dbgi[ip].fname? dbgi[ip].fname: oocstr_dash), dbgi[ip].sline);
|
||||
hcl_seterrbfmt (hcl, HCL_EEXCEPT, "exception not handled in %js:%zu", (dbgi[ip].fname? dbgi[ip].fname: oocstr_dash), dbgi[ip].sline);
|
||||
}
|
||||
else
|
||||
{
|
||||
HCL_LOG0 (hcl, HCL_LOG_IC | HCL_LOG_WARN, "Warning - exception not handled");
|
||||
hcl_seterrbfmt (hcl, HCL_EEXCEPT, "exception not handled");
|
||||
}
|
||||
|
||||
/* exception not handled. terminate the active process */
|
||||
/*terminate_process (hcl, hcl->processor->active); <- the vm cleanup code will do this */
|
||||
|
||||
|
||||
|
||||
return -1;
|
||||
}
|
||||
|
||||
// must rewind context....
|
||||
HCL_EXSTACK_POP_TO(hcl, catch_ctx, catch_ip);
|
||||
|
||||
|
||||
/* the below code is similar to do_return_from_block() */
|
||||
hcl->ip = -1; /* mark context dead. saved into hcl->active_context->ip in SWITCH_ACTIVE_CONTEXT */
|
||||
SWITCH_ACTIVE_CONTEXT (hcl, catch_ctx);
|
||||
hcl->ip = catch_ip; /* override the instruction pointer */
|
||||
return 0;
|
||||
#endif
|
||||
}
|
||||
|
||||
/* ------------------------------------------------------------------------- */
|
||||
@ -2395,16 +2518,15 @@ static HCL_INLINE int switch_process_if_needed (hcl_t* hcl)
|
||||
hcl_ntime_t ft;
|
||||
|
||||
HCL_ASSERT (hcl, hcl->processor->runnable.count == HCL_SMOOI_TO_OOP(0));
|
||||
/* no running process while there is an io semaphore being waited for */
|
||||
|
||||
#if defined(ENABLE_GCFIN)
|
||||
/* no runnable process while there is an io semaphore being waited for */
|
||||
if ((hcl_oop_t)hcl->sem_gcfin != hcl->_nil && hcl->sem_gcfin_sigreq) goto signal_sem_gcfin;
|
||||
#endif
|
||||
|
||||
if (hcl->processor->suspended.count == HCL_SMOOI_TO_OOP(0))
|
||||
{
|
||||
/* no suspended process. the program is buggy or is probably being
|
||||
* terminated forcibly.
|
||||
/* no suspended process. the program is buggy or is probably being terminated forcibly.
|
||||
* the default signal handler may lead to this situation. */
|
||||
hcl->abort_req = 1;
|
||||
}
|
||||
@ -2528,7 +2650,7 @@ static HCL_INLINE int switch_process_if_needed (hcl_t* hcl)
|
||||
/* there exist suspended processes while no processes are runnable.
|
||||
* most likely, the running program contains process/semaphore related bugs */
|
||||
HCL_LOG1 (hcl, HCL_LOG_IC | HCL_LOG_WARN,
|
||||
"%zd suspended process(es) found - check your program\n",
|
||||
"Warning - %zd suspended process(es) found in process switcher - check your program\n",
|
||||
HCL_OOP_TO_SMOOI(hcl->processor->suspended.count));
|
||||
}
|
||||
return 0;
|
||||
@ -2674,6 +2796,7 @@ static HCL_INLINE void do_return_from_block (hcl_t* hcl)
|
||||
SWITCH_ACTIVE_CONTEXT (hcl, (hcl_oop_context_t)hcl->active_context->sender);
|
||||
}
|
||||
}
|
||||
|
||||
/* ------------------------------------------------------------------------- */
|
||||
|
||||
static void xma_dumper (void* ctx, const char* fmt, ...)
|
||||
@ -2725,11 +2848,8 @@ static int execute (hcl_t* hcl)
|
||||
while (1)
|
||||
{
|
||||
/* stop requested or no more runnable process */
|
||||
if (hcl->abort_req || (!hcl->no_proc_switch && switch_process_if_needed(hcl) == 0))
|
||||
{
|
||||
/* TODO: if aborting, ensure to terminate all ongoing processes */
|
||||
break;
|
||||
}
|
||||
if (hcl->abort_req <= -1) goto oops;
|
||||
if (hcl->abort_req && !hcl->no_proc_switch && switch_process_if_needed(hcl) == 0) break;
|
||||
|
||||
if (HCL_UNLIKELY(hcl->ip >= HCL_FUNCTION_GET_CODE_SIZE(hcl->active_function)))
|
||||
{
|
||||
@ -3120,30 +3240,41 @@ static int execute (hcl_t* hcl)
|
||||
|
||||
/* -------------------------------------------------------- */
|
||||
case HCL_CODE_TRY_ENTER:
|
||||
{
|
||||
hcl_ooi_t catch_ip;
|
||||
|
||||
FETCH_PARAM_CODE_TO (hcl, b1);
|
||||
LOG_INST_1 (hcl, "try_enter %zu", b1);
|
||||
#if 0
|
||||
if (call_try_catch(hcl) <= -1)
|
||||
{
|
||||
supplement_errmsg (hcl, fetched_instruction_pointer);
|
||||
goto oops;
|
||||
}
|
||||
#endif
|
||||
|
||||
catch_ip = hcl->ip + b1;
|
||||
/* TODO: ip overflow check? */
|
||||
HCL_EXSTACK_PUSH (hcl, hcl->active_context, catch_ip);
|
||||
break;
|
||||
}
|
||||
|
||||
case HCL_CODE_TRY_ENTER2:
|
||||
{
|
||||
hcl_oow_t catch_ip;
|
||||
FETCH_PARAM_CODE_TO (hcl, b1);
|
||||
LOG_INST_1 (hcl, "try_enter2 %zu", b1);
|
||||
catch_ip = hcl->ip + MAX_CODE_JUMP + b1;
|
||||
/* TODO: ip overflow check? */
|
||||
HCL_EXSTACK_PUSH (hcl, hcl->active_context, catch_ip);
|
||||
break;
|
||||
}
|
||||
|
||||
case HCL_CODE_TRY_EXIT:
|
||||
LOG_INST_0 (hcl, "try_exit");
|
||||
/* TODO: stack underflow check? */
|
||||
HCL_EXSTACK_POP (hcl);
|
||||
break;
|
||||
|
||||
case HCL_CODE_THROW:
|
||||
LOG_INST_0 (hcl, "throw");
|
||||
return_value = HCL_STACK_GETTOP(hcl);
|
||||
HCL_STACK_POP (hcl);
|
||||
do_throw (hcl, return_value, fetched_instruction_pointer);
|
||||
|
||||
if (do_throw (hcl, return_value, fetched_instruction_pointer) <= -1) goto oops;
|
||||
break;
|
||||
/* -------------------------------------------------------- */
|
||||
|
||||
@ -3635,11 +3766,13 @@ static int execute (hcl_t* hcl)
|
||||
break;
|
||||
|
||||
case HCL_CODE_RETURN_STACKTOP:
|
||||
/* this implements the non-local return. the non-local return is not compatible with stack based try-catch implementation. */
|
||||
LOG_INST_0 (hcl, "return_stacktop");
|
||||
return_value = HCL_STACK_GETTOP(hcl);
|
||||
HCL_STACK_POP (hcl);
|
||||
goto handle_return;
|
||||
|
||||
/* the current HCL compiler doesn't produce HCL_CODE_RETURN_RECEIVER as the receiver concept is not implemented */
|
||||
case HCL_CODE_RETURN_RECEIVER:
|
||||
LOG_INST_0 (hcl, "return_receiver");
|
||||
return_value = hcl->active_context->origin->receiver_or_base;
|
||||
@ -3653,9 +3786,9 @@ 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);
|
||||
|
||||
hcl->last_retv = HCL_STACK_GETTOP(hcl); /* get the stack top */
|
||||
do_return_from_block (hcl);
|
||||
|
||||
break;
|
||||
|
||||
case HCL_CODE_MAKE_FUNCTION:
|
||||
@ -3748,19 +3881,18 @@ 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, "EXEC OK - TOTAL INST COUTNER = %zu\n", inst_counter);
|
||||
#endif
|
||||
return 0;
|
||||
|
||||
oops:
|
||||
hcl->gci.lazy_sweep = 1;
|
||||
|
||||
/* TODO: anything to do here? */
|
||||
if (hcl->processor->active != hcl->nil_process)
|
||||
{
|
||||
HCL_LOG2 (hcl, HCL_LOG_IC | HCL_LOG_INFO, "TERMINATING ACTIVE PROCESS %zd for execution error - %js\n", HCL_OOP_TO_SMOOI(hcl->processor->active->id), hcl_geterrmsg(hcl));
|
||||
terminate_process (hcl, hcl->processor->active);
|
||||
}
|
||||
vm_cleanup (hcl);
|
||||
#if defined(HCL_PROFILE_VM)
|
||||
HCL_LOG1 (hcl, HCL_LOG_IC | HCL_LOG_INFO, "EXEC ERROR - TOTAL INST COUTNER = %zu\n", inst_counter);
|
||||
#endif
|
||||
|
||||
return -1;
|
||||
}
|
||||
|
||||
@ -3841,16 +3973,12 @@ hcl_oop_t hcl_execute (hcl_t* hcl)
|
||||
|
||||
hcl->initial_context = HCL_NULL;
|
||||
hcl->active_context = HCL_NULL;
|
||||
if (hcl->processor->total_count != HCL_SMOOI_TO_OOP(0))
|
||||
{
|
||||
/* if there is a suspended process, your program is probably wrong */
|
||||
HCL_LOG3 (hcl, HCL_LOG_WARN, "Warning - non-zero number of processes - total: %zd runnable: %zd suspended: %zd\n",
|
||||
(hcl_ooi_t)HCL_OOP_TO_SMOOI(hcl->processor->total_count),
|
||||
(hcl_ooi_t)HCL_OOP_TO_SMOOI(hcl->processor->runnable.count),
|
||||
(hcl_ooi_t)HCL_OOP_TO_SMOOI(hcl->processor->suspended.count));
|
||||
}
|
||||
|
||||
HCL_ASSERT (hcl, hcl->processor->active == hcl->nil_process);
|
||||
HCL_ASSERT (hcl, HCL_OOP_TO_SMOOI(hcl->processor->total_count) == 0);
|
||||
HCL_ASSERT (hcl, HCL_OOP_TO_SMOOI(hcl->processor->runnable.count) == 0);
|
||||
HCL_ASSERT (hcl, HCL_OOP_TO_SMOOI(hcl->processor->suspended.count) == 0);
|
||||
|
||||
LOAD_ACTIVE_SP (hcl); /* sync hcl->nil_process->sp with hcl->sp */
|
||||
HCL_ASSERT (hcl, hcl->sp == -1);
|
||||
|
||||
|
25
lib/hcl.h
25
lib/hcl.h
@ -88,7 +88,8 @@ enum hcl_errnum_t
|
||||
HCL_ESYNERR, /**< syntax error */
|
||||
HCL_ECALL, /**< runtime error - cannot call */
|
||||
HCL_ECALLARG, /**< runtime error - wrong number of arguments to call */
|
||||
HCL_ESEMFLOOD /**< runtime error - too many semaphores */
|
||||
HCL_ESEMFLOOD, /**< runtime error - too many semaphores */
|
||||
HCL_EEXCEPT /**< runtime error - exception not handled */
|
||||
};
|
||||
typedef enum hcl_errnum_t hcl_errnum_t;
|
||||
|
||||
@ -641,7 +642,7 @@ struct hcl_context_t
|
||||
hcl_oop_t slot[1]; /* stack */
|
||||
};
|
||||
|
||||
#define HCL_PROCESS_NAMED_INSTVARS 10
|
||||
#define HCL_PROCESS_NAMED_INSTVARS 12
|
||||
typedef struct hcl_process_t hcl_process_t;
|
||||
typedef struct hcl_process_t* hcl_oop_process_t;
|
||||
|
||||
@ -662,6 +663,9 @@ struct hcl_process_t
|
||||
hcl_oop_t id; /* SmallInteger */
|
||||
hcl_oop_t state; /* SmallInteger */
|
||||
hcl_oop_t sp; /* stack pointer. SmallInteger */
|
||||
hcl_oop_t ss; /* process stack size. SmallInteger */
|
||||
hcl_oop_t exsp; /* exception stack pointer. SmallInteger */
|
||||
hcl_oop_t exss; /* exception stack size. SmallInteger */
|
||||
|
||||
struct
|
||||
{
|
||||
@ -679,6 +683,13 @@ struct hcl_process_t
|
||||
|
||||
/* == variable indexed part == */
|
||||
hcl_oop_t slot[1]; /* process stack */
|
||||
|
||||
/* after the process stack comes the exception stack.
|
||||
* the exception stack is composed of instruction pointers and some context values.
|
||||
* the instruction pointers are OOPs of small integers. safe without GC.
|
||||
* the context values must be referenced by the active call chain. GC doesn't need to scan this area.
|
||||
* If this assumption is not correct, GC code must be modified.
|
||||
* so the garbage collector is free to ignore the exception stack */
|
||||
};
|
||||
|
||||
enum hcl_semaphore_subtype_t
|
||||
@ -1587,12 +1598,12 @@ struct hcl_t
|
||||
/* TODO: stack bound check when pushing */
|
||||
#define HCL_STACK_PUSH(hcl,v) \
|
||||
do { \
|
||||
(hcl)->sp = (hcl)->sp + 1; \
|
||||
if ((hcl)->sp >= (hcl_ooi_t)(HCL_OBJ_GET_SIZE((hcl)->processor->active) - HCL_PROCESS_NAMED_INSTVARS)) \
|
||||
if ((hcl)->sp >= HCL_OOP_TO_SMOOI((hcl)->processor->active->ss) - 1) \
|
||||
{ \
|
||||
hcl_seterrbfmt (hcl, HCL_EOOMEM, "process stack overflow"); \
|
||||
(hcl)->abort_req = -1; \
|
||||
} \
|
||||
(hcl)->sp = (hcl)->sp + 1; \
|
||||
(hcl)->processor->active->slot[(hcl)->sp] = v; \
|
||||
} while (0)
|
||||
|
||||
@ -2320,17 +2331,11 @@ HCL_EXPORT hcl_oop_t hcl_makedic (
|
||||
hcl_oow_t inisize /* initial bucket size */
|
||||
);
|
||||
|
||||
HCL_EXPORT hcl_oop_t hcl_makeprocess (
|
||||
hcl_t* hcl,
|
||||
hcl_oow_t stksize
|
||||
);
|
||||
|
||||
HCL_EXPORT hcl_oop_t hcl_makecontext (
|
||||
hcl_t* hcl,
|
||||
hcl_ooi_t ntmprs
|
||||
);
|
||||
|
||||
|
||||
HCL_EXPORT void hcl_freengcobj (
|
||||
hcl_t* hcl,
|
||||
hcl_oop_t obj
|
||||
|
Loading…
Reference in New Issue
Block a user