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

fixed some compiler bugs in processing weird if..elif..else expressions without body parts - (if true), (if false else), (if false elif true)

Browse Source
This commit is contained in:
hyung-hwan 2021-02-18 15:48:44 +00:00
parent 33db65a8b9
commit 378bae261a
4 changed files with 150 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

176
lib/comp.c
View File

@ -781,11 +781,13 @@ enum
{
COP_COMPILE_OBJECT,
COP_COMPILE_OBJECT_LIST,
COP_COMPILE_IF_OBJECT_LIST,
COP_COMPILE_ARGUMENT_LIST,
COP_COMPILE_OBJECT_LIST_TAIL,
COP_COMPILE_OBJECT_LIST,
COP_COMPILE_OBJECT_LIST_TAIL,
COP_COMPILE_IF_OBJECT_LIST,
COP_COMPILE_IF_OBJECT_LIST_TAIL,
COP_COMPILE_TRY_OBJECT_LIST,
COP_COMPILE_TRY_OBJECT_LIST_TAIL,
COP_COMPILE_ARRAY_LIST,
COP_COMPILE_BYTEARRAY_LIST,
@ -794,6 +796,7 @@ enum
COP_SUBCOMPILE_ELIF,
COP_SUBCOMPILE_ELSE,
COP_SUBCOMPILE_CATCH,
COP_SUBCOMPILE_AND_EXPR,
COP_SUBCOMPILE_OR_EXPR,
@ -1003,6 +1006,41 @@ static int compile_continue (hcl_t* hcl, hcl_cnode_t* src)
return -1;
}
static int compile_do (hcl_t* hcl, hcl_cnode_t* src)
{
hcl_cnode_t* cmd, * obj;
/* (do
* (+ 10 20)
* (* 2 30)
* ...
* )
* you can use this to combine multiple expressions to a single expression
*/
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_DO));
cmd = HCL_CNODE_CONS_CDR(src);
obj = HCL_CNODE_CONS_CDR(src);
if (!obj)
{
/* no value */
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(src), HCL_NULL, "no expression specified in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
return -1;
}
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 %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
return -1;
}
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj);
return 0;
}
static int compile_if (hcl_t* hcl, hcl_cnode_t* src)
{
hcl_cnode_t* cmd, * obj, * cond;
@ -1042,6 +1080,7 @@ static int compile_if (hcl_t* hcl, hcl_cnode_t* src)
PUSH_SUBCFRAME (hcl, COP_POST_IF_COND, obj); /* 2 */
cf = GET_SUBCFRAME(hcl);
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);
/* TODO: OPTIMIZATION:
* pass information on the conditional if it's an absoluate true or absolute false to
@ -1416,22 +1455,23 @@ static int compile_set (hcl_t* hcl, hcl_cnode_t* src)
return 0;
}
static int compile_do (hcl_t* hcl, hcl_cnode_t* src)
static int compile_try (hcl_t* hcl, hcl_cnode_t* src)
{
hcl_cnode_t* cmd, * obj;
/* (do
* (+ 10 20)
* (* 2 30)
* ...
* )
* you can use this to combine multiple expressions to a single expression
*/
hcl_cnode_t* cmd, * obj, * cond;
hcl_cframe_t* cf;
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_DO));
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_TRY));
/* (try
* (perform this)
* (perform that)
* catch (x)
* (perform xxx)
* (perform yyy)
* )
*/
cmd = HCL_CNODE_CONS_CDR(src);
obj = HCL_CNODE_CONS_CDR(src);
@ -1447,7 +1487,7 @@ static int compile_do (hcl_t* hcl, hcl_cnode_t* src)
return -1;
}
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj);
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_TRY_OBJECT_LIST, obj);
return 0;
}
@ -1496,6 +1536,7 @@ static int compile_while (hcl_t* hcl, hcl_cnode_t* src, int next_cop)
return 0;
}
/* ========================================================================= */
static int compile_cons_array_expression (hcl_t* hcl, hcl_cnode_t* obj)
@ -1610,6 +1651,10 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj)
if (compile_break(hcl, obj) <= -1) return -1;
break;
case HCL_SYNCODE_CATCH:
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ELIF, HCL_CNODE_GET_LOC(car), HCL_CNODE_GET_TOK(car), "catch without try");
return -1;
case HCL_SYNCODE_CONTINUE:
/* (continue)*/
if (compile_continue(hcl, obj) <= -1) return -1;
@ -1660,6 +1705,10 @@ static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj)
if (compile_return(hcl, obj, 1) <= -1) return -1;
break;
case HCL_SYNCODE_TRY:
if (compile_try(hcl, obj) <= -1) return -1;
break;
case HCL_SYNCODE_UNTIL:
if (compile_while(hcl, obj, COP_POST_UNTIL_COND) <= -1) return -1;
break;
@ -2142,11 +2191,13 @@ static int compile_object_list (hcl_t* hcl)
int cop;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_OBJECT_LIST ||
HCL_ASSERT (hcl, cf->opcode == COP_COMPILE_ARGUMENT_LIST ||
cf->opcode == COP_COMPILE_OBJECT_LIST ||
cf->opcode == COP_COMPILE_OBJECT_LIST_TAIL ||
cf->opcode == COP_COMPILE_IF_OBJECT_LIST ||
cf->opcode == COP_COMPILE_ARGUMENT_LIST ||
cf->opcode == COP_COMPILE_IF_OBJECT_LIST_TAIL ||
cf->opcode == COP_COMPILE_OBJECT_LIST_TAIL);
cf->opcode == COP_COMPILE_TRY_OBJECT_LIST ||
cf->opcode == COP_COMPILE_TRY_OBJECT_LIST_TAIL);
cop = cf->opcode;
oprnd = cf->operand;
@ -2205,6 +2256,14 @@ static int compile_object_list (hcl_t* hcl)
goto done;
}
}
else if (cop == COP_COMPILE_TRY_OBJECT_LIST || cop == COP_COMPILE_TRY_OBJECT_LIST_TAIL)
{
if (HCL_CNODE_IS_SYMBOL_SYNCODED(car, HCL_SYNCODE_CATCH))
{
SWITCH_TOP_CFRAME (hcl, COP_SUBCOMPILE_CATCH, oprnd);
goto done;
}
}
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, car);
@ -2224,12 +2283,14 @@ static int compile_object_list (hcl_t* hcl)
*/
int nextcop;
nextcop = (cop == COP_COMPILE_OBJECT_LIST)? COP_COMPILE_OBJECT_LIST_TAIL:
(cop == COP_COMPILE_IF_OBJECT_LIST)? COP_COMPILE_IF_OBJECT_LIST_TAIL: cop;
(cop == COP_COMPILE_IF_OBJECT_LIST)? COP_COMPILE_IF_OBJECT_LIST_TAIL:
(cop == COP_COMPILE_TRY_OBJECT_LIST)? COP_COMPILE_TRY_OBJECT_LIST_TAIL: cop;
PUSH_SUBCFRAME (hcl, nextcop, cdr);
}
if (cop == COP_COMPILE_OBJECT_LIST_TAIL ||
cop == COP_COMPILE_IF_OBJECT_LIST_TAIL)
cop == COP_COMPILE_IF_OBJECT_LIST_TAIL ||
cop == COP_COMPILE_TRY_OBJECT_LIST_TAIL)
{
/* emit POP_STACKTOP before evaluating the second objects
* and onwards. this goes above COP_COMPILE_OBJECT */
@ -2541,6 +2602,37 @@ static HCL_INLINE int subcompile_else (hcl_t* hcl)
cmd = HCL_CNODE_CONS_CAR(src);
obj = HCL_CNODE_CONS_CDR(src);
if (obj && !HCL_CNODE_IS_CONS(obj))
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(obj), HCL_CNODE_GET_TOK(obj), "redundant cdr in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
return -1;
}
else
{
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj);
}
return patch_nearest_post_if_body(hcl, cmd);
}
/* ========================================================================= */
static HCL_INLINE int subcompile_catch (hcl_t* hcl)
{
hcl_cnode_t* cmd, * obj, * src;
hcl_cframe_t* cf;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_SUBCOMPILE_CATCH);
src = cf->operand;
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_CATCH));
cmd = HCL_CNODE_CONS_CAR(src);
obj = HCL_CNODE_CONS_CDR(src);
if (!obj)
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGCOUNT, HCL_CNODE_GET_LOC(src), HCL_NULL, "no condition in %.*js", HCL_CNODE_GET_TOKLEN(cmd), HCL_CNODE_GET_TOKPTR(cmd));
@ -2553,8 +2645,8 @@ static HCL_INLINE int subcompile_else (hcl_t* hcl)
}
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, obj);
return patch_nearest_post_if_body(hcl, cmd);
/* TODO: do extra work */
return 0;
}
/* ========================================================================= */
@ -2684,30 +2776,36 @@ static HCL_INLINE int post_or_expr (hcl_t* hcl)
static HCL_INLINE int post_if_cond (hcl_t* hcl)
{
hcl_cframe_t* cf;
hcl_cframe_t* cf, * cf2;
hcl_ooi_t jump_inst_pos;
hcl_ooi_t body_pos;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_POST_IF_COND);
HCL_ASSERT (hcl, cf->operand != HCL_NULL);
/* cf->operand can be HCL_NULL in these expressions
* (if true)
* (if false)
* (if true 20 elif false)
*/
/*HCL_ASSERT (hcl, cf->operand != HCL_NULL);*/
HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
jump_inst_pos = hcl->code.bc.len;
if (emit_single_param_instruction(hcl, HCL_CODE_JUMP_FORWARD_IF_FALSE, MAX_CODE_JUMP, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1;
if (emit_single_param_instruction(hcl, HCL_CODE_JUMP_FORWARD_IF_FALSE, MAX_CODE_JUMP, &cf->u.post_if.start_loc) <= -1) return -1;
/* to drop the result of the conditional when it is true */
if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1;
if (emit_byte_instruction(hcl, HCL_CODE_POP_STACKTOP, &cf->u.post_if.start_loc) <= -1) return -1;
HCL_ASSERT (hcl, hcl->code.bc.len < HCL_SMOOI_MAX);
body_pos = hcl->code.bc.len;
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_IF_OBJECT_LIST, cf->operand); /* 1 */
PUSH_SUBCFRAME (hcl, COP_POST_IF_BODY, cf->operand); /* 2 */
cf = GET_SUBCFRAME(hcl);
cf->u.post_if.body_pos = body_pos;
cf->u.post_if.jump_inst_pos = jump_inst_pos;
cf2 = GET_SUBCFRAME(hcl);
cf2->u.post_if.body_pos = body_pos;
cf2->u.post_if.jump_inst_pos = jump_inst_pos;
cf2->u.post_if.start_loc = cf->u.post_if.start_loc;
return 0;
}
@ -2719,14 +2817,20 @@ static HCL_INLINE int post_if_body (hcl_t* hcl)
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_POST_IF_BODY);
HCL_ASSERT (hcl, cf->operand != HCL_NULL);
/* cf->operand can be HCL_NULL in these expressions
* (if true)
* (if false)
* (if true 20 elif false)
*/
/*HCL_ASSERT (hcl, cf->operand != HCL_NULL);*/
jip = cf->u.post_if.jump_inst_pos;
if (hcl->code.bc.len <= cf->u.post_if.body_pos)
{
/* if body is empty */
if (emit_byte_instruction(hcl, HCL_CODE_PUSH_NIL, HCL_CNODE_GET_LOC(cf->operand)) <= -1) return -1;
if (emit_byte_instruction(hcl, HCL_CODE_PUSH_NIL, &cf->u.post_if.start_loc) <= -1) return -1;
}
/* HCL_CODE_LONG_PARAM_SIZE + 1 => size of the long JUMP_FORWARD_IF_FALSE instruction */
@ -3247,11 +3351,13 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj)
if (compile_object(hcl) <= -1) goto oops;
break;
case COP_COMPILE_ARGUMENT_LIST:
case COP_COMPILE_OBJECT_LIST:
case COP_COMPILE_OBJECT_LIST_TAIL:
case COP_COMPILE_IF_OBJECT_LIST:
case COP_COMPILE_IF_OBJECT_LIST_TAIL:
case COP_COMPILE_ARGUMENT_LIST:
case COP_COMPILE_TRY_OBJECT_LIST:
case COP_COMPILE_TRY_OBJECT_LIST_TAIL:
if (compile_object_list(hcl) <= -1) goto oops;
break;
@ -3279,6 +3385,10 @@ int hcl_compile (hcl_t* hcl, hcl_cnode_t* obj)
if (subcompile_else(hcl) <= -1) goto oops;
break;
case COP_SUBCOMPILE_CATCH:
if (subcompile_catch(hcl) <= -1) goto oops;
break;
case COP_SUBCOMPILE_AND_EXPR:
if (subcompile_and_expr(hcl) <= -1) goto oops;
break;

