From a69434a96f1b4c1006c3dc0d648786f41df091e6 Mon Sep 17 00:00:00 2001 From: hyung-hwan Date: Thu, 8 Oct 2020 09:25:54 +0000 Subject: [PATCH] enhancing the compiler and hcl_execute() for better interactive use --- bin/main.c | 27 ++++++++++----------- lib/comp.c | 32 ++++++++++++------------ lib/decode.c | 2 +- lib/exec.c | 67 ++++++++++++++++++++++++--------------------------- lib/fmt.c | 5 ++-- lib/gc.c | 39 ++++++++++++++++-------------- lib/hcl-prv.h | 10 +++++++- lib/hcl.c | 6 ++--- lib/hcl.h | 8 ++---- 9 files changed, 99 insertions(+), 97 deletions(-) diff --git a/bin/main.c b/bin/main.c index 79c1e31..a898deb 100644 --- a/bin/main.c +++ b/bin/main.c @@ -1160,15 +1160,10 @@ hcl_logufmt (hcl, HCL_LOG_WARN, fmt, ustr, 0x6789); } #endif -#if 1 - 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 +#if 0 +// TODO: change the option name +// 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. { hcl_bitmask_t trait; hcl_getoption (hcl, HCL_TRAIT, &trait); @@ -1215,11 +1210,15 @@ count++; } else { - hcl_oow_t code_offset; - - code_offset = hcl_getbclen(hcl); + if (xtn->reader_istty) + { + /* TODO: create a proper function for this and call it */ + hcl->code.bc.len = 0; + hcl->code.lit.len = 0; + } if (verbose) hcl_prbfmt (hcl, "\n"); /* flush the output buffer by hcl_print above */ + if (hcl_compile(hcl, obj) <= -1) { if (hcl->errnum == HCL_ESYNERR) @@ -1239,12 +1238,12 @@ count++; /* interactive mode */ hcl_oop_t retv; - hcl_decode (hcl, code_offset, hcl_getbclen(hcl)); + hcl_decode (hcl, 0, hcl_getbclen(hcl)); HCL_LOG0 (hcl, HCL_LOG_MNEMONIC, "------------------------------------------\n"); g_hcl = hcl; //setup_tick (); - retv = hcl_executefromip(hcl, code_offset); + retv = hcl_execute(hcl); /* flush pending output data in the interactive mode(e.g. printf without a newline) */ hcl_flushio (hcl); diff --git a/lib/comp.c b/lib/comp.c index 3da8bb2..4fb2439 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -190,13 +190,11 @@ static int store_temporary_variable_count_for_block (hcl_t* hcl, hcl_oow_t tmpr_ static HCL_INLINE void patch_instruction (hcl_t* hcl, hcl_oow_t index, hcl_oob_t bc) { HCL_ASSERT (hcl, index < hcl->code.bc.len); - hcl->code.bc.arr->slot[index] = bc; + hcl->code.bc.ptr[index] = bc; } static int emit_byte_instruction (hcl_t* hcl, hcl_oob_t bc) { - hcl_oow_t capa; - /* the context object has the ip field. it should be representable * in a small integer. for simplicity, limit the total byte code length * to fit in a small integer. because 'ip' points to the next instruction @@ -208,23 +206,27 @@ static int emit_byte_instruction (hcl_t* hcl, hcl_oob_t bc) return -1; } - capa = HCL_OBJ_GET_SIZE(hcl->code.bc.arr); - if (hcl->code.bc.len >= capa) + if (hcl->code.bc.len >= hcl->code.bc.capa) { - hcl_oop_t tmp; + hcl_oob_t* tmp; hcl_oow_t newcapa; - newcapa = HCL_ALIGN(capa + 1, HCL_BC_BUFFER_ALIGN); - tmp = hcl_remakengcbytearray(hcl, (hcl_oop_t)hcl->code.bc.arr, newcapa); + newcapa = HCL_ALIGN(hcl->code.bc.capa + 1, HCL_BC_BUFFER_ALIGN); + tmp = hcl_reallocmem(hcl, hcl->code.bc.ptr, HCL_SIZEOF(*tmp) * newcapa); if (!tmp) return -1; - hcl->code.bc.arr = (hcl_oop_byte_t)tmp; + hcl->code.bc.ptr = tmp; + hcl->code.bc.capa = newcapa; } - hcl->code.bc.arr->slot[hcl->code.bc.len++] = bc; + hcl->code.bc.ptr[hcl->code.bc.len++] = bc; return 0; } +int hcl_emitbyteinstruction (hcl_t* hcl, hcl_oob_t bc) +{ + return emit_byte_instruction(hcl, bc); +} static int emit_single_param_instruction (hcl_t* hcl, int cmd, hcl_oow_t param_1) { @@ -486,13 +488,13 @@ static HCL_INLINE void patch_long_jump (hcl_t* hcl, hcl_ooi_t jip, hcl_ooi_t jum HCL_ASSERT (hcl, jump_offset <= MAX_CODE_JUMP * 2); - HCL_ASSERT (hcl, hcl->code.bc.arr->slot[jip] == HCL_CODE_JUMP_FORWARD_X || - hcl->code.bc.arr->slot[jip] == HCL_CODE_JUMP_BACKWARD_X || - hcl->code.bc.arr->slot[jip] == HCL_CODE_JUMP_FORWARD_IF_TRUE || - hcl->code.bc.arr->slot[jip] == HCL_CODE_JUMP_FORWARD_IF_FALSE); + HCL_ASSERT (hcl, hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_FORWARD_X || + hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_BACKWARD_X || + hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_FORWARD_IF_TRUE || + hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_FORWARD_IF_FALSE); /* JUMP2 instructions are chosen to be greater than its JUMP counterpart by 1 */ - patch_instruction (hcl, jip, hcl->code.bc.arr->slot[jip] + 1); + patch_instruction (hcl, jip, hcl->code.bc.ptr[jip] + 1); jump_offset -= MAX_CODE_JUMP; } diff --git a/lib/decode.c b/lib/decode.c index deccc07..0657336 100644 --- a/lib/decode.c +++ b/lib/decode.c @@ -77,7 +77,7 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end) if (end > hcl->code.bc.len) end = hcl->code.bc.len; ip = start; - cdptr = ((hcl_oop_byte_t)hcl->code.bc.arr)->slot; + cdptr = hcl->code.bc.ptr; /* TODO: check if ip increases beyond bcode when fetching parameters too */ while (ip < end) diff --git a/lib/exec.c b/lib/exec.c index 58237f5..a7a9b1e 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -1483,9 +1483,9 @@ static int execute (hcl_t* hcl) hcl->proc_switched = 0; #endif - if (HCL_UNLIKELY(hcl->ip >= hcl->code.bc.len)) + if (HCL_UNLIKELY(hcl->ip >= HCL_FUNCTION_GET_CODE_SIZE(hcl->active_function))) { - HCL_DEBUG1 (hcl, "Stopping executeion as IP reached the end of bytecode(%zu)\n", hcl->code.bc.len); + HCL_DEBUG1 (hcl, "Stopping execution as IP reached the end of bytecode(%zu)\n", hcl->code.bc.len); return_value = hcl->_nil; goto handle_return; } @@ -2186,7 +2186,7 @@ static int execute (hcl_t* hcl) HCL_ASSERT (hcl, !HCL_STACK_ISEMPTY(hcl)); /* at the top level, the value is just popped off the stack - * after evaluation of an expressio. so it's likely the + * after evaluation of an expression. so it's likely the * return value of the last expression unless explicit * returning is performed */ hcl->last_retv = HCL_STACK_GETTOP(hcl); @@ -2204,12 +2204,9 @@ static int execute (hcl_t* hcl) return_value = hcl->active_context->origin->receiver_or_base; handle_return: + hcl->last_retv = return_value; if (hcl->active_context->origin == hcl->processor->active->initial_context->origin) { -/* -// HCL_ASSERT (hcl, HCL_CLASSOF(hcl, hcl->active_context) == hcl->_block_context); -// HCL_ASSERT (hcl, HCL_CLASSOF(hcl, hcl->processor->active->initial_context) == hcl->_block_context); -*/ /* decrement the instruction pointer back to the return instruction. * even if the context is reentered, it will just return. *hcl->ip--;*/ @@ -2222,7 +2219,6 @@ static int execute (hcl_t* hcl) * before context switching and marks a dead context */ if (hcl->active_context->origin == hcl->active_context) { - /* returning from a method */ /* // HCL_ASSERT (hcl, HCL_CLASSOF(hcl, hcl->active_context) == hcl->_method_context); */ @@ -2258,9 +2254,6 @@ static int execute (hcl_t* hcl) hcl->active_context->origin->ip = HCL_SMOOI_TO_OOP(-1); } -/* -// 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); SWITCH_ACTIVE_CONTEXT (hcl, hcl->active_context->origin->sender); @@ -2442,17 +2435,14 @@ oops: return -1; } -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; int n; hcl_bitmask_t log_default_type_mask; HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX); /* asserted by the compiler */ - if (initial_ip >= hcl->code.bc.len) - { - hcl_seterrnum (hcl, HCL_EINVAL); - return HCL_NULL; - } log_default_type_mask = hcl->log.default_type_mask; hcl->log.default_type_mask |= HCL_LOG_VM; @@ -2460,9 +2450,31 @@ hcl_oop_t hcl_executefromip (hcl_t* hcl, hcl_oow_t initial_ip) HCL_ASSERT (hcl, hcl->initial_context == HCL_NULL); HCL_ASSERT (hcl, hcl->active_context == HCL_NULL); - hcl->last_retv = hcl->_nil; - n = start_initial_process_and_context(hcl, initial_ip); + /* the code generated doesn't cater for its use as an initial funtion. + * mutate the generated code so that the intiail function can break + * out of the execution loop in execute() smoothly */ +#if 0 + /* append RETURN_FROM_BLOCK */ + if (hcl_emitbyteinstruction(hcl, HCL_CODE_RETURN_FROM_BLOCK) <= -1) return -1; +#else + /* substitute RETURN_STACKTOP for POP_STACKTOP) */ + HCL_ASSERT (hcl, hcl->code.bc.ptr[hcl->code.bc.len - 1] == HCL_CODE_POP_STACKTOP); + hcl->code.bc.ptr[hcl->code.bc.len - 1] = HCL_CODE_RETURN_STACKTOP; +#endif + + func = (hcl_oop_function_t)make_function(hcl, hcl->code.lit.len, hcl->code.bc.ptr, 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_oop_context_t)hcl->_nil, hcl->code.lit.arr->slot, hcl->code.lit.len); + + hcl->initial_function = func; +////////////////////////////////////////////////////////////////////////////////////////////// + + + hcl->last_retv = hcl->_nil; + n = start_initial_process_and_context(hcl, 0); if (n >= 0) { n = execute(hcl); @@ -2477,23 +2489,6 @@ hcl_oop_t hcl_executefromip (hcl_t* hcl, hcl_oow_t initial_ip) return (n <= -1)? HCL_NULL: hcl->last_retv; } -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_oop_context_t)hcl->_nil, hcl->code.lit.arr->slot, hcl->code.lit.len); - - hcl->initial_function = func; -////////////////////////////////////////////////////////////////////////////////////////////// - - return hcl_executefromip (hcl, 0); -} - void hcl_abort (hcl_t* hcl) { hcl->abort_req = 1; diff --git a/lib/fmt.c b/lib/fmt.c index f56c122..a83cf34 100644 --- a/lib/fmt.c +++ b/lib/fmt.c @@ -2145,7 +2145,7 @@ static HCL_INLINE int format_stack_args (hcl_fmtout_t* fmtout, hcl_ooi_t nargs, if (!hcl_inttostr(hcl, arg, 10 | HCL_INTTOSTR_NONEWOBJ)) { - HCL_LOG1 (hcl, HCL_LOG_WARN | HCL_LOG_UNTYPED, "unable to convert %O to string \n", arg); + HCL_LOG2 (hcl, HCL_LOG_WARN | HCL_LOG_UNTYPED, "unable to convert %O for float output\n", arg, hcl_geterrmsg(hcl)); goto invalid_format; } @@ -2489,7 +2489,6 @@ static HCL_INLINE int format_stack_args (hcl_fmtout_t* fmtout, hcl_ooi_t nargs, break; } - print_integer: { const hcl_ooch_t* nsptr; @@ -2523,7 +2522,7 @@ static HCL_INLINE int format_stack_args (hcl_fmtout_t* fmtout, hcl_ooi_t nargs, { /*hcl_seterrbfmt (hcl, HCL_EINVAL, "not a valid number - %O", arg); goto oops;*/ - HCL_LOG1 (hcl, HCL_LOG_WARN | HCL_LOG_UNTYPED, "unable to convert integer %O to string \n", arg); + HCL_LOG2 (hcl, HCL_LOG_WARN | HCL_LOG_UNTYPED, "unable to convert %O for integer output - %js\n", arg, hcl_geterrmsg(hcl)); goto invalid_format; } diff --git a/lib/gc.c b/lib/gc.c index a6bd488..6d07519 100644 --- a/lib/gc.c +++ b/lib/gc.c @@ -451,32 +451,32 @@ int hcl_ignite (hcl_t* hcl) if (!hcl->_nil) { - hcl->_nil = hcl_makenil (hcl); - if (!hcl->_nil) return -1; + hcl->_nil = hcl_makenil(hcl); + if (HCL_UNLIKELY(!hcl->_nil)) return -1; } if (!hcl->_true) { - hcl->_true = hcl_maketrue (hcl); - if (!hcl->_true) return -1; + hcl->_true = hcl_maketrue(hcl); + if (HCL_UNLIKELY(!hcl->_true)) return -1; } if (!hcl->_false) { - hcl->_false = hcl_makefalse (hcl); - if (!hcl->_false) return -1; + hcl->_false = hcl_makefalse(hcl); + if (HCL_UNLIKELY(!hcl->_false)) return -1; } if (!hcl->symtab) { - hcl->symtab = (hcl_oop_dic_t)hcl_makedic (hcl, hcl->option.dfl_symtab_size); - if (!hcl->symtab) return -1; + hcl->symtab = (hcl_oop_dic_t)hcl_makedic(hcl, hcl->option.dfl_symtab_size); + if (HCL_UNLIKELY(!hcl->symtab)) return -1; } if (!hcl->sysdic) { - hcl->sysdic = (hcl_oop_dic_t)hcl_makedic (hcl, hcl->option.dfl_sysdic_size); - if (!hcl->sysdic) return -1; + hcl->sysdic = (hcl_oop_dic_t)hcl_makedic(hcl, hcl->option.dfl_sysdic_size); + if (HCL_UNLIKELY(!hcl->sysdic)) return -1; } /* symbol table available now. symbols can be created */ @@ -484,8 +484,8 @@ int hcl_ignite (hcl_t* hcl) { hcl_oop_t tmp; - tmp = hcl_makesymbol (hcl, syminfo[i].ptr, syminfo[i].len); - if (!tmp) return -1; + tmp = hcl_makesymbol(hcl, syminfo[i].ptr, syminfo[i].len); + if (HCL_UNLIKELY(!tmp)) return -1; HCL_OBJ_SET_FLAGS_SYNCODE (tmp, syminfo[i].syncode); *(hcl_oop_t*)((hcl_uint8_t*)hcl + syminfo[i].offset) = tmp; @@ -496,29 +496,32 @@ int hcl_ignite (hcl_t* hcl) /* Create a nil process used to simplify nil check in GC. * only accessible by VM. not exported via the global dictionary. */ hcl->nil_process = (hcl_oop_process_t)hcl_allocoopobj(hcl, HCL_BRAND_PROCESS, HCL_PROCESS_NAMED_INSTVARS); - if (!hcl->nil_process) return -1; + if (HCL_UNLIKELY(!hcl->nil_process)) return -1; hcl->nil_process->sp = HCL_SMOOI_TO_OOP(-1); } if (!hcl->processor) { hcl->processor = (hcl_oop_process_scheduler_t)hcl_allocoopobj(hcl, HCL_BRAND_PROCESS_SCHEDULER, HCL_PROCESS_SCHEDULER_NAMED_INSTVARS); - if (!hcl->processor) return -1; + if (HCL_UNLIKELY(!hcl->processor)) return -1; hcl->processor->tally = HCL_SMOOI_TO_OOP(0); hcl->processor->active = hcl->nil_process; } - if (!hcl->code.bc.arr) + /* TODO: move code.bc.ptr creation to hcl_init? */ + if (!hcl->code.bc.ptr) { - hcl->code.bc.arr = (hcl_oop_byte_t)hcl_makengcbytearray(hcl, HCL_NULL, HCL_BC_BUFFER_INIT); /* TODO: set a proper intial size */ - if (!hcl->code.bc.arr) return -1; + hcl->code.bc.ptr = (hcl_oop_byte_t)hcl_allocmem(hcl, HCL_SIZEOF(*hcl->code.bc.ptr) * HCL_BC_BUFFER_INIT); /* TODO: set a proper intial size */ + if (HCL_UNLIKELY(!hcl->code.bc.ptr)) return -1; HCL_ASSERT (hcl, hcl->code.bc.len == 0); + hcl->code.bc.capa = HCL_BC_BUFFER_INIT; } + /* TODO: move code.lit.arr creation to hcl_init() after swithching to hcl_allocmem? */ if (!hcl->code.lit.arr) { hcl->code.lit.arr = (hcl_oop_oop_t)hcl_makengcarray(hcl, HCL_LIT_BUFFER_INIT); /* TOOD: set a proper initial size */ - if (!hcl->code.lit.arr) return -1; + if (HCL_UNLIKELY(!hcl->code.lit.arr)) return -1; HCL_ASSERT (hcl, hcl->code.lit.len == 0); } diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index 334d404..6ec7a42 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -1093,7 +1093,7 @@ hcl_pfbase_t* hcl_querymod ( ); /* ========================================================================= */ -/* fmt.c */ +/* fmt.c */ /* ========================================================================= */ int hcl_fmt_object_ ( hcl_fmtout_t* fmtout, @@ -1115,6 +1115,14 @@ int hcl_strfmtcallstack ( hcl_ooi_t nargs ); +/* ========================================================================= */ +/* comp.c */ +/* ========================================================================= */ +int hcl_emitbyteinstruction ( + hcl_t* hcl, + hcl_oob_t bc +); + #if defined(__cplusplus) } #endif diff --git a/lib/hcl.c b/lib/hcl.c index 6207025..0418414 100644 --- a/lib/hcl.c +++ b/lib/hcl.c @@ -241,10 +241,10 @@ void hcl_fini (hcl_t* hcl) hcl->proc_map_free_last = -1; } - if (hcl->code.bc.arr) + if (hcl->code.bc.ptr) { - hcl_freengcobj (hcl, (hcl_oop_t)hcl->code.bc.arr); - hcl->code.bc.arr = HCL_NULL; + hcl_freemem (hcl, hcl->code.bc.ptr); + hcl->code.bc.ptr = HCL_NULL; hcl->code.bc.len = 0; } diff --git a/lib/hcl.h b/lib/hcl.h index c13d53b..3451337 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -1285,8 +1285,9 @@ struct hcl_t { struct { - hcl_oop_byte_t arr; /* byte code array - not part of object memory */ + hcl_oob_t* ptr; /* byte code array */ hcl_oow_t len; + hcl_oow_t capa; } bc; struct @@ -1650,11 +1651,6 @@ HCL_EXPORT hcl_oop_t hcl_execute ( hcl_t* hcl ); -HCL_EXPORT hcl_oop_t hcl_executefromip ( - hcl_t* hcl, - hcl_oow_t initial_ip -); - HCL_EXPORT void hcl_abort ( hcl_t* hcl );