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

added hcl_getip(), hcl_getbclen(), hcl_getlflen()

Browse Source 
renamed vm_checkpoint to vm_checkbc while adding a new parameter
This commit is contained in:
hyung-hwan
2018-03-11 11:16:28 +00:00
parent 2d63035d4e
commit 873bc033b5
6 changed files with 65 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
hcl/lib/comp.c
View File

@ -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);

8
hcl/lib/decode.c
View File

@ -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;

18
hcl/lib/exec.c
View File

@ -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;

14
hcl/lib/hcl.c
View File

@ -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);
}

29
hcl/lib/hcl.h
View File

@ -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() */

24
hcl/lib/main.c
View File

@ -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);*/
}