working on return-from-home for non-local return
This commit is contained in:
parent
d127456da8
commit
b9f78f7c13
18
lib/comp.c
18
lib/comp.c
@ -1124,15 +1124,16 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src, int defun)
|
|||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
static int compile_return (hcl_t* hcl, hcl_oop_t src)
|
static int compile_return (hcl_t* hcl, hcl_oop_t src, int mode)
|
||||||
{
|
{
|
||||||
hcl_oop_t obj, val;
|
hcl_oop_t obj, val;
|
||||||
|
|
||||||
HCL_ASSERT (hcl, HCL_IS_CONS(hcl, src));
|
HCL_ASSERT (hcl, HCL_IS_CONS(hcl, src));
|
||||||
HCL_ASSERT (hcl, HCL_CONS_CAR(src) == hcl->_return);
|
HCL_ASSERT (hcl, HCL_CONS_CAR(src) == hcl->_return || HCL_CONS_CAR(src) == hcl->_return_from_home);
|
||||||
|
|
||||||
obj = HCL_CONS_CDR(src);
|
obj = HCL_CONS_CDR(src);
|
||||||
|
|
||||||
|
/* TODO: error message - cater for return-from home */
|
||||||
if (HCL_IS_NIL(hcl, obj))
|
if (HCL_IS_NIL(hcl, obj))
|
||||||
{
|
{
|
||||||
/* TODO: should i allow (return)? does it return the last value on the stack? */
|
/* TODO: should i allow (return)? does it return the last value on the stack? */
|
||||||
@ -1156,7 +1157,8 @@ static int compile_return (hcl_t* hcl, hcl_oop_t src)
|
|||||||
}
|
}
|
||||||
|
|
||||||
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, val);
|
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, val);
|
||||||
PUSH_SUBCFRAME (hcl, COP_EMIT_RETURN, hcl->_nil);
|
|
||||||
|
PUSH_SUBCFRAME (hcl, COP_EMIT_RETURN, HCL_SMOOI_TO_OOP(mode));
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
@ -1473,7 +1475,11 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_oop_t obj)
|
|||||||
case HCL_SYNCODE_RETURN:
|
case HCL_SYNCODE_RETURN:
|
||||||
/* (return 10)
|
/* (return 10)
|
||||||
* (return (+ 10 20)) */
|
* (return (+ 10 20)) */
|
||||||
if (compile_return(hcl, obj) <= -1) return -1;
|
if (compile_return(hcl, obj, 0) <= -1) return -1;
|
||||||
|
break;
|
||||||
|
|
||||||
|
case HCL_SYNCODE_RETURN_FROM_HOME:
|
||||||
|
if (compile_return(hcl, obj, 1) <= -1) return -1;
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case HCL_SYNCODE_UNTIL:
|
case HCL_SYNCODE_UNTIL:
|
||||||
@ -2577,9 +2583,9 @@ static HCL_INLINE int emit_return (hcl_t* hcl)
|
|||||||
|
|
||||||
cf = GET_TOP_CFRAME(hcl);
|
cf = GET_TOP_CFRAME(hcl);
|
||||||
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_RETURN);
|
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_RETURN);
|
||||||
HCL_ASSERT (hcl, HCL_IS_NIL(hcl, cf->operand));
|
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand));
|
||||||
|
|
||||||
n = emit_byte_instruction(hcl, HCL_CODE_RETURN_FROM_BLOCK);
|
n = emit_byte_instruction(hcl, (HCL_OOP_TO_SMOOI(cf->operand) == 0? HCL_CODE_RETURN_FROM_BLOCK: HCL_CODE_RETURN_STACKTOP));
|
||||||
|
|
||||||
POP_CFRAME (hcl);
|
POP_CFRAME (hcl);
|
||||||
return n;
|
return n;
|
||||||
|
161
lib/exec.c
161
lib/exec.c
@ -925,7 +925,7 @@ static void update_sem_heap (hcl_t* hcl, hcl_ooi_t index, hcl_oop_semaphore_t ne
|
|||||||
}
|
}
|
||||||
/* ------------------------------------------------------------------------- */
|
/* ------------------------------------------------------------------------- */
|
||||||
|
|
||||||
static int __activate_block (hcl_t* hcl, hcl_oop_block_t rcv_blk, hcl_ooi_t nargs, hcl_oop_context_t* pblkctx)
|
static int __activate_block (hcl_t* hcl, hcl_oop_block_t rcv_blk, hcl_ooi_t nargs, hcl_oop_context_t* pnewctx)
|
||||||
{
|
{
|
||||||
/* prepare a new block context for activation.
|
/* prepare a new block context for activation.
|
||||||
* the receiver must be a block context which becomes the base
|
* the receiver must be a block context which becomes the base
|
||||||
@ -995,7 +995,7 @@ static int __activate_block (hcl_t* hcl, hcl_oop_block_t rcv_blk, hcl_ooi_t narg
|
|||||||
blkctx->sp = HCL_SMOOI_TO_OOP(-1); /* not important at all */
|
blkctx->sp = HCL_SMOOI_TO_OOP(-1); /* not important at all */
|
||||||
blkctx->sender = hcl->active_context;
|
blkctx->sender = hcl->active_context;
|
||||||
|
|
||||||
*pblkctx = blkctx;
|
*pnewctx = blkctx;
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -1003,27 +1003,27 @@ static HCL_INLINE int activate_block (hcl_t* hcl, hcl_ooi_t nargs)
|
|||||||
{
|
{
|
||||||
int x;
|
int x;
|
||||||
hcl_oop_block_t rcv;
|
hcl_oop_block_t rcv;
|
||||||
hcl_oop_context_t blkctx;
|
hcl_oop_context_t newctx;
|
||||||
|
|
||||||
rcv = (hcl_oop_block_t)HCL_STACK_GETRCV(hcl, nargs);
|
rcv = (hcl_oop_block_t)HCL_STACK_GETRCV(hcl, nargs);
|
||||||
HCL_ASSERT (hcl, HCL_IS_BLOCK(hcl, rcv));
|
HCL_ASSERT (hcl, HCL_IS_BLOCK(hcl, rcv));
|
||||||
|
|
||||||
x = __activate_block(hcl, rcv, nargs, &blkctx);
|
x = __activate_block(hcl, rcv, nargs, &newctx);
|
||||||
if (HCL_UNLIKELY(x <= -1)) return -1;
|
if (HCL_UNLIKELY(x <= -1)) return -1;
|
||||||
|
|
||||||
SWITCH_ACTIVE_CONTEXT (hcl, (hcl_oop_context_t)blkctx);
|
SWITCH_ACTIVE_CONTEXT (hcl, newctx);
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* ------------------------------------------------------------------------- */
|
/* ------------------------------------------------------------------------- */
|
||||||
|
|
||||||
static int __activate_function (hcl_t* hcl, hcl_oop_function_t rcv_func, hcl_ooi_t nargs, hcl_oop_context_t* pblkctx)
|
static int __activate_function (hcl_t* hcl, hcl_oop_function_t rcv_func, hcl_ooi_t nargs, hcl_oop_context_t* pnewctx)
|
||||||
{
|
{
|
||||||
/* prepare a new block context for activation.
|
/* prepare a new block context for activation.
|
||||||
* the receiver must be a block context which becomes the base
|
* the receiver must be a block context which becomes the base
|
||||||
* for a new block context. */
|
* for a new block context. */
|
||||||
|
|
||||||
hcl_oop_context_t blkctx;
|
hcl_oop_context_t functx;
|
||||||
hcl_ooi_t local_ntmprs, i;
|
hcl_ooi_t local_ntmprs, i;
|
||||||
|
|
||||||
/*
|
/*
|
||||||
@ -1050,31 +1050,31 @@ static int __activate_function (hcl_t* hcl, hcl_oop_function_t rcv_func, hcl_ooi
|
|||||||
|
|
||||||
/* create a new block context to clone rcv_func */
|
/* create a new block context to clone rcv_func */
|
||||||
hcl_pushtmp (hcl, (hcl_oop_t*)&rcv_func);
|
hcl_pushtmp (hcl, (hcl_oop_t*)&rcv_func);
|
||||||
blkctx = (hcl_oop_context_t)make_context(hcl, local_ntmprs);
|
functx = (hcl_oop_context_t)make_context(hcl, local_ntmprs);
|
||||||
hcl_poptmp (hcl);
|
hcl_poptmp (hcl);
|
||||||
if (!blkctx) return -1;
|
if (!functx) return -1;
|
||||||
|
|
||||||
blkctx->ip = HCL_SMOOI_TO_OOP(0);
|
functx->ip = HCL_SMOOI_TO_OOP(0);
|
||||||
blkctx->ntmprs = rcv_func->ntmprs;
|
functx->ntmprs = rcv_func->ntmprs;
|
||||||
blkctx->nargs = rcv_func->nargs;
|
functx->nargs = rcv_func->nargs;
|
||||||
blkctx->receiver_or_base = (hcl_oop_t)rcv_func;
|
functx->receiver_or_base = (hcl_oop_t)rcv_func;
|
||||||
blkctx->home = rcv_func->home;
|
functx->home = rcv_func->home;
|
||||||
blkctx->origin = blkctx; /* the origin of the context over a function should be itself */
|
functx->origin = functx; /* the origin of the context over a function should be itself */
|
||||||
|
|
||||||
/* TODO: check the stack size of a block context to see if it's large enough to hold arguments */
|
/* TODO: check the stack size of a block context to see if it's large enough to hold arguments */
|
||||||
/* copy the arguments to the stack */
|
/* copy the arguments to the stack */
|
||||||
for (i = 0; i < nargs; i++)
|
for (i = 0; i < nargs; i++)
|
||||||
{
|
{
|
||||||
blkctx->slot[i] = HCL_STACK_GETARG(hcl, nargs, i);
|
functx->slot[i] = HCL_STACK_GETARG(hcl, nargs, i);
|
||||||
}
|
}
|
||||||
|
|
||||||
HCL_STACK_POPS (hcl, nargs + 1); /* pop arguments and receiver */
|
HCL_STACK_POPS (hcl, nargs + 1); /* pop arguments and receiver */
|
||||||
|
|
||||||
HCL_ASSERT (hcl, (hcl_oop_t)blkctx->home != hcl->_nil);
|
HCL_ASSERT (hcl, (hcl_oop_t)functx->home != hcl->_nil);
|
||||||
blkctx->sp = HCL_SMOOI_TO_OOP(-1); /* not important at all */
|
functx->sp = HCL_SMOOI_TO_OOP(-1); /* not important at all */
|
||||||
blkctx->sender = hcl->active_context;
|
functx->sender = hcl->active_context;
|
||||||
|
|
||||||
*pblkctx = blkctx;
|
*pnewctx = functx;
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -1082,15 +1082,15 @@ static HCL_INLINE int activate_function (hcl_t* hcl, hcl_ooi_t nargs)
|
|||||||
{
|
{
|
||||||
int x;
|
int x;
|
||||||
hcl_oop_function_t rcv;
|
hcl_oop_function_t rcv;
|
||||||
hcl_oop_context_t blkctx;
|
hcl_oop_context_t newctx;
|
||||||
|
|
||||||
rcv = (hcl_oop_function_t)HCL_STACK_GETRCV(hcl, nargs);
|
rcv = (hcl_oop_function_t)HCL_STACK_GETRCV(hcl, nargs);
|
||||||
HCL_ASSERT (hcl, HCL_IS_FUNCTION(hcl, rcv));
|
HCL_ASSERT (hcl, HCL_IS_FUNCTION(hcl, rcv));
|
||||||
|
|
||||||
x = __activate_function(hcl, rcv, nargs, &blkctx);
|
x = __activate_function(hcl, rcv, nargs, &newctx);
|
||||||
if (HCL_UNLIKELY(x <= -1)) return -1;
|
if (HCL_UNLIKELY(x <= -1)) return -1;
|
||||||
|
|
||||||
SWITCH_ACTIVE_CONTEXT (hcl, (hcl_oop_context_t)blkctx);
|
SWITCH_ACTIVE_CONTEXT (hcl, newctx);
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -1335,7 +1335,7 @@ static int start_initial_process_and_context (hcl_t* hcl, hcl_ooi_t initial_ip)
|
|||||||
ctx->sp = HCL_SMOOI_TO_OOP(-1); /* pointer to -1 below the bottom */
|
ctx->sp = HCL_SMOOI_TO_OOP(-1); /* pointer to -1 below the bottom */
|
||||||
ctx->nargs = HCL_SMOOI_TO_OOP(0);
|
ctx->nargs = HCL_SMOOI_TO_OOP(0);
|
||||||
ctx->ntmprs = HCL_SMOOI_TO_OOP(0);
|
ctx->ntmprs = HCL_SMOOI_TO_OOP(0);
|
||||||
ctx->origin = ctx; /* the origin of the initial context should be itself */
|
ctx->origin = ctx; /* the origin of the initial context is itself as this is created over the initial function */
|
||||||
ctx->home = hcl->initial_function->home; /* this should be nil */
|
ctx->home = hcl->initial_function->home; /* this should be nil */
|
||||||
ctx->sender = (hcl_oop_context_t)hcl->_nil;
|
ctx->sender = (hcl_oop_context_t)hcl->_nil;
|
||||||
ctx->receiver_or_base = hcl->initial_function;
|
ctx->receiver_or_base = hcl->initial_function;
|
||||||
@ -1374,6 +1374,75 @@ static int start_initial_process_and_context (hcl_t* hcl, hcl_ooi_t initial_ip)
|
|||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* ------------------------------------------------------------------------- */
|
||||||
|
static HCL_INLINE int do_return (hcl_t* hcl, hcl_oop_t return_value)
|
||||||
|
{
|
||||||
|
#if 0
|
||||||
|
(defun x(a)
|
||||||
|
(defun y(k) (return-from-home (+ k k k)))
|
||||||
|
(+ a a a)
|
||||||
|
(y 40) ; this should act like (return (y 40))
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
(x 2)
|
||||||
|
(y 10) ; this should return from x but x it should end up with dead return...
|
||||||
|
#endif
|
||||||
|
hcl_oop_context_t ctx;
|
||||||
|
|
||||||
|
// TODO: home could be null...
|
||||||
|
HCL_DEBUG4 (hcl, "do_return >>>>>>>>>> %d active_context %p active_context->home %p home->ip %O\n", HCL_OOP_TO_SMOOI(hcl->active_context->home->ip), hcl->active_context, hcl->active_context->home, hcl->active_context->home->ip);
|
||||||
|
if (hcl->active_context->home->ip == HCL_SMOOI_TO_OOP(-1))
|
||||||
|
{
|
||||||
|
HCL_LOG0 (hcl, HCL_LOG_IC | HCL_LOG_ERROR, "Error - cannot return from dead context\n");
|
||||||
|
hcl_seterrbfmt (hcl, HCL_EINTERN, "unable to return from dead context"); /* TODO: can i make this error catchable at the hcl level? */
|
||||||
|
return -1;
|
||||||
|
}
|
||||||
|
|
||||||
|
#if 0
|
||||||
|
ctx = hcl->active_context;
|
||||||
|
while ((hcl_oop_t)ctx != hcl->_nil)
|
||||||
|
{
|
||||||
|
if (ctx == hcl->active_context->origin) goto non_local_return_ok;
|
||||||
|
ctx = ctx->sender;
|
||||||
|
}
|
||||||
|
|
||||||
|
HCL_ASSERT (hcl, hcl->active_context->origin->ip == HCL_SMOOI_TO_OOP(-1));
|
||||||
|
HCL_LOG0 (hcl, HCL_LOG_IC | HCL_LOG_ERROR, "Error - cannot return from dead context\n");
|
||||||
|
hcl_seterrbfmt (hcl, HCL_EINTERN, "unable to return from dead context"); /* TODO: can i make this error catchable at the hcl level? */
|
||||||
|
return -1;
|
||||||
|
|
||||||
|
non_local_return_ok:
|
||||||
|
#endif
|
||||||
|
HCL_DEBUG1 (hcl, "NON LOCAL RETURN XXXXXXXXXXXXXXXXXXXXXXXXXXX from active context %p\n", hcl->active_context);
|
||||||
|
if (hcl->active_context == hcl->processor->active->initial_context)
|
||||||
|
{
|
||||||
|
hcl->active_context->ip = HCL_SMOOI_TO_OOP(-1); /* mark that this context has returned */
|
||||||
|
hcl->active_context->home->ip = HCL_SMOOI_TO_OOP(-1); /* mark that this context has returned */
|
||||||
|
terminate_process (hcl, hcl->processor->active);
|
||||||
|
}
|
||||||
|
else
|
||||||
|
{
|
||||||
|
#if 0
|
||||||
|
//hcl->active_context->origin->ip = HCL_SMOOI_TO_OOP(-1);
|
||||||
|
|
||||||
|
/* restore the stack pointer */
|
||||||
|
//hcl->sp = HCL_OOP_TO_SMOOI(hcl->active_context->origin->sp);
|
||||||
|
//SWITCH_ACTIVE_CONTEXT (hcl, hcl->active_context->origin->sender);
|
||||||
|
#else
|
||||||
|
|
||||||
|
|
||||||
|
hcl->ip = -1;
|
||||||
|
hcl->active_context->home->ip = HCL_SMOOI_TO_OOP(-1); /* mark that this context has returned */
|
||||||
|
SWITCH_ACTIVE_CONTEXT (hcl, hcl->active_context->home->sender);
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/* push the return value to the stack of the new active context */
|
||||||
|
HCL_STACK_PUSH (hcl, return_value);
|
||||||
|
}
|
||||||
|
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
/* ------------------------------------------------------------------------- */
|
/* ------------------------------------------------------------------------- */
|
||||||
|
|
||||||
static int execute (hcl_t* hcl)
|
static int execute (hcl_t* hcl)
|
||||||
@ -2217,23 +2286,27 @@ static int execute (hcl_t* hcl)
|
|||||||
|
|
||||||
handle_return:
|
handle_return:
|
||||||
hcl->last_retv = return_value;
|
hcl->last_retv = return_value;
|
||||||
if (hcl->active_context->origin == hcl->processor->active->initial_context->origin)
|
|
||||||
|
#if 1
|
||||||
|
if (do_return(hcl, return_value) <= -1) goto oops;
|
||||||
|
#else
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
//if (hcl->active_context->origin == hcl->processor->active->initial_context->origin)
|
||||||
|
if (hcl->active_context == hcl->processor->active->initial_context)
|
||||||
{
|
{
|
||||||
/* 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);
|
terminate_process (hcl, hcl->processor->active);
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
/* set the instruction pointer to an invalid value.
|
|
||||||
* this is stored into the current method context
|
|
||||||
* before context switching and marks a dead context */
|
|
||||||
if (hcl->active_context->origin == hcl->active_context)
|
if (hcl->active_context->origin == hcl->active_context)
|
||||||
{
|
{
|
||||||
/*
|
/* it is a method context... */
|
||||||
// HCL_ASSERT (hcl, HCL_CLASSOF(hcl, hcl->active_context) == hcl->_method_context);
|
/* set the instruction pointer to an invalid value.
|
||||||
*/
|
* this is stored into the current method context
|
||||||
|
* before context switching in SWITCH_ACTIVE_CONTEXT and
|
||||||
|
* marks a dead context */
|
||||||
hcl->ip = -1;
|
hcl->ip = -1;
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
@ -2280,7 +2353,7 @@ static int execute (hcl_t* hcl)
|
|||||||
HCL_ASSERT (hcl, HCL_IS_CONTEXT(hcl, hcl->active_context));
|
HCL_ASSERT (hcl, HCL_IS_CONTEXT(hcl, hcl->active_context));
|
||||||
HCL_ASSERT (hcl, (hcl_oop_t)hcl->active_context->sender == hcl->_nil);
|
HCL_ASSERT (hcl, (hcl_oop_t)hcl->active_context->sender == hcl->_nil);
|
||||||
|
|
||||||
HCL_ASSERT (hcl, hcl->active_context->receiver_or_base == hcl->_nil);
|
//HCL_ASSERT (hcl, hcl->active_context->receiver_or_base == hcl->_nil);
|
||||||
HCL_ASSERT (hcl, hcl->active_context == hcl->processor->active->initial_context);
|
HCL_ASSERT (hcl, hcl->active_context == hcl->processor->active->initial_context);
|
||||||
HCL_ASSERT (hcl, hcl->active_context->origin == hcl->processor->active->initial_context->origin);
|
HCL_ASSERT (hcl, hcl->active_context->origin == hcl->processor->active->initial_context->origin);
|
||||||
HCL_ASSERT (hcl, hcl->active_context->origin == hcl->active_context);
|
HCL_ASSERT (hcl, hcl->active_context->origin == hcl->active_context);
|
||||||
@ -2302,6 +2375,7 @@ static int execute (hcl_t* hcl)
|
|||||||
* the caller to hcl_execute() can fetch it to return it to the system */
|
* the caller to hcl_execute() can fetch it to return it to the system */
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
#endif
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case HCL_CODE_RETURN_FROM_BLOCK:
|
case HCL_CODE_RETURN_FROM_BLOCK:
|
||||||
@ -2309,6 +2383,9 @@ static int execute (hcl_t* hcl)
|
|||||||
|
|
||||||
HCL_ASSERT(hcl, HCL_IS_CONTEXT(hcl, hcl->active_context));
|
HCL_ASSERT(hcl, HCL_IS_CONTEXT(hcl, hcl->active_context));
|
||||||
hcl->last_retv = HCL_STACK_GETTOP(hcl);
|
hcl->last_retv = HCL_STACK_GETTOP(hcl);
|
||||||
|
|
||||||
|
HCL_DEBUG1 (hcl, "RETURNING(return_from_block) FROM active_context %p\n", hcl->active_context);
|
||||||
|
|
||||||
if (hcl->active_context == hcl->processor->active->initial_context)
|
if (hcl->active_context == hcl->processor->active->initial_context)
|
||||||
{
|
{
|
||||||
/* the active context to return from is an initial context of
|
/* the active context to return from is an initial context of
|
||||||
@ -2316,10 +2393,13 @@ static int execute (hcl_t* hcl)
|
|||||||
* the initial context has been forged over the initial function
|
* the initial context has been forged over the initial function
|
||||||
* in start_initial_process_and_context() */
|
* in start_initial_process_and_context() */
|
||||||
HCL_ASSERT (hcl, (hcl_oop_t)hcl->active_context->sender == hcl->_nil);
|
HCL_ASSERT (hcl, (hcl_oop_t)hcl->active_context->sender == hcl->_nil);
|
||||||
|
hcl->active_context->ip = HCL_SMOOI_TO_OOP(-1); /* mark that this context has returned */
|
||||||
terminate_process (hcl, hcl->processor->active);
|
terminate_process (hcl, hcl->processor->active);
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
|
hcl->ip = -1; /* this will be saved to hcl->active_context->ip in SWITCH_ACTIVE_CONTEXT */
|
||||||
|
|
||||||
/* it is a normal block return as the active block context
|
/* it is a normal block return as the active block context
|
||||||
* is not the initial context of a process */
|
* is not the initial context of a process */
|
||||||
SWITCH_ACTIVE_CONTEXT (hcl, (hcl_oop_context_t)hcl->active_context->sender);
|
SWITCH_ACTIVE_CONTEXT (hcl, (hcl_oop_context_t)hcl->active_context->sender);
|
||||||
@ -2493,12 +2573,15 @@ hcl_oop_t hcl_execute (hcl_t* hcl)
|
|||||||
/* the code generated doesn't cater for its use as an initial funtion.
|
/* the code generated doesn't cater for its use as an initial funtion.
|
||||||
* mutate the generated code so that the intiail function can break
|
* mutate the generated code so that the intiail function can break
|
||||||
* out of the execution loop in execute() smoothly */
|
* out of the execution loop in execute() smoothly */
|
||||||
#if 0
|
|
||||||
/* append RETURN_FROM_BLOCK */
|
HCL_ASSERT (hcl, hcl->code.bc.ptr[hcl->code.bc.len - 1] == HCL_CODE_POP_STACKTOP);
|
||||||
if (hcl_emitbyteinstruction(hcl, HCL_CODE_RETURN_FROM_BLOCK) <= -1) return -1;
|
#if 1
|
||||||
|
/* append RETURN_FROM_BLOCK
|
||||||
|
if (hcl_emitbyteinstruction(hcl, HCL_CODE_RETURN_FROM_BLOCK) <= -1) return -1;*/
|
||||||
|
/* substitute RETURN_FROM_BLOCK for POP_STACKTOP) */
|
||||||
|
hcl->code.bc.ptr[hcl->code.bc.len - 1] = HCL_CODE_RETURN_FROM_BLOCK;
|
||||||
#else
|
#else
|
||||||
/* substitute RETURN_STACKTOP for POP_STACKTOP) */
|
/* substitute RETURN_STACKTOP for POP_STACKTOP) */
|
||||||
HCL_ASSERT (hcl, hcl->code.bc.ptr[hcl->code.bc.len - 1] == HCL_CODE_POP_STACKTOP);
|
|
||||||
hcl->code.bc.ptr[hcl->code.bc.len - 1] = HCL_CODE_RETURN_STACKTOP;
|
hcl->code.bc.ptr[hcl->code.bc.len - 1] = HCL_CODE_RETURN_STACKTOP;
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
4
lib/gc.c
4
lib/gc.c
@ -29,7 +29,7 @@
|
|||||||
static struct
|
static struct
|
||||||
{
|
{
|
||||||
hcl_oow_t len;
|
hcl_oow_t len;
|
||||||
hcl_ooch_t ptr[10];
|
hcl_ooch_t ptr[20];
|
||||||
int syncode;
|
int syncode;
|
||||||
hcl_oow_t offset;
|
hcl_oow_t offset;
|
||||||
} syminfo[] =
|
} syminfo[] =
|
||||||
@ -44,6 +44,8 @@ static struct
|
|||||||
{ 6, { 'l','a','m','b','d','a' }, HCL_SYNCODE_LAMBDA, HCL_OFFSETOF(hcl_t,_lambda) },
|
{ 6, { 'l','a','m','b','d','a' }, HCL_SYNCODE_LAMBDA, HCL_OFFSETOF(hcl_t,_lambda) },
|
||||||
{ 2, { 'o','r' }, HCL_SYNCODE_OR, HCL_OFFSETOF(hcl_t,_or) },
|
{ 2, { 'o','r' }, HCL_SYNCODE_OR, HCL_OFFSETOF(hcl_t,_or) },
|
||||||
{ 6, { 'r','e','t','u','r','n'}, HCL_SYNCODE_RETURN, HCL_OFFSETOF(hcl_t,_return) },
|
{ 6, { 'r','e','t','u','r','n'}, HCL_SYNCODE_RETURN, HCL_OFFSETOF(hcl_t,_return) },
|
||||||
|
{ 16, { 'r','e','t','u','r','n','-','f','r','o','m','-','h','o','m','e'},
|
||||||
|
HCL_SYNCODE_RETURN_FROM_HOME, HCL_OFFSETOF(hcl_t,_return_from_home) },
|
||||||
{ 3, { 's','e','t' }, HCL_SYNCODE_SET, HCL_OFFSETOF(hcl_t,_set) },
|
{ 3, { 's','e','t' }, HCL_SYNCODE_SET, HCL_OFFSETOF(hcl_t,_set) },
|
||||||
{ 5, { 'u','n','t','i','l' }, HCL_SYNCODE_UNTIL, HCL_OFFSETOF(hcl_t,_until) },
|
{ 5, { 'u','n','t','i','l' }, HCL_SYNCODE_UNTIL, HCL_OFFSETOF(hcl_t,_until) },
|
||||||
{ 5, { 'w','h','i','l','e' }, HCL_SYNCODE_WHILE, HCL_OFFSETOF(hcl_t,_while) }
|
{ 5, { 'w','h','i','l','e' }, HCL_SYNCODE_WHILE, HCL_OFFSETOF(hcl_t,_while) }
|
||||||
|
@ -1217,6 +1217,7 @@ struct hcl_t
|
|||||||
hcl_oop_t _lambda; /* symbol */
|
hcl_oop_t _lambda; /* symbol */
|
||||||
hcl_oop_t _or; /* symbol */
|
hcl_oop_t _or; /* symbol */
|
||||||
hcl_oop_t _return; /* symbol */
|
hcl_oop_t _return; /* symbol */
|
||||||
|
hcl_oop_t _return_from_home; /* symbol */
|
||||||
hcl_oop_t _set; /* symbol */
|
hcl_oop_t _set; /* symbol */
|
||||||
hcl_oop_t _until; /* symbol */
|
hcl_oop_t _until; /* symbol */
|
||||||
hcl_oop_t _while; /* symbol */
|
hcl_oop_t _while; /* symbol */
|
||||||
@ -1425,6 +1426,7 @@ enum hcl_syncode_t
|
|||||||
HCL_SYNCODE_LAMBDA,
|
HCL_SYNCODE_LAMBDA,
|
||||||
HCL_SYNCODE_OR,
|
HCL_SYNCODE_OR,
|
||||||
HCL_SYNCODE_RETURN,
|
HCL_SYNCODE_RETURN,
|
||||||
|
HCL_SYNCODE_RETURN_FROM_HOME,
|
||||||
HCL_SYNCODE_SET,
|
HCL_SYNCODE_SET,
|
||||||
HCL_SYNCODE_UNTIL,
|
HCL_SYNCODE_UNTIL,
|
||||||
HCL_SYNCODE_WHILE
|
HCL_SYNCODE_WHILE
|
||||||
|
Loading…
Reference in New Issue
Block a user