diff --git a/lib/comp.c b/lib/comp.c index 5e117ba..0b95308 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -2452,7 +2452,7 @@ static HCL_INLINE int emit_lambda (hcl_t* hcl) { hcl_cframe_t* cf; hcl_oow_t block_code_size; - hcl_oow_t jip; + hcl_ooi_t jip; cf = GET_TOP_CFRAME(hcl); HCL_ASSERT (hcl, cf->opcode == COP_EMIT_LAMBDA); diff --git a/lib/decode.c b/lib/decode.c index e1cf0e5..8305e8e 100644 --- a/lib/decode.c +++ b/lib/decode.c @@ -55,7 +55,7 @@ #endif /* TODO: check if ip shoots beyond the maximum length in fetching code and parameters */ -int hcl_decode (hcl_t* hcl, hcl_ooi_t start, hcl_ooi_t end) +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; @@ -67,6 +67,12 @@ int hcl_decode (hcl_t* hcl, hcl_ooi_t start, hcl_ooi_t end) HCL_ASSERT (hcl, start >= 0 && end >= 0); HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX); /* asserted by the compiler */ HCL_ASSERT (hcl, end <= hcl->code.bc.len); /* not harmful though this fails */ + if (start >= hcl->code.bc.len) + { + hcl_seterrnum (hcl, HCL_EINVAL); + return -1; + } + if (end > hcl->code.bc.len) end = hcl->code.bc.len; ip = start; cdptr = ((hcl_oop_byte_t)hcl->code.bc.arr)->slot; diff --git a/lib/exec.c b/lib/exec.c index d550181..abfaf5d 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -148,12 +148,12 @@ static void vm_cleanup (hcl_t* hcl) HCL_DEBUG1 (hcl, "VM cleaned up at IP %zd\n", hcl->ip); } -static void vm_checkpoint (hcl_t* hcl) +static void vm_checkbc (hcl_t* hcl, hcl_oob_t bcode) { hcl_cb_t* cb; for (cb = hcl->cblist; cb; cb = cb->next) { - if (cb->vm_checkpoint) cb->vm_checkpoint(hcl); + if (cb->vm_checkbc) cb->vm_checkbc(hcl, bcode); } } /* ------------------------------------------------------------------------- */ @@ -1213,11 +1213,11 @@ static int execute (hcl_t* hcl) FETCH_BYTE_CODE_TO (hcl, bcode); /*while (bcode == HCL_CODE_NOOP) FETCH_BYTE_CODE_TO (hcl, bcode);*/ - if (hcl->vm_checkpoint_cb_count) vm_checkpoint (hcl); + if (hcl->vm_checkbc_cb_count) vm_checkbc (hcl, bcode); if (HCL_UNLIKELY(hcl->abort_req)) { - /* place the abortion check after vm_checkpoint + /* i place this abortion check after vm_checkbc() * to honor hcl_abort() if called in the callback, */ HCL_DEBUG0 (hcl, "Stopping execution for abortion request\n"); return_value = hcl->_nil; @@ -2241,10 +2241,18 @@ oops: return -1; } -hcl_oop_t hcl_executefromip (hcl_t* hcl, hcl_ooi_t initial_ip) +hcl_oop_t hcl_executefromip (hcl_t* hcl, hcl_oow_t initial_ip) { int n, log_default_type_mask; + HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX); /* asserted by the compiler */ + HCL_ASSERT (hcl, initial_ip < hcl->code.bc.len); + 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; diff --git a/lib/hcl.c b/lib/hcl.c index 7ff45b0..fcc6a28 100644 --- a/lib/hcl.c +++ b/lib/hcl.c @@ -416,11 +416,11 @@ hcl_cb_t* hcl_regcb (hcl_t* hcl, hcl_cb_t* tmpl) actual->prev = HCL_NULL; hcl->cblist = actual; - /* vm_checkpoint is invoked very frequently. - * and there might be multiple vm_checkpoint callbacks registered. - * keeping the count of vm_checkpoint callbacks registered + /* vm_checkbc is invoked very frequently. + * and there might be multiple vm_checkbc callbacks registered. + * keeping the count of vm_checkbc callbacks registered * speeds up the check */ - if (actual->vm_checkpoint) hcl->vm_checkpoint_cb_count++; + if (actual->vm_checkbc) hcl->vm_checkbc_cb_count++; return actual; } @@ -438,10 +438,10 @@ void hcl_deregcb (hcl_t* hcl, hcl_cb_t* cb) if (cb->prev) cb->prev->next = cb->next; } - if (cb->vm_checkpoint) + if (cb->vm_checkbc) { - HCL_ASSERT (hcl, hcl->vm_checkpoint_cb_count > 0); - hcl->vm_checkpoint_cb_count--; + HCL_ASSERT (hcl, hcl->vm_checkbc_cb_count > 0); + hcl->vm_checkbc_cb_count--; } hcl_freemem (hcl, cb); } diff --git a/lib/hcl.h b/lib/hcl.h index 641275a..24e3497 100644 --- a/lib/hcl.h +++ b/lib/hcl.h @@ -863,7 +863,7 @@ typedef void (*hcl_cb_fini_t) (hcl_t* hcl); typedef void (*hcl_cb_gc_t) (hcl_t* hcl); typedef int (*hcl_cb_vm_startup_t) (hcl_t* hcl); typedef void (*hcl_cb_vm_cleanup_t) (hcl_t* hcl); -typedef void (*hcl_cb_vm_checkpoint_t) (hcl_t* hcl); +typedef void (*hcl_cb_vm_checkbc_t) (hcl_t* hcl, hcl_oob_t bcode); typedef struct hcl_cb_t hcl_cb_t; struct hcl_cb_t @@ -873,7 +873,7 @@ struct hcl_cb_t hcl_cb_vm_startup_t vm_startup; hcl_cb_vm_cleanup_t vm_cleanup; - hcl_cb_vm_checkpoint_t vm_checkpoint; + hcl_cb_vm_checkbc_t vm_checkbc; /* private below */ hcl_cb_t* prev; @@ -1027,7 +1027,7 @@ struct hcl_t hcl_vmprim_t vmprim; - hcl_oow_t vm_checkpoint_cb_count; + hcl_oow_t vm_checkbc_cb_count; hcl_cb_t* cblist; hcl_rbt_t modtab; /* primitive module table */ @@ -1560,7 +1560,7 @@ HCL_EXPORT hcl_oop_t hcl_execute ( HCL_EXPORT hcl_oop_t hcl_executefromip ( hcl_t* hcl, - hcl_ooi_t initial_ip + hcl_oow_t initial_ip ); HCL_EXPORT void hcl_abort ( @@ -1593,12 +1593,27 @@ HCL_EXPORT int hcl_compile ( hcl_oop_t obj ); +/** + * The hcl_decode() function decodes instructions from the position + * \a start to the position \a end - 1, and prints the decoded instructions + * in the textual form. + */ HCL_EXPORT int hcl_decode ( - hcl_t* hcl, - hcl_ooi_t start, - hcl_ooi_t end + hcl_t* hcl, + hcl_oow_t start, + hcl_oow_t end ); +#if defined(HCL_HAVE_INLINE) + static HCL_INLINE hcl_oow_t hcl_getbclen (hcl_t* hcl) { return hcl->code.bc.len; } + static HCL_INLINE hcl_oow_t hcl_getlflen (hcl_t* hcl) { return hcl->code.lit.len; } + static HCL_INLINE hcl_ooi_t hcl_getip (hcl_t* hcl) { return hcl->ip; } +#else +# define hcl_getbclen(hcl) ((hcl)->code.bc.len) +# define hcl_getlflen(hcl) ((hcl)->code.lit.len) +# define hcl_getip(hcl) ((hcl)->ip) +#endif + /* if you should read charcters from the input stream before hcl_read(), * you can call hcl_readchar() */ diff --git a/lib/main.c b/lib/main.c index 4f2a4db..8dc0c54 100644 --- a/lib/main.c +++ b/lib/main.c @@ -1220,6 +1220,12 @@ static void vm_cleanup (hcl_t* hcl) #endif } +/* +static void vm_checkbc (hcl_t* hcl, hcl_oob_t bcode) +{ +} +*/ + static void gc_hcl (hcl_t* hcl) { xtn_t* xtn = (xtn_t*)hcl_getxtn(hcl); @@ -1398,6 +1404,7 @@ static void arrange_process_switching (int sig) } #endif +#if 0 static void setup_tick (void) { #if defined(__MSDOS__) && defined(_INTELC32_) @@ -1463,6 +1470,7 @@ static void cancel_tick (void) # error UNSUPPORTED #endif } +#endif /* ========================================================================= */ @@ -1698,7 +1706,7 @@ int main (int argc, char* argv[]) hclcb.gc = gc_hcl; hclcb.vm_startup = vm_startup; hclcb.vm_cleanup = vm_cleanup; - /*hclcb.vm_checkpoint = vm_checkpoint;*/ + /*hclcb.vm_checkbc = vm_checkbc;*/ hcl_regcb (hcl, &hclcb); if (logopt) @@ -1802,7 +1810,7 @@ count++; { hcl_oow_t code_offset; - code_offset = hcl->code.bc.len; + code_offset = hcl_getbclen(hcl); hcl_proutbfmt (hcl, 0, "\n"); if (hcl_compile(hcl, obj) <= -1) @@ -1823,7 +1831,7 @@ count++; { hcl_oop_t retv; - hcl_decode (hcl, code_offset, hcl->code.bc.len); + hcl_decode (hcl, code_offset, hcl_getbclen(hcl)); HCL_LOG0 (hcl, HCL_LOG_MNEMONIC, "------------------------------------------\n"); g_hcl = hcl; //setup_tick (); @@ -1858,11 +1866,10 @@ count++; { hcl_oop_t retv; - hcl_decode (hcl, 0, hcl->code.bc.len); - HCL_LOG2 (hcl, HCL_LOG_MNEMONIC, "BYTECODES hcl->code.bc.len = > %lu hcl->code.lit.len => %lu\n", - (unsigned long int)hcl->code.bc.len, (unsigned long int)hcl->code.lit.len); + hcl_decode (hcl, 0, hcl_getbclen(hcl)); + HCL_LOG2 (hcl, HCL_LOG_MNEMONIC, "BYTECODES bclen = > %zu lflen => %zu\n", hcl_getbclen(hcl), hcl_getlflen(hcl)); g_hcl = hcl; - //setup_tick (); + /*setup_tick ();*/ retv = hcl_execute(hcl); if (!retv) @@ -1874,8 +1881,7 @@ count++; hcl_logbfmt (hcl, HCL_LOG_STDERR, "EXECUTION OK - EXITED WITH %O\n", retv); } - - //cancel_tick(); + /*cancel_tick();*/ g_hcl = HCL_NULL; /*hcl_dumpsymtab (hcl);*/ }