From e30cbc844c1956153a78e8c9ba4458f6fb41b413 Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Mon, 5 Oct 2020 09:37:26 +0000 Subject: [PATCH] writing code for function activation using function-local literal frame --- bin/main.c | 7 +++++ lib/comp.c | 77 ++++++++++++++++++++++++++++++++++----------------- lib/exec.c | 36 ++++++++---------------- lib/hcl-prv.h | 8 +++++- lib/print.c | 6 ++++ 5 files changed, 83 insertions(+), 51 deletions(-) diff --git a/bin/main.c b/bin/main.c index b678be2..acd50f8 100644 --- a/bin/main.c +++ b/bin/main.c @@ -1167,6 +1167,13 @@ hcl_logufmt (hcl, HCL_LOG_WARN, fmt, ustr, 0x6789); trait |= HCL_TRAIT_INTERACTIVE; hcl_setoption (hcl, HCL_TRAIT, &trait); } +else +{ + hcl_bitmask_t trait; + hcl_getoption (hcl, HCL_TRAIT, &trait); + trait |= HCL_TRAIT_INTERACTIVE; + hcl_setoption (hcl, HCL_TRAIT, &trait); +} while (1) { diff --git a/lib/comp.c b/lib/comp.c index 554573a..2f3b0c7 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -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 (emit_double_param_instruction(hcl, HCL_CODE_MAKE_BLOCK, nargs, ntmprs) <= -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; } diff --git a/lib/exec.c b/lib/exec.c index 0ae1238..9799746 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -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,20 +2313,7 @@ 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); - } + SWITCH_ACTIVE_CONTEXT (hcl, (hcl_oop_context_t)hcl->active_context->sender); } break; diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index e9ecdd3..334d404 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -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; diff --git a/lib/print.c b/lib/print.c index 14536c4..df455c6 100644 --- a/lib/print.c +++ b/lib/print.c @@ -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;