2
lib/gc.c
View File

@ -41,6 +41,7 @@ static struct
{
{ 3, { 'a','n','d' }, HCL_SYNCODE_AND, HCL_OFFSETOF(hcl_t,_and) },
{ 5, { 'b','r','e','a','k' }, HCL_SYNCODE_BREAK, HCL_OFFSETOF(hcl_t,_break) },
{ 5, { 'c','a','t','c','h' }, HCL_SYNCODE_CATCH, HCL_OFFSETOF(hcl_t,_catch) },
{ 8, { 'c','o','n','t','i','n','u','e' }, HCL_SYNCODE_CONTINUE, HCL_OFFSETOF(hcl_t,_continue) },
{ 5, { 'd','e','f','u','n' }, HCL_SYNCODE_DEFUN, HCL_OFFSETOF(hcl_t,_defun) },
{ 2, { 'd','o' }, HCL_SYNCODE_DO, HCL_OFFSETOF(hcl_t,_do) },
@ -53,6 +54,7 @@ static struct
{ 16, { 'r','e','t','u','r','n','-','f','r','o','m','-','h','o','m','e'},
HCL_SYNCODE_RETURN_FROM_HOME, HCL_OFFSETOF(hcl_t,_return_from_home) },
{ 3, { 's','e','t' }, HCL_SYNCODE_SET, HCL_OFFSETOF(hcl_t,_set) },
{ 3, { 't','r','y' }, HCL_SYNCODE_TRY, HCL_OFFSETOF(hcl_t,_try) },
{ 5, { 'u','n','t','i','l' }, HCL_SYNCODE_UNTIL, HCL_OFFSETOF(hcl_t,_until) },
{ 5, { 'w','h','i','l','e' }, HCL_SYNCODE_WHILE, HCL_OFFSETOF(hcl_t,_while) }
};

