changing vm implementation a bit. this commit is buggy
This commit is contained in:
parent
c7e87698d0
commit
2b786018d7
@ -1062,11 +1062,7 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src, int defun)
|
||||
hcl->c->blk.depth++;
|
||||
if (store_temporary_variable_count_for_block(hcl, hcl->c->tv.size, hcl->code.lit.len) <= -1) return -1;
|
||||
|
||||
/* use the accumulated number of temporaries so far when generating
|
||||
* the make_block instruction. at context activation time, the actual
|
||||
* count of temporaries for this block is derived by subtracting the
|
||||
* count of temporaries in the home context */
|
||||
if (emit_double_param_instruction(hcl, HCL_CODE_MAKE_BLOCK, nargs, hcl->c->tv.size/*ntmprs*/) <= -1) return -1;
|
||||
if (emit_double_param_instruction(hcl, HCL_CODE_MAKE_BLOCK, nargs, ntmprs) <= -1) return -1;
|
||||
|
||||
HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX); /* guaranteed in emit_byte_instruction() */
|
||||
jump_inst_pos = hcl->code.bc.len;
|
||||
@ -1557,7 +1553,6 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_oop_t obj)
|
||||
|
||||
static int emit_indexed_variable_access (hcl_t* hcl, hcl_oow_t index, hcl_oob_t baseinst1, hcl_oob_t baseinst2)
|
||||
{
|
||||
#if defined(HCL_USE_CTXTEMPVAR)
|
||||
if (hcl->c->blk.depth >= 0)
|
||||
{
|
||||
hcl_oow_t i;
|
||||
@ -1582,7 +1577,6 @@ static int emit_indexed_variable_access (hcl_t* hcl, hcl_oow_t index, hcl_oob_t
|
||||
}
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
/* TODO: top-level... verify this. this will vary depending on how i implement the top-level and global variables... */
|
||||
if (emit_single_param_instruction (hcl, baseinst2, index) <= -1) return -1;
|
||||
|
||||
26
lib/decode.c
26
lib/decode.c
@ -35,11 +35,13 @@
|
||||
# define LOG_INST_1(hcl,fmt,a1)
|
||||
# define LOG_INST_2(hcl,fmt,a1,a2)
|
||||
# define LOG_INST_3(hcl,fmt,a1,a2,a3)
|
||||
# define LOG_INST_4(hcl,fmt,a1,a2,a3,a4)
|
||||
#else
|
||||
# define LOG_INST_0(hcl,fmt) HCL_LOG1(hcl, DECODE_LOG_MASK, " %06zd " fmt "\n", fetched_instruction_pointer)
|
||||
# define LOG_INST_1(hcl,fmt,a1) HCL_LOG2(hcl, DECODE_LOG_MASK, " %06zd " fmt "\n", fetched_instruction_pointer, a1)
|
||||
# define LOG_INST_2(hcl,fmt,a1,a2) HCL_LOG3(hcl, DECODE_LOG_MASK, " %06zd " fmt "\n", fetched_instruction_pointer, a1, a2)
|
||||
# define LOG_INST_3(hcl,fmt,a1,a2,a3) HCL_LOG4(hcl, DECODE_LOG_MASK, " %06zd " fmt "\n", fetched_instruction_pointer, a1, a2, a3)
|
||||
# define LOG_INST_4(hcl,fmt,a1,a2,a3,a4) HCL_LOG5(hcl, DECODE_LOG_MASK, " %06zd " fmt "\n", fetched_instruction_pointer, a1, a2, a3, a4)
|
||||
#endif
|
||||
|
||||
#define FETCH_BYTE_CODE(hcl) (cdptr[ip++])
|
||||
@ -59,7 +61,7 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
|
||||
{
|
||||
hcl_oob_t bcode, * cdptr;
|
||||
hcl_ooi_t ip = start, fetched_instruction_pointer;
|
||||
hcl_oow_t b1, b2;
|
||||
hcl_oow_t b1, b2, b3, b4;
|
||||
|
||||
/* the instruction at the offset 'end' is not decoded.
|
||||
* decoding offset range is from start to end - 1. */
|
||||
@ -550,6 +552,23 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
|
||||
LOG_INST_0 (hcl, "return_from_block");
|
||||
break;
|
||||
|
||||
case HCL_CODE_MAKE_FUNCTION:
|
||||
/* b1 - number of block arguments
|
||||
* b2 - number of block temporaries
|
||||
* b3 - base literal frame start
|
||||
* b4 - base literal frame end */
|
||||
FETCH_PARAM_CODE_TO (hcl, b1);
|
||||
FETCH_PARAM_CODE_TO (hcl, b2);
|
||||
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);
|
||||
|
||||
HCL_ASSERT (hcl, b1 >= 0);
|
||||
HCL_ASSERT (hcl, b2 >= b1);
|
||||
HCL_ASSERT (hcl, b4 >= b3);
|
||||
break;
|
||||
|
||||
case HCL_CODE_MAKE_BLOCK:
|
||||
/* b1 - number of block arguments
|
||||
* b2 - number of block temporaries */
|
||||
@ -562,10 +581,6 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
|
||||
HCL_ASSERT (hcl, b2 >= b1);
|
||||
break;
|
||||
|
||||
case HCL_CODE_SEND_BLOCK_COPY:
|
||||
LOG_INST_0 (hcl, "send_block_copy");
|
||||
break;
|
||||
|
||||
case HCL_CODE_NOOP:
|
||||
/* do nothing */
|
||||
LOG_INST_0 (hcl, "noop");
|
||||
@ -578,6 +593,7 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
|
||||
}
|
||||
}
|
||||
|
||||
// TODO: this needs changes... */
|
||||
/* print literal frame contents */
|
||||
for (ip = 0; ip < hcl->code.lit.len; ip++)
|
||||
{
|
||||
|
||||
@ -363,7 +363,7 @@ hcl_oop_t hcl_makedic (hcl_t* hcl, hcl_oow_t inisize)
|
||||
{
|
||||
hcl_oop_dic_t obj;
|
||||
|
||||
obj = (hcl_oop_dic_t)hcl_allocoopobj (hcl, HCL_BRAND_DIC, 2);
|
||||
obj = (hcl_oop_dic_t)hcl_allocoopobj(hcl, HCL_BRAND_DIC, 2);
|
||||
if (obj)
|
||||
{
|
||||
hcl_oop_oop_t bucket;
|
||||
|
||||
431
lib/exec.c
431
lib/exec.c
@ -82,12 +82,14 @@ static HCL_INLINE const char* proc_state_to_string (int state)
|
||||
{ \
|
||||
STORE_ACTIVE_IP (hcl); \
|
||||
(hcl)->active_context = (v_ctx); \
|
||||
(hcl)->active_function = (hcl_oop_function_t)(hcl)->active_context->origin; \
|
||||
(hcl)->active_code = HCL_FUNCTION_GET_CODE_BYTE((hcl)->active_function); \
|
||||
LOAD_ACTIVE_IP (hcl); \
|
||||
(hcl)->processor->active->current_context = (hcl)->active_context; \
|
||||
} while (0)
|
||||
|
||||
|
||||
#define FETCH_BYTE_CODE(hcl) ((hcl)->code.bc.arr->slot[(hcl)->ip++])
|
||||
/*#define FETCH_BYTE_CODE(hcl) ((hcl)->code.bc.arr->slot[(hcl)->ip++])*/
|
||||
#define FETCH_BYTE_CODE(hcl) ((hcl)->active_code[(hcl)->ip++])
|
||||
#define FETCH_BYTE_CODE_TO(hcl, v_oow) (v_oow = FETCH_BYTE_CODE(hcl))
|
||||
#if (HCL_HCL_CODE_LONG_PARAM_SIZE == 2)
|
||||
# define FETCH_PARAM_CODE_TO(hcl, v_oow) \
|
||||
@ -107,12 +109,14 @@ static HCL_INLINE const char* proc_state_to_string (int state)
|
||||
# define LOG_INST_1(hcl,fmt,a1) HCL_LOG2(hcl, LOG_MASK_INST, "%010zd " fmt "\n",fetched_instruction_pointer, a1)
|
||||
# define LOG_INST_2(hcl,fmt,a1,a2) HCL_LOG3(hcl, LOG_MASK_INST, "%010zd " fmt "\n", fetched_instruction_pointer, a1, a2)
|
||||
# define LOG_INST_3(hcl,fmt,a1,a2,a3) HCL_LOG4(hcl, LOG_MASK_INST, "%010zd " fmt "\n", fetched_instruction_pointer, a1, a2, a3)
|
||||
# define LOG_INST_4(hcl,fmt,a1,a2,a3,a4) HCL_LOG5(hcl, LOG_MASK_INST, "%010zd " fmt "\n", fetched_instruction_pointer, a1, a2, a3, a4)
|
||||
|
||||
#else
|
||||
# define LOG_INST_0(hcl,fmt)
|
||||
# define LOG_INST_1(hcl,fmt,a1)
|
||||
# define LOG_INST_2(hcl,fmt,a1,a2)
|
||||
# define LOG_INST_3(hcl,fmt,a1,a2,a3)
|
||||
# define LOG_INST_3(hcl,fmt,a1,a2,a3,a4)
|
||||
#endif
|
||||
|
||||
static int vm_startup (hcl_t* hcl)
|
||||
@ -164,6 +168,29 @@ 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);
|
||||
}
|
||||
|
||||
static HCL_INLINE hcl_oop_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 byte code is placed in the trailer space */
|
||||
return hcl_allocoopobjwithtrailer(hcl, HCL_BRAND_FUNCTION, HCL_FUNCTION_NAMED_INSTVARS + lfsize, bptr, blen);
|
||||
}
|
||||
|
||||
static HCL_INLINE void fill_function_data (hcl_t* hcl, hcl_oop_function_t func, hcl_ooi_t nargs, hcl_ooi_t ntmprs, hcl_oop_t homectx, const hcl_oop_t* lfptr, hcl_oow_t lfsize)
|
||||
{
|
||||
/* Although this function could be integrated into make_function(),
|
||||
* this function has been separated from make_function() to make GC handling simpler */
|
||||
hcl_oow_t i;
|
||||
|
||||
/* copy literal frames */
|
||||
HCL_ASSERT (hcl, lfsize <= HCL_OBJ_GET_SIZE(func) - HCL_FUNCTION_NAMED_INSTVARS);
|
||||
for (i = 0; i < lfsize; i++) func->literal_frame[i] = lfptr[i];
|
||||
|
||||
/* initialize other fields */
|
||||
func->home = homectx;
|
||||
func->nargs = HCL_SMOOI_TO_OOP(nargs);
|
||||
func->ntmprs = HCL_SMOOI_TO_OOP(ntmprs);
|
||||
}
|
||||
|
||||
static HCL_INLINE int prepare_to_alloc_pid (hcl_t* hcl)
|
||||
{
|
||||
hcl_oow_t new_capa;
|
||||
@ -250,9 +277,9 @@ static hcl_oop_process_t make_process (hcl_t* hcl, hcl_oop_context_t c)
|
||||
stksize = HCL_TYPE_MAX(hcl_oow_t) - HCL_PROCESS_NAMED_INSTVARS;
|
||||
|
||||
hcl_pushtmp (hcl, (hcl_oop_t*)&c);
|
||||
proc = (hcl_oop_process_t)hcl_allocoopobj (hcl, HCL_BRAND_PROCESS, HCL_PROCESS_NAMED_INSTVARS + stksize);
|
||||
proc = (hcl_oop_process_t)hcl_allocoopobj(hcl, HCL_BRAND_PROCESS, HCL_PROCESS_NAMED_INSTVARS + stksize);
|
||||
hcl_poptmp (hcl);
|
||||
if (!proc) return HCL_NULL;
|
||||
if (HCL_UNLIKELY(!proc)) return HCL_NULL;
|
||||
|
||||
/* assign a process id to the process */
|
||||
alloc_pid (hcl, proc);
|
||||
@ -894,7 +921,7 @@ static int __activate_context (hcl_t* hcl, hcl_oop_context_t rcv_blkctx, hcl_ooi
|
||||
|
||||
/* the receiver must be a block context */
|
||||
HCL_ASSERT (hcl, HCL_IS_CONTEXT (hcl, rcv_blkctx));
|
||||
if (rcv_blkctx->receiver_or_source != hcl->_nil)
|
||||
if (rcv_blkctx->receiver_or_base != hcl->_nil)
|
||||
{
|
||||
/* the 'source' field is not nil.
|
||||
* this block context has already been activated once.
|
||||
@ -908,25 +935,21 @@ static int __activate_context (hcl_t* hcl, hcl_oop_context_t rcv_blkctx, hcl_ooi
|
||||
}
|
||||
HCL_ASSERT (hcl, HCL_OBJ_GET_SIZE(rcv_blkctx) == HCL_CONTEXT_NAMED_INSTVARS);
|
||||
|
||||
if (HCL_OOP_TO_SMOOI(rcv_blkctx->method_or_nargs) != nargs)
|
||||
if (HCL_OOP_TO_SMOOI(rcv_blkctx->nargs) != nargs)
|
||||
{
|
||||
HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_ERROR,
|
||||
"Error - wrong number of arguments to a block context %O - expecting %zd, got %zd\n",
|
||||
rcv_blkctx, HCL_OOP_TO_SMOOI(rcv_blkctx->method_or_nargs), nargs);
|
||||
rcv_blkctx, HCL_OOP_TO_SMOOI(rcv_blkctx->nargs), nargs);
|
||||
hcl_seterrnum (hcl, HCL_ECALLARG);
|
||||
return -1;
|
||||
}
|
||||
|
||||
/* the number of temporaries stored in the block context
|
||||
* accumulates the number of temporaries starting from the origin.
|
||||
* simple calculation is needed to find the number of local temporaries */
|
||||
local_ntmprs = HCL_OOP_TO_SMOOI(rcv_blkctx->ntmprs) -
|
||||
HCL_OOP_TO_SMOOI(((hcl_oop_context_t)rcv_blkctx->home)->ntmprs);
|
||||
local_ntmprs = HCL_OOP_TO_SMOOI(rcv_blkctx->ntmprs);
|
||||
HCL_ASSERT (hcl, local_ntmprs >= nargs);
|
||||
|
||||
/* create a new block context to clone rcv_blkctx */
|
||||
hcl_pushtmp (hcl, (hcl_oop_t*)&rcv_blkctx);
|
||||
blkctx = (hcl_oop_context_t) make_context(hcl, local_ntmprs);
|
||||
blkctx = (hcl_oop_context_t)make_context(hcl, local_ntmprs);
|
||||
hcl_poptmp (hcl);
|
||||
if (!blkctx) return -1;
|
||||
|
||||
@ -939,12 +962,90 @@ static int __activate_context (hcl_t* hcl, hcl_oop_context_t rcv_blkctx, hcl_ooi
|
||||
#else
|
||||
blkctx->ip = rcv_blkctx->ip;
|
||||
blkctx->ntmprs = rcv_blkctx->ntmprs;
|
||||
blkctx->method_or_nargs = rcv_blkctx->method_or_nargs;
|
||||
blkctx->receiver_or_source = (hcl_oop_t)rcv_blkctx;
|
||||
blkctx->nargs = rcv_blkctx->nargs;
|
||||
blkctx->receiver_or_base = (hcl_oop_t)rcv_blkctx;
|
||||
blkctx->home = rcv_blkctx->home;
|
||||
blkctx->origin = rcv_blkctx->origin;
|
||||
#endif
|
||||
|
||||
/* 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 */
|
||||
for (i = 0; i < nargs; i++)
|
||||
{
|
||||
blkctx->slot[i] = HCL_STACK_GETARG(hcl, nargs, i);
|
||||
}
|
||||
|
||||
HCL_STACK_POPS (hcl, nargs + 1); /* pop arguments and receiver */
|
||||
|
||||
HCL_ASSERT (hcl, (rcv_blkctx == hcl->initial_context && blkctx->home == hcl->_nil) || blkctx->home != hcl->_nil);
|
||||
blkctx->sp = HCL_SMOOI_TO_OOP(-1); /* not important at all */
|
||||
blkctx->sender = hcl->active_context;
|
||||
|
||||
*pblkctx = blkctx;
|
||||
return 0;
|
||||
}
|
||||
|
||||
static HCL_INLINE int activate_context (hcl_t* hcl, hcl_ooi_t nargs)
|
||||
{
|
||||
int x;
|
||||
hcl_oop_context_t rcv, blkctx;
|
||||
|
||||
rcv = (hcl_oop_context_t)HCL_STACK_GETRCV(hcl, nargs);
|
||||
HCL_ASSERT (hcl, HCL_IS_CONTEXT(hcl, rcv));
|
||||
|
||||
x = __activate_context(hcl, rcv, nargs, &blkctx);
|
||||
if (HCL_UNLIKELY(x <= -1)) return -1;
|
||||
|
||||
SWITCH_ACTIVE_CONTEXT (hcl, (hcl_oop_context_t)blkctx);
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* ------------------------------------------------------------------------- */
|
||||
|
||||
static int __activate_function (hcl_t* hcl, hcl_oop_function_t rcv_func, hcl_ooi_t nargs, hcl_oop_context_t* pblkctx)
|
||||
{
|
||||
/* prepare a new block context for activation.
|
||||
* the receiver must be a block context which becomes the base
|
||||
* for a new block context. */
|
||||
|
||||
hcl_oop_context_t blkctx;
|
||||
hcl_ooi_t local_ntmprs, i;
|
||||
|
||||
/*
|
||||
* (defun sum (x)
|
||||
* (if (< x 2) 1
|
||||
* else (+ x (sum (- x 1)))))
|
||||
* (printf ">>>> %d\n" (sum 10))
|
||||
*/
|
||||
|
||||
/* the receiver must be a block context */
|
||||
HCL_ASSERT (hcl, HCL_IS_FUNCTION(hcl, rcv_func));
|
||||
|
||||
if (HCL_OOP_TO_SMOOI(rcv_func->nargs) != nargs)
|
||||
{
|
||||
HCL_LOG3 (hcl, HCL_LOG_IC | HCL_LOG_ERROR,
|
||||
"Error - wrong number of arguments to a function %O - expecting %zd, got %zd\n",
|
||||
rcv_func, HCL_OOP_TO_SMOOI(rcv_func->nargs), nargs);
|
||||
hcl_seterrnum (hcl, HCL_ECALLARG);
|
||||
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 */
|
||||
hcl_pushtmp (hcl, (hcl_oop_t*)&rcv_func);
|
||||
blkctx = (hcl_oop_context_t)make_context(hcl, local_ntmprs);
|
||||
hcl_poptmp (hcl);
|
||||
if (!blkctx) return -1;
|
||||
|
||||
blkctx->ip = HCL_SMOOI_TO_OOP(0);
|
||||
blkctx->ntmprs = rcv_func->ntmprs;
|
||||
blkctx->nargs = rcv_func->nargs;
|
||||
blkctx->receiver_or_base = (hcl_oop_t)rcv_func;
|
||||
blkctx->home = rcv_func->home;
|
||||
blkctx->origin = rcv_func;
|
||||
|
||||
/* 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 */
|
||||
for (i = 0; i < nargs; i++)
|
||||
@ -962,16 +1063,16 @@ static int __activate_context (hcl_t* hcl, hcl_oop_context_t rcv_blkctx, hcl_ooi
|
||||
return 0;
|
||||
}
|
||||
|
||||
static HCL_INLINE int activate_context (hcl_t* hcl, hcl_ooi_t nargs)
|
||||
static HCL_INLINE int activate_function (hcl_t* hcl, hcl_ooi_t nargs)
|
||||
{
|
||||
int x;
|
||||
hcl_oop_context_t rcv, blkctx;
|
||||
|
||||
rcv = (hcl_oop_context_t)HCL_STACK_GETRCV(hcl, nargs);
|
||||
HCL_ASSERT (hcl, HCL_IS_CONTEXT (hcl, rcv));
|
||||
HCL_ASSERT (hcl, HCL_IS_FUNCTION(hcl, rcv));
|
||||
|
||||
x = __activate_context (hcl, rcv, nargs, &blkctx);
|
||||
if (x <= -1) return -1;
|
||||
x = __activate_function(hcl, rcv, nargs, &blkctx);
|
||||
if (HCL_UNLIKELY(x <= -1)) return -1;
|
||||
|
||||
SWITCH_ACTIVE_CONTEXT (hcl, (hcl_oop_context_t)blkctx);
|
||||
return 0;
|
||||
@ -1187,11 +1288,11 @@ static hcl_oop_process_t start_initial_process (hcl_t* hcl, hcl_oop_context_t ct
|
||||
HCL_ASSERT (hcl, hcl->processor->tally == HCL_SMOOI_TO_OOP(0));
|
||||
HCL_ASSERT (hcl, hcl->processor->active == hcl->nil_process);
|
||||
|
||||
proc = make_process (hcl, ctx);
|
||||
if (!proc) return HCL_NULL;
|
||||
proc = make_process(hcl, ctx);
|
||||
if (HCL_UNLIKELY(!proc)) return HCL_NULL;
|
||||
|
||||
/* skip RUNNABLE and go to RUNNING */
|
||||
if (chain_into_processor (hcl, proc, PROC_STATE_RUNNING) <= -1) return HCL_NULL;
|
||||
if (chain_into_processor(hcl, proc, PROC_STATE_RUNNING) <= -1) return HCL_NULL;
|
||||
hcl->processor->active = proc;
|
||||
|
||||
/* do something that resume_process() would do with less overhead */
|
||||
@ -1207,7 +1308,7 @@ static int start_initial_process_and_context (hcl_t* hcl, hcl_ooi_t initial_ip)
|
||||
hcl_oop_context_t ctx;
|
||||
hcl_oop_process_t proc;
|
||||
|
||||
/* create a fake initial context. */
|
||||
/* create a fake initial context over the initial function */
|
||||
ctx = (hcl_oop_context_t)make_context(hcl, 0); /* no temporary variables */
|
||||
if (!ctx) return -1;
|
||||
|
||||
@ -1218,15 +1319,14 @@ static int start_initial_process_and_context (hcl_t* hcl, hcl_ooi_t initial_ip)
|
||||
hcl->ip = initial_ip;
|
||||
hcl->sp = -1;
|
||||
|
||||
ctx->ip = HCL_SMOOI_TO_OOP(0); /* point to the beginning */
|
||||
ctx->ip = HCL_SMOOI_TO_OOP(initial_ip);
|
||||
ctx->sp = HCL_SMOOI_TO_OOP(-1); /* pointer to -1 below the bottom */
|
||||
ctx->origin = ctx; /* point to self */
|
||||
/*ctx->method_or_nargs = (hcl_oop_t)mth;*/ /* fake. help SWITCH_ACTIVE_CONTEXT() not fail. */
|
||||
ctx->method_or_nargs = HCL_SMOOI_TO_OOP(0);
|
||||
/* TODO: XXXXX */
|
||||
/*ctx->nargs = (hcl_oop_t)mth;*/ /* fake. help SWITCH_ACTIVE_CONTEXT() not fail. */
|
||||
ctx->nargs = HCL_SMOOI_TO_OOP(0);
|
||||
ctx->ntmprs = HCL_SMOOI_TO_OOP(0);
|
||||
ctx->home = (hcl_oop_t)ctx; /* is this correct??? */
|
||||
/* END XXXXX */
|
||||
ctx->origin = hcl->initial_function;
|
||||
ctx->home = hcl->initial_function->home; /* this should be nil */
|
||||
HCL_ASSERT (hcl, ctx->home == hcl->_nil);
|
||||
|
||||
/* [NOTE]
|
||||
* the receiver field and the sender field of ctx are nils.
|
||||
@ -1247,14 +1347,16 @@ static int start_initial_process_and_context (hcl_t* hcl, hcl_ooi_t initial_ip)
|
||||
hcl->active_context = ctx;
|
||||
|
||||
hcl_pushtmp (hcl, (hcl_oop_t*)&ctx);
|
||||
proc = start_initial_process (hcl, ctx);
|
||||
proc = start_initial_process(hcl, ctx);
|
||||
hcl_poptmp (hcl);
|
||||
if (!proc) return -1;
|
||||
if (HCL_UNLIKELY(!proc)) return -1;
|
||||
|
||||
HCL_STACK_PUSH (hcl, (hcl_oop_t)ctx);
|
||||
STORE_ACTIVE_SP (hcl); /* hcl->active_context->sp = HCL_SMOOI_TO_OOP(hcl->sp) */
|
||||
|
||||
return activate_context (hcl, 0);
|
||||
HCL_ASSERT (hcl, proc == hcl->processor->active);
|
||||
hcl->initial_context = proc->initial_context;
|
||||
return activate_context(hcl, 0);
|
||||
}
|
||||
|
||||
/* ------------------------------------------------------------------------- */
|
||||
@ -1425,8 +1527,8 @@ static int execute (hcl_t* hcl)
|
||||
b1 = bcode & 0x7; /* low 3 bits */
|
||||
push_instvar:
|
||||
LOG_INST_1 (hcl, "push_instvar %zu", b1);
|
||||
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->origin->receiver_or_source) == HCL_OBJ_TYPE_OOP);
|
||||
HCL_STACK_PUSH (hcl, ((hcl_oop_oop_t)hcl->active_context->origin->receiver_or_source)->slot[b1]);
|
||||
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->origin->receiver_or_base) == HCL_OBJ_TYPE_OOP);
|
||||
HCL_STACK_PUSH (hcl, ((hcl_oop_oop_t)hcl->active_context->origin->receiver_or_base)->slot[b1]);
|
||||
break;
|
||||
|
||||
/* ------------------------------------------------- */
|
||||
@ -1445,8 +1547,8 @@ static int execute (hcl_t* hcl)
|
||||
b1 = bcode & 0x7; /* low 3 bits */
|
||||
store_instvar:
|
||||
LOG_INST_1 (hcl, "store_into_instvar %zu", b1);
|
||||
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->receiver_or_source) == HCL_OBJ_TYPE_OOP);
|
||||
((hcl_oop_oop_t)hcl->active_context->origin->receiver_or_source)->slot[b1] = HCL_STACK_GETTOP(hcl);
|
||||
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->receiver_or_base) == HCL_OBJ_TYPE_OOP);
|
||||
((hcl_oop_oop_t)hcl->active_context->origin->receiver_or_base)->slot[b1] = HCL_STACK_GETTOP(hcl);
|
||||
break;
|
||||
|
||||
/* ------------------------------------------------- */
|
||||
@ -1464,8 +1566,8 @@ static int execute (hcl_t* hcl)
|
||||
b1 = bcode & 0x7; /* low 3 bits */
|
||||
pop_into_instvar:
|
||||
LOG_INST_1 (hcl, "pop_into_instvar %zu", b1);
|
||||
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->receiver_or_source) == HCL_OBJ_TYPE_OOP);
|
||||
((hcl_oop_oop_t)hcl->active_context->origin->receiver_or_source)->slot[b1] = HCL_STACK_GETTOP(hcl);
|
||||
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(hcl->active_context->receiver_or_base) == HCL_OBJ_TYPE_OOP);
|
||||
((hcl_oop_oop_t)hcl->active_context->origin->receiver_or_base)->slot[b1] = HCL_STACK_GETTOP(hcl);
|
||||
HCL_STACK_POP (hcl);
|
||||
break;
|
||||
#endif
|
||||
@ -1508,7 +1610,6 @@ static int execute (hcl_t* hcl)
|
||||
b1 = bcode & 0x7; /* low 3 bits */
|
||||
handle_tempvar:
|
||||
|
||||
#if defined(HCL_USE_CTXTEMPVAR)
|
||||
/* when CTXTEMPVAR inststructions are used, the above
|
||||
* instructions are used only for temporary access
|
||||
* outside a block. i can assume that the temporary
|
||||
@ -1517,48 +1618,6 @@ static int execute (hcl_t* hcl)
|
||||
ctx = hcl->active_context->origin;
|
||||
bx = b1;
|
||||
HCL_ASSERT (hcl, HCL_IS_CONTEXT(hcl, ctx));
|
||||
#else
|
||||
/* otherwise, the index may point to a temporaries
|
||||
* declared inside a block */
|
||||
|
||||
if (hcl->active_context->home != hcl->_nil)
|
||||
{
|
||||
/* this code assumes that the method context and
|
||||
* the block context place some key fields in the
|
||||
* same offset. such fields include 'home', 'ntmprs' */
|
||||
hcl_oop_t home;
|
||||
hcl_ooi_t home_ntmprs;
|
||||
|
||||
ctx = hcl->active_context;
|
||||
home = ctx->home;
|
||||
|
||||
do
|
||||
{
|
||||
/* ntmprs contains the number of defined temporaries
|
||||
* including those defined in the home context */
|
||||
home_ntmprs = HCL_OOP_TO_SMOOI(((hcl_oop_context_t)home)->ntmprs);
|
||||
if (b1 >= home_ntmprs) break;
|
||||
|
||||
ctx = (hcl_oop_context_t)home;
|
||||
home = ((hcl_oop_context_t)home)->home;
|
||||
if (home == hcl->_nil)
|
||||
{
|
||||
home_ntmprs = 0;
|
||||
break;
|
||||
}
|
||||
}
|
||||
while (1);
|
||||
|
||||
/* bx is the actual index within the actual context
|
||||
* containing the temporary */
|
||||
bx = b1 - home_ntmprs;
|
||||
}
|
||||
else
|
||||
{
|
||||
ctx = hcl->active_context;
|
||||
bx = b1;
|
||||
}
|
||||
#endif
|
||||
|
||||
if ((bcode >> 4) & 1)
|
||||
{
|
||||
@ -1612,7 +1671,7 @@ static int execute (hcl_t* hcl)
|
||||
b1 = bcode & 0x7; /* low 3 bits */
|
||||
push_literal:
|
||||
LOG_INST_1 (hcl, "push_literal @%zu", b1);
|
||||
HCL_STACK_PUSH (hcl, hcl->code.lit.arr->slot[b1]);
|
||||
HCL_STACK_PUSH (hcl, hcl->active_function->literal_frame[b1]);
|
||||
break;
|
||||
|
||||
/* ------------------------------------------------- */
|
||||
@ -1639,7 +1698,7 @@ static int execute (hcl_t* hcl)
|
||||
|
||||
b1 = bcode & 0x3; /* low 2 bits */
|
||||
handle_object:
|
||||
ass = (hcl_oop_cons_t)hcl->code.lit.arr->slot[b1];
|
||||
ass = (hcl_oop_cons_t)hcl->active_function->literal_frame[b1];
|
||||
HCL_ASSERT (hcl, HCL_IS_CONS(hcl, ass));
|
||||
|
||||
if ((bcode >> 3) & 1)
|
||||
@ -1759,6 +1818,11 @@ static int execute (hcl_t* hcl)
|
||||
case HCL_BRAND_CONTEXT:
|
||||
if (activate_context(hcl, b1) <= -1) goto oops;
|
||||
break;
|
||||
|
||||
case HCL_BRAND_FUNCTION:
|
||||
if (activate_function(hcl, b1) <= -1) goto oops;
|
||||
break;
|
||||
|
||||
case HCL_BRAND_PRIM:
|
||||
if (call_primitive(hcl, b1) <= -1) goto oops;
|
||||
break;
|
||||
@ -1811,6 +1875,9 @@ static int execute (hcl_t* hcl)
|
||||
for (i = 0; i < b1; i++)
|
||||
{
|
||||
ctx = (hcl_oop_context_t)ctx->home;
|
||||
/* the initial context has nil in the home field.
|
||||
* the loop must not reach beyond the initial context */
|
||||
HCL_ASSERT (hcl, ctx != hcl->_nil);
|
||||
}
|
||||
|
||||
if ((bcode >> 3) & 1)
|
||||
@ -1868,7 +1935,7 @@ static int execute (hcl_t* hcl)
|
||||
FETCH_BYTE_CODE_TO (hcl, b2);
|
||||
|
||||
handle_objvar:
|
||||
t = (hcl_oop_oop_t)hcl->code.lit.arr->slot[b2];
|
||||
t = (hcl_oop_oop_t)hcl->active_function->literal_frame[b2];
|
||||
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_TYPE(t) == HCL_OBJ_TYPE_OOP);
|
||||
HCL_ASSERT (hcl, b1 < HCL_OBJ_GET_SIZE(t));
|
||||
|
||||
@ -1934,9 +2001,9 @@ static int execute (hcl_t* hcl)
|
||||
#endif
|
||||
/* -------------------------------------------------------- */
|
||||
|
||||
case HCL_CODE_PUSH_RECEIVER:
|
||||
case HCL_CODE_PUSH_RECEIVER: /* push self or super */
|
||||
LOG_INST_0 (hcl, "push_receiver");
|
||||
HCL_STACK_PUSH (hcl, hcl->active_context->origin->receiver_or_source);
|
||||
HCL_STACK_PUSH (hcl, hcl->active_context->origin->receiver_or_base);
|
||||
break;
|
||||
|
||||
case HCL_CODE_PUSH_NIL:
|
||||
@ -2128,7 +2195,7 @@ static int execute (hcl_t* hcl)
|
||||
|
||||
case HCL_CODE_RETURN_RECEIVER:
|
||||
LOG_INST_0 (hcl, "return_receiver");
|
||||
return_value = hcl->active_context->origin->receiver_or_source;
|
||||
return_value = hcl->active_context->origin->receiver_or_base;
|
||||
|
||||
handle_return:
|
||||
if (hcl->active_context->origin == hcl->processor->active->initial_context->origin)
|
||||
@ -2203,7 +2270,7 @@ static int execute (hcl_t* hcl)
|
||||
/*
|
||||
// HCL_ASSERT (hcl, HCL_CLASSOF(hcl, hcl->active_context) == hcl->_method_context);
|
||||
*/
|
||||
HCL_ASSERT (hcl, hcl->active_context->receiver_or_source == 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->origin == hcl->processor->active->initial_context->origin);
|
||||
HCL_ASSERT (hcl, hcl->active_context->origin == hcl->active_context);
|
||||
@ -2263,6 +2330,52 @@ static int execute (hcl_t* hcl)
|
||||
|
||||
break;
|
||||
|
||||
case HCL_CODE_MAKE_FUNCTION:
|
||||
{
|
||||
hcl_oop_function_t func;
|
||||
hcl_oow_t b3, b4, i, j;
|
||||
hcl_oow_t joff;
|
||||
|
||||
/* b1 - number of block arguments
|
||||
* b2 - number of block temporaries
|
||||
* b3 - literal frame base
|
||||
* b4 - literal frame size */
|
||||
FETCH_PARAM_CODE_TO (hcl, b1);
|
||||
FETCH_PARAM_CODE_TO (hcl, b2);
|
||||
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);
|
||||
|
||||
HCL_ASSERT (hcl, b1 >= 0);
|
||||
HCL_ASSERT (hcl, b2 >= b1);
|
||||
HCL_ASSERT (hcl, b3 >= 0);
|
||||
|
||||
/* the MAKE_FUNCTION instruction is followed by the long JUMP_FORWARD_X instruction.
|
||||
* i can decode the instruction and get the size of instructions
|
||||
* of the block context */
|
||||
HCL_ASSERT (hcl, hcl->active_code[hcl->ip] == HCL_CODE_JUMP_FORWARD_X);
|
||||
joff = hcl->active_code[hcl->ip + 1];
|
||||
#if (HCL_HCL_CODE_LONG_PARAM_SIZE == 2)
|
||||
joff = (joff << 8) | hcl->active_code[hcl->ip + 2];
|
||||
#endif
|
||||
|
||||
HCL_DEBUG1(hcl, "**** MAKE FUNCTION joff = %zu\n", joff);
|
||||
/* copy the byte codes from the active context to the new context */
|
||||
#if (HCL_HCL_CODE_LONG_PARAM_SIZE == 2)
|
||||
func = (hcl_oop_function_t)make_function(hcl, b4 - b3, &hcl->active_code[hcl->ip + 3], joff);
|
||||
#else
|
||||
func = (hcl_oop_function_t)make_function(hcl, b4 - b3, &hcl->active_code[hcl->ip + 2], joff);
|
||||
#endif
|
||||
if (HCL_UNLIKELY(!func)) goto oops;
|
||||
|
||||
fill_function_data (hcl, func, b1, b2, hcl->active_context, &hcl->active_function->literal_frame[b3], b4 - b3);
|
||||
|
||||
/* push the new function to the stack of the active context */
|
||||
HCL_STACK_PUSH (hcl, (hcl_oop_t)func);
|
||||
break;
|
||||
}
|
||||
|
||||
case HCL_CODE_MAKE_BLOCK:
|
||||
{
|
||||
hcl_oop_context_t blkctx;
|
||||
@ -2277,38 +2390,13 @@ static int execute (hcl_t* hcl)
|
||||
HCL_ASSERT (hcl, b1 >= 0);
|
||||
HCL_ASSERT (hcl, b2 >= b1);
|
||||
|
||||
|
||||
|
||||
#if 0
|
||||
if (hcl->option.trait & HCL_TRAIT_INTERACTIVE)
|
||||
{
|
||||
|
||||
/* the MAKE_BLOCK instruction is followed by the long JUMP_FORWARD_X instruction.
|
||||
* i can decode the instruction and get the size of instructions
|
||||
* of the block context */
|
||||
{
|
||||
|
||||
hcl_oow_t joff;
|
||||
HCL_ASSERT (hcl, hcl->code.bc.arr->slot[hcl->ip] == HCL_CODE_JUMP_FORWARD_X);
|
||||
joff = hcl->code.bc.arr->slot[hcl->ip + 1];
|
||||
#if (HCL_HCL_CODE_LONG_PARAM_SIZE == 2)
|
||||
joff = (joff << 8) | hcl->code.bc.arr->slot[hcl->ip + 2];
|
||||
#endif
|
||||
|
||||
HCL_DEBUG1(hcl, "**** MAKE BLOCK joff = %zu\n", joff);
|
||||
}
|
||||
|
||||
}
|
||||
#endif
|
||||
|
||||
|
||||
/* the block context object created here is used as a base
|
||||
* object for block context activation. activate_context()
|
||||
* clones a block context and activates the cloned context.
|
||||
* this base block context is created with no temporaries
|
||||
* for this reason */
|
||||
blkctx = (hcl_oop_context_t)make_context(hcl, 0);
|
||||
if (!blkctx) goto oops;
|
||||
if (HCL_UNLIKELY(!blkctx)) goto oops;
|
||||
|
||||
/* the long forward jump instruction has the format of
|
||||
* 11000100 KKKKKKKK or 11000100 KKKKKKKK KKKKKKKK
|
||||
@ -2318,17 +2406,15 @@ HCL_DEBUG1(hcl, "**** MAKE BLOCK joff = %zu\n", joff);
|
||||
/* stack pointer below the bottom. this base block context
|
||||
* has an empty stack anyway. */
|
||||
blkctx->sp = HCL_SMOOI_TO_OOP(-1);
|
||||
/* the number of arguments for a block context is local to the block */
|
||||
blkctx->method_or_nargs = HCL_SMOOI_TO_OOP(b1);
|
||||
/* the number of temporaries here is an accumulated count including
|
||||
* the number of temporaries of a home context */
|
||||
/* the number of arguments */
|
||||
blkctx->nargs = HCL_SMOOI_TO_OOP(b1);
|
||||
/* the number of temporaries including arguments */
|
||||
blkctx->ntmprs = HCL_SMOOI_TO_OOP(b2);
|
||||
|
||||
/* no source for a base block context. */
|
||||
blkctx->receiver_or_base = hcl->_nil;
|
||||
/* set the home context where it's defined */
|
||||
blkctx->home = (hcl_oop_t)hcl->active_context;
|
||||
/* no source for a base block context. */
|
||||
blkctx->receiver_or_source = hcl->_nil;
|
||||
|
||||
blkctx->origin = hcl->active_context->origin;
|
||||
|
||||
/* push the new block context to the stack of the active context */
|
||||
@ -2336,85 +2422,6 @@ HCL_DEBUG1(hcl, "**** MAKE BLOCK joff = %zu\n", joff);
|
||||
break;
|
||||
}
|
||||
|
||||
case HCL_CODE_SEND_BLOCK_COPY:
|
||||
{
|
||||
hcl_ooi_t nargs, ntmprs;
|
||||
hcl_oop_context_t rctx;
|
||||
hcl_oop_context_t blkctx;
|
||||
|
||||
LOG_INST_0 (hcl, "send_block_copy");
|
||||
|
||||
/* it emulates thisContext blockCopy: nargs ofTmprCount: ntmprs */
|
||||
HCL_ASSERT (hcl, hcl->sp >= 2);
|
||||
|
||||
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(HCL_STACK_GETTOP(hcl)));
|
||||
ntmprs = HCL_OOP_TO_SMOOI(HCL_STACK_GETTOP(hcl));
|
||||
HCL_STACK_POP (hcl);
|
||||
|
||||
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(HCL_STACK_GETTOP(hcl)));
|
||||
nargs = HCL_OOP_TO_SMOOI(HCL_STACK_GETTOP(hcl));
|
||||
HCL_STACK_POP (hcl);
|
||||
|
||||
HCL_ASSERT (hcl, nargs >= 0);
|
||||
HCL_ASSERT (hcl, ntmprs >= nargs);
|
||||
|
||||
/* the block context object created here is used
|
||||
* as a base object for block context activation.
|
||||
* prim_block_value() clones a block
|
||||
* context and activates the cloned context.
|
||||
* this base block context is created with no
|
||||
* stack for this reason. */
|
||||
blkctx = (hcl_oop_context_t)make_context(hcl, 0);
|
||||
if (!blkctx) goto oops;
|
||||
|
||||
/* get the receiver to the block copy message after block context instantiation
|
||||
* not to get affected by potential GC */
|
||||
rctx = (hcl_oop_context_t)HCL_STACK_GETTOP(hcl);
|
||||
HCL_ASSERT (hcl, rctx == hcl->active_context);
|
||||
|
||||
/* [NOTE]
|
||||
* blkctx->sender is left to nil. it is set to the
|
||||
* active context before it gets activated. see
|
||||
* prim_block_value().
|
||||
*
|
||||
* blkctx->home is set here to the active context.
|
||||
* it's redundant to have them pushed to the stack
|
||||
* though it is to emulate the message sending of
|
||||
* blockCopy:withNtmprs:. HCL_CODE_MAKE_BLOCK has been
|
||||
* added to replace HCL_CODE_SEND_BLOCK_COPY and pusing
|
||||
* arguments to the stack.
|
||||
*
|
||||
* blkctx->origin is set here by copying the origin
|
||||
* of the active context.
|
||||
*/
|
||||
|
||||
/* the extended jump instruction has the format of
|
||||
* 0000XXXX KKKKKKKK or 0000XXXX KKKKKKKK KKKKKKKK
|
||||
* depending on HCL_HCL_CODE_LONG_PARAM_SIZE. change 'ip' to point to
|
||||
* the instruction after the jump. */
|
||||
blkctx->ip = HCL_SMOOI_TO_OOP(hcl->ip + HCL_HCL_CODE_LONG_PARAM_SIZE + 1);
|
||||
blkctx->sp = HCL_SMOOI_TO_OOP(-1);
|
||||
/* the number of arguments for a block context is local to the block */
|
||||
blkctx->method_or_nargs = HCL_SMOOI_TO_OOP(nargs);
|
||||
/* the number of temporaries here is an accumulated count including
|
||||
* the number of temporaries of a home context */
|
||||
blkctx->ntmprs = HCL_SMOOI_TO_OOP(ntmprs);
|
||||
|
||||
blkctx->home = (hcl_oop_t)rctx;
|
||||
blkctx->receiver_or_source = hcl->_nil;
|
||||
|
||||
|
||||
/* [NOTE]
|
||||
* the origin of a method context is set to itself
|
||||
* when it's created. so it's safe to simply copy
|
||||
* the origin field this way.
|
||||
*/
|
||||
blkctx->origin = rctx->origin;
|
||||
|
||||
HCL_STACK_SETTOP (hcl, (hcl_oop_t)blkctx);
|
||||
break;
|
||||
}
|
||||
|
||||
case HCL_CODE_NOOP:
|
||||
/* do nothing */
|
||||
LOG_INST_0 (hcl, "noop");
|
||||
@ -2465,12 +2472,12 @@ hcl_oop_t hcl_executefromip (hcl_t* hcl, hcl_oow_t initial_ip)
|
||||
|
||||
hcl->last_retv = hcl->_nil;
|
||||
|
||||
if (start_initial_process_and_context(hcl, initial_ip) <= -1) return HCL_NULL;
|
||||
hcl->initial_context = hcl->processor->active->initial_context;
|
||||
|
||||
n = execute (hcl);
|
||||
|
||||
n = start_initial_process_and_context(hcl, initial_ip);
|
||||
if (n >= 0)
|
||||
{
|
||||
n = execute(hcl);
|
||||
HCL_INFO1 (hcl, "RETURNED VALUE - %O\n", hcl->last_retv);
|
||||
}
|
||||
|
||||
/* TODO: reset processor fields. set processor->tally to zero. processor->active to nil_process... */
|
||||
hcl->initial_context = HCL_NULL;
|
||||
@ -2482,6 +2489,18 @@ hcl_oop_t hcl_executefromip (hcl_t* hcl, hcl_oow_t initial_ip)
|
||||
|
||||
hcl_oop_t hcl_execute (hcl_t* hcl)
|
||||
{
|
||||
//////////////////////////////////////////////////////////////////////////////////////////////
|
||||
hcl_oop_function_t func;
|
||||
|
||||
func = (hcl_oop_function_t)make_function(hcl, hcl->code.lit.len, hcl->code.bc.arr->slot, hcl->code.bc.len);
|
||||
if (HCL_UNLIKELY(!func)) return HCL_NULL;
|
||||
|
||||
/* pass nil for the home context of the initial function */
|
||||
fill_function_data (hcl, func, 0, 0, hcl->_nil, hcl->code.lit.arr->slot, hcl->code.lit.len);
|
||||
|
||||
hcl->initial_function = func;
|
||||
//////////////////////////////////////////////////////////////////////////////////////////////
|
||||
|
||||
return hcl_executefromip (hcl, 0);
|
||||
}
|
||||
|
||||
|
||||
22
lib/gc.c
22
lib/gc.c
@ -116,7 +116,6 @@ static void compact_symbol_table (hcl_t* hcl, hcl_oop_t _nil)
|
||||
hcl->symtab->tally = HCL_SMOOI_TO_OOP(tally);
|
||||
}
|
||||
|
||||
|
||||
static HCL_INLINE hcl_oow_t get_payload_bytes (hcl_t* hcl, hcl_oop_t oop)
|
||||
{
|
||||
hcl_oow_t nbytes_aligned;
|
||||
@ -142,15 +141,14 @@ static HCL_INLINE hcl_oow_t get_payload_bytes (hcl_t* hcl, hcl_oop_t oop)
|
||||
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_UNIT(oop) == HCL_SIZEOF(hcl_oow_t));
|
||||
HCL_ASSERT (hcl, HCL_OBJ_GET_FLAGS_EXTRA(oop) == 0); /* no 'extra' for an OOP object */
|
||||
|
||||
nbytes = HCL_OBJ_BYTESOF(oop) + HCL_SIZEOF(hcl_oow_t) + \
|
||||
(hcl_oow_t)((hcl_oop_oop_t)oop)->slot[HCL_OBJ_GET_SIZE(oop)];
|
||||
nbytes_aligned = HCL_ALIGN (nbytes, HCL_SIZEOF(hcl_oop_t));
|
||||
nbytes = HCL_OBJ_BYTESOF(oop) + HCL_SIZEOF(hcl_oow_t) + HCL_OBJ_GET_TRAILER_SIZE(oop);
|
||||
nbytes_aligned = HCL_ALIGN(nbytes, HCL_SIZEOF(hcl_oop_t));
|
||||
}
|
||||
else
|
||||
{
|
||||
#endif
|
||||
/* calculate the payload size in bytes */
|
||||
nbytes_aligned = HCL_ALIGN (HCL_OBJ_BYTESOF(oop), HCL_SIZEOF(hcl_oop_t));
|
||||
nbytes_aligned = HCL_ALIGN(HCL_OBJ_BYTESOF(oop), HCL_SIZEOF(hcl_oop_t));
|
||||
#if defined(HCL_USE_OBJECT_TRAILER)
|
||||
}
|
||||
#endif
|
||||
@ -180,10 +178,10 @@ hcl_oop_t hcl_moveoop (hcl_t* hcl, hcl_oop_t oop)
|
||||
hcl_oow_t nbytes_aligned;
|
||||
hcl_oop_t tmp;
|
||||
|
||||
nbytes_aligned = get_payload_bytes (hcl, oop);
|
||||
nbytes_aligned = get_payload_bytes(hcl, oop);
|
||||
|
||||
/* allocate space in the new heap */
|
||||
tmp = (hcl_oop_t)hcl_allocheapmem (hcl, hcl->newheap, HCL_SIZEOF(hcl_obj_t) + nbytes_aligned);
|
||||
tmp = (hcl_oop_t)hcl_allocheapmem(hcl, hcl->newheap, HCL_SIZEOF(hcl_obj_t) + nbytes_aligned);
|
||||
|
||||
/* allocation here must not fail because
|
||||
* i'm allocating the new space in a new heap for
|
||||
@ -326,6 +324,7 @@ void hcl_gc (hcl_t* hcl)
|
||||
hcl->processor = (hcl_oop_process_scheduler_t)hcl_moveoop(hcl, (hcl_oop_t)hcl->processor);
|
||||
hcl->nil_process = (hcl_oop_process_t)hcl_moveoop(hcl, (hcl_oop_t)hcl->nil_process);
|
||||
|
||||
|
||||
for (i = 0; i < hcl->code.lit.len; i++)
|
||||
{
|
||||
/* the literal array ia a NGC object. but the literal objects
|
||||
@ -334,7 +333,7 @@ void hcl_gc (hcl_t* hcl)
|
||||
hcl_moveoop(hcl, ((hcl_oop_oop_t)hcl->code.lit.arr)->slot[i]);
|
||||
}
|
||||
|
||||
hcl->p.e = hcl_moveoop (hcl, hcl->p.e);
|
||||
hcl->p.e = hcl_moveoop(hcl, hcl->p.e);
|
||||
|
||||
for (i = 0; i < hcl->sem_list_count; i++)
|
||||
{
|
||||
@ -355,6 +354,8 @@ void hcl_gc (hcl_t* hcl)
|
||||
hcl->initial_context = (hcl_oop_context_t)hcl_moveoop(hcl, (hcl_oop_t)hcl->initial_context);
|
||||
if (hcl->active_context)
|
||||
hcl->active_context = (hcl_oop_context_t)hcl_moveoop(hcl, (hcl_oop_t)hcl->active_context);
|
||||
if (hcl->initial_function)
|
||||
hcl->initial_function = (hcl_oop_function_t)hcl_moveoop(hcl, (hcl_oop_t)hcl->initial_function);
|
||||
|
||||
if (hcl->last_retv) hcl->last_retv = hcl_moveoop(hcl, hcl->last_retv);
|
||||
|
||||
@ -374,7 +375,7 @@ void hcl_gc (hcl_t* hcl)
|
||||
compact_symbol_table (hcl, old_nil);
|
||||
|
||||
/* move the symbol table itself */
|
||||
hcl->symtab = (hcl_oop_dic_t)hcl_moveoop (hcl, (hcl_oop_t)hcl->symtab);
|
||||
hcl->symtab = (hcl_oop_dic_t)hcl_moveoop(hcl, (hcl_oop_t)hcl->symtab);
|
||||
|
||||
/* scan the new heap again from the end position of
|
||||
* the previous scan to move referenced objects by
|
||||
@ -391,7 +392,6 @@ void hcl_gc (hcl_t* hcl)
|
||||
hcl->curheap = hcl->newheap;
|
||||
hcl->newheap = tmp;
|
||||
|
||||
|
||||
/*
|
||||
if (hcl->symtab && HCL_LOG_ENABLED(hcl, HCL_LOG_GC | HCL_LOG_DEBUG))
|
||||
{
|
||||
@ -410,6 +410,8 @@ void hcl_gc (hcl_t* hcl)
|
||||
}
|
||||
*/
|
||||
|
||||
if (hcl->active_function) hcl->active_code = HCL_FUNCTION_GET_CODE_BYTE(hcl->active_function); /* update hcl->active_code */
|
||||
|
||||
/* TODO: include some gc statstics like number of live objects, gc performance, etc */
|
||||
HCL_LOG4 (hcl, HCL_LOG_GC | HCL_LOG_INFO,
|
||||
"Finished GC curheap base %p ptr %p newheap base %p ptr %p\n",
|
||||
|
||||
@ -37,14 +37,6 @@
|
||||
* while hcl has not been fully initialized when this is defined*/
|
||||
#define HCL_SUPPORT_GC_DURING_IGNITION
|
||||
|
||||
/* define this to generate XXXX_CTXTEMVAR instructions */
|
||||
#define HCL_USE_CTXTEMPVAR
|
||||
|
||||
/* define this to use the MAKE_BLOCK instruction instead of
|
||||
* PUSH_CONTEXT, PUSH_INTLIT, PUSH_INTLIT, SEND_BLOCK_COPY */
|
||||
#define HCL_USE_MAKE_BLOCK
|
||||
|
||||
|
||||
/* define this to enable karatsuba multiplication in bigint */
|
||||
#define HCL_ENABLE_KARATSUBA
|
||||
#define HCL_KARATSUBA_CUTOFF 32
|
||||
@ -642,9 +634,10 @@ enum hcl_bcode_t
|
||||
HCL_CODE_RETURN_STACKTOP = 0xF9, /* ^something */
|
||||
HCL_CODE_RETURN_RECEIVER = 0xFA, /* ^self */
|
||||
HCL_CODE_RETURN_FROM_BLOCK = 0xFB, /* return the stack top from a block */
|
||||
/* UNUSED 252 */
|
||||
|
||||
HCL_CODE_MAKE_FUNCTION = 0xFC, /* 252 */
|
||||
HCL_CODE_MAKE_BLOCK = 0xFD, /* 253 */
|
||||
HCL_CODE_SEND_BLOCK_COPY = 0xFE, /* 254 */
|
||||
/* UNUSED 254 */
|
||||
HCL_CODE_NOOP = 0xFF /* 255 */
|
||||
};
|
||||
|
||||
@ -725,6 +718,7 @@ hcl_oop_t hcl_allocoopobj (
|
||||
#if defined(HCL_USE_OBJECT_TRAILER)
|
||||
hcl_oop_t hcl_allocoopobjwithtrailer (
|
||||
hcl_t* hcl,
|
||||
int brand,
|
||||
hcl_oow_t size,
|
||||
const hcl_oob_t* tptr,
|
||||
hcl_oow_t tlen
|
||||
|
||||
63
lib/hcl.h
63
lib/hcl.h
@ -478,6 +478,10 @@ struct hcl_trailer_t
|
||||
hcl_oob_t slot[1];
|
||||
};
|
||||
|
||||
#define HCL_OBJ_GET_TRAILER_BYTE(oop) ((hcl_oob_t*)&((hcl_oop_oop_t)oop)->slot[HCL_OBJ_GET_SIZE(oop) + 1])
|
||||
#define HCL_OBJ_GET_TRAILER_SIZE(oop) ((hcl_oow_t)((hcl_oop_oop_t)oop)->slot[HCL_OBJ_GET_SIZE(oop)])
|
||||
|
||||
|
||||
#define HCL_CONS_NAMED_INSTVARS 2
|
||||
typedef struct hcl_cons_t hcl_cons_t;
|
||||
typedef struct hcl_cons_t* hcl_oop_cons_t;
|
||||
@ -508,6 +512,32 @@ struct hcl_fpdec_t
|
||||
hcl_oop_t scale; /* smooi, positive */
|
||||
};
|
||||
|
||||
#define HCL_FUNCTION_NAMED_INSTVARS 3 /* this excludes literal frames and byte codes */
|
||||
typedef struct hcl_function_t hcl_function_t;
|
||||
typedef struct hcl_function_t* hcl_oop_function_t;
|
||||
struct hcl_function_t
|
||||
{
|
||||
HCL_OBJ_HEADER;
|
||||
|
||||
hcl_oop_t ntmprs; /* smooi */
|
||||
hcl_oop_t nargs; /* smooi */
|
||||
hcl_oop_t home; /* home function. nil for the initial function */
|
||||
|
||||
/* == variable indexed part == */
|
||||
hcl_oop_t literal_frame[1]; /* it stores literals. it may not exist */
|
||||
|
||||
/* after the literal frame comes the actual byte code */
|
||||
};
|
||||
|
||||
/* the first byte after the main payload is the trailer size
|
||||
* the code bytes are placed after the trailer size.
|
||||
*
|
||||
* code bytes -> ((hcl_oob_t*)&((hcl_oop_oop_t)m)->slot[HCL_OBJ_GET_SIZE(m) + 1]) or
|
||||
* ((hcl_oob_t*)&((hcl_oop_function_t)m)->literal_frame[HCL_OBJ_GET_SIZE(m) + 1 - HCL_METHOD_NAMED_INSTVARS])
|
||||
* size -> ((hcl_oow_t)((hcl_oop_oop_t)m)->slot[HCL_OBJ_GET_SIZE(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_CONTEXT_NAMED_INSTVARS 8
|
||||
typedef struct hcl_context_t hcl_context_t;
|
||||
typedef struct hcl_context_t* hcl_oop_context_t;
|
||||
@ -530,34 +560,38 @@ struct hcl_context_t
|
||||
* of the active process before it gets activated. */
|
||||
hcl_oop_t sp;
|
||||
|
||||
/* SmallInteger. Number of temporaries.
|
||||
* For a block context, it's inclusive of the temporaries
|
||||
* defined its 'home'. */
|
||||
/* SmallInteger. Number of temporaries. Includes arguments as well */
|
||||
hcl_oop_t ntmprs;
|
||||
|
||||
/* CompiledMethod for a method context,
|
||||
* SmallInteger for a block context */
|
||||
hcl_oop_t method_or_nargs;
|
||||
/* SmallInteger. Number of arguments */
|
||||
hcl_oop_t nargs;
|
||||
|
||||
/* 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
|
||||
* field. if a block context is activated by 'value', it points
|
||||
* to the block context object used as a base for shallow-copy. */
|
||||
hcl_oop_t receiver_or_source;
|
||||
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.
|
||||
* for a block context, it points to the active context at the
|
||||
* moment the block context was created. that is, it points to
|
||||
* a method context where the base block has been defined.
|
||||
* an activated block context copies this field from the source. */
|
||||
* an activated block context copies this field from the base block context. */
|
||||
hcl_oop_t home;
|
||||
|
||||
/* when a method context is created, it is set to itself. no change is
|
||||
* made when the method context is activated. when a block context is
|
||||
/* it points to the method context created of the method defining the code
|
||||
* of this context. a method context points to itself. a block context
|
||||
* 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
|
||||
* made when the method context is activated. when a base block context is
|
||||
* created (when MAKE_BLOCK or BLOCK_COPY is executed), it is set to the
|
||||
* origin of the active context. when the block context is shallow-copied
|
||||
* origin of the active context. when the base block context is shallow-copied
|
||||
* for activation (when it is sent 'value'), it is set to the origin of
|
||||
* the source block context. */
|
||||
* the base block context. */
|
||||
hcl_oop_context_t origin;
|
||||
|
||||
/* variable indexed part */
|
||||
@ -1197,8 +1231,11 @@ struct hcl_t
|
||||
int tagged_brands[16];
|
||||
|
||||
/* == EXECUTION REGISTERS == */
|
||||
hcl_oop_function_t initial_function;
|
||||
hcl_oop_context_t initial_context; /* fake initial context */
|
||||
hcl_oop_context_t active_context;
|
||||
hcl_oop_function_t active_function;
|
||||
hcl_oob_t* active_code;
|
||||
hcl_ooi_t sp;
|
||||
hcl_ooi_t ip;
|
||||
int proc_switched; /* TODO: this is temporary. implement something else to skip immediate context switching */
|
||||
@ -1346,6 +1383,7 @@ enum hcl_brand_t
|
||||
HCL_BRAND_CFRAME,/* compiler frame */
|
||||
HCL_BRAND_PRIM,
|
||||
|
||||
HCL_BRAND_FUNCTION,
|
||||
HCL_BRAND_CONTEXT,
|
||||
HCL_BRAND_PROCESS,
|
||||
HCL_BRAND_PROCESS_SCHEDULER,
|
||||
@ -1389,6 +1427,7 @@ typedef enum hcl_concode_t hcl_concode_t;
|
||||
#define HCL_IS_SYMBOL(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_SYMBOL)
|
||||
#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_FUNCTION(hcl,v) (HCL_OOP_IS_POINTER(v) && HCL_OBJ_GET_FLAGS_BRAND(v) == HCL_BRAND_FUNCTION)
|
||||
#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_CONCODED(hcl,v,concode) (HCL_IS_CONS(hcl,v) && HCL_OBJ_GET_FLAGS_SYNCODE(v) == (concode))
|
||||
|
||||
@ -89,11 +89,11 @@ static HCL_INLINE hcl_oop_t alloc_oop_array (hcl_t* hcl, int brand, hcl_oow_t si
|
||||
|
||||
hcl_oop_t hcl_allocoopobj (hcl_t* hcl, int brand, hcl_oow_t size)
|
||||
{
|
||||
return alloc_oop_array (hcl, brand, size, 0);
|
||||
return alloc_oop_array(hcl, brand, size, 0);
|
||||
}
|
||||
|
||||
#if defined(HCL_USE_OBJECT_TRAILER)
|
||||
hcl_oop_t hcl_allocoopobjwithtrailer (hcl_t* hcl, hcl_oow_t size, const hcl_oob_t* bptr, hcl_oow_t blen)
|
||||
hcl_oop_t hcl_allocoopobjwithtrailer (hcl_t* hcl, int brand, hcl_oow_t size, const hcl_oob_t* bptr, hcl_oow_t blen)
|
||||
{
|
||||
hcl_oop_oop_t hdr;
|
||||
hcl_oow_t nbytes, nbytes_aligned;
|
||||
@ -109,6 +109,7 @@ hcl_oop_t hcl_allocoopobjwithtrailer (hcl_t* hcl, hcl_oow_t size, const hcl_oob_
|
||||
hdr->_flags = HCL_OBJ_MAKE_FLAGS(HCL_OBJ_TYPE_OOP, HCL_SIZEOF(hcl_oop_t), 0, 0, 0, 0, 1, 0);
|
||||
HCL_OBJ_SET_SIZE (hdr, size);
|
||||
HCL_OBJ_SET_CLASS (hdr, hcl->_nil);
|
||||
HCL_OBJ_SET_FLAGS_BRAND (hdr, brand);
|
||||
|
||||
for (i = 0; i < size; i++) hdr->slot[i] = hcl->_nil;
|
||||
|
||||
@ -333,7 +334,7 @@ hcl_oop_t hcl_remakengcbytearray (hcl_t* hcl, hcl_oop_t obj, hcl_oow_t newsize)
|
||||
|
||||
hcl_oop_t hcl_makengcarray (hcl_t* hcl, hcl_oow_t len)
|
||||
{
|
||||
return alloc_numeric_array (hcl, HCL_BRAND_ARRAY, HCL_NULL, len, HCL_OBJ_TYPE_OOP, HCL_SIZEOF(hcl_oop_t), 0, 1);
|
||||
return alloc_numeric_array(hcl, HCL_BRAND_ARRAY, HCL_NULL, len, HCL_OBJ_TYPE_OOP, HCL_SIZEOF(hcl_oop_t), 0, 1);
|
||||
}
|
||||
|
||||
hcl_oop_t hcl_remakengcarray (hcl_t* hcl, hcl_oop_t obj, hcl_oow_t newsize)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user