added hcl_block_t to express a base block. no more reuse of hcl_context_t for the base block
This commit is contained in:
parent
a69434a96f
commit
d127456da8
@ -1160,7 +1160,7 @@ hcl_logufmt (hcl, HCL_LOG_WARN, fmt, ustr, 0x6789);
|
|||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#if 0
|
#if 1
|
||||||
// TODO: change the option name
|
// TODO: change the option name
|
||||||
// in the INTERACTIVE mode, the compiler generates MAKE_FUNCTION for lambda functions.
|
// in the INTERACTIVE mode, the compiler generates MAKE_FUNCTION for lambda functions.
|
||||||
// in the non-INTERACTIVE mode, the compiler generates MAKE_CONTEXT for lambda functions.
|
// in the non-INTERACTIVE mode, the compiler generates MAKE_CONTEXT for lambda functions.
|
||||||
|
123
lib/exec.c
123
lib/exec.c
@ -167,7 +167,7 @@ static HCL_INLINE hcl_oop_t make_context (hcl_t* hcl, hcl_ooi_t ntmprs)
|
|||||||
return hcl_allocoopobj(hcl, HCL_BRAND_CONTEXT, HCL_CONTEXT_NAMED_INSTVARS + (hcl_oow_t)ntmprs);
|
return hcl_allocoopobj(hcl, HCL_BRAND_CONTEXT, HCL_CONTEXT_NAMED_INSTVARS + (hcl_oow_t)ntmprs);
|
||||||
}
|
}
|
||||||
|
|
||||||
static HCL_INLINE hcl_oop_t make_function (hcl_t* hcl, hcl_oow_t lfsize, const hcl_oob_t* bptr, hcl_oow_t blen)
|
static HCL_INLINE hcl_oop_function_t make_function (hcl_t* hcl, hcl_oow_t lfsize, const hcl_oob_t* bptr, hcl_oow_t blen)
|
||||||
{
|
{
|
||||||
/* the literal frame is placed in the variable part.
|
/* the literal frame is placed in the variable part.
|
||||||
* the byte code is placed in the trailer space */
|
* the byte code is placed in the trailer space */
|
||||||
@ -180,6 +180,10 @@ static HCL_INLINE void fill_function_data (hcl_t* hcl, hcl_oop_function_t func,
|
|||||||
* 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, 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);
|
||||||
for (i = 0; i < lfsize; i++)
|
for (i = 0; i < lfsize; i++)
|
||||||
@ -194,6 +198,25 @@ static HCL_INLINE void fill_function_data (hcl_t* hcl, hcl_oop_function_t func,
|
|||||||
func->ntmprs = HCL_SMOOI_TO_OOP(ntmprs);
|
func->ntmprs = HCL_SMOOI_TO_OOP(ntmprs);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static HCL_INLINE hcl_oop_block_t make_block (hcl_t* hcl)
|
||||||
|
{
|
||||||
|
/* create a base block used for creation of a block context */
|
||||||
|
return 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)
|
||||||
|
{
|
||||||
|
HCL_ASSERT (hcl, nargs >= 0 && nargs <= HCL_SMOOI_MAX);
|
||||||
|
HCL_ASSERT (hcl, ntmprs >= 0 && ntmprs <= HCL_SMOOI_MAX);
|
||||||
|
HCL_ASSERT (hcl, nargs <= ntmprs);
|
||||||
|
HCL_ASSERT (hcl, ip >= 0 && nargs <= HCL_SMOOI_MAX);
|
||||||
|
|
||||||
|
blk->home = homectx;
|
||||||
|
blk->nargs = HCL_SMOOI_TO_OOP(nargs);
|
||||||
|
blk->ntmprs = HCL_SMOOI_TO_OOP(ntmprs);
|
||||||
|
blk->ip = HCL_SMOOI_TO_OOP(ip);
|
||||||
|
}
|
||||||
|
|
||||||
static HCL_INLINE int prepare_to_alloc_pid (hcl_t* hcl)
|
static HCL_INLINE int prepare_to_alloc_pid (hcl_t* hcl)
|
||||||
{
|
{
|
||||||
hcl_oow_t new_capa;
|
hcl_oow_t new_capa;
|
||||||
@ -902,7 +925,7 @@ static void update_sem_heap (hcl_t* hcl, hcl_ooi_t index, hcl_oop_semaphore_t ne
|
|||||||
}
|
}
|
||||||
/* ------------------------------------------------------------------------- */
|
/* ------------------------------------------------------------------------- */
|
||||||
|
|
||||||
static int __activate_context (hcl_t* hcl, hcl_oop_context_t rcv_blkctx, 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* pblkctx)
|
||||||
{
|
{
|
||||||
/* 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
|
||||||
@ -923,35 +946,22 @@ static int __activate_context (hcl_t* hcl, hcl_oop_context_t rcv_blkctx, hcl_ooi
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
/* the receiver must be a block context */
|
/* the receiver must be a block context */
|
||||||
HCL_ASSERT (hcl, HCL_IS_CONTEXT (hcl, rcv_blkctx));
|
HCL_ASSERT (hcl, HCL_IS_BLOCK(hcl, rcv_blk));
|
||||||
if (rcv_blkctx->receiver_or_base != hcl->_nil)
|
|
||||||
{
|
|
||||||
/* the 'source' field is not nil.
|
|
||||||
* this block context has already been activated once.
|
|
||||||
* you can't send 'value' again to reactivate it.
|
|
||||||
* For example, [thisContext value] value. */
|
|
||||||
HCL_ASSERT (hcl, HCL_OBJ_GET_SIZE(rcv_blkctx) > HCL_CONTEXT_NAMED_INSTVARS);
|
|
||||||
HCL_LOG1 (hcl, HCL_LOG_IC | HCL_LOG_ERROR,
|
|
||||||
"Error - re-valuing of a block context - %O\n", rcv_blkctx);
|
|
||||||
hcl_seterrbfmt (hcl, HCL_ERECALL, "cannot recall %O", rcv_blkctx);
|
|
||||||
return -1;
|
|
||||||
}
|
|
||||||
HCL_ASSERT (hcl, HCL_OBJ_GET_SIZE(rcv_blkctx) == HCL_CONTEXT_NAMED_INSTVARS);
|
|
||||||
|
|
||||||
if (HCL_OOP_TO_SMOOI(rcv_blkctx->nargs) != nargs)
|
if (HCL_OOP_TO_SMOOI(rcv_blk->nargs) != 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 context %O - expecting %zd, got %zd\n",
|
"Error - wrong number of arguments to a block %O - expecting %zd, got %zd\n",
|
||||||
rcv_blkctx, HCL_OOP_TO_SMOOI(rcv_blkctx->nargs), nargs);
|
rcv_blk, HCL_OOP_TO_SMOOI(rcv_blk->nargs), nargs);
|
||||||
hcl_seterrnum (hcl, HCL_ECALLARG);
|
hcl_seterrnum (hcl, HCL_ECALLARG);
|
||||||
return -1;
|
return -1;
|
||||||
}
|
}
|
||||||
|
|
||||||
local_ntmprs = HCL_OOP_TO_SMOOI(rcv_blkctx->ntmprs);
|
local_ntmprs = HCL_OOP_TO_SMOOI(rcv_blk->ntmprs);
|
||||||
HCL_ASSERT (hcl, local_ntmprs >= nargs);
|
HCL_ASSERT (hcl, local_ntmprs >= nargs);
|
||||||
|
|
||||||
/* create a new block context to clone rcv_blkctx */
|
/* create a new block context to clone rcv_blk */
|
||||||
hcl_pushtmp (hcl, (hcl_oop_t*)&rcv_blkctx);
|
hcl_pushtmp (hcl, (hcl_oop_t*)&rcv_blk);
|
||||||
blkctx = (hcl_oop_context_t)make_context(hcl, local_ntmprs);
|
blkctx = (hcl_oop_context_t)make_context(hcl, local_ntmprs);
|
||||||
hcl_poptmp (hcl);
|
hcl_poptmp (hcl);
|
||||||
if (!blkctx) return -1;
|
if (!blkctx) return -1;
|
||||||
@ -960,15 +970,16 @@ static int __activate_context (hcl_t* hcl, hcl_oop_context_t rcv_blkctx, hcl_ooi
|
|||||||
/* 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_blkctx)->slot[i];
|
((hcl_oop_oop_t)blkctx)->slot[i] = ((hcl_oop_oop_t)rcv_blk)->slot[i];
|
||||||
}
|
}
|
||||||
#else
|
#else
|
||||||
blkctx->ip = rcv_blkctx->ip;
|
blkctx->ip = rcv_blk->ip;
|
||||||
blkctx->ntmprs = rcv_blkctx->ntmprs;
|
blkctx->ntmprs = rcv_blk->ntmprs;
|
||||||
blkctx->nargs = rcv_blkctx->nargs;
|
blkctx->nargs = rcv_blk->nargs;
|
||||||
blkctx->receiver_or_base = (hcl_oop_t)rcv_blkctx;
|
blkctx->receiver_or_base = (hcl_oop_t)rcv_blk;
|
||||||
blkctx->home = rcv_blkctx->home;
|
blkctx->home = rcv_blk->home;
|
||||||
blkctx->origin = rcv_blkctx->origin;
|
/* blkctx->origin = rcv_blk->origin; */
|
||||||
|
blkctx->origin = rcv_blk->home->origin;
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* 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 */
|
||||||
@ -980,7 +991,7 @@ static int __activate_context (hcl_t* hcl, hcl_oop_context_t rcv_blkctx, hcl_ooi
|
|||||||
|
|
||||||
HCL_STACK_POPS (hcl, nargs + 1); /* pop arguments and receiver */
|
HCL_STACK_POPS (hcl, nargs + 1); /* pop arguments and receiver */
|
||||||
|
|
||||||
HCL_ASSERT (hcl, (rcv_blkctx == hcl->initial_context && (hcl_oop_t)blkctx->home == hcl->_nil) || (hcl_oop_t)blkctx->home != hcl->_nil);
|
HCL_ASSERT (hcl, (rcv_blk == hcl->initial_context && (hcl_oop_t)blkctx->home == hcl->_nil) || (hcl_oop_t)blkctx->home != hcl->_nil);
|
||||||
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;
|
||||||
|
|
||||||
@ -988,15 +999,16 @@ static int __activate_context (hcl_t* hcl, hcl_oop_context_t rcv_blkctx, hcl_ooi
|
|||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
static HCL_INLINE int activate_context (hcl_t* hcl, hcl_ooi_t nargs)
|
static HCL_INLINE int activate_block (hcl_t* hcl, hcl_ooi_t nargs)
|
||||||
{
|
{
|
||||||
int x;
|
int x;
|
||||||
hcl_oop_context_t rcv, blkctx;
|
hcl_oop_block_t rcv;
|
||||||
|
hcl_oop_context_t blkctx;
|
||||||
|
|
||||||
rcv = (hcl_oop_context_t)HCL_STACK_GETRCV(hcl, nargs);
|
rcv = (hcl_oop_block_t)HCL_STACK_GETRCV(hcl, nargs);
|
||||||
HCL_ASSERT (hcl, HCL_IS_CONTEXT(hcl, rcv));
|
HCL_ASSERT (hcl, HCL_IS_BLOCK(hcl, rcv));
|
||||||
|
|
||||||
x = __activate_context(hcl, rcv, nargs, &blkctx);
|
x = __activate_block(hcl, rcv, nargs, &blkctx);
|
||||||
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, (hcl_oop_context_t)blkctx);
|
||||||
@ -1820,14 +1832,14 @@ static int execute (hcl_t* hcl)
|
|||||||
{
|
{
|
||||||
switch (HCL_OBJ_GET_FLAGS_BRAND(rcv))
|
switch (HCL_OBJ_GET_FLAGS_BRAND(rcv))
|
||||||
{
|
{
|
||||||
case HCL_BRAND_CONTEXT:
|
|
||||||
if (activate_context(hcl, b1) <= -1) goto oops;
|
|
||||||
break;
|
|
||||||
|
|
||||||
case HCL_BRAND_FUNCTION:
|
case HCL_BRAND_FUNCTION:
|
||||||
if (activate_function(hcl, b1) <= -1) goto oops;
|
if (activate_function(hcl, b1) <= -1) goto oops;
|
||||||
break;
|
break;
|
||||||
|
|
||||||
|
case HCL_BRAND_BLOCK:
|
||||||
|
if (activate_block(hcl, b1) <= -1) goto oops;
|
||||||
|
break;
|
||||||
|
|
||||||
case HCL_BRAND_PRIM:
|
case HCL_BRAND_PRIM:
|
||||||
if (call_primitive(hcl, b1) <= -1) goto oops;
|
if (call_primitive(hcl, b1) <= -1) goto oops;
|
||||||
break;
|
break;
|
||||||
@ -2346,9 +2358,9 @@ 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_HCL_CODE_LONG_PARAM_SIZE == 2)
|
#if (HCL_HCL_CODE_LONG_PARAM_SIZE == 2)
|
||||||
func = (hcl_oop_function_t)make_function(hcl, b4, &hcl->active_code[hcl->ip + 3], joff);
|
func = make_function(hcl, b4, &hcl->active_code[hcl->ip + 3], joff);
|
||||||
#else
|
#else
|
||||||
func = (hcl_oop_function_t)make_function(hcl, b4, &hcl->active_code[hcl->ip + 2], joff);
|
func = make_function(hcl, b4, &hcl->active_code[hcl->ip + 2], joff);
|
||||||
#endif
|
#endif
|
||||||
if (HCL_UNLIKELY(!func)) goto oops;
|
if (HCL_UNLIKELY(!func)) goto oops;
|
||||||
|
|
||||||
@ -2361,6 +2373,7 @@ static int execute (hcl_t* hcl)
|
|||||||
|
|
||||||
case HCL_CODE_MAKE_BLOCK:
|
case HCL_CODE_MAKE_BLOCK:
|
||||||
{
|
{
|
||||||
|
#if 0
|
||||||
hcl_oop_context_t blkctx;
|
hcl_oop_context_t blkctx;
|
||||||
|
|
||||||
/* b1 - number of block arguments
|
/* b1 - number of block arguments
|
||||||
@ -2373,6 +2386,7 @@ static int execute (hcl_t* hcl)
|
|||||||
HCL_ASSERT (hcl, b1 >= 0);
|
HCL_ASSERT (hcl, b1 >= 0);
|
||||||
HCL_ASSERT (hcl, b2 >= b1);
|
HCL_ASSERT (hcl, b2 >= b1);
|
||||||
|
|
||||||
|
|
||||||
/* the block context object created here is used as a base
|
/* the block context object created here is used as a base
|
||||||
* object for block context activation. activate_context()
|
* object for block context activation. activate_context()
|
||||||
* clones a block context and activates the cloned context.
|
* clones a block context and activates the cloned context.
|
||||||
@ -2402,6 +2416,31 @@ static int execute (hcl_t* hcl)
|
|||||||
|
|
||||||
/* 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)blkctx);
|
HCL_STACK_PUSH (hcl, (hcl_oop_t)blkctx);
|
||||||
|
#else
|
||||||
|
hcl_oop_block_t blkobj;
|
||||||
|
|
||||||
|
/* b1 - number of block arguments
|
||||||
|
* b2 - number of block temporaries */
|
||||||
|
FETCH_PARAM_CODE_TO (hcl, b1);
|
||||||
|
FETCH_PARAM_CODE_TO (hcl, b2);
|
||||||
|
|
||||||
|
LOG_INST_2 (hcl, "make_block %zu %zu", b1, b2);
|
||||||
|
|
||||||
|
HCL_ASSERT (hcl, b1 >= 0);
|
||||||
|
HCL_ASSERT (hcl, b2 >= b1);
|
||||||
|
|
||||||
|
blkobj = make_block(hcl);
|
||||||
|
if (HCL_UNLIKELY(!blkobj)) goto oops;
|
||||||
|
|
||||||
|
/* the long forward jump instruction has the format of
|
||||||
|
* 11000100 KKKKKKKK or 11000100 KKKKKKKK KKKKKKKK
|
||||||
|
* depending on HCL_HCL_CODE_LONG_PARAM_SIZE. change 'ip' to point to
|
||||||
|
* the instruction after the jump. */
|
||||||
|
fill_block_data (hcl, blkobj, b1, b2, hcl->ip + HCL_HCL_CODE_LONG_PARAM_SIZE + 1, hcl->active_context);
|
||||||
|
|
||||||
|
/* push the new block context to the stack of the active context */
|
||||||
|
HCL_STACK_PUSH (hcl, (hcl_oop_t)blkobj);
|
||||||
|
#endif
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -2463,7 +2502,7 @@ hcl_oop_t hcl_execute (hcl_t* hcl)
|
|||||||
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
|
||||||
|
|
||||||
func = (hcl_oop_function_t)make_function(hcl, hcl->code.lit.len, hcl->code.bc.ptr, hcl->code.bc.len);
|
func = make_function(hcl, hcl->code.lit.len, hcl->code.bc.ptr, hcl->code.bc.len);
|
||||||
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 */
|
||||||
|
56
lib/hcl.h
56
lib/hcl.h
@ -525,6 +525,10 @@ struct hcl_fpdec_t
|
|||||||
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 4
|
||||||
|
typedef struct hcl_block_t hcl_block_t;
|
||||||
|
typedef struct hcl_block_t* hcl_oop_block_t;
|
||||||
|
|
||||||
#define HCL_CONTEXT_NAMED_INSTVARS 8
|
#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;
|
||||||
@ -533,8 +537,8 @@ struct hcl_function_t
|
|||||||
{
|
{
|
||||||
HCL_OBJ_HEADER;
|
HCL_OBJ_HEADER;
|
||||||
|
|
||||||
hcl_oop_t ntmprs; /* smooi */
|
hcl_oop_t ntmprs; /* smooi. number of temporaries. includes arguments as well */
|
||||||
hcl_oop_t nargs; /* 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 */
|
||||||
|
|
||||||
/* == variable indexed part == */
|
/* == variable indexed part == */
|
||||||
@ -543,6 +547,19 @@ struct hcl_function_t
|
|||||||
/* after the literal frame comes the actual byte code */
|
/* after the literal frame comes the actual byte code */
|
||||||
};
|
};
|
||||||
|
|
||||||
|
/* hcl_function_t copies the byte codes and literal frames into itself
|
||||||
|
* hlc_block_t contains minimal information(ip) for referening byte codes
|
||||||
|
* and literal frames available in home->origin.
|
||||||
|
*/
|
||||||
|
struct hcl_block_t
|
||||||
|
{
|
||||||
|
HCL_OBJ_HEADER;
|
||||||
|
hcl_oop_t ntmprs; /* smooi. number of temporaries. includes arguments as well */
|
||||||
|
hcl_oop_t nargs; /* smooi. number of arguments */
|
||||||
|
hcl_oop_t ip; /* smooi. instruction pointer where the byte code begins in home->origin */
|
||||||
|
hcl_oop_context_t home; /* home context */
|
||||||
|
};
|
||||||
|
|
||||||
struct hcl_context_t
|
struct hcl_context_t
|
||||||
{
|
{
|
||||||
HCL_OBJ_HEADER;
|
HCL_OBJ_HEADER;
|
||||||
@ -569,10 +586,9 @@ struct hcl_context_t
|
|||||||
hcl_oop_t nargs;
|
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 base block context(created but not yet activated) has nil in this
|
* a block context points to a block object and a function context
|
||||||
* field. if a block context is activated by 'value', it points
|
* points to a function object */
|
||||||
* to the block context object used as a base for shallow-copy. */
|
hcl_oop_t receiver_or_base; /* when used as a base, it's either a block or a function */
|
||||||
hcl_oop_t receiver_or_base; /* when used as a base, it's either a context or a function */
|
|
||||||
|
|
||||||
/* 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
|
||||||
@ -581,19 +597,21 @@ struct hcl_context_t
|
|||||||
* an activated block context copies this field from the base block context. */
|
* an activated block context copies this field from the base block context. */
|
||||||
hcl_oop_context_t home; /* context or nil */
|
hcl_oop_context_t home; /* context or nil */
|
||||||
|
|
||||||
/* it points to the method context created of the method defining the code
|
/* a function context is created with itself in this field. The function
|
||||||
* of this context. a method context points to itself. a block context
|
* context creation is based on a function object(initial or lambda/defun).
|
||||||
* points to the method context where it is created. another block context
|
|
||||||
* created within the block context also points to the same method context.
|
|
||||||
* ctx->origin: method context
|
|
||||||
* ctx->origin->receiver_or_base: actual function containing byte codes pertaining to ctx.
|
|
||||||
*
|
*
|
||||||
* when a method context is created, it is set to itself. no change is
|
* a block context is created over a block object. it stores
|
||||||
* made when the method context is activated. when a base block context is
|
* a function context points to itself in this field. a block context
|
||||||
* created (when MAKE_BLOCK or BLOCK_COPY is executed), it is set to the
|
* points to the function context where it is created. another block context
|
||||||
* origin of the active context. when the base block context is shallow-copied
|
* created within the block context also points to the same function context.
|
||||||
* for activation (when it is sent 'value'), it is set to the origin of
|
*
|
||||||
* the base block context. */
|
* take note of the following points:
|
||||||
|
* ctx->origin: function context
|
||||||
|
* ctx->origin->receiver_or_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 function context. so its base is also a function object all the time.
|
||||||
|
*/
|
||||||
hcl_oop_context_t origin;
|
hcl_oop_context_t origin;
|
||||||
|
|
||||||
/* variable indexed part */
|
/* variable indexed part */
|
||||||
@ -1386,6 +1404,7 @@ enum hcl_brand_t
|
|||||||
HCL_BRAND_PRIM,
|
HCL_BRAND_PRIM,
|
||||||
|
|
||||||
HCL_BRAND_FUNCTION,
|
HCL_BRAND_FUNCTION,
|
||||||
|
HCL_BRAND_BLOCK,
|
||||||
HCL_BRAND_CONTEXT,
|
HCL_BRAND_CONTEXT,
|
||||||
HCL_BRAND_PROCESS,
|
HCL_BRAND_PROCESS,
|
||||||
HCL_BRAND_PROCESS_SCHEDULER,
|
HCL_BRAND_PROCESS_SCHEDULER,
|
||||||
@ -1430,6 +1449,7 @@ typedef enum hcl_concode_t hcl_concode_t;
|
|||||||
#define HCL_IS_SYMBOL_ARRAY(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_SYMBOL_ARRAY)
|
#define HCL_IS_SYMBOL_ARRAY(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_SYMBOL_ARRAY)
|
||||||
#define HCL_IS_CONTEXT(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_CONTEXT)
|
#define HCL_IS_CONTEXT(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_CONTEXT)
|
||||||
#define HCL_IS_FUNCTION(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_FUNCTION)
|
#define HCL_IS_FUNCTION(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_FUNCTION)
|
||||||
|
#define HCL_IS_BLOCK(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_BLOCK)
|
||||||
#define HCL_IS_PROCESS(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_PROCESS)
|
#define HCL_IS_PROCESS(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_PROCESS)
|
||||||
#define HCL_IS_CONS(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_CONS)
|
#define HCL_IS_CONS(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_CONS)
|
||||||
#define HCL_IS_CONS_CONCODED(hcl,v,concode) (HCL_IS_CONS(hcl,v) && HCL_OBJ_GET_FLAGS_SYNCODE(v) == (concode))
|
#define HCL_IS_CONS_CONCODED(hcl,v,concode) (HCL_IS_CONS(hcl,v) && HCL_OBJ_GET_FLAGS_SYNCODE(v) == (concode))
|
||||||
|
@ -88,6 +88,7 @@ enum
|
|||||||
WORD_PRIM,
|
WORD_PRIM,
|
||||||
|
|
||||||
WORD_FUNCTION,
|
WORD_FUNCTION,
|
||||||
|
WORD_BLOCK,
|
||||||
WORD_CONTEXT,
|
WORD_CONTEXT,
|
||||||
WORD_PROCESS,
|
WORD_PROCESS,
|
||||||
WORD_PROCESS_SCHEDULER,
|
WORD_PROCESS_SCHEDULER,
|
||||||
@ -109,6 +110,7 @@ static struct
|
|||||||
{ 7, { '#','<','P','R','I','M','>' } },
|
{ 7, { '#','<','P','R','I','M','>' } },
|
||||||
|
|
||||||
{ 11, { '#','<','F','U','N','C','T','I','O','N','>' } },
|
{ 11, { '#','<','F','U','N','C','T','I','O','N','>' } },
|
||||||
|
{ 11, { '#','<','B','L','O','C','K','>' } },
|
||||||
{ 10, { '#','<','C','O','N','T','E','X','T','>' } },
|
{ 10, { '#','<','C','O','N','T','E','X','T','>' } },
|
||||||
{ 10, { '#','<','P','R','O','C','E','S','S','>' } },
|
{ 10, { '#','<','P','R','O','C','E','S','S','>' } },
|
||||||
{ 20, { '#','<','P','R','O','C','E','S','S','-','S','C','H','E','D','U','L','E','R','>' } },
|
{ 20, { '#','<','P','R','O','C','E','S','S','-','S','C','H','E','D','U','L','E','R','>' } },
|
||||||
@ -663,6 +665,10 @@ next:
|
|||||||
word_index = WORD_FUNCTION;
|
word_index = WORD_FUNCTION;
|
||||||
goto print_word;
|
goto print_word;
|
||||||
|
|
||||||
|
case HCL_BRAND_BLOCK:
|
||||||
|
word_index = WORD_BLOCK;
|
||||||
|
goto print_word;
|
||||||
|
|
||||||
case HCL_BRAND_CONTEXT:
|
case HCL_BRAND_CONTEXT:
|
||||||
word_index = WORD_CONTEXT;
|
word_index = WORD_CONTEXT;
|
||||||
goto print_word;
|
goto print_word;
|
||||||
|
Loading…
Reference in New Issue
Block a user