hyung-hwan/hcl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

changed the block temporaries scheme

Browse Source
This commit is contained in:
hyung-hwan 2021-05-05 14:37:01 +00:00
parent f954199d38
commit bd3730fd12
5 changed files with 93 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lib/comp.c
View File

@ -1764,7 +1764,7 @@ static int compile_lambda (hcl_t* hcl, hcl_cnode_t* src, int defun)
if (push_fnblk(hcl, HCL_CNODE_GET_LOC(src), hcl->c->tv.wcount, hcl->c->tv.s.len, hcl->code.bc.len, hcl->code.lit.len) <= -1) return -1; if (push_fnblk(hcl, HCL_CNODE_GET_LOC(src), hcl->c->tv.wcount, hcl->c->tv.s.len, hcl->code.bc.len, hcl->code.lit.len) <= -1) return -1;
tmpr_mask = ENCODE_BLK_TMPR_MASK(0, nargs, 0, nlvars); tmpr_mask = ENCODE_BLKTMPR_MASK(0, nargs, 0, nlvars);
if (hcl->option.trait & HCL_TRAIT_INTERACTIVE) if (hcl->option.trait & HCL_TRAIT_INTERACTIVE)
{ {

20
lib/decode.c
View File

@ -61,7 +61,7 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
{ {
hcl_oob_t bcode, * cdptr; hcl_oob_t bcode, * cdptr;
hcl_ooi_t ip = start, fetched_instruction_pointer; hcl_ooi_t ip = start, fetched_instruction_pointer;
hcl_oow_t b1, b2, b3, b4; hcl_oow_t b1, b2, b3;
/* the instruction at the offset 'end' is not decoded. /* the instruction at the offset 'end' is not decoded.
* decoding offset range is from start to end - 1. */ * decoding offset range is from start to end - 1. */
@ -606,31 +606,25 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
break; break;
case HCL_CODE_MAKE_FUNCTION: case HCL_CODE_MAKE_FUNCTION:
/* b1 - number of block arguments /* b1 - block temporaries mask
* b2 - number of block temporaries * b2 - base literal frame start
* b3 - base literal frame start * b3 - base literal frame end */
* b4 - base literal frame end */
FETCH_PARAM_CODE_TO (hcl, b1); FETCH_PARAM_CODE_TO (hcl, b1);
FETCH_PARAM_CODE_TO (hcl, b2); FETCH_PARAM_CODE_TO (hcl, b2);
FETCH_PARAM_CODE_TO (hcl, b3); FETCH_PARAM_CODE_TO (hcl, b3);
FETCH_PARAM_CODE_TO (hcl, b4);
LOG_INST_4 (hcl, "make_function %zu %zu %zu %zu", b1, b2, b3, b4); LOG_INST_3 (hcl, "make_function %zu %zu %zu", b1, b2, b3);
HCL_ASSERT (hcl, b1 >= 0); HCL_ASSERT (hcl, b1 >= 0);
HCL_ASSERT (hcl, b2 >= b1);
break; break;
case HCL_CODE_MAKE_BLOCK: case HCL_CODE_MAKE_BLOCK:
/* b1 - number of block arguments /* b1 - block temporaries mask */
* b2 - number of block temporaries */
FETCH_PARAM_CODE_TO (hcl, b1); FETCH_PARAM_CODE_TO (hcl, b1);
FETCH_PARAM_CODE_TO (hcl, b2);
LOG_INST_2 (hcl, "make_block %zu %zu", b1, b2); LOG_INST_1 (hcl, "make_block %zu", b1);
HCL_ASSERT (hcl, b1 >= 0); HCL_ASSERT (hcl, b1 >= 0);
HCL_ASSERT (hcl, b2 >= b1);
break; break;
case HCL_CODE_NOOP: case HCL_CODE_NOOP:

117
lib/exec.c
View File

@ -339,15 +339,13 @@ static HCL_INLINE hcl_oop_function_t make_function (hcl_t* hcl, hcl_oow_t lfsize
return func; return func;
} }
static HCL_INLINE void fill_function_data (hcl_t* hcl, hcl_oop_function_t func, hcl_ooi_t ntmprs, hcl_ooi_t nargs, hcl_oop_context_t homectx, const hcl_oop_t* lfptr, hcl_oow_t lfsize) static HCL_INLINE void fill_function_data (hcl_t* hcl, hcl_oop_function_t func, hcl_ooi_t tmpr_mask, hcl_oop_context_t homectx, const hcl_oop_t* lfptr, hcl_oow_t lfsize)
{ {
/* Although this function could be integrated into make_function(), /* Although this function could be integrated into make_function(),
* this function has been separated from make_function() to make GC handling simpler */ * this function has been separated from make_function() to make GC handling simpler */
hcl_oow_t i; hcl_oow_t i;
HCL_ASSERT (hcl, nargs >= 0 && nargs <= HCL_SMOOI_MAX); HCL_ASSERT (hcl, tmpr_mask >= 0 && tmpr_mask <= HCL_SMOOI_MAX);
HCL_ASSERT (hcl, ntmprs >= 0 && ntmprs <= HCL_SMOOI_MAX);
HCL_ASSERT (hcl, nargs <= ntmprs);
/* copy literal frames */ /* copy literal frames */
HCL_ASSERT (hcl, lfsize <= HCL_OBJ_GET_SIZE(func) - HCL_FUNCTION_NAMED_INSTVARS); HCL_ASSERT (hcl, lfsize <= HCL_OBJ_GET_SIZE(func) - HCL_FUNCTION_NAMED_INSTVARS);
@ -362,8 +360,7 @@ static HCL_INLINE void fill_function_data (hcl_t* hcl, hcl_oop_function_t func,
/* initialize other fields */ /* initialize other fields */
func->home = homectx; func->home = homectx;
func->flags = HCL_SMOOI_TO_OOP(0); func->flags = HCL_SMOOI_TO_OOP(0);
func->nargs = HCL_SMOOI_TO_OOP(nargs); func->tmpr_mask = HCL_SMOOI_TO_OOP(tmpr_mask);
func->ntmprs = HCL_SMOOI_TO_OOP(ntmprs);
} }
static HCL_INLINE hcl_oop_block_t make_block (hcl_t* hcl) static HCL_INLINE hcl_oop_block_t make_block (hcl_t* hcl)
@ -372,18 +369,15 @@ static HCL_INLINE hcl_oop_block_t make_block (hcl_t* hcl)
return (hcl_oop_block_t)hcl_allocoopobj(hcl, HCL_BRAND_BLOCK, HCL_BLOCK_NAMED_INSTVARS); return (hcl_oop_block_t)hcl_allocoopobj(hcl, HCL_BRAND_BLOCK, HCL_BLOCK_NAMED_INSTVARS);
} }
static HCL_INLINE void fill_block_data (hcl_t* hcl, hcl_oop_block_t blk, hcl_ooi_t nargs, hcl_ooi_t ntmprs, hcl_ooi_t ip, hcl_oop_context_t homectx) static HCL_INLINE void fill_block_data (hcl_t* hcl, hcl_oop_block_t blk, hcl_ooi_t tmpr_mask, hcl_ooi_t ip, hcl_oop_context_t homectx)
{ {
HCL_ASSERT (hcl, nargs >= 0 && nargs <= HCL_SMOOI_MAX); HCL_ASSERT (hcl, tmpr_mask >= 0 && tmpr_mask <= HCL_SMOOI_MAX);
HCL_ASSERT (hcl, ntmprs >= 0 && ntmprs <= HCL_SMOOI_MAX); HCL_ASSERT (hcl, ip >= 0 && ip <= HCL_SMOOI_MAX);
HCL_ASSERT (hcl, nargs <= ntmprs);
HCL_ASSERT (hcl, ip >= 0 && nargs <= HCL_SMOOI_MAX);
blk->home = homectx; blk->home = homectx;
blk->ip = HCL_SMOOI_TO_OOP(ip); blk->ip = HCL_SMOOI_TO_OOP(ip);
blk->flags = HCL_SMOOI_TO_OOP(0); blk->flags = HCL_SMOOI_TO_OOP(0);
blk->nargs = HCL_SMOOI_TO_OOP(nargs); blk->tmpr_mask = HCL_SMOOI_TO_OOP(tmpr_mask);
blk->ntmprs = HCL_SMOOI_TO_OOP(ntmprs);
} }
static HCL_INLINE int prepare_to_alloc_pid (hcl_t* hcl) static HCL_INLINE int prepare_to_alloc_pid (hcl_t* hcl)
@ -1814,19 +1808,23 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t rcv_blk, hcl_ooi_t n
* context which becomes the base for a new block context. */ * context which becomes the base for a new block context. */
hcl_oop_context_t blkctx; hcl_oop_context_t blkctx;
hcl_ooi_t local_ntmprs, flags; hcl_ooi_t tmpr_mask;
hcl_ooi_t nrvars, nlvars, flags;
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, rcv_blk));
flags = HCL_OOP_TO_SMOOI(rcv_blk->flags); flags = HCL_OOP_TO_SMOOI(rcv_blk->flags);
local_ntmprs = HCL_OOP_TO_SMOOI(rcv_blk->ntmprs); tmpr_mask = HCL_OOP_TO_SMOOI(rcv_blk->tmpr_mask);
fixed_nargs = HCL_OOP_TO_SMOOI(rcv_blk->nargs);
nrvars = GET_BLKTMPR_MASK_NRVARS(tmpr_mask);
nlvars = GET_BLKTMPR_MASK_NLVARS(tmpr_mask);
fixed_nargs = GET_BLKTMPR_MASK_NARGS(tmpr_mask);
actual_nargs = nargs - nargs_offset; actual_nargs = nargs - nargs_offset;
excess_nargs = actual_nargs - fixed_nargs; excess_nargs = actual_nargs - fixed_nargs;
if (actual_nargs < fixed_nargs || /*!(flags & HCL_BLOCK_FLAG_VA) ||*/ actual_nargs > fixed_nargs) if (actual_nargs < fixed_nargs || (!GET_BLKTMPR_MASK_VA(tmpr_mask) && actual_nargs > fixed_nargs))
{ {
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",
@ -1835,11 +1833,9 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t rcv_blk, hcl_ooi_t n
return -1; return -1;
} }
HCL_ASSERT (hcl, local_ntmprs >= actual_nargs);
/* create a new block context to clone rcv_blk */ /* create a new block context to clone rcv_blk */
hcl_pushvolat (hcl, (hcl_oop_t*)&rcv_blk); hcl_pushvolat (hcl, (hcl_oop_t*)&rcv_blk);
blkctx = make_context(hcl, local_ntmprs + excess_nargs + extra_slots); blkctx = make_context(hcl, fixed_nargs + nrvars + nlvars + excess_nargs + extra_slots);
hcl_popvolat (hcl); hcl_popvolat (hcl);
if (HCL_UNLIKELY(!blkctx)) return -1; if (HCL_UNLIKELY(!blkctx)) return -1;
@ -1852,8 +1848,7 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t rcv_blk, hcl_ooi_t n
#else #else
blkctx->ip = rcv_blk->ip; blkctx->ip = rcv_blk->ip;
blkctx->flags = rcv_blk->flags; blkctx->flags = rcv_blk->flags;
blkctx->ntmprs = rcv_blk->ntmprs; blkctx->tmpr_mask = rcv_blk->tmpr_mask;
blkctx->nargs = rcv_blk->nargs;
blkctx->receiver_or_base = (hcl_oop_t)rcv_blk; blkctx->receiver_or_base = (hcl_oop_t)rcv_blk;
blkctx->home = rcv_blk->home; blkctx->home = rcv_blk->home;
/* blkctx->origin = rcv_blk->origin; */ /* blkctx->origin = rcv_blk->origin; */
@ -1871,7 +1866,7 @@ static int prepare_new_context (hcl_t* hcl, hcl_oop_block_t rcv_blk, hcl_ooi_t n
} }
/* variable arguments. place them behind after local variables. */ /* variable arguments. place them behind after local variables. */
for (i = local_ntmprs; j < nargs; i++, j++) for (i = fixed_nargs + nrvars + nlvars ; j < nargs; i++, j++)
{ {
blkctx->slot[i] = HCL_STACK_GETARG(hcl, nargs, j); blkctx->slot[i] = HCL_STACK_GETARG(hcl, nargs, j);
} }
@ -1919,7 +1914,10 @@ static int __activate_function (hcl_t* hcl, hcl_oop_function_t rcv_func, hcl_ooi
* for a new block context. */ * for a new block context. */
hcl_oop_context_t functx; hcl_oop_context_t functx;
hcl_ooi_t local_ntmprs, i; hcl_ooi_t i, j;
hcl_ooi_t tmpr_mask;
hcl_ooi_t nrvars, nlvars, fixed_nargs, actual_nargs, excess_nargs;
hcl_ooi_t nargs_offset = 0;
/* /*
(defun sum (x) (defun sum (x)
@ -1931,37 +1929,45 @@ static int __activate_function (hcl_t* hcl, hcl_oop_function_t rcv_func, hcl_ooi
/* the receiver must be a function */ /* the receiver must be a function */
HCL_ASSERT (hcl, HCL_IS_FUNCTION(hcl, rcv_func)); HCL_ASSERT (hcl, HCL_IS_FUNCTION(hcl, rcv_func));
if (HCL_OOP_TO_SMOOI(rcv_func->nargs) != nargs) tmpr_mask = HCL_OOP_TO_SMOOI(rcv_func->tmpr_mask);
nrvars = GET_BLKTMPR_MASK_NRVARS(tmpr_mask);
nlvars = GET_BLKTMPR_MASK_NLVARS(tmpr_mask);
fixed_nargs = GET_BLKTMPR_MASK_NARGS(tmpr_mask);
actual_nargs = nargs - nargs_offset;
excess_nargs = actual_nargs - fixed_nargs;
if (actual_nargs < fixed_nargs || (!GET_BLKTMPR_MASK_VA(tmpr_mask) && actual_nargs > fixed_nargs))
{ {
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 function %O - expecting %zd, got %zd\n", "Error - wrong number of arguments to a function %O - expecting %zd, got %zd\n",
rcv_func, HCL_OOP_TO_SMOOI(rcv_func->nargs), nargs); rcv_func, fixed_nargs, nargs);
hcl_seterrnum (hcl, HCL_ECALLARG); hcl_seterrnum (hcl, HCL_ECALLARG);
return -1; return -1;
} }
local_ntmprs = HCL_OOP_TO_SMOOI(rcv_func->ntmprs);
HCL_ASSERT (hcl, local_ntmprs >= nargs);
/* create a new block context to clone rcv_func */ /* create a new block context to clone rcv_func */
hcl_pushvolat (hcl, (hcl_oop_t*)&rcv_func); hcl_pushvolat (hcl, (hcl_oop_t*)&rcv_func);
functx = make_context(hcl, local_ntmprs); functx = make_context(hcl, fixed_nargs + nrvars + nlvars + excess_nargs);
hcl_popvolat (hcl); hcl_popvolat (hcl);
if (HCL_UNLIKELY(!functx)) return -1; if (HCL_UNLIKELY(!functx)) return -1;
functx->ip = HCL_SMOOI_TO_OOP(0); functx->ip = HCL_SMOOI_TO_OOP(0);
functx->flags = rcv_func->flags; functx->flags = rcv_func->flags;
functx->ntmprs = rcv_func->ntmprs; functx->tmpr_mask = rcv_func->tmpr_mask;
functx->nargs = rcv_func->nargs;
functx->receiver_or_base = (hcl_oop_t)rcv_func; functx->receiver_or_base = (hcl_oop_t)rcv_func;
functx->home = rcv_func->home; functx->home = rcv_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 */
/* TODO: check the stack size of a block context to see if it's large enough to hold arguments */ /* copy the fixed arguments to the beginning of the variable part of the context block */
/* copy the arguments to the stack */ for (i = 0, j = nargs_offset; i < fixed_nargs; i++, j++)
for (i = 0; i < nargs; i++)
{ {
functx->slot[i] = HCL_STACK_GETARG(hcl, nargs, i); functx->slot[i] = HCL_STACK_GETARG(hcl, nargs, j);
}
/* variable arguments. place them behind after local variables. */
for (i = fixed_nargs + nrvars + nlvars ; j < nargs; i++, j++)
{
functx->slot[i] = HCL_STACK_GETARG(hcl, nargs, j);
} }
HCL_STACK_POPS (hcl, nargs + 1); /* pop arguments and receiver */ HCL_STACK_POPS (hcl, nargs + 1); /* pop arguments and receiver */
@ -2256,13 +2262,15 @@ static hcl_oop_process_t start_initial_process (hcl_t* hcl, hcl_oop_context_t ct
return proc; return proc;
} }
static int start_initial_process_and_context (hcl_t* hcl, hcl_ooi_t initial_ip, hcl_ooi_t ntmprs) static int start_initial_process_and_context (hcl_t* hcl, hcl_ooi_t initial_ip, hcl_ooi_t nlvars)
{ {
hcl_oop_context_t ctx; hcl_oop_context_t ctx;
hcl_oop_process_t proc; hcl_oop_process_t proc;
hcl_ooi_t tmpr_mask;
tmpr_mask = ENCODE_BLKTMPR_MASK(0, 0, 0, nlvars);
/* create the initial context over the initial function */ /* create the initial context over the initial function */
ctx = make_context(hcl, ntmprs); /* no temporary variables */ ctx = make_context(hcl, nlvars);
if (HCL_UNLIKELY(!ctx)) return -1; if (HCL_UNLIKELY(!ctx)) return -1;
hcl->ip = initial_ip; hcl->ip = initial_ip;
@ -2270,8 +2278,7 @@ static int start_initial_process_and_context (hcl_t* hcl, hcl_ooi_t initial_ip,
ctx->ip = HCL_SMOOI_TO_OOP(initial_ip); ctx->ip = HCL_SMOOI_TO_OOP(initial_ip);
ctx->flags = HCL_SMOOI_TO_OOP(0); ctx->flags = HCL_SMOOI_TO_OOP(0);
ctx->nargs = HCL_SMOOI_TO_OOP(0); ctx->tmpr_mask = HCL_SMOOI_TO_OOP(tmpr_mask);
ctx->ntmprs = HCL_SMOOI_TO_OOP(ntmprs);
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;
@ -3704,22 +3711,19 @@ static int execute (hcl_t* hcl)
case HCL_CODE_MAKE_FUNCTION: case HCL_CODE_MAKE_FUNCTION:
{ {
hcl_oop_function_t func; hcl_oop_function_t func;
hcl_oow_t b3, b4; hcl_oow_t b3;
hcl_oow_t joff; hcl_oow_t joff;
/* b1 - number of block arguments /* b1 - block temporaries mask
* b2 - number of block temporaries * b2 - literal frame base
* b3 - literal frame base * b3 - literal frame size */
* b4 - literal frame size */
FETCH_PARAM_CODE_TO (hcl, b1); FETCH_PARAM_CODE_TO (hcl, b1);
FETCH_PARAM_CODE_TO (hcl, b2); FETCH_PARAM_CODE_TO (hcl, b2);
FETCH_PARAM_CODE_TO (hcl, b3); FETCH_PARAM_CODE_TO (hcl, b3);
FETCH_PARAM_CODE_TO (hcl, b4);
LOG_INST_4 (hcl, "make_function %zu %zu %zu %zu", b1, b2, b3, b4); LOG_INST_3 (hcl, "make_function %zu %zu %zu", b1, b2, b3);
HCL_ASSERT (hcl, b1 >= 0); HCL_ASSERT (hcl, b1 >= 0);
HCL_ASSERT (hcl, b2 >= b1);
/* the MAKE_FUNCTION instruction is followed by the long JUMP_FORWARD_X instruction. /* the MAKE_FUNCTION instruction is followed by the long JUMP_FORWARD_X instruction.
* i can decode the instruction and get the size of instructions * i can decode the instruction and get the size of instructions
@ -3732,13 +3736,13 @@ static int execute (hcl_t* hcl)
/* copy the byte codes from the active context to the new context */ /* copy the byte codes from the active context to the new context */
#if (HCL_CODE_LONG_PARAM_SIZE == 2) #if (HCL_CODE_LONG_PARAM_SIZE == 2)
func = make_function(hcl, b4, &hcl->active_code[hcl->ip + 3], joff, HCL_NULL); func = make_function(hcl, b3, &hcl->active_code[hcl->ip + 3], joff, HCL_NULL);
#else #else
func = make_function(hcl, b4, &hcl->active_code[hcl->ip + 2], joff, HCL_NULL); func = make_function(hcl, b3, &hcl->active_code[hcl->ip + 2], joff, HCL_NULL);
#endif #endif
if (HCL_UNLIKELY(!func)) goto oops; if (HCL_UNLIKELY(!func)) goto oops;
fill_function_data (hcl, func, b2, b1, hcl->active_context, &hcl->active_function->literal_frame[b3], b4); fill_function_data (hcl, func, b1, hcl->active_context, &hcl->active_function->literal_frame[b2], b3);
/* push the new function to the stack of the active context */ /* push the new function to the stack of the active context */
HCL_STACK_PUSH (hcl, (hcl_oop_t)func); HCL_STACK_PUSH (hcl, (hcl_oop_t)func);
@ -3749,15 +3753,12 @@ static int execute (hcl_t* hcl)
{ {
hcl_oop_block_t blkobj; hcl_oop_block_t blkobj;
/* b1 - number of block arguments /* b1 - block temporaries mask */
* b2 - number of block temporaries */
FETCH_PARAM_CODE_TO (hcl, b1); FETCH_PARAM_CODE_TO (hcl, b1);
FETCH_PARAM_CODE_TO (hcl, b2);
LOG_INST_2 (hcl, "make_block %zu %zu", b1, b2); LOG_INST_1 (hcl, "make_block %zu", b1);
HCL_ASSERT (hcl, b1 >= 0); HCL_ASSERT (hcl, b1 >= 0);
HCL_ASSERT (hcl, b2 >= b1);
blkobj = make_block(hcl); blkobj = make_block(hcl);
if (HCL_UNLIKELY(!blkobj)) goto oops; if (HCL_UNLIKELY(!blkobj)) goto oops;
@ -3766,7 +3767,7 @@ static int execute (hcl_t* hcl)
* 11000100 KKKKKKKK or 11000100 KKKKKKKK KKKKKKKK * 11000100 KKKKKKKK or 11000100 KKKKKKKK KKKKKKKK
* depending on HCL_CODE_LONG_PARAM_SIZE. change 'ip' to point to * depending on HCL_CODE_LONG_PARAM_SIZE. change 'ip' to point to
* the instruction after the jump. */ * the instruction after the jump. */
fill_block_data (hcl, blkobj, b1, b2, hcl->ip + HCL_CODE_LONG_PARAM_SIZE + 1, hcl->active_context); fill_block_data (hcl, blkobj, b1, hcl->ip + HCL_CODE_LONG_PARAM_SIZE + 1, hcl->active_context);
/* push the new block context to the stack of the active context */ /* push the new block context to the stack of the active context */
HCL_STACK_PUSH (hcl, (hcl_oop_t)blkobj); HCL_STACK_PUSH (hcl, (hcl_oop_t)blkobj);
@ -3843,7 +3844,7 @@ hcl_oop_t hcl_execute (hcl_t* hcl)
if (HCL_UNLIKELY(!func)) return HCL_NULL; if (HCL_UNLIKELY(!func)) return HCL_NULL;
/* pass nil for the home context of the initial function */ /* pass nil for the home context of the initial function */
fill_function_data (hcl, func, hcl->code.ngtmprs, 0, (hcl_oop_context_t)hcl->_nil, hcl->code.lit.arr->slot, hcl->code.lit.len); fill_function_data (hcl, func, ENCODE_BLKTMPR_MASK(0,0,0,hcl->code.ngtmprs), (hcl_oop_context_t)hcl->_nil, hcl->code.lit.arr->slot, hcl->code.lit.len);
hcl->initial_function = func; /* the initial function is ready */ hcl->initial_function = func; /* the initial function is ready */

16
lib/hcl-prv.h
View File

@ -507,8 +507,12 @@ struct hcl_compiler_t
# define MAX_CODE_NBLKRVARS (0xFu) /* 15 */ # define MAX_CODE_NBLKRVARS (0xFu) /* 15 */
# define MAX_CODE_NBLKLVARS (0x7Fu) /* 127 */ # define MAX_CODE_NBLKLVARS (0x7Fu) /* 127 */
# define ENCODE_BLK_TMPR_MASK(v,nargs,nrvars,nlvars) \ # define ENCODE_BLKTMPR_MASK(va,nargs,nrvars,nlvars) \
((((v) & 1) << 15) | (((nargs) & 0xF) << 11) | (((nrvars) & 0xF) << 7) | (((nlvars) & 0x7F))) ((((va) & 0x1) << 15) | (((nargs) & 0xF) << 11) | (((nrvars) & 0xF) << 7) | (((nlvars) & 0x7F)))
# define GET_BLKTMPR_MASK_VA(x) (((x) >> 15) & 0x1)
# define GET_BLKTMPR_MASK_NARGS(x) (((x) >> 11) & 0xF)
# define GET_BLKTMPR_MASK_NRVARS(x) (((x) >> 7) & 0xF)
# define GET_BLKTMPR_MASK_NLVARS(x) ((x) & 0x7F)
# define MAX_CODE_JUMP (0xFFu) # define MAX_CODE_JUMP (0xFFu)
# define MAX_CODE_PARAM (0xFFu) # define MAX_CODE_PARAM (0xFFu)
@ -521,8 +525,12 @@ struct hcl_compiler_t
# define MAX_CODE_NBLKARGS (0xFFu) /* 255 */ # define MAX_CODE_NBLKARGS (0xFFu) /* 255 */
# define MAX_CODE_NBLKRVARS (0xFFu) /* 255 */ # define MAX_CODE_NBLKRVARS (0xFFu) /* 255 */
# define MAX_CODE_NBLKLVARS (0xFFFu) /* 4095 */ # define MAX_CODE_NBLKLVARS (0xFFFu) /* 4095 */
# define ENCODE_BLK_TMPR_MASK(v,nargs,nrvars,nlvars) \ # define ENCODE_BLKTMPR_MASK(va,nargs,nrvars,nlvars) \
((((v) & 1) << 28) | (((nargs) & 0xFF) << 20) | (((nrvars) & 0xFF) << 12) | (((nlvars) & 0xFFF))) ((((va) & 0x1) << 28) | (((nargs) & 0xFF) << 20) | (((nrvars) & 0xFF) << 12) | (((nlvars) & 0xFFF)))
# define GET_BLKTMPR_MASK_VA(x) (((x) >> 28) & 0x1)
# define GET_BLKTMPR_MASK_NARGS(x) (((x) >> 20) & 0xFF)
# define GET_BLKTMPR_MASK_NRVARS(x) (((x) >> 12) & 0xFF)
# define GET_BLKTMPR_MASK_NLVARS(x) ((x) & 0xFFF)
# define MAX_CODE_JUMP (0xFFFFu) # define MAX_CODE_JUMP (0xFFFFu)
# define MAX_CODE_PARAM (0xFFFFu) # define MAX_CODE_PARAM (0xFFFFu)

27
lib/hcl.h
View File

@ -545,15 +545,15 @@ struct hcl_fpdec_t
#define HCL_FUNCTION_GET_CODE_BYTE(m) HCL_OBJ_GET_TRAILER_BYTE(m) #define HCL_FUNCTION_GET_CODE_BYTE(m) HCL_OBJ_GET_TRAILER_BYTE(m)
#define HCL_FUNCTION_GET_CODE_SIZE(m) HCL_OBJ_GET_TRAILER_SIZE(m) #define HCL_FUNCTION_GET_CODE_SIZE(m) HCL_OBJ_GET_TRAILER_SIZE(m)
#define HCL_FUNCTION_NAMED_INSTVARS 5 /* this excludes literal frames and byte codes */ #define HCL_FUNCTION_NAMED_INSTVARS 4 /* this excludes literal frames and byte codes */
typedef struct hcl_function_t hcl_function_t; typedef struct hcl_function_t hcl_function_t;
typedef struct hcl_function_t* hcl_oop_function_t; typedef struct hcl_function_t* hcl_oop_function_t;
#define HCL_BLOCK_NAMED_INSTVARS 5 #define HCL_BLOCK_NAMED_INSTVARS 4
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 8 #define HCL_CONTEXT_NAMED_INSTVARS 7
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;
@ -564,8 +564,7 @@ struct hcl_function_t
HCL_OBJ_HEADER; HCL_OBJ_HEADER;
hcl_oop_t flags; hcl_oop_t flags;
hcl_oop_t ntmprs; /* smooi. number of temporaries. includes arguments as well */ hcl_oop_t tmpr_mask; /* smooi */
hcl_oop_t nargs; /* smooi. number of arguments */
hcl_oop_context_t home; /* home context. nil for the initial function */ hcl_oop_context_t home; /* home context. nil for the initial function */
hcl_oop_t dbgi; /* byte array containing debug information. nil if not available */ hcl_oop_t dbgi; /* byte array containing debug information. nil if not available */
@ -585,8 +584,7 @@ struct hcl_block_t
HCL_OBJ_HEADER; HCL_OBJ_HEADER;
hcl_oop_t flags; hcl_oop_t flags;
hcl_oop_t ntmprs; /* smooi. number of temporaries. includes arguments as well */ hcl_oop_t tmpr_mask; /* smooi */
hcl_oop_t nargs; /* smooi. number of arguments */
hcl_oop_context_t home; /* home context */ hcl_oop_context_t home; /* home context */
hcl_oop_t ip; /* smooi. instruction pointer where the byte code begins in home->origin */ hcl_oop_t ip; /* smooi. instruction pointer where the byte code begins in home->origin */
}; };
@ -598,6 +596,12 @@ struct hcl_context_t
/* SmallInteger, context flags */ /* SmallInteger, context flags */
hcl_oop_t flags; hcl_oop_t flags;
/* SmallInteger. */
hcl_oop_t tmpr_mask;
/* SmallInteger, instruction pointer */
hcl_oop_t ip;
/* 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
@ -605,15 +609,6 @@ struct hcl_context_t
* nil if a block context created hasn't received 'value'. */ * nil if a block context created hasn't received 'value'. */
hcl_oop_context_t sender; /* context or nil */ hcl_oop_context_t sender; /* context or nil */
/* SmallInteger, instruction pointer */
hcl_oop_t ip;
/* SmallInteger. Number of temporaries. Includes arguments as well */
hcl_oop_t ntmprs;
/* SmallInteger. Number of arguments */
hcl_oop_t nargs;
/* 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 */