fixing compiler bugs regarding MAKE_FUNCTION and literal frame rebasing

This commit is contained in:
hyung-hwan 2020-10-07 08:06:49 +00:00
parent 0ffb5b239d
commit 9d5e580387
4 changed files with 37 additions and 13 deletions

View File

@ -1160,6 +1160,7 @@ hcl_logufmt (hcl, HCL_LOG_WARN, fmt, ustr, 0x6789);
}
#endif
#if 1
if (xtn->reader_istty)
{
hcl_bitmask_t trait;
@ -1174,6 +1175,7 @@ else
trait |= HCL_TRAIT_INTERACTIVE;
hcl_setoption (hcl, HCL_TRAIT, &trait);
}
#endif
while (1)
{

View File

@ -86,7 +86,7 @@ static int add_literal (hcl_t* hcl, hcl_oop_t obj, hcl_oow_t* index)
/* this removes redundancy of symbols, characters, and integers. */
if (((hcl_oop_oop_t)hcl->code.lit.arr)->slot[i] == obj)
{
*index = i;
*index = i - lfbase;
return i;
}
}
@ -1070,7 +1070,7 @@ static int compile_lambda (hcl_t* hcl, hcl_oop_t src, int defun)
/* 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 */
if (emit_long_param(hcl, hcl->code.lit.len - hcl->c->blk.info[hcl->c->blk.depth - 1].lfbase) <= -1) return -1; /* lfbase */
lfsize_pos = hcl->code.bc.len;
if (emit_long_param(hcl, 0) <= -1) return -1;
}
@ -1637,7 +1637,6 @@ static HCL_INLINE int compile_symbol (hcl_t* hcl, hcl_oop_t obj)
if (add_literal(hcl, cons, &index) <= -1 ||
emit_single_param_instruction(hcl, HCL_CODE_PUSH_OBJECT_0, index) <= -1) return -1;
HCL_DEBUG5 (hcl, "************* blk depth [%d] %O , index %d lfbase %d lit len %d\n", (int)hcl->c->blk.depth, cons, (int)index, (int)hcl->c->blk.info[hcl->c->blk.depth].lfbase, (int)hcl->code.lit.len);
return 0;
}
@ -2513,7 +2512,6 @@ static HCL_INLINE int emit_lambda (hcl_t* hcl)
hcl_oow_t block_code_size, lfsize;
hcl_ooi_t jip;
HCL_DEBUG1 (hcl, "emit_lambda depth %d\n", (int)hcl->c->blk.depth);
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_LAMBDA);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand));
@ -2600,7 +2598,6 @@ static HCL_INLINE int emit_set (hcl_t* hcl)
HCL_ASSERT (hcl, HCL_IS_SYMBOL(hcl, cf->operand));
HCL_DEBUG2 (hcl, "emit_set....%O --- %d\n", cf->operand, (int)hcl->c->blk.depth);
cons = (hcl_oop_t)hcl_getatsysdic(hcl, cf->operand);
if (!cons)
{
@ -2646,9 +2643,39 @@ int hcl_compile (hcl_t* hcl, hcl_oop_t obj)
/* TODO: in case i implement all global variables as block arguments at the top level...what should i do? */
hcl->c->blk.depth++;
HCL_DEBUG2 (hcl, "ENTERING DEPTH %d LIT LEN %d\n", (int)hcl->c->blk.depth, (int)hcl->code.lit.len);
if (store_temporary_variable_count_for_block(hcl, hcl->c->tv.size, hcl->code.lit.len) <= -1) return -1;
hcl->c->blk.depth++; /* this must be 0 here */
/*
* In the non-INTERACTIVE mode, the literal frame base doesn't matter.
* Only the initial function object contains the literal frame.
* No other function objects are created. All lambda defintions are
* translated to base context objects instead.
*
* In the INTERACTIVE mode, the literal frame base plays a key role.
* hcl_compile() is called for the top-level expression andthe literal
* frame base can be 0. The means it is ok for a top-level code to
* reference part of the literal frame reserved for a lambda function.
*
* (set b 1)
* (defun set-a(x) (set a x))
* (set a 2)
* (set-a 4)
* (printf "%d\n" a)
*
* the global literal frame looks like this:
* @0 (b)
* @1 (a)
* @2 (set-a)
* @3 (printf . #<PRIM>)
* @4 "%d\n"
*
* @1 to @2 will be copied to a function object when defun is executed.
* The literal frame of the created function object for set-a looks
* like this
* @0 (a)
* @1 (set-a)
*/
if (store_temporary_variable_count_for_block(hcl, hcl->c->tv.size, 0) <= -1) return -1;
PUSH_CFRAME (hcl, COP_COMPILE_OBJECT, obj);

View File

@ -566,7 +566,6 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
HCL_ASSERT (hcl, b1 >= 0);
HCL_ASSERT (hcl, b2 >= b1);
HCL_ASSERT (hcl, b4 >= b3);
break;
case HCL_CODE_MAKE_BLOCK:

View File

@ -1676,7 +1676,6 @@ static int execute (hcl_t* hcl)
LOG_INST_1 (hcl, "push_literal @%zu", b1);
/*HCL_STACK_PUSH (hcl, hcl->code.lit.arr->slot[b1]);*/
HCL_STACK_PUSH (hcl, hcl->active_function->literal_frame[b1]);
HCL_DEBUG3 (hcl, "*** push literal %O => %d active_function %p\n", hcl->active_function->literal_frame[b1], b1, hcl->active_function);
break;
/* ------------------------------------------------- */
@ -1705,7 +1704,6 @@ HCL_DEBUG3 (hcl, "*** push literal %O => %d active_function %p\n", hcl->activ
handle_object:
/*ass = hcl->code.lit.arr->slot[b1];*/
ass = (hcl_oop_cons_t)hcl->active_function->literal_frame[b1];
HCL_DEBUG3 (hcl, "handle object ass => %O => %d active_function %p\n", ass, b1, hcl->active_function);
HCL_ASSERT (hcl, HCL_IS_CONS(hcl, ass));
if ((bcode >> 3) & 1)
@ -2343,7 +2341,6 @@ HCL_DEBUG3 (hcl, "handle object ass => %O => %d active_function %p\n", ass, b1
HCL_ASSERT (hcl, b1 >= 0);
HCL_ASSERT (hcl, b2 >= b1);
HCL_ASSERT (hcl, b3 >= 0);
/* the MAKE_FUNCTION instruction is followed by the long JUMP_FORWARD_X instruction.
* i can decode the instruction and get the size of instructions
@ -2354,7 +2351,6 @@ HCL_DEBUG3 (hcl, "handle object ass => %O => %d active_function %p\n", ass, b1
joff = (joff << 8) | hcl->active_code[hcl->ip + 2];
#endif
HCL_DEBUG1(hcl, "**** MAKE FUNCTION joff = %zu\n", joff);
/* copy the byte codes from the active context to the new context */
#if (HCL_HCL_CODE_LONG_PARAM_SIZE == 2)
func = (hcl_oop_function_t)make_function(hcl, b4, &hcl->active_code[hcl->ip + 3], joff);