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

writing code for function activation using function-local literal frame

Browse Source
This commit is contained in:
hyung-hwan 2020-10-05 09:37:26 +00:00
parent a28553b195
commit e30cbc844c
5 changed files with 83 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
bin/main.c
View File

@ -1161,6 +1161,13 @@ hcl_logufmt (hcl, HCL_LOG_WARN, fmt, ustr, 0x6789);
#endif
if (xtn->reader_istty)
{
hcl_bitmask_t trait;
hcl_getoption (hcl, HCL_TRAIT, &trait);
trait |= HCL_TRAIT_INTERACTIVE;
hcl_setoption (hcl, HCL_TRAIT, &trait);
}
else
{
hcl_bitmask_t trait;
hcl_getoption (hcl, HCL_TRAIT, &trait);

75
lib/comp.c
View File

@ -102,7 +102,7 @@ static int add_literal (hcl_t* hcl, hcl_oop_t obj, hcl_oow_t* index)
}
*index = hcl->code.lit.len;
if (hcl->option.trait & HCL_TRAIT_INTERACTIVE) *index -= hcl->c->blk.info[hcl->c->blk.depth].litbase;
if (hcl->option.trait & HCL_TRAIT_INTERACTIVE) *index -= hcl->c->blk.info[hcl->c->blk.depth].lfbase;
((hcl_oop_oop_t)hcl->code.lit.arr)->slot[hcl->code.lit.len++] = obj;
return 0;
@ -161,7 +161,7 @@ static int find_temporary_variable_backward (hcl_t* hcl, hcl_oop_t name, hcl_oow
return -1;
}
static int store_temporary_variable_count_for_block (hcl_t* hcl, hcl_oow_t tmpr_count, hcl_oow_t lit_base)
static int store_temporary_variable_count_for_block (hcl_t* hcl, hcl_oow_t tmpr_count, hcl_oow_t lfbase)
{
HCL_ASSERT (hcl, hcl->c->blk.depth >= 0);
@ -179,7 +179,7 @@ static int store_temporary_variable_count_for_block (hcl_t* hcl, hcl_oow_t tmpr_
}
hcl->c->blk.info[hcl->c->blk.depth].tmprcnt = tmpr_count;
hcl->c->blk.info[hcl->c->blk.depth].litbase = lit_base;
hcl->c->blk.info[hcl->c->blk.depth].lfbase = lfbase;
return 0;
}
@ -376,6 +376,7 @@ static int emit_double_param_instruction (hcl_t* hcl, int cmd, hcl_oow_t param_1
}
case HCL_CODE_MAKE_FUNCTION: /* this is quad-param instruction. you should emit two more parameters after the call to this function */
case HCL_CODE_MAKE_BLOCK:
bc = cmd;
goto write_long;
@ -407,33 +408,22 @@ write_long:
emit_byte_instruction(hcl, param_2) <= -1) return -1;
#endif
return 0;
}
/*
write_long2:
if (param_1 > MAX_CODE_PARAM || param_2 > MAX_CODE_PARAM)
static HCL_INLINE int emit_long_param (hcl_t* hcl, hcl_oow_t param)
{
if (param > MAX_CODE_PARAM)
{
hcl_seterrnum (hcl, HCL_ERANGE);
return -1;
}
#if (HCL_HCL_CODE_LONG_PARAM_SIZE == 2)
if (emit_byte_instruction(hcl, bc) <= -1 ||
emit_byte_instruction(hcl, (param_1 >> 24) & 0xFF) <= -1 ||
emit_byte_instruction(hcl, (param_1 >> 16) & 0xFF) <= -1 ||
emit_byte_instruction(hcl, (param_1 >> 8) & 0xFF) <= -1 ||
emit_byte_instruction(hcl, param_1 & 0xFF) <= -1 ||
emit_byte_instruction(hcl, (param_2 >> 24) & 0xFF) <= -1 ||
emit_byte_instruction(hcl, (param_2 >> 16) & 0xFF) <= -1 ||
emit_byte_instruction(hcl, (param_2 >> 8) & 0xFF) <= -1 ||
emit_byte_instruction(hcl, param_2 & 0xFF) <= -1) return -1;
return (emit_byte_instruction(hcl, param >> 8) <= -1 ||
emit_byte_instruction(hcl, param & 0xFF) <= -1)? -1: 0;
#else
if (emit_byte_instruction(hcl, bc) <= -1 ||
emit_byte_instruction(hcl, param_1 >> 8) <= -1 ||
emit_byte_instruction(hcl, param_1 & 0xFF) <= -1 ||
emit_byte_instruction(hcl, param_2 >> 8) <= -1 ||
emit_byte_instruction(hcl, param_2 & 0xFF) <= -1) return -1;
return emit_byte_instruction(hcl, param_1);
#endif
*/
return 0;
}
static int emit_push_literal (hcl_t* hcl, hcl_oop_t obj)
@ -512,6 +502,16 @@ static HCL_INLINE void patch_long_jump (hcl_t* hcl, hcl_ooi_t jip, hcl_ooi_t jum
#endif
}
static HCL_INLINE void patch_long_param (hcl_t* hcl, hcl_ooi_t ip, hcl_oow_t param)
{
#if (HCL_HCL_CODE_LONG_PARAM_SIZE == 2)
patch_instruction (hcl, ip, param >> 8);
patch_instruction (hcl, ip + 1, param & 0xFF);
#else
patch_instruction (hcl, ip, param);
#endif
}
/* ========================================================================= */
static HCL_INLINE int _insert_cframe (hcl_t* hcl, hcl_ooi_t index, int opcode, hcl_oop_t operand)
{
@ -868,7 +868,7 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src, int defun)
{
hcl_oop_t obj, args;
hcl_oow_t nargs, ntmprs;
hcl_ooi_t jump_inst_pos;
hcl_ooi_t jump_inst_pos, lfbase_pos, lfsize_pos;
hcl_oow_t saved_tv_count, tv_dup_start;
hcl_oop_t defun_name;
@ -1062,7 +1062,20 @@ 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;
if (hcl->option.trait & HCL_TRAIT_INTERACTIVE)
{
/* make_function nargs ntmprs lfbase lfsize */
if (emit_double_param_instruction(hcl, HCL_CODE_MAKE_FUNCTION, nargs, ntmprs) <= -1) return -1;
lfbase_pos = hcl->code.bc.len;
if (emit_long_param(hcl, hcl->code.lit.len) <= -1) return -1; /* lfbase */
lfsize_pos = hcl->code.bc.len;
if (emit_long_param(hcl, 0) <= -1) return -1;
}
else
{
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;
@ -1096,6 +1109,14 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src, int defun)
PUSH_SUBCFRAME (hcl, COP_EMIT_LAMBDA, HCL_SMOOI_TO_OOP(jump_inst_pos));
if (hcl->option.trait & HCL_TRAIT_INTERACTIVE)
{
hcl_cframe_t* cf;
cf = GET_SUBCFRAME (hcl);
cf->u.lambda.lfbase_pos = lfbase_pos;
cf->u.lambda.lfsize_pos= lfsize_pos;
}
return 0;
}
@ -2485,7 +2506,7 @@ static HCL_INLINE int emit_pop_into_dic (hcl_t* hcl)
static HCL_INLINE int emit_lambda (hcl_t* hcl)
{
hcl_cframe_t* cf;
hcl_oow_t block_code_size;
hcl_oow_t block_code_size, lfsize;
hcl_ooi_t jip;
cf = GET_TOP_CFRAME(hcl);
@ -2494,6 +2515,9 @@ static HCL_INLINE int emit_lambda (hcl_t* hcl)
jip = HCL_OOP_TO_SMOOI(cf->operand);
if (hcl->option.trait & HCL_TRAIT_INTERACTIVE)
lfsize = hcl->code.lit.len - hcl->c->blk.info[hcl->c->blk.depth].lfbase;
hcl->c->blk.depth--;
hcl->c->tv.size = hcl->c->blk.info[hcl->c->blk.depth].tmprcnt;
@ -2519,6 +2543,9 @@ static HCL_INLINE int emit_lambda (hcl_t* hcl)
}
patch_long_jump (hcl, jip, block_code_size);
if (hcl->option.trait & HCL_TRAIT_INTERACTIVE)
patch_long_param (hcl, cf->u.lambda.lfsize_pos, lfsize);
POP_CFRAME (hcl);
return 0;
}