4
lib/hcl.h
View File

@ -1401,6 +1401,7 @@ struct hcl_t
hcl_oop_t _and; /* symbol */
hcl_oop_t _break; /* symbol */
hcl_oop_t _catch; /* symbol */
hcl_oop_t _continue; /* symbol */
hcl_oop_t _defun; /* symbol */
hcl_oop_t _do; /* symbol */
@ -1412,6 +1413,7 @@ struct hcl_t
hcl_oop_t _return; /* symbol */
hcl_oop_t _return_from_home; /* symbol */
hcl_oop_t _set; /* symbol */
hcl_oop_t _try; /* symbol */
hcl_oop_t _until; /* symbol */
hcl_oop_t _while; /* symbol */
@ -1672,6 +1674,7 @@ enum hcl_syncode_t
/* these enumerators can be set in the SYNCODE flags for a symbol */
HCL_SYNCODE_AND = 1,
HCL_SYNCODE_BREAK,
HCL_SYNCODE_CATCH,
HCL_SYNCODE_CONTINUE,
HCL_SYNCODE_DEFUN,
HCL_SYNCODE_DO,
@ -1683,6 +1686,7 @@ enum hcl_syncode_t
HCL_SYNCODE_RETURN,
HCL_SYNCODE_RETURN_FROM_HOME,
HCL_SYNCODE_SET,
HCL_SYNCODE_TRY,
HCL_SYNCODE_UNTIL,
HCL_SYNCODE_WHILE
};

2
lib/std.c
View File

@ -2618,7 +2618,7 @@ static void* dl_getsym (hcl_t* hcl, void* handle, const hcl_ooch_t* name)
* EVENT CALLBACKS
* ----------------------------------------------------------------- */
#define ENABLE_LOG_INITIALLY
/*#define ENABLE_LOG_INITIALLY*/
static HCL_INLINE void reset_log_to_default (xtn_t* xtn)
{