compiler enhancement in progress

This commit is contained in:
hyung-hwan 2021-01-28 10:09:38 +00:00
parent c93ddd5042
commit 624f2d02cd
2 changed files with 79 additions and 54 deletions

View File

@ -525,7 +525,7 @@ static HCL_INLINE int emit_long_param (hcl_t* hcl, hcl_oow_t param)
#endif #endif
} }
static int emit_push_literal (hcl_t* hcl, hcl_oop_t obj) static int emit_push_literal (hcl_t* hcl, hcl_oop_t obj, const hcl_ioloc_t* srcloc)
{ {
hcl_oow_t index; hcl_oow_t index;
@ -537,25 +537,25 @@ static int emit_push_literal (hcl_t* hcl, hcl_oop_t obj)
switch (i) switch (i)
{ {
case -1: case -1:
return emit_byte_instruction(hcl, HCL_CODE_PUSH_NEGONE, HCL_NULL); return emit_byte_instruction(hcl, HCL_CODE_PUSH_NEGONE, srcloc);
case 0: case 0:
return emit_byte_instruction(hcl, HCL_CODE_PUSH_ZERO, HCL_NULL); return emit_byte_instruction(hcl, HCL_CODE_PUSH_ZERO, srcloc);
case 1: case 1:
return emit_byte_instruction(hcl, HCL_CODE_PUSH_ONE, HCL_NULL); return emit_byte_instruction(hcl, HCL_CODE_PUSH_ONE, srcloc);
case 2: case 2:
return emit_byte_instruction(hcl, HCL_CODE_PUSH_TWO, HCL_NULL); return emit_byte_instruction(hcl, HCL_CODE_PUSH_TWO, srcloc);
} }
if (i >= 0 && i <= MAX_CODE_PARAM) if (i >= 0 && i <= MAX_CODE_PARAM)
{ {
return emit_single_param_instruction(hcl, HCL_CODE_PUSH_INTLIT, i, HCL_NULL); return emit_single_param_instruction(hcl, HCL_CODE_PUSH_INTLIT, i, srcloc);
} }
else if (i < 0 && i >= -(hcl_ooi_t)MAX_CODE_PARAM) else if (i < 0 && i >= -(hcl_ooi_t)MAX_CODE_PARAM)
{ {
return emit_single_param_instruction(hcl, HCL_CODE_PUSH_NEGINTLIT, -i, HCL_NULL); return emit_single_param_instruction(hcl, HCL_CODE_PUSH_NEGINTLIT, -i, srcloc);
} }
} }
else if (HCL_OOP_IS_CHAR(obj)) else if (HCL_OOP_IS_CHAR(obj))
@ -565,11 +565,11 @@ static int emit_push_literal (hcl_t* hcl, hcl_oop_t obj)
i = HCL_OOP_TO_CHAR(obj); i = HCL_OOP_TO_CHAR(obj);
if (i >= 0 && i <= MAX_CODE_PARAM) if (i >= 0 && i <= MAX_CODE_PARAM)
return emit_single_param_instruction(hcl, HCL_CODE_PUSH_CHARLIT, i, HCL_NULL); return emit_single_param_instruction(hcl, HCL_CODE_PUSH_CHARLIT, i, srcloc);
} }
if (add_literal(hcl, obj, &index) <= -1 || if (add_literal(hcl, obj, &index) <= -1 ||
emit_single_param_instruction(hcl, HCL_CODE_PUSH_LITERAL_0, index, HCL_NULL) <= -1) return -1; emit_single_param_instruction(hcl, HCL_CODE_PUSH_LITERAL_0, index, srcloc) <= -1) return -1;
return 0; return 0;
} }
@ -680,7 +680,7 @@ static HCL_INLINE int _insert_cframe (hcl_t* hcl, hcl_ooi_t index, int opcode, h
tmp = &hcl->c->cfs2.ptr[index]; tmp = &hcl->c->cfs2.ptr[index];
tmp->opcode = opcode; tmp->opcode = opcode;
tmp->operand = operand; tmp->operand = operand;
/* leave tmp->u untouched/uninitialized */ HCL_MEMSET (&tmp->u, 0, HCL_SIZEOF(tmp->u));
return 0; return 0;
} }
@ -858,7 +858,7 @@ static int compile_and (hcl_t* hcl, hcl_cnode_t* src)
obj = HCL_CNODE_CONS_CDR(obj); obj = HCL_CNODE_CONS_CDR(obj);
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */ SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */
PUSH_SUBCFRAME (hcl, COP_SUBCOMPILE_AND_EXPR, obj); /* 2 */ if (obj) PUSH_SUBCFRAME (hcl, COP_SUBCOMPILE_AND_EXPR, obj); /* 2 */
return 0; return 0;
} }
@ -1452,13 +1452,15 @@ static int compile_while (hcl_t* hcl, hcl_cnode_t* src, int next_cop)
cond_pos = hcl->code.bc.len; /* position where the bytecode for the conditional is emitted */ cond_pos = hcl->code.bc.len; /* position where the bytecode for the conditional is emitted */
cond = HCL_CNODE_CONS_CAR(obj); cond = HCL_CNODE_CONS_CAR(obj);
obj = HCL_CNODE_CONS_CDR(obj);
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, cond); /* 1 */ SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, cond); /* 1 */
/* pass the cons cell branching to the conditional and the body. see post_while_cond() for the reason */
PUSH_SUBCFRAME (hcl, next_cop, obj); /* 2 */ PUSH_SUBCFRAME (hcl, next_cop, obj); /* 2 */
cf = GET_SUBCFRAME(hcl); cf = GET_SUBCFRAME(hcl);
cf->u.post_while.cond_pos = cond_pos; cf->u.post_while.cond_pos = cond_pos;
cf->u.post_while.body_pos = -1; /* unknown yet*/ cf->u.post_while.body_pos = -1; /* unknown yet*/
cf->u.post_while.jump_inst_pos = -1; /* not needed */
cf->u.post_while.start_loc = *HCL_CNODE_GET_LOC(src); cf->u.post_while.start_loc = *HCL_CNODE_GET_LOC(src);
return 0; return 0;
@ -1946,6 +1948,7 @@ static int compile_object (hcl_t* hcl)
cf = GET_TOP_CFRAME(hcl); cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_OBJECT); HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_OBJECT);
HCL_ASSERT (hcl, cf->operand != HCL_NULL);
oprnd = cf->operand; oprnd = cf->operand;
redo: redo:
@ -2089,7 +2092,7 @@ redo:
return 0; return 0;
literal: literal:
if (emit_push_literal(hcl, lit) <= -1) return -1; if (emit_push_literal(hcl, lit, HCL_CNODE_GET_LOC(oprnd)) <= -1) return -1;
done: done:
POP_CFRAME (hcl); POP_CFRAME (hcl);
@ -2441,8 +2444,8 @@ static HCL_INLINE int patch_nearest_post_if_body (hcl_t* hcl, hcl_cnode_t* cmd)
/* modify the POST_IF_BODY frame */ /* modify the POST_IF_BODY frame */
HCL_ASSERT (hcl, cf->opcode == COP_POST_IF_BODY); HCL_ASSERT (hcl, cf->opcode == COP_POST_IF_BODY);
HCL_ASSERT (hcl, cf->operand != HCL_NULL); HCL_ASSERT (hcl, cf->operand != HCL_NULL);
cf->u.post_if.jump_inst_pos = jump_inst_pos;
cf->u.post_if.body_pos = body_pos; cf->u.post_if.body_pos = body_pos;
cf->u.post_if.jump_inst_pos = jump_inst_pos;
return 0; return 0;
} }
@ -2481,6 +2484,7 @@ static HCL_INLINE int subcompile_elif (hcl_t* hcl)
PUSH_SUBCFRAME (hcl, COP_POST_IF_COND, obj); /* 2 */ PUSH_SUBCFRAME (hcl, COP_POST_IF_COND, obj); /* 2 */
cf = GET_SUBCFRAME(hcl); cf = GET_SUBCFRAME(hcl);
cf->u.post_if.body_pos = -1; /* unknown yet */ cf->u.post_if.body_pos = -1; /* unknown yet */
cf->u.post_if.jump_inst_pos = -1; /* not needed */
cf->u.post_if.start_loc = *HCL_CNODE_GET_LOC(src); cf->u.post_if.start_loc = *HCL_CNODE_GET_LOC(src);
return patch_nearest_post_if_body(hcl, cmd); return patch_nearest_post_if_body(hcl, cmd);
@ -2527,17 +2531,11 @@ static HCL_INLINE int subcompile_and_expr (hcl_t* hcl)
cf = GET_TOP_CFRAME(hcl); cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_SUBCOMPILE_AND_EXPR); HCL_ASSERT (hcl, cf->opcode == COP_SUBCOMPILE_AND_EXPR);
HCL_ASSERT (hcl, cf->operand != HCL_NULL);
obj = cf->operand;
/* TODO: optimization - eat away all true expressions */ /* TODO: optimization - eat away all true expressions */
if (!obj) obj = cf->operand;
{ if (!HCL_CNODE_IS_CONS(obj))
/* no more */
POP_CFRAME (hcl);
return 0;
}
else if (!HCL_CNODE_IS_CONS(obj))
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in and"); hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in and");
return -1; return -1;
@ -2554,11 +2552,11 @@ static HCL_INLINE int subcompile_and_expr (hcl_t* hcl)
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */ SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */
PUSH_SUBCFRAME (hcl, COP_POST_AND_EXPR, obj); /* 3 */ PUSH_SUBCFRAME (hcl, COP_POST_AND_EXPR, expr); /* 3 */
cf = GET_SUBCFRAME(hcl); cf = GET_SUBCFRAME(hcl);
cf->operand = HCL_SMOOI_TO_OOP(jump_inst_pos); cf->u.post_and.jump_inst_pos = jump_inst_pos;
PUSH_SUBCFRAME (hcl, COP_SUBCOMPILE_AND_EXPR, obj); /* 2 */ if (obj) PUSH_SUBCFRAME (hcl, COP_SUBCOMPILE_AND_EXPR, obj); /* 2 */
return 0; return 0;
} }
@ -2571,9 +2569,10 @@ static HCL_INLINE int post_and_expr (hcl_t* hcl)
cf = GET_TOP_CFRAME(hcl); cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_POST_AND_EXPR); HCL_ASSERT (hcl, cf->opcode == COP_POST_AND_EXPR);
HCL_ASSERT (hcl, cf->operand != HCL_NULL);
HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX); HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
jip = HCL_OOP_TO_SMOOI(cf->operand); jip = cf->u.post_and.jump_inst_pos;
/* patch the jump insruction emitted after each expression inside the 'and' expression */ /* patch the jump insruction emitted after each expression inside the 'and' expression */
jump_offset = hcl->code.bc.len - jip - (HCL_HCL_CODE_LONG_PARAM_SIZE + 1); jump_offset = hcl->code.bc.len - jip - (HCL_HCL_CODE_LONG_PARAM_SIZE + 1);
@ -2593,17 +2592,12 @@ static HCL_INLINE int subcompile_or_expr (hcl_t* hcl)
cf = GET_TOP_CFRAME(hcl); cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_SUBCOMPILE_OR_EXPR); HCL_ASSERT (hcl, cf->opcode == COP_SUBCOMPILE_OR_EXPR);
HCL_ASSERT (hcl, cf->operand != HCL_NULL);
obj = cf->operand;
/* TODO: optimization - eat away all false expressions */ /* TODO: optimization - eat away all false expressions */
if (!obj)
{ obj = cf->operand;
/* no more */ if (!HCL_CNODE_IS_CONS(obj))
POP_CFRAME (hcl);
return 0;
}
else if (!HCL_CNODE_IS_CONS(obj))
{ {
hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in or"); hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in or");
return -1; return -1;
@ -2612,19 +2606,19 @@ static HCL_INLINE int subcompile_or_expr (hcl_t* hcl)
HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX); HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
jump_inst_pos = hcl->code.bc.len; jump_inst_pos = hcl->code.bc.len;
if (emit_single_param_instruction(hcl, HCL_CODE_JUMP_FORWARD_IF_TRUE, MAX_CODE_JUMP, HCL_NULL) <= -1) return -1; if (emit_single_param_instruction(hcl, HCL_CODE_JUMP_FORWARD_IF_TRUE, MAX_CODE_JUMP, HCL_CNODE_GET_LOC(obj)) <= -1) return -1;
if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_NULL) <= -1) return -1; if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_CNODE_GET_LOC(obj)) <= -1) return -1;
expr = HCL_CNODE_CONS_CAR(obj); expr = HCL_CNODE_CONS_CAR(obj);
obj = HCL_CNODE_CONS_CDR(obj); obj = HCL_CNODE_CONS_CDR(obj);
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */ SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, expr); /* 1 */
PUSH_SUBCFRAME (hcl, COP_POST_OR_EXPR, obj); /* 3 */ PUSH_SUBCFRAME (hcl, COP_POST_OR_EXPR, expr); /* 3 */
cf = GET_SUBCFRAME(hcl); cf = GET_SUBCFRAME(hcl);
cf->operand = HCL_SMOOI_TO_OOP(jump_inst_pos); cf->u.post_or.jump_inst_pos = jump_inst_pos;
PUSH_SUBCFRAME (hcl, COP_SUBCOMPILE_OR_EXPR, obj); /* 2 */ if (obj) PUSH_SUBCFRAME (hcl, COP_SUBCOMPILE_OR_EXPR, obj); /* 2 */
return 0; return 0;
} }
@ -2637,9 +2631,10 @@ static HCL_INLINE int post_or_expr (hcl_t* hcl)
cf = GET_TOP_CFRAME(hcl); cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_POST_OR_EXPR); HCL_ASSERT (hcl, cf->opcode == COP_POST_OR_EXPR);
HCL_ASSERT (hcl, cf->operand != HCL_NULL);
HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX); HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
jip = HCL_OOP_TO_SMOOI(cf->operand); jip = cf->u.post_or.jump_inst_pos;
/* patch the jump insruction emitted after each expression inside the 'and' expression */ /* patch the jump insruction emitted after each expression inside the 'and' expression */
jump_offset = hcl->code.bc.len - jip - (HCL_HCL_CODE_LONG_PARAM_SIZE + 1); jump_offset = hcl->code.bc.len - jip - (HCL_HCL_CODE_LONG_PARAM_SIZE + 1);
@ -2720,9 +2715,17 @@ static HCL_INLINE int post_while_cond (hcl_t* hcl)
hcl_ooi_t cond_pos, body_pos; hcl_ooi_t cond_pos, body_pos;
hcl_ioloc_t start_loc; hcl_ioloc_t start_loc;
int jump_inst, next_cop; int jump_inst, next_cop;
hcl_cnode_t* cond, * body;
cf = GET_TOP_CFRAME(hcl); cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_POST_UNTIL_COND || cf->opcode == COP_POST_WHILE_COND); HCL_ASSERT (hcl, cf->opcode == COP_POST_UNTIL_COND || cf->opcode == COP_POST_WHILE_COND);
HCL_ASSERT (hcl, cf->operand != HCL_NULL);
/* the caller must pass the cons cell branching to the conditinal and the body
* if the body cell is given, things gets complicated because the body part can be HCL_NULL.
* for instance, the body part is empty in (while (< i 1) ) */
cond = HCL_CNODE_CONS_CAR(cf->operand);
body = HCL_CNODE_CONS_CDR(cf->operand);
cond_pos = cf->u.post_while.cond_pos; cond_pos = cf->u.post_while.cond_pos;
start_loc = cf->u.post_while.start_loc; start_loc = cf->u.post_while.start_loc;
@ -2740,18 +2743,29 @@ static HCL_INLINE int post_while_cond (hcl_t* hcl)
next_cop = COP_POST_WHILE_BODY; next_cop = COP_POST_WHILE_BODY;
} }
if (emit_single_param_instruction (hcl, jump_inst, MAX_CODE_JUMP, HCL_NULL) <= -1) return -1; if (emit_single_param_instruction (hcl, jump_inst, MAX_CODE_JUMP, HCL_CNODE_GET_LOC(cond)) <= -1) return -1;
if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_NULL) <= -1) return -1; if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_CNODE_GET_LOC(cond)) <= -1) return -1;
HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX); HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
body_pos = hcl->code.bc.len; body_pos = hcl->code.bc.len;
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, cf->operand); /* 1 */ if (body)
PUSH_SUBCFRAME (hcl, next_cop, HCL_SMOOI_TO_OOP(jump_inst_pos)); /* 2 */ {
cf = GET_SUBCFRAME(hcl); SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, body); /* 1 */
PUSH_SUBCFRAME (hcl, next_cop, cf->operand); /* 2 */
cf = GET_SUBCFRAME(hcl);
}
else
{
/* the body is empty */
SWITCH_TOP_CFRAME (hcl, next_cop, cond); /* 2 */
cf = GET_TOP_CFRAME(hcl);
}
cf->u.post_while.cond_pos = cond_pos; cf->u.post_while.cond_pos = cond_pos;
cf->u.post_while.body_pos = body_pos; cf->u.post_while.body_pos = body_pos;
cf->u.post_while.jump_inst_pos = jump_inst_pos;
cf->u.post_while.start_loc = start_loc; cf->u.post_while.start_loc = start_loc;
return 0; return 0;
} }
@ -2763,7 +2777,7 @@ static HCL_INLINE int post_while_body (hcl_t* hcl)
cf = GET_TOP_CFRAME(hcl); cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_POST_UNTIL_BODY || cf->opcode == COP_POST_WHILE_BODY); HCL_ASSERT (hcl, cf->opcode == COP_POST_UNTIL_BODY || cf->opcode == COP_POST_WHILE_BODY);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand)); HCL_ASSERT (hcl, cf->operand != HCL_NULL);
HCL_ASSERT (hcl, hcl->code.bc.len >= cf->u.post_while.cond_pos); HCL_ASSERT (hcl, hcl->code.bc.len >= cf->u.post_while.cond_pos);
if (hcl->code.bc.len > cf->u.post_while.body_pos) if (hcl->code.bc.len > cf->u.post_while.body_pos)
@ -2777,15 +2791,15 @@ static HCL_INLINE int post_while_body (hcl_t* hcl)
* pop_stacktop * pop_stacktop
* this check prevents another pop_stacktop between 1) and 2) * this check prevents another pop_stacktop between 1) and 2)
*/ */
if (emit_byte_instruction (hcl, HCL_CODE_POP_STACKTOP, HCL_NULL) <= -1) return -1; if (emit_byte_instruction (hcl, HCL_CODE_POP_STACKTOP, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1;
} }
HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX); HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
jump_offset = hcl->code.bc.len - cf->u.post_while.cond_pos + 1; jump_offset = hcl->code.bc.len - cf->u.post_while.cond_pos + 1;
if (jump_offset > 3) jump_offset += HCL_HCL_CODE_LONG_PARAM_SIZE; if (jump_offset > 3) jump_offset += HCL_HCL_CODE_LONG_PARAM_SIZE;
if (emit_single_param_instruction (hcl, HCL_CODE_JUMP_BACKWARD_0, jump_offset, HCL_NULL) <= -1) return -1; if (emit_single_param_instruction (hcl, HCL_CODE_JUMP_BACKWARD_0, jump_offset, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1;
jip = HCL_OOP_TO_SMOOI(cf->operand); jip = cf->u.post_while.jump_inst_pos;
/* HCL_CODE_LONG_PARAM_SIZE + 1 => size of the long JUMP_FORWARD_IF_FALSE/JUMP_FORWARD_IF_TRUE instruction */ /* HCL_CODE_LONG_PARAM_SIZE + 1 => size of the long JUMP_FORWARD_IF_FALSE/JUMP_FORWARD_IF_TRUE instruction */
jump_offset = hcl->code.bc.len - jip - (HCL_HCL_CODE_LONG_PARAM_SIZE + 1); jump_offset = hcl->code.bc.len - jip - (HCL_HCL_CODE_LONG_PARAM_SIZE + 1);
if (jump_offset > MAX_CODE_JUMP * 2) if (jump_offset > MAX_CODE_JUMP * 2)

View File

@ -337,6 +337,7 @@ struct hcl_cframe2_t
{ {
hcl_ooi_t cond_pos; hcl_ooi_t cond_pos;
hcl_ooi_t body_pos; hcl_ooi_t body_pos;
hcl_ooi_t jump_inst_pos;
hcl_ioloc_t start_loc; hcl_ioloc_t start_loc;
} post_while; } post_while;
@ -347,6 +348,16 @@ struct hcl_cframe2_t
hcl_ioloc_t start_loc; hcl_ioloc_t start_loc;
} post_if; } post_if;
struct
{
hcl_ooi_t jump_inst_pos;
} post_and;
struct
{
hcl_ooi_t jump_inst_pos;
} post_or;
/* COP_COMPILE_ARRAY_LIST, COP_POP_INTO_ARRAY, COP_EMIT_MAKE_ARRAY */ /* COP_COMPILE_ARRAY_LIST, COP_POP_INTO_ARRAY, COP_EMIT_MAKE_ARRAY */
struct struct
{ {