34
lib/exec.c
View File

@ -81,7 +81,7 @@ 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_function = (hcl)->active_context->origin->receiver_or_base; \
(hcl)->active_code = HCL_FUNCTION_GET_CODE_BYTE((hcl)->active_function); \
LOAD_ACTIVE_IP (hcl); \
(hcl)->processor->active->current_context = (hcl)->active_context; \
@ -1017,7 +1017,7 @@ static int __activate_function (hcl_t* hcl, hcl_oop_function_t rcv_func, hcl_ooi
* (printf ">>>> %d\n" (sum 10))
*/
/* the receiver must be a block context */
/* the receiver must be a function */
HCL_ASSERT (hcl, HCL_IS_FUNCTION(hcl, rcv_func));
if (HCL_OOP_TO_SMOOI(rcv_func->nargs) != nargs)
@ -1043,7 +1043,7 @@ static int __activate_function (hcl_t* hcl, hcl_oop_function_t rcv_func, hcl_ooi
blkctx->nargs = rcv_func->nargs;
blkctx->receiver_or_base = (hcl_oop_t)rcv_func;
blkctx->home = rcv_func->home;
blkctx->origin = rcv_func;
blkctx->origin = blkctx; /* 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 arguments to the stack */
@ -1319,7 +1319,7 @@ static int start_initial_process_and_context (hcl_t* hcl, hcl_ooi_t initial_ip)
ctx->sp = HCL_SMOOI_TO_OOP(-1); /* pointer to -1 below the bottom */
ctx->nargs = HCL_SMOOI_TO_OOP(0);
ctx->ntmprs = HCL_SMOOI_TO_OOP(0);
ctx->origin = hcl->initial_function;
ctx->origin = ctx; /* the origin of the initial context should be itself */
ctx->home = hcl->initial_function->home; /* this should be nil */
ctx->sender = (hcl_oop_context_t)hcl->_nil;
ctx->receiver_or_base = hcl->initial_function;
@ -2255,7 +2255,7 @@ static int execute (hcl_t* hcl)
}
/*
// HCL_ASSERT (hcl, HCL_CLASSOF(hcl, hcl->active_context->origin) == hcl->_method_context);
// HCL_ASSERT (hcl, HCL_IS_FUNCTION(hcl, hcl->active_context->origin) == hcl->_method_context);
*/
/* restore the stack pointer */
hcl->sp = HCL_OOP_TO_SMOOI(hcl->active_context->origin->sp);
@ -2268,10 +2268,9 @@ static int execute (hcl_t* hcl)
{
/* the new active context is the fake initial context.
* this context can't get executed further. */
HCL_ASSERT (hcl, HCL_IS_CONTEXT(hcl, hcl->active_context));
HCL_ASSERT (hcl, (hcl_oop_t)hcl->active_context->sender == hcl->_nil);
/*
// HCL_ASSERT (hcl, HCL_CLASSOF(hcl, hcl->active_context) == hcl->_method_context);
*/
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);
@ -2304,9 +2303,9 @@ static int execute (hcl_t* hcl)
if (hcl->active_context == hcl->processor->active->initial_context)
{
/* the active context to return from is an initial context of
* the active process. this process must have been created
* over a block using the newProcess method. let's terminate
* the process. */
* the active process. let's terminate the process.
* the initial context has been forged over the initial function
* in start_initial_process_and_context() */
HCL_ASSERT (hcl, (hcl_oop_t)hcl->active_context->sender == hcl->_nil);
terminate_process (hcl, hcl->processor->active);
}
@ -2314,21 +2313,8 @@ static int execute (hcl_t* hcl)
{
/* it is a normal block return as the active block context
* is not the initial context of a process */
/* the process stack is shared. the return value
* doesn't need to get moved. */
/*
//XXX SWITCH_ACTIVE_CONTEXT (hcl, (hcl_oop_context_t)hcl->active_context->sender);
*/
if (hcl->active_context->sender == hcl->processor->active->initial_context)
{
terminate_process (hcl, hcl->processor->active);
}
else
{
SWITCH_ACTIVE_CONTEXT (hcl, (hcl_oop_context_t)hcl->active_context->sender);
}
}
break;

8
lib/hcl-prv.h
View File

@ -209,6 +209,12 @@ struct hcl_cframe_t
{
hcl_ooi_t index;
} bytearray_list;
struct
{
hcl_ooi_t lfbase_pos;
hcl_ooi_t lfsize_pos;
} lambda;
} u;
};
@ -217,7 +223,7 @@ typedef struct hcl_cframe_t hcl_cframe_t;
struct hcl_blk_info_t
{
hcl_oow_t tmprcnt;
hcl_oow_t litbase;
hcl_oow_t lfbase;
};
typedef struct hcl_blk_info_t hcl_blk_info_t;

6
lib/print.c
View File

@ -87,6 +87,7 @@ enum
WORD_CFRAME,
WORD_PRIM,
WORD_FUNCTION,
WORD_CONTEXT,
WORD_PROCESS,
WORD_PROCESS_SCHEDULER,
@ -107,6 +108,7 @@ static struct
{ 9, { '#','<','C','F','R','A','M','E','>' } },
{ 7, { '#','<','P','R','I','M','>' } },
{ 11, { '#','<','F','U','N','C','T','I','O','N','>' } },
{ 10, { '#','<','C','O','N','T','E','X','T','>' } },
{ 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','>' } },
@ -657,6 +659,10 @@ next:
word_index = WORD_PRIM;
goto print_word;
case HCL_BRAND_FUNCTION:
word_index = WORD_FUNCTION;
goto print_word;
case HCL_BRAND_CONTEXT:
word_index = WORD_CONTEXT;
goto print_word;