attempting to touch up the context object
This commit is contained in:
parent
5ded15d06a
commit
d1c12bc543
79
lib/exec.c
79
lib/exec.c
@ -93,7 +93,7 @@ static hcl_ooch_t oocstr_dash[] = { '-', '\0' };
|
|||||||
{ \
|
{ \
|
||||||
STORE_ACTIVE_IP (hcl); \
|
STORE_ACTIVE_IP (hcl); \
|
||||||
(hcl)->active_context = (v_ctx); \
|
(hcl)->active_context = (v_ctx); \
|
||||||
(hcl)->active_function = (hcl)->active_context->origin->receiver_or_base; \
|
(hcl)->active_function = (hcl)->active_context->origin->base; \
|
||||||
(hcl)->active_code = HCL_FUNCTION_GET_CODE_BYTE((hcl)->active_function); \
|
(hcl)->active_code = HCL_FUNCTION_GET_CODE_BYTE((hcl)->active_function); \
|
||||||
LOAD_ACTIVE_IP (hcl); \
|
LOAD_ACTIVE_IP (hcl); \
|
||||||
(hcl)->processor->active->current_context = (hcl)->active_context; \
|
(hcl)->processor->active->current_context = (hcl)->active_context; \
|
||||||
@ -1885,10 +1885,10 @@ void hcl_releaseiohandle (hcl_t* hcl, hcl_ooi_t io_handle)
|
|||||||
|
|
||||||
/* ------------------------------------------------------------------------- */
|
/* ------------------------------------------------------------------------- */
|
||||||
|
|
||||||
static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t rcv_blk, hcl_ooi_t nargs, int nargs_offset, hcl_ooi_t req_nrvars, int copy_args, hcl_oop_context_t* pnewctx)
|
static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t op_blk, hcl_ooi_t nargs, int nargs_offset, hcl_ooi_t req_nrvars, int copy_args, int is_msgsend, hcl_oop_context_t* pnewctx)
|
||||||
{
|
{
|
||||||
/* prepare a new block context for activation. the receiver must be a block
|
/* prepare a new block context for activation.
|
||||||
* context which becomes the base for a new block context. */
|
* the passed block context becomes the base for a new block context. */
|
||||||
|
|
||||||
hcl_oop_context_t blkctx;
|
hcl_oop_context_t blkctx;
|
||||||
hcl_ooi_t tmpr_mask;
|
hcl_ooi_t tmpr_mask;
|
||||||
@ -1896,9 +1896,9 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t rcv_blk, hcl_ooi_t n
|
|||||||
hcl_ooi_t fixed_nargs, actual_nargs, excess_nargs;
|
hcl_ooi_t fixed_nargs, actual_nargs, excess_nargs;
|
||||||
|
|
||||||
/* the receiver must be a block context */
|
/* the receiver must be a block context */
|
||||||
HCL_ASSERT (hcl, HCL_IS_BLOCK(hcl, rcv_blk));
|
HCL_ASSERT (hcl, HCL_IS_BLOCK(hcl, op_blk));
|
||||||
|
|
||||||
tmpr_mask = HCL_OOP_TO_SMOOI(rcv_blk->tmpr_mask);
|
tmpr_mask = HCL_OOP_TO_SMOOI(op_blk->tmpr_mask);
|
||||||
|
|
||||||
fblk_nrvars = GET_BLKTMPR_MASK_NRVARS(tmpr_mask);
|
fblk_nrvars = GET_BLKTMPR_MASK_NRVARS(tmpr_mask);
|
||||||
fblk_nlvars = GET_BLKTMPR_MASK_NLVARS(tmpr_mask);
|
fblk_nlvars = GET_BLKTMPR_MASK_NLVARS(tmpr_mask);
|
||||||
@ -1910,7 +1910,7 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t rcv_blk, hcl_ooi_t n
|
|||||||
{
|
{
|
||||||
HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_ERROR,
|
HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_ERROR,
|
||||||
"Error - wrong number of arguments to a block %O - expecting %zd, got %zd\n",
|
"Error - wrong number of arguments to a block %O - expecting %zd, got %zd\n",
|
||||||
rcv_blk, fixed_nargs, actual_nargs);
|
op_blk, fixed_nargs, actual_nargs);
|
||||||
hcl_seterrbfmt (hcl, HCL_ECALLARG, "wrong number of argument passed to function block - %zd expected, %zd passed", fixed_nargs, actual_nargs);
|
hcl_seterrbfmt (hcl, HCL_ECALLARG, "wrong number of argument passed to function block - %zd expected, %zd passed", fixed_nargs, actual_nargs);
|
||||||
return -1;
|
return -1;
|
||||||
}
|
}
|
||||||
@ -1919,13 +1919,13 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t rcv_blk, hcl_ooi_t n
|
|||||||
{
|
{
|
||||||
HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_ERROR,
|
HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_ERROR,
|
||||||
"Error - wrong number of returns specified of a block %O - max expected %zd, requested %zd\n",
|
"Error - wrong number of returns specified of a block %O - max expected %zd, requested %zd\n",
|
||||||
rcv_blk, fblk_nrvars, req_nrvars);
|
op_blk, fblk_nrvars, req_nrvars);
|
||||||
hcl_seterrbfmt (hcl, HCL_ECALLRET, "wrong number of returns requested of function block - %zd expected at most, %zd requested", fblk_nrvars, req_nrvars);
|
hcl_seterrbfmt (hcl, HCL_ECALLRET, "wrong number of returns requested of function block - %zd expected at most, %zd requested", fblk_nrvars, req_nrvars);
|
||||||
return -1;
|
return -1;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* create a new block context to clone rcv_blk */
|
/* create a new block context to clone op_blk */
|
||||||
hcl_pushvolat (hcl, (hcl_oop_t*)&rcv_blk);
|
hcl_pushvolat (hcl, (hcl_oop_t*)&op_blk);
|
||||||
blkctx = make_context(hcl, fixed_nargs + fblk_nrvars + fblk_nlvars + excess_nargs);
|
blkctx = make_context(hcl, fixed_nargs + fblk_nrvars + fblk_nlvars + excess_nargs);
|
||||||
hcl_popvolat (hcl);
|
hcl_popvolat (hcl);
|
||||||
if (HCL_UNLIKELY(!blkctx)) return -1;
|
if (HCL_UNLIKELY(!blkctx)) return -1;
|
||||||
@ -1934,16 +1934,17 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t rcv_blk, hcl_ooi_t n
|
|||||||
/* shallow-copy the named part including home, origin, etc. */
|
/* shallow-copy the named part including home, origin, etc. */
|
||||||
for (i = 0; i < HCL_CONTEXT_NAMED_INSTVARS; i++)
|
for (i = 0; i < HCL_CONTEXT_NAMED_INSTVARS; i++)
|
||||||
{
|
{
|
||||||
((hcl_oop_oop_t)blkctx)->slot[i] = ((hcl_oop_oop_t)rcv_blk)->slot[i];
|
((hcl_oop_oop_t)blkctx)->slot[i] = ((hcl_oop_oop_t)op_blk)->slot[i];
|
||||||
}
|
}
|
||||||
#else
|
#else
|
||||||
blkctx->ip = rcv_blk->ip;
|
blkctx->ip = op_blk->ip;
|
||||||
blkctx->req_nrets = HCL_SMOOI_TO_OOP(req_nrvars);
|
blkctx->req_nrets = HCL_SMOOI_TO_OOP(req_nrvars);
|
||||||
blkctx->tmpr_mask = rcv_blk->tmpr_mask;
|
blkctx->tmpr_mask = op_blk->tmpr_mask;
|
||||||
blkctx->receiver_or_base = (hcl_oop_t)rcv_blk;
|
blkctx->base = (hcl_oop_t)op_blk;
|
||||||
blkctx->home = rcv_blk->home;
|
blkctx->home = op_blk->home;
|
||||||
/* blkctx->origin = rcv_blk->origin; */
|
/* blkctx->origin = op_blk->origin; */
|
||||||
blkctx->origin = rcv_blk->home->origin;
|
blkctx->origin = op_blk->home->origin;
|
||||||
|
blkctx->receiver = is_msgsend? HCL_STACK_GETRCV(hcl, nargs): op_blk->home->receiver;
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
if (HCL_LIKELY(copy_args))
|
if (HCL_LIKELY(copy_args))
|
||||||
@ -1970,7 +1971,7 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t rcv_blk, hcl_ooi_t n
|
|||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
static HCL_INLINE int __activate_block (hcl_t* hcl, hcl_oop_block_t op, hcl_ooi_t nargs, hcl_ooi_t nrvars, hcl_oop_context_t* pnewctx)
|
static HCL_INLINE int __activate_block (hcl_t* hcl, hcl_oop_block_t op, hcl_ooi_t nargs, hcl_ooi_t nrvars, int is_msgsend, hcl_oop_context_t* pnewctx)
|
||||||
{
|
{
|
||||||
int x;
|
int x;
|
||||||
|
|
||||||
@ -1983,6 +1984,7 @@ static HCL_INLINE int __activate_block (hcl_t* hcl, hcl_oop_block_t op, hcl_ooi_
|
|||||||
0, /* nargs_offset */
|
0, /* nargs_offset */
|
||||||
nrvars,
|
nrvars,
|
||||||
1, /* copy_args */
|
1, /* copy_args */
|
||||||
|
is_msgsend,
|
||||||
pnewctx);
|
pnewctx);
|
||||||
if (HCL_UNLIKELY(x <= -1)) return -1;
|
if (HCL_UNLIKELY(x <= -1)) return -1;
|
||||||
|
|
||||||
@ -2001,7 +2003,7 @@ static HCL_INLINE int activate_block (hcl_t* hcl, hcl_ooi_t nargs, hcl_ooi_t nrv
|
|||||||
op = (hcl_oop_block_t)HCL_STACK_GETOP(hcl, nargs);
|
op = (hcl_oop_block_t)HCL_STACK_GETOP(hcl, nargs);
|
||||||
HCL_ASSERT (hcl, HCL_IS_BLOCK(hcl, op));
|
HCL_ASSERT (hcl, HCL_IS_BLOCK(hcl, op));
|
||||||
|
|
||||||
x = __activate_block(hcl, op, nargs, nrvars, &newctx);
|
x = __activate_block(hcl, op, nargs, nrvars, 0, &newctx);
|
||||||
if (HCL_UNLIKELY(x <= -1)) return -1;
|
if (HCL_UNLIKELY(x <= -1)) return -1;
|
||||||
|
|
||||||
SWITCH_ACTIVE_CONTEXT (hcl, newctx);
|
SWITCH_ACTIVE_CONTEXT (hcl, newctx);
|
||||||
@ -2057,9 +2059,10 @@ static int __activate_function (hcl_t* hcl, hcl_oop_function_t op_func, hcl_ooi_
|
|||||||
functx->ip = HCL_SMOOI_TO_OOP(0);
|
functx->ip = HCL_SMOOI_TO_OOP(0);
|
||||||
functx->req_nrets = HCL_SMOOI_TO_OOP(1);
|
functx->req_nrets = HCL_SMOOI_TO_OOP(1);
|
||||||
functx->tmpr_mask = op_func->tmpr_mask;
|
functx->tmpr_mask = op_func->tmpr_mask;
|
||||||
functx->receiver_or_base = (hcl_oop_t)op_func;
|
functx->base = (hcl_oop_t)op_func;
|
||||||
functx->home = op_func->home;
|
functx->home = op_func->home;
|
||||||
functx->origin = functx; /* 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 */
|
||||||
|
functx->receiver = HCL_STACK_GETRCV(hcl, nargs);
|
||||||
|
|
||||||
/* copy the fixed arguments to the beginning of the variable part of the context block */
|
/* copy the fixed arguments to the beginning of the variable part of the context block */
|
||||||
for (i = 0, j = nargs_offset; i < fixed_nargs; i++, j++)
|
for (i = 0, j = nargs_offset; i < fixed_nargs; i++, j++)
|
||||||
@ -2178,7 +2181,7 @@ static HCL_INLINE int send_message (hcl_t* hcl, hcl_oop_t rcv, hcl_oop_t op, int
|
|||||||
return -1;
|
return -1;
|
||||||
}
|
}
|
||||||
|
|
||||||
x = __activate_block(hcl, mth, nargs, 0 /* TODO: not 0 */ , &newctx);
|
x = __activate_block(hcl, mth, nargs, 0 /* TODO: not 0 */, 1 , &newctx);
|
||||||
if (HCL_UNLIKELY(x <= -1)) return -1;
|
if (HCL_UNLIKELY(x <= -1)) return -1;
|
||||||
|
|
||||||
SWITCH_ACTIVE_CONTEXT (hcl, newctx);
|
SWITCH_ACTIVE_CONTEXT (hcl, newctx);
|
||||||
@ -2498,7 +2501,8 @@ static int start_initial_process_and_context (hcl_t* hcl, hcl_ooi_t initial_ip,
|
|||||||
ctx->origin = ctx; /* the origin of the initial context is itself as this is created over the initial function */
|
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->base = hcl->initial_function;
|
||||||
|
ctx->receiver = (hcl_oop_context_t)hcl->_nil; /* TODO: change this? keep this in sync with the fake receiver used in the call instruction */
|
||||||
HCL_ASSERT (hcl, (hcl_oop_t)ctx->home == hcl->_nil);
|
HCL_ASSERT (hcl, (hcl_oop_t)ctx->home == hcl->_nil);
|
||||||
|
|
||||||
/* [NOTE]
|
/* [NOTE]
|
||||||
@ -3025,9 +3029,10 @@ static int execute (hcl_t* hcl)
|
|||||||
b1 = bcode & 0x7; /* low 3 bits */
|
b1 = bcode & 0x7; /* low 3 bits */
|
||||||
push_instvar:
|
push_instvar:
|
||||||
LOG_INST_1 (hcl, "push_instvar %zu", b1);
|
LOG_INST_1 (hcl, "push_instvar %zu", b1);
|
||||||
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->origin->receiver_or_base) == HCL_OBJ_TYPE_OOP);
|
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->origin->receiver) == HCL_OBJ_TYPE_OOP);
|
||||||
/* TODO: FIX TO OFFSET THE INHERTED PART... */
|
/* TODO: FIX TO OFFSET THE INHERTED PART... */
|
||||||
HCL_STACK_PUSH (hcl, ((hcl_oop_oop_t)hcl->active_context->origin->receiver_or_base)->slot[b1]);
|
//HCL_STACK_PUSH (hcl, ((hcl_oop_oop_t)hcl->active_context->origin->receiver)->slot[b1]);
|
||||||
|
HCL_STACK_PUSH (hcl, ((hcl_oop_oop_t)hcl->active_context->receiver)->slot[b1]);
|
||||||
break;
|
break;
|
||||||
|
|
||||||
/* ------------------------------------------------- */
|
/* ------------------------------------------------- */
|
||||||
@ -3046,8 +3051,8 @@ static int execute (hcl_t* hcl)
|
|||||||
b1 = bcode & 0x7; /* low 3 bits */
|
b1 = bcode & 0x7; /* low 3 bits */
|
||||||
store_instvar:
|
store_instvar:
|
||||||
LOG_INST_1 (hcl, "store_into_instvar %zu", b1);
|
LOG_INST_1 (hcl, "store_into_instvar %zu", b1);
|
||||||
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->receiver_or_base) == HCL_OBJ_TYPE_OOP);
|
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->receiver) == HCL_OBJ_TYPE_OOP);
|
||||||
((hcl_oop_oop_t)hcl->active_context->origin->receiver_or_base)->slot[b1] = HCL_STACK_GETTOP(hcl);
|
((hcl_oop_oop_t)hcl->active_context->origin->receiver)->slot[b1] = HCL_STACK_GETTOP(hcl);
|
||||||
break;
|
break;
|
||||||
|
|
||||||
/* ------------------------------------------------- */
|
/* ------------------------------------------------- */
|
||||||
@ -3065,8 +3070,8 @@ static int execute (hcl_t* hcl)
|
|||||||
b1 = bcode & 0x7; /* low 3 bits */
|
b1 = bcode & 0x7; /* low 3 bits */
|
||||||
pop_into_instvar:
|
pop_into_instvar:
|
||||||
LOG_INST_1 (hcl, "pop_into_instvar %zu", b1);
|
LOG_INST_1 (hcl, "pop_into_instvar %zu", b1);
|
||||||
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->receiver_or_base) == HCL_OBJ_TYPE_OOP);
|
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->receiver) == HCL_OBJ_TYPE_OOP);
|
||||||
((hcl_oop_oop_t)hcl->active_context->origin->receiver_or_base)->slot[b1] = HCL_STACK_GETTOP(hcl);
|
((hcl_oop_oop_t)hcl->active_context->origin->receiver)->slot[b1] = HCL_STACK_GETTOP(hcl);
|
||||||
HCL_STACK_POP (hcl);
|
HCL_STACK_POP (hcl);
|
||||||
break;
|
break;
|
||||||
|
|
||||||
@ -3822,7 +3827,7 @@ HCL_DEBUG2 (hcl, "class_mstore %O %O\n", hcl->active_function->literal_frame[b1]
|
|||||||
FETCH_PARAM_CODE_TO (hcl, b1);
|
FETCH_PARAM_CODE_TO (hcl, b1);
|
||||||
LOG_INST_1 (hcl, "push_clsvar_m %zu", b1);
|
LOG_INST_1 (hcl, "push_clsvar_m %zu", b1);
|
||||||
/* TODO: finish implementing CLSVAR_M_X instructions ....*/
|
/* TODO: finish implementing CLSVAR_M_X instructions ....*/
|
||||||
t = (hcl_oop_oop_t)hcl->active_context->origin->receiver_or_base;
|
t = (hcl_oop_oop_t)hcl->active_context->origin->receiver;
|
||||||
if (!HCL_IS_INSTANCE(hcl, t))
|
if (!HCL_IS_INSTANCE(hcl, t))
|
||||||
{
|
{
|
||||||
hcl_seterrbfmt (hcl, HCL_ESTKUNDFLW, "non-instance receiver");
|
hcl_seterrbfmt (hcl, HCL_ESTKUNDFLW, "non-instance receiver");
|
||||||
@ -3838,8 +3843,8 @@ HCL_DEBUG2 (hcl, "class_mstore %O %O\n", hcl->active_function->literal_frame[b1]
|
|||||||
{
|
{
|
||||||
hcl_oop_class_t t;
|
hcl_oop_class_t t;
|
||||||
FETCH_PARAM_CODE_TO (hcl, b1);
|
FETCH_PARAM_CODE_TO (hcl, b1);
|
||||||
LOG_INST_1 (hcl, "store_into_clsvar_m %zu", b1);
|
LOG_INST_1 (hcl, "store_into_clsvar_m %zu", b1);
|
||||||
t = (hcl_oop_oop_t)hcl->active_context->origin->receiver_or_base;
|
t = (hcl_oop_oop_t)hcl->active_context->origin->receiver;
|
||||||
if (!HCL_IS_INSTANCE(hcl, t))
|
if (!HCL_IS_INSTANCE(hcl, t))
|
||||||
{
|
{
|
||||||
hcl_seterrbfmt (hcl, HCL_ESTKUNDFLW, "non-instance receiver");
|
hcl_seterrbfmt (hcl, HCL_ESTKUNDFLW, "non-instance receiver");
|
||||||
@ -3856,7 +3861,7 @@ HCL_DEBUG2 (hcl, "class_mstore %O %O\n", hcl->active_function->literal_frame[b1]
|
|||||||
hcl_oop_class_t t;
|
hcl_oop_class_t t;
|
||||||
FETCH_PARAM_CODE_TO (hcl, b1);
|
FETCH_PARAM_CODE_TO (hcl, b1);
|
||||||
LOG_INST_1 (hcl, "pop_into_clsvar_m %zu", b1);
|
LOG_INST_1 (hcl, "pop_into_clsvar_m %zu", b1);
|
||||||
t = (hcl_oop_oop_t)hcl->active_context->origin->receiver_or_base;
|
t = (hcl_oop_oop_t)hcl->active_context->origin->receiver;
|
||||||
if (!HCL_IS_INSTANCE(hcl, t))
|
if (!HCL_IS_INSTANCE(hcl, t))
|
||||||
{
|
{
|
||||||
hcl_seterrbfmt (hcl, HCL_ESTKUNDFLW, "non-instance receiver");
|
hcl_seterrbfmt (hcl, HCL_ESTKUNDFLW, "non-instance receiver");
|
||||||
@ -3872,7 +3877,7 @@ HCL_DEBUG2 (hcl, "class_mstore %O %O\n", hcl->active_function->literal_frame[b1]
|
|||||||
|
|
||||||
case HCL_CODE_PUSH_RECEIVER: /* push self or super */
|
case HCL_CODE_PUSH_RECEIVER: /* push self or super */
|
||||||
LOG_INST_0 (hcl, "push_receiver");
|
LOG_INST_0 (hcl, "push_receiver");
|
||||||
HCL_STACK_PUSH (hcl, hcl->active_context->origin->receiver_or_base);
|
HCL_STACK_PUSH (hcl, hcl->active_context->origin->receiver);
|
||||||
break;
|
break;
|
||||||
|
|
||||||
case HCL_CODE_PUSH_NIL:
|
case HCL_CODE_PUSH_NIL:
|
||||||
@ -4196,11 +4201,10 @@ HCL_DEBUG2 (hcl, "class_mstore %O %O\n", hcl->active_function->literal_frame[b1]
|
|||||||
return_value = HCL_STACK_GETTOP(hcl);
|
return_value = HCL_STACK_GETTOP(hcl);
|
||||||
HCL_STACK_POP (hcl);
|
HCL_STACK_POP (hcl);
|
||||||
goto handle_return;
|
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:
|
case HCL_CODE_RETURN_RECEIVER:
|
||||||
LOG_INST_0 (hcl, "return_receiver");
|
LOG_INST_0 (hcl, "return_receiver");
|
||||||
return_value = hcl->active_context->origin->receiver_or_base;
|
return_value = hcl->active_context->origin->receiver;
|
||||||
|
|
||||||
handle_return:
|
handle_return:
|
||||||
hcl->last_retv = return_value;
|
hcl->last_retv = return_value;
|
||||||
@ -4373,7 +4377,7 @@ hcl_oop_t hcl_execute (hcl_t* hcl)
|
|||||||
|
|
||||||
hcl->initial_function = func; /* the initial function is ready */
|
hcl->initial_function = func; /* the initial function is ready */
|
||||||
|
|
||||||
#if 0
|
#if 0
|
||||||
/* unless the system is buggy, hcl->proc_map_used should be 0.
|
/* unless the system is buggy, hcl->proc_map_used should be 0.
|
||||||
* the standard library terminates all processes before halting.
|
* the standard library terminates all processes before halting.
|
||||||
*
|
*
|
||||||
@ -4469,6 +4473,7 @@ hcl_pfrc_t hcl_pf_process_fork (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
|
|||||||
1, /* nargs_offset */
|
1, /* nargs_offset */
|
||||||
0, /* number of return variables expected */
|
0, /* number of return variables expected */
|
||||||
1, /* copy_args */
|
1, /* copy_args */
|
||||||
|
0, /* is_msgsend */
|
||||||
&newctx);
|
&newctx);
|
||||||
if (HCL_UNLIKELY(x <= -1)) return HCL_PF_FAILURE;
|
if (HCL_UNLIKELY(x <= -1)) return HCL_PF_FAILURE;
|
||||||
|
|
||||||
|
10
lib/hcl.h
10
lib/hcl.h
@ -577,7 +577,7 @@ typedef struct hcl_function_t* hcl_oop_function_t;
|
|||||||
typedef struct hcl_block_t hcl_block_t;
|
typedef struct hcl_block_t hcl_block_t;
|
||||||
typedef struct hcl_block_t* hcl_oop_block_t;
|
typedef struct hcl_block_t* hcl_oop_block_t;
|
||||||
|
|
||||||
#define HCL_CONTEXT_NAMED_INSTVARS 7
|
#define HCL_CONTEXT_NAMED_INSTVARS 8
|
||||||
typedef struct hcl_context_t hcl_context_t;
|
typedef struct hcl_context_t hcl_context_t;
|
||||||
typedef struct hcl_context_t* hcl_oop_context_t;
|
typedef struct hcl_context_t* hcl_oop_context_t;
|
||||||
|
|
||||||
@ -624,6 +624,8 @@ struct hcl_context_t
|
|||||||
/* SmallInteger, instruction pointer */
|
/* SmallInteger, instruction pointer */
|
||||||
hcl_oop_t ip;
|
hcl_oop_t ip;
|
||||||
|
|
||||||
|
hcl_oop_t base; /* either a block or a function */
|
||||||
|
|
||||||
/* it points to the active context at the moment when
|
/* it points to the active context at the moment when
|
||||||
* this context object has been activated. a new method context
|
* this context object has been activated. a new method context
|
||||||
* is activated as a result of normal message sending and a block
|
* is activated as a result of normal message sending and a block
|
||||||
@ -634,7 +636,7 @@ struct hcl_context_t
|
|||||||
/* it points to the receiver of the message for a method context.
|
/* it points to the receiver of the message for a method context.
|
||||||
* a block context points to a block object and a function context
|
* a block context points to a block object and a function context
|
||||||
* points to a function object */
|
* points to a function object */
|
||||||
hcl_oop_t receiver_or_base; /* when used as a base, it's either a block or a function */
|
hcl_oop_t receiver;
|
||||||
|
|
||||||
/* it is set to nil for a method context.
|
/* it is set to nil for a method context.
|
||||||
* for a block context, it points to the active context at the
|
* for a block context, it points to the active context at the
|
||||||
@ -647,13 +649,13 @@ struct hcl_context_t
|
|||||||
* context creation is based on a function object(initial or lambda/defun).
|
* context creation is based on a function object(initial or lambda/defun).
|
||||||
*
|
*
|
||||||
* a block context is created over a block object. it stores
|
* a block context is created over a block object. it stores
|
||||||
* a function context points to itself in this field. a block context
|
* a function context that points to itself in this field. a block context
|
||||||
* points to the function context where it is created. another block context
|
* points to the function context where it is created. another block context
|
||||||
* created within the block context also points to the same function context.
|
* created within the block context also points to the same function context.
|
||||||
*
|
*
|
||||||
* take note of the following points:
|
* take note of the following points:
|
||||||
* ctx->origin: function context
|
* ctx->origin: function context
|
||||||
* ctx->origin->receiver_or_base: actual function containing byte codes pertaining to ctx.
|
* ctx->origin->base: actual function containing byte codes pertaining to ctx.
|
||||||
*
|
*
|
||||||
* a base of a block context is a block object but ctx->origin is guaranteed to be
|
* a base of a block context is a block object but ctx->origin is guaranteed to be
|
||||||
* a function context. so its base is also a function object all the time.
|
* a function context. so its base is also a function object all the time.
|
||||||
|
@ -427,8 +427,8 @@ hcl_oop_t hcl_instantiate (hcl_t* hcl, hcl_oop_class_t _class, const void* vptr,
|
|||||||
function and initialize payloads then.
|
function and initialize payloads then.
|
||||||
if (oop && vptr && vlen > 0)
|
if (oop && vptr && vlen > 0)
|
||||||
{
|
{
|
||||||
hcl_oop_oop_t hdr = (hcl_oop_oop_t)oop;
|
hcl_oop_oop_t hdr = (hcl_oop_oop_t)oop;
|
||||||
HCL_MEMCPY (&hdr->slot[named_instvar], vptr, vlen * HCL_SIZEOF(hcl_oop_t));
|
HCL_MEMCPY (&hdr->slot[named_instvar], vptr, vlen * HCL_SIZEOF(hcl_oop_t));
|
||||||
}
|
}
|
||||||
|
|
||||||
For the above code to work, it should protect the elements of
|
For the above code to work, it should protect the elements of
|
||||||
|
@ -878,7 +878,7 @@ static hcl_pfrc_t pf_object_new (hcl_t* hcl, hcl_mod_t* mod, hcl_ooi_t nargs)
|
|||||||
return HCL_PF_FAILURE;
|
return HCL_PF_FAILURE;
|
||||||
}
|
}
|
||||||
|
|
||||||
obj = hcl_instantiate(hcl, class_, HCL_NULL, 0);
|
obj = hcl_instantiate(hcl, (hcl_oop_class_t)class_, HCL_NULL, 0);
|
||||||
if (HCL_UNLIKELY(!obj)) return HCL_PF_FAILURE;
|
if (HCL_UNLIKELY(!obj)) return HCL_PF_FAILURE;
|
||||||
|
|
||||||
HCL_STACK_SETRET (hcl, nargs, obj);
|
HCL_STACK_SETRET (hcl, nargs, obj);
|
||||||
|
Loading…
Reference in New Issue
Block a user