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

enhanced the new compiler to produce working bytecodes for the #() list

Browse Source
This commit is contained in:
hyung-hwan 2021-01-24 15:45:28 +00:00
parent f3315811ed
commit 41de130fe4
5 changed files with 333 additions and 130 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
lib/comp.c
View File

@ -312,6 +312,10 @@ static int emit_single_param_instruction (hcl_t* hcl, int cmd, hcl_oow_t param_1
case HCL_CODE_JUMP2_FORWARD_IF_TRUE:
case HCL_CODE_JUMP2_FORWARD_IF_FALSE:
case HCL_CODE_JUMP2_FORWARD:
case HCL_CODE_JUMP_BACKWARD_IF_TRUE:
case HCL_CODE_JUMP_BACKWARD_IF_FALSE:
case HCL_CODE_JUMP2_BACKWARD_IF_TRUE:
case HCL_CODE_JUMP2_BACKWARD_IF_FALSE:
case HCL_CODE_JUMP2_BACKWARD:
case HCL_CODE_PUSH_INTLIT:
case HCL_CODE_PUSH_NEGINTLIT:
@ -510,9 +514,11 @@ static HCL_INLINE void patch_long_jump (hcl_t* hcl, hcl_ooi_t jip, hcl_ooi_t jum
HCL_ASSERT (hcl, jump_offset <= MAX_CODE_JUMP * 2);
HCL_ASSERT (hcl, hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_FORWARD_X ||
hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_BACKWARD_X ||
hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_FORWARD_IF_TRUE ||
hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_FORWARD_IF_FALSE);
hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_FORWARD_IF_FALSE ||
hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_BACKWARD_X ||
hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_BACKWARD_IF_TRUE ||
hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_BACKWARD_IF_FALSE);
/* JUMP2 instructions are chosen to be greater than its JUMP counterpart by 1 */
patch_instruction (hcl, jip, hcl->code.bc.ptr[jip] + 1);
@ -688,11 +694,11 @@ enum
COP_EMIT_MAKE_ARRAY,
COP_EMIT_MAKE_BYTEARRAY,
COP_EMIT_MAKE_DIC,
COP_EMIT_MAKE_DLIST,
COP_EMIT_MAKE_CONS,
COP_EMIT_POP_INTO_ARRAY,
COP_EMIT_POP_INTO_BYTEARRAY,
COP_EMIT_POP_INTO_DIC,
COP_EMIT_POP_INTO_DLIST,
COP_EMIT_POP_INTO_CONS,
COP_EMIT_LAMBDA,
COP_EMIT_POP_STACKTOP,
@ -1442,7 +1448,7 @@ static int compile_cons_qlist_expression (hcl_t* hcl, hcl_oop_t obj)
/* NOTE: cframe management functions don't use the object memory.
* many operations can be performed without taking GC into account */
SWITCH_TOP_CFRAME (hcl, COP_EMIT_MAKE_DLIST, HCL_SMOOI_TO_OOP(0));
SWITCH_TOP_CFRAME (hcl, COP_EMIT_MAKE_CONS, HCL_SMOOI_TO_OOP(0));
nargs = hcl_countcons(hcl, obj);
if (nargs > MAX_CODE_PARAM)
@ -1459,7 +1465,7 @@ static int compile_cons_qlist_expression (hcl_t* hcl, hcl_oop_t obj)
/* patch the argument count in the operand field of the COP_EMIT_MAKE_ARRAY frame */
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_MAKE_DLIST);
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_MAKE_CONS);
cf->operand = HCL_SMOOI_TO_OOP(nargs);
return 0;
@ -2080,7 +2086,7 @@ static int compile_qlist (hcl_t* hcl)
/*cf->u.qlist_list.index = oldidx + 1;*/
}
PUSH_SUBCFRAME (hcl, COP_EMIT_POP_INTO_DLIST, HCL_SMOOI_TO_OOP(oldidx));
PUSH_SUBCFRAME (hcl, COP_EMIT_POP_INTO_CONS, HCL_SMOOI_TO_OOP(oldidx));
}
return 0;
@ -2577,16 +2583,16 @@ static HCL_INLINE int emit_make_dic (hcl_t* hcl)
return n;
}
static HCL_INLINE int emit_make_dlist (hcl_t* hcl)
static HCL_INLINE int emit_make_cons (hcl_t* hcl)
{
hcl_cframe_t* cf;
int n;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_MAKE_DLIST);
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_MAKE_CONS);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand));
n = emit_single_param_instruction (hcl, HCL_CODE_MAKE_DLIST, HCL_OOP_TO_SMOOI(cf->operand));
n = emit_single_param_instruction (hcl, HCL_CODE_MAKE_CONS, HCL_OOP_TO_SMOOI(cf->operand));
POP_CFRAME (hcl);
return n;
@ -2601,7 +2607,7 @@ static HCL_INLINE int emit_pop_into_array (hcl_t* hcl)
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_POP_INTO_ARRAY);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand));
n = emit_single_param_instruction (hcl, HCL_CODE_POP_INTO_ARRAY, HCL_OOP_TO_SMOOI(cf->operand));
n = emit_single_param_instruction(hcl, HCL_CODE_POP_INTO_ARRAY, HCL_OOP_TO_SMOOI(cf->operand));
POP_CFRAME (hcl);
return n;
@ -2616,7 +2622,7 @@ static HCL_INLINE int emit_pop_into_bytearray (hcl_t* hcl)
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_POP_INTO_BYTEARRAY);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand));
n = emit_single_param_instruction (hcl, HCL_CODE_POP_INTO_BYTEARRAY, HCL_OOP_TO_SMOOI(cf->operand));
n = emit_single_param_instruction(hcl, HCL_CODE_POP_INTO_BYTEARRAY, HCL_OOP_TO_SMOOI(cf->operand));
POP_CFRAME (hcl);
return n;
@ -2636,16 +2642,16 @@ static HCL_INLINE int emit_pop_into_dic (hcl_t* hcl)
return n;
}
static HCL_INLINE int emit_pop_into_dlist (hcl_t* hcl)
static HCL_INLINE int emit_pop_into_cons (hcl_t* hcl)
{
hcl_cframe_t* cf;
int n;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_POP_INTO_DLIST);
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_POP_INTO_CONS);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand));
n = emit_single_param_instruction (hcl, HCL_CODE_POP_INTO_DLIST, HCL_OOP_TO_SMOOI(cf->operand));
n = emit_single_param_instruction (hcl, HCL_CODE_POP_INTO_ARRAY, HCL_OOP_TO_SMOOI(cf->operand));
POP_CFRAME (hcl);
return n;
@ -2875,8 +2881,8 @@ int hcl_compile (hcl_t* hcl, hcl_oop_t obj)
if (emit_make_dic(hcl) <= -1) goto oops;
break;
case COP_EMIT_MAKE_DLIST:
if (emit_make_dlist(hcl) <= -1) goto oops;
case COP_EMIT_MAKE_CONS:
if (emit_make_cons(hcl) <= -1) goto oops;
break;
case COP_EMIT_POP_INTO_ARRAY:
@ -2887,8 +2893,8 @@ int hcl_compile (hcl_t* hcl, hcl_oop_t obj)
if (emit_pop_into_bytearray(hcl) <= -1) goto oops;
break;
case COP_EMIT_POP_INTO_DLIST:
if (emit_pop_into_dlist(hcl) <= -1) goto oops;
case COP_EMIT_POP_INTO_CONS:
if (emit_pop_into_cons(hcl) <= -1) goto oops;
break;
case COP_EMIT_POP_INTO_DIC:

145
lib/comp2.c
View File

@ -381,6 +381,10 @@ static int emit_single_param_instruction (hcl_t* hcl, int cmd, hcl_oow_t param_1
case HCL_CODE_JUMP2_FORWARD_IF_TRUE:
case HCL_CODE_JUMP2_FORWARD_IF_FALSE:
case HCL_CODE_JUMP2_FORWARD:
case HCL_CODE_JUMP_BACKWARD_IF_TRUE:
case HCL_CODE_JUMP_BACKWARD_IF_FALSE:
case HCL_CODE_JUMP2_BACKWARD_IF_TRUE:
case HCL_CODE_JUMP2_BACKWARD_IF_FALSE:
case HCL_CODE_JUMP2_BACKWARD:
case HCL_CODE_PUSH_INTLIT:
case HCL_CODE_PUSH_NEGINTLIT:
@ -579,9 +583,11 @@ static HCL_INLINE void patch_long_jump (hcl_t* hcl, hcl_ooi_t jip, hcl_ooi_t jum
HCL_ASSERT (hcl, jump_offset <= MAX_CODE_JUMP * 2);
HCL_ASSERT (hcl, hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_FORWARD_X ||
hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_BACKWARD_X ||
hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_FORWARD_IF_TRUE ||
hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_FORWARD_IF_FALSE);
hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_FORWARD_IF_FALSE ||
hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_BACKWARD_X ||
hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_BACKWARD_IF_TRUE ||
hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_BACKWARD_IF_FALSE);
/* JUMP2 instructions are chosen to be greater than its JUMP counterpart by 1 */
patch_instruction (hcl, jip, hcl->code.bc.ptr[jip] + 1);
@ -789,11 +795,13 @@ enum
COP_EMIT_MAKE_ARRAY,
COP_EMIT_MAKE_BYTEARRAY,
COP_EMIT_MAKE_DIC,
COP_EMIT_MAKE_DLIST,
COP_EMIT_MAKE_CONS,
COP_EMIT_POP_INTO_ARRAY,
COP_EMIT_POP_INTO_BYTEARRAY,
COP_EMIT_POP_INTO_DIC,
COP_EMIT_POP_INTO_DLIST,
COP_EMIT_POP_INTO_CONS,
COP_EMIT_POP_INTO_CONS_END,
COP_EMIT_POP_INTO_CONS_CDR,
COP_EMIT_LAMBDA,
COP_EMIT_POP_STACKTOP,
@ -1252,7 +1260,8 @@ static int compile_return (hcl_t* hcl, hcl_cnode_t* src, int mode)
hcl_cnode_t* obj, * val;
HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src));
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_RETURN) || HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_RETURN_FROM_HOME));
HCL_ASSERT (hcl, HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_RETURN) ||
HCL_CNODE_IS_SYMBOL_SYNCODED(HCL_CNODE_CONS_CAR(src), HCL_SYNCODE_RETURN_FROM_HOME));
obj = HCL_CNODE_CONS_CDR(src);
@ -1532,40 +1541,15 @@ static int compile_cons_dic_expression (hcl_t* hcl, hcl_cnode_t* obj)
return 0;
}
#if 0
static int compile_cons_qlist_expression (hcl_t* hcl, hcl_cnode_t* obj)
{
/* #( 1 2 3 )
* #(1 (+ 2 3) 5)
* #(1 (+ 2 3) 5) --> #(1 5 5)
* */
hcl_ooi_t nargs;
hcl_cframe2_t* cf;
/* NOTE: cframe management functions don't use the object memory.
* many operations can be performed without taking GC into account */
SWITCH_TOP_CFRAME (hcl, COP_EMIT_MAKE_DLIST, HCL_SMOOI_TO_OOP(0));
nargs = hcl_countcnodecons(hcl, obj);
if (nargs > MAX_CODE_PARAM)
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_ARGFLOOD, HCL_CNODE_GET_LOC(obj), HCL_NULL, "too many(%zd) elements", nargs);
return -1;
}
/* redundant cdr check is performed inside compile_object_list() */
SWITCH_TOP_CFRAME (hcl, COP_EMIT_MAKE_CONS, HCL_NULL);
PUSH_SUBCFRAME (hcl, COP_COMPILE_QLIST, obj);
cf = GET_SUBCFRAME(hcl);
/* cf->u.qlist.index = 0;*/
/* patch the argument count in the operand field of the COP_EMIT_MAKE_ARRAY frame */
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_MAKE_DLIST);
cf->operand = HCL_SMOOI_TO_OOP(nargs);
return 0;
}
#endif // QQQQQ
static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj)
{
@ -2037,9 +2021,9 @@ static int compile_object (hcl_t* hcl)
if (compile_cons_dic_expression(hcl, oprnd) <= -1) return -1;
break;
case HCL_CONCODE_QLIST:
#if 0
//if (compile_cons_qlist_expression(hcl, oprnd) <= -1) return -1;
// break;
#if 1
if (compile_cons_qlist_expression(hcl, oprnd) <= -1) return -1;
break;
#else
hcl_setsynerrbfmt (hcl, HCL_SYNERR_INTERN, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "internal error - qlist not implemented");
return -1;
@ -2372,30 +2356,29 @@ static int compile_qlist (hcl_t* hcl)
hcl_cnode_t* car, * cdr;
hcl_ooi_t oldidx;
// TODO: correct this function in pair with compile_cons_qlist_expression()
#if 0
//qlist allows non-nil cdr...
if (!HCL_CNODE_IS_CONS(oprnd))
{
hcl_setsynerrbfmt (hcl, HCL_SYNERR_DOTBANNED, HCL_CNODE_GET_LOC(oprnd), HCL_CNODE_GET_TOK(oprnd), "redundant cdr in the q-list");
return -1;
/* the last element after . */
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, oprnd);
PUSH_SUBCFRAME (hcl, COP_EMIT_POP_INTO_CONS_CDR, HCL_NULL);
}
#endif
car = HCL_CNODE_CONS_CAR(oprnd);
cdr = HCL_CNODE_CONS_CDR(oprnd);
/*oldidx = cf->u.qlist.index;*/
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, car);
if (!cdr)
else
{
PUSH_SUBCFRAME (hcl, COP_COMPILE_QLIST, cdr);
cf = GET_SUBCFRAME(hcl);
/*cf->u.qlist_list.index = oldidx + 1;*/
}
car = HCL_CNODE_CONS_CAR(oprnd);
cdr = HCL_CNODE_CONS_CDR(oprnd);
PUSH_SUBCFRAME (hcl, COP_EMIT_POP_INTO_DLIST, HCL_SMOOI_TO_OOP(oldidx));
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, car); /* 1 */
if (cdr)
{
PUSH_SUBCFRAME (hcl, COP_COMPILE_QLIST, cdr); /* 3 */
PUSH_SUBCFRAME (hcl, COP_EMIT_POP_INTO_CONS, HCL_NULL); /* 2 */
}
else
{
/* the last element */
PUSH_SUBCFRAME (hcl, COP_EMIT_POP_INTO_CONS_END, HCL_NULL); /* 2 */
}
}
}
return 0;
@ -2844,7 +2827,7 @@ static HCL_INLINE int emit_call (hcl_t* hcl)
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_CALL);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand));
n = emit_single_param_instruction (hcl, HCL_CODE_CALL_0, HCL_OOP_TO_SMOOI(cf->operand));
n = emit_single_param_instruction(hcl, HCL_CODE_CALL_0, HCL_OOP_TO_SMOOI(cf->operand));
POP_CFRAME (hcl);
return n;
@ -2859,7 +2842,7 @@ static HCL_INLINE int emit_make_array (hcl_t* hcl)
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_MAKE_ARRAY);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand));
n = emit_single_param_instruction (hcl, HCL_CODE_MAKE_ARRAY, HCL_OOP_TO_SMOOI(cf->operand));
n = emit_single_param_instruction(hcl, HCL_CODE_MAKE_ARRAY, HCL_OOP_TO_SMOOI(cf->operand));
POP_CFRAME (hcl);
return n;
@ -2874,7 +2857,7 @@ static HCL_INLINE int emit_make_bytearray (hcl_t* hcl)
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_MAKE_BYTEARRAY);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand));
n = emit_single_param_instruction (hcl, HCL_CODE_MAKE_BYTEARRAY, HCL_OOP_TO_SMOOI(cf->operand));
n = emit_single_param_instruction(hcl, HCL_CODE_MAKE_BYTEARRAY, HCL_OOP_TO_SMOOI(cf->operand));
POP_CFRAME (hcl);
return n;
@ -2889,22 +2872,22 @@ static HCL_INLINE int emit_make_dic (hcl_t* hcl)
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_MAKE_DIC);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand));
n = emit_single_param_instruction (hcl, HCL_CODE_MAKE_DIC, HCL_OOP_TO_SMOOI(cf->operand));
n = emit_single_param_instruction(hcl, HCL_CODE_MAKE_DIC, HCL_OOP_TO_SMOOI(cf->operand));
POP_CFRAME (hcl);
return n;
}
static HCL_INLINE int emit_make_dlist (hcl_t* hcl)
static HCL_INLINE int emit_make_cons (hcl_t* hcl)
{
hcl_cframe2_t* cf;
int n;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_MAKE_DLIST);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand));
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_MAKE_CONS);
HCL_ASSERT (hcl, cf->operand == HCL_NULL);
n = emit_single_param_instruction (hcl, HCL_CODE_MAKE_DLIST, HCL_OOP_TO_SMOOI(cf->operand));
n = emit_byte_instruction(hcl, HCL_CODE_MAKE_CONS, HCL_NULL);
POP_CFRAME (hcl);
return n;
@ -2919,7 +2902,7 @@ static HCL_INLINE int emit_pop_into_array (hcl_t* hcl)
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_POP_INTO_ARRAY);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand));
n = emit_single_param_instruction (hcl, HCL_CODE_POP_INTO_ARRAY, HCL_OOP_TO_SMOOI(cf->operand));
n = emit_single_param_instruction(hcl, HCL_CODE_POP_INTO_ARRAY, HCL_OOP_TO_SMOOI(cf->operand));
POP_CFRAME (hcl);
return n;
@ -2934,7 +2917,7 @@ static HCL_INLINE int emit_pop_into_bytearray (hcl_t* hcl)
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_POP_INTO_BYTEARRAY);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand));
n = emit_single_param_instruction (hcl, HCL_CODE_POP_INTO_BYTEARRAY, HCL_OOP_TO_SMOOI(cf->operand));
n = emit_single_param_instruction(hcl, HCL_CODE_POP_INTO_BYTEARRAY, HCL_OOP_TO_SMOOI(cf->operand));
POP_CFRAME (hcl);
return n;
@ -2948,22 +2931,24 @@ static HCL_INLINE int emit_pop_into_dic (hcl_t* hcl)
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_POP_INTO_DIC);
n = emit_byte_instruction (hcl, HCL_CODE_POP_INTO_DIC, HCL_NULL);
n = emit_byte_instruction(hcl, HCL_CODE_POP_INTO_DIC, HCL_NULL);
POP_CFRAME (hcl);
return n;
}
static HCL_INLINE int emit_pop_into_dlist (hcl_t* hcl)
static HCL_INLINE int emit_pop_into_cons (hcl_t* hcl, int cmd)
{
hcl_cframe2_t* cf;
int n;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_POP_INTO_DLIST);
HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand));
HCL_ASSERT (hcl, cf->opcode == COP_EMIT_POP_INTO_CONS ||
cf->opcode == COP_EMIT_POP_INTO_CONS_END ||
cf->opcode == COP_EMIT_POP_INTO_CONS_CDR);
HCL_ASSERT (hcl, cf->operand == HCL_NULL);
n = emit_single_param_instruction (hcl, HCL_CODE_POP_INTO_DLIST, HCL_OOP_TO_SMOOI(cf->operand));
n = emit_byte_instruction (hcl, cmd, HCL_NULL);
POP_CFRAME (hcl);
return n;
@ -3178,7 +3163,7 @@ int hcl_compile2 (hcl_t* hcl, hcl_cnode_t* obj)
break;
case COP_COMPILE_QLIST:
if (compile_qlist(hcl) <= -1) goto oops;
if (compile_qlist(hcl) <= -1) goto oops;
break;
case COP_EMIT_CALL:
@ -3197,8 +3182,8 @@ int hcl_compile2 (hcl_t* hcl, hcl_cnode_t* obj)
if (emit_make_dic(hcl) <= -1) goto oops;
break;
case COP_EMIT_MAKE_DLIST:
if (emit_make_dlist(hcl) <= -1) goto oops;
case COP_EMIT_MAKE_CONS:
if (emit_make_cons(hcl) <= -1) goto oops;
break;
case COP_EMIT_POP_INTO_ARRAY:
@ -3209,14 +3194,22 @@ int hcl_compile2 (hcl_t* hcl, hcl_cnode_t* obj)
if (emit_pop_into_bytearray(hcl) <= -1) goto oops;
break;
case COP_EMIT_POP_INTO_DLIST:
if (emit_pop_into_dlist(hcl) <= -1) goto oops;
break;
case COP_EMIT_POP_INTO_DIC:
if (emit_pop_into_dic(hcl) <= -1) goto oops;
break;
case COP_EMIT_POP_INTO_CONS:
if (emit_pop_into_cons(hcl, HCL_CODE_POP_INTO_CONS) <= -1) goto oops;
break;
case COP_EMIT_POP_INTO_CONS_END:
if (emit_pop_into_cons(hcl, HCL_CODE_POP_INTO_CONS_END) <= -1) goto oops;
break;
case COP_EMIT_POP_INTO_CONS_CDR:
if (emit_pop_into_cons(hcl, HCL_CODE_POP_INTO_CONS_CDR) <= -1) goto oops;
break;
case COP_EMIT_LAMBDA:
if (emit_lambda(hcl) <= -1) goto oops;
break;

37
lib/decode.c
View File

@ -309,6 +309,26 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
LOG_INST_1 (hcl, "jump2_forward %zu", b1);
break;
case HCL_CODE_JUMP_BACKWARD_IF_TRUE:
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "jump_backward_if_true %zu", b1);
break;
case HCL_CODE_JUMP2_BACKWARD_IF_TRUE:
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "jump2_backward_if_true %zu", b1);
break;
case HCL_CODE_JUMP_BACKWARD_IF_FALSE:
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "jump_backward_if_false %zu", b1);
break;
case HCL_CODE_JUMP2_BACKWARD_IF_FALSE:
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "jump2_backward_if_false %zu", b1);
break;
case HCL_CODE_JUMP2_BACKWARD:
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "jump2_backward %zu", b1);
@ -530,14 +550,21 @@ int hcl_decode (hcl_t* hcl, hcl_oow_t start, hcl_oow_t end)
LOG_INST_0 (hcl, "pop_into_dic");
break;
case HCL_CODE_MAKE_DLIST:
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "make_dlist %zu", b1);
case HCL_CODE_MAKE_CONS:
LOG_INST_0 (hcl, "make_cons");
break;
case HCL_CODE_POP_INTO_DLIST:
LOG_INST_0 (hcl, "pop_into_dlist");
case HCL_CODE_POP_INTO_CONS:
LOG_INST_0 (hcl, "pop_into_cons");
break;
case HCL_CODE_POP_INTO_CONS_END:
LOG_INST_0 (hcl, "pop_into_cons_end");
break;
case HCL_CODE_POP_INTO_CONS_CDR:
LOG_INST_0 (hcl, "pop_into_cons_cdr");
break;
/* -------------------------------------------------------- */
case HCL_CODE_DUP_STACKTOP:

178
lib/exec.c
View File

@ -2897,6 +2897,30 @@ static int execute (hcl_t* hcl)
hcl->ip += MAX_CODE_JUMP + b1;
break;
case HCL_CODE_JUMP_BACKWARD_IF_TRUE:
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "jump_backward_if_true %zu", b1);
if (HCL_STACK_GETTOP(hcl) != hcl->_false) hcl->ip -= b1;
break;
case HCL_CODE_JUMP2_BACKWARD_IF_TRUE:
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "jump2_backward_if_true %zu", b1);
if (HCL_STACK_GETTOP(hcl) != hcl->_false) hcl->ip -= MAX_CODE_JUMP + b1;
break;
case HCL_CODE_JUMP_BACKWARD_IF_FALSE:
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "jump_backward_if_false %zu", b1);
if (HCL_STACK_GETTOP(hcl) == hcl->_false) hcl->ip -= b1;
break;
case HCL_CODE_JUMP2_BACKWARD_IF_FALSE:
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "jump2_backward_if_false %zu", b1);
if (HCL_STACK_GETTOP(hcl) == hcl->_false) hcl->ip -= MAX_CODE_JUMP + b1;
break;
case HCL_CODE_JUMP2_BACKWARD:
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "jump2_backward %zu", b1);
@ -3207,6 +3231,12 @@ static int execute (hcl_t* hcl)
t1 = HCL_STACK_GETTOP(hcl); /* value to store */
HCL_STACK_POP (hcl);
t2 = HCL_STACK_GETTOP(hcl); /* array */
if (HCL_UNLIKELY(b1 >= HCL_OBJ_GET_SIZE(t2)))
{
hcl_seterrbfmt (hcl, HCL_ECALL, "index %zu out of upper bound %zd ", b1, (hcl_oow_t)HCL_OBJ_GET_SIZE(t2));
goto oops;
}
((hcl_oop_oop_t)t2)->slot[b1] = t1;
break;
}
@ -3273,29 +3303,155 @@ static int execute (hcl_t* hcl)
break;
}
case HCL_CODE_MAKE_DLIST:
case HCL_CODE_MAKE_CONS:
{
hcl_oop_t t;
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "make_dlist %zu", b1);
LOG_INST_0 (hcl, "make_cons");
/* create an empty array */
t = hcl_makedlist(hcl, b1, 0);
t = hcl_makecons(hcl, hcl->_nil, hcl->_nil);
if (HCL_UNLIKELY(!t)) goto oops;
HCL_STACK_PUSH (hcl, t); /* push the list created */
HCL_STACK_PUSH (hcl, t); /* push the head cons cell */
HCL_STACK_PUSH (hcl, hcl->_nil); /* sentinnel */
break;
}
case HCL_CODE_POP_INTO_DLIST:
case HCL_CODE_POP_INTO_CONS:
{
hcl_oop_t t1, t2;
LOG_INST_0 (hcl, "pop_into_dlist");
hcl_oop_t t1, t2, t3;
LOG_INST_0 (hcl, "pop_into_cons");
t1 = HCL_STACK_GETTOP(hcl); /* value to store */
HCL_STACK_POP (hcl);
t2 = HCL_STACK_GETTOP(hcl); /* dlist */
/* TODO: append t2 to the dlist */
t3 = HCL_STACK_GETTOP(hcl); /* sentinnel */
HCL_STACK_POP (hcl);
t2 = HCL_STACK_GETTOP(hcl); /* head cons */
if (HCL_UNLIKELY(!HCL_IS_CONS(hcl, t2)))
{
hcl_seterrbfmt (hcl, HCL_EINTERN, "internal error - invalid vm state detected in pop_into_cons");
goto oops;
}
if (t3 == hcl->_nil)
{
((hcl_oop_oop_t)t2)->slot[0] = t1;
HCL_STACK_PUSH (hcl, t2); /* push self again */
}
else
{
hcl_oop_t t;
hcl_pushvolat (hcl, &t3);
t = hcl_makecons(hcl, t1, hcl->_nil);
hcl_popvolat (hcl);
if (HCL_UNLIKELY(!t)) goto oops;
((hcl_oop_oop_t)t3)->slot[1] = t;
HCL_STACK_PUSH (hcl, t);
}
#if 0
if (b1 == 1 || b1 == 3)
{
if (t3 == hcl->_nil)
{
((hcl_oop_oop_t)t2)->slot[0] = t1;
if (b1 == 1) HCL_STACK_PUSH (hcl, t2); /* push self again */
}
else
{
hcl_oop_t t;
t = hcl_makecons(hcl, t1, hcl->_nil);
if (HCL_UNLIKELY(!t)) goto oops;
((hcl_oop_oop_t)t3)->slot[1] = t;
if (b1 == 1) HCL_STACK_PUSH (hcl, t);
}
}
else if (b1 == 2)
{
if (t3 == hcl->_nil)
{
((hcl_oop_oop_t)t2)->slot[1] = t1;
}
else
{
((hcl_oop_oop_t)t3)->slot[1] = t1;
}
}
#endif
break;
}
case HCL_CODE_POP_INTO_CONS_END:
{
hcl_oop_t t1, t2, t3;
LOG_INST_0 (hcl, "pop_into_cons_end");
t1 = HCL_STACK_GETTOP(hcl); /* value to store */
HCL_STACK_POP (hcl);
t3 = HCL_STACK_GETTOP(hcl); /* sentinnel */
HCL_STACK_POP (hcl);
t2 = HCL_STACK_GETTOP(hcl); /* head cons */
if (HCL_UNLIKELY(!HCL_IS_CONS(hcl, t2)))
{
hcl_seterrbfmt (hcl, HCL_EINTERN, "internal error - invalid vm state detected in pop_into_cons");
goto oops;
}
if (t3 == hcl->_nil)
{
((hcl_oop_oop_t)t2)->slot[0] = t1;
}
else
{
hcl_oop_t t;
hcl_pushvolat (hcl, &t3);
t = hcl_makecons(hcl, t1, hcl->_nil);
hcl_popvolat (hcl);
if (HCL_UNLIKELY(!t)) goto oops;
((hcl_oop_oop_t)t3)->slot[1] = t;
}
break;
}
case HCL_CODE_POP_INTO_CONS_CDR:
{
hcl_oop_t t1, t2, t3;
LOG_INST_0 (hcl, "pop_into_cons_end");
t1 = HCL_STACK_GETTOP(hcl); /* value to store */
HCL_STACK_POP (hcl);
t3 = HCL_STACK_GETTOP(hcl); /* sentinnel */
HCL_STACK_POP (hcl);
t2 = HCL_STACK_GETTOP(hcl); /* head cons */
if (HCL_UNLIKELY(!HCL_IS_CONS(hcl, t2)))
{
hcl_seterrbfmt (hcl, HCL_EINTERN, "internal error - invalid vm state detected in pop_into_cons");
goto oops;
}
if (t3 == hcl->_nil)
{
((hcl_oop_oop_t)t2)->slot[1] = t1;
}
else
{
((hcl_oop_oop_t)t3)->slot[1] = t1;
}
/* no push back of the sentinnel */
break;
}

59
lib/hcl-prv.h
View File

@ -528,8 +528,12 @@ SHORT INSTRUCTION CODE LONG INSTRUCTION C
201 1100 1001 XXXXXXXX JUMP2_BACKWARD
76-79 0100 11XX UNUSED 204 1100 1100 XXXXXXXX JUMP_FORWARD_IF_TRUE
205 1100 1101 XXXXXXXX JUMP2_FORWARD_IF_TRUE
206 1100 1110 XXXXXXXX JUMP_BACKWARD_IF_TRUE
207 1100 1111 XXXXXXXX JUMP2_BACKWARD_IF_TRUE
80-83 0101 00XX UNUSED 208 1101 0000 XXXXXXXX JUMP_FORWARD_IF_FALSE
209 1101 0001 XXXXXXXX JUMP2_FORWARD_IF_FALSE
210 1101 0010 XXXXXXXX JUMP_BACKWARD_IF_FALSE
211 1101 0011 XXXXXXXX JUMP2_BACKWARD_IF_FALSE
84-87 0101 01XX CALL 212 1101 0100 XXXXXXXX CALL_X
@ -657,17 +661,7 @@ enum hcl_bcode_t
HCL_CODE_JUMP_BACKWARD_2 = 0x4A, /* 74 */
HCL_CODE_JUMP_BACKWARD_3 = 0x4B, /* 75 */
#if 0
HCL_CODE_JUMP_BACKWARD_IF_FALSE_0 = 0x4C, /* 76 */
HCL_CODE_JUMP_BACKWARD_IF_FALSE_1 = 0x4D, /* 77 */
HCL_CODE_JUMP_BACKWARD_IF_FALSE_2 = 0x4E, /* 78 */
HCL_CODE_JUMP_BACKWARD_IF_FALSE_3 = 0x4F, /* 79 */
HCL_CODE_JUMP_BACKWARD_IF_TRUE_0 = 0x50, /* 80 */
HCL_CODE_JUMP_BACKWARD_IF_TRUE_1 = 0x51, /* 81 */
HCL_CODE_JUMP_BACKWARD_IF_TRUE_2 = 0x52, /* 82 */
HCL_CODE_JUMP_BACKWARD_IF_TRUE_3 = 0x53, /* 83 */
#endif
/* UNUSED 0x4C - 0x53 */
HCL_CODE_CALL_0 = 0x54, /* 84 */
HCL_CODE_CALL_1 = 0x55, /* 85 */
@ -746,46 +740,73 @@ enum hcl_bcode_t
HCL_CODE_PUSH_NEGINTLIT = 0xB3, /* 179 */
HCL_CODE_PUSH_CHARLIT = 0xB4, /* 180 */
/* UNUSED - 0xB5 - 0xB7 */
HCL_CODE_STORE_INTO_OBJECT_X = 0xB8, /* 184 ## */
HCL_CODE_POP_INTO_OBJECT_X = 0xBC, /* 188 ## */
HCL_CODE_PUSH_OBJECT_X = 0xC0, /* 192 ## */
/* UNUSED - 0xC1 - 0xC3 */
HCL_CODE_JUMP_FORWARD_X = 0xC4, /* 196 ## */
HCL_CODE_JUMP2_FORWARD = 0xC5, /* 197 */
/* UNUSED - 0xC6 - 0xC7 */
HCL_CODE_JUMP_BACKWARD_X = 0xC8, /* 200 ## */
HCL_CODE_JUMP2_BACKWARD = 0xC9, /* 201 */
/* UNUSED - 0xCA - 0xCB */
HCL_CODE_JUMP_FORWARD_IF_TRUE = 0xCC, /* 204 ## */
HCL_CODE_JUMP2_FORWARD_IF_TRUE = 0xCD, /* 205 */
HCL_CODE_JUMP_BACKWARD_IF_TRUE = 0xCE, /* 206 ## */
HCL_CODE_JUMP2_BACKWARD_IF_TRUE = 0xCF, /* 207 */
HCL_CODE_JUMP_FORWARD_IF_FALSE = 0xD0, /* 208 ## */
HCL_CODE_JUMP2_FORWARD_IF_FALSE = 0xD1, /* 209 */
HCL_CODE_JUMP_BACKWARD_IF_FALSE = 0xD2, /* 210 ## */
HCL_CODE_JUMP2_BACKWARD_IF_FALSE = 0xD3, /* 211 */
HCL_CODE_CALL_X = 0xD4, /* 212 */
/* UNUSED - 0xD5 - 0xD7 */
HCL_CODE_STORE_INTO_CTXTEMPVAR_X = 0xD8, /* 216 ## */
/* UNUSED - 0xD9 - 0xDB */
HCL_CODE_POP_INTO_CTXTEMPVAR_X = 0xDC, /* 220 ## */
/* UNUSED - 0xDD - 0xDF */
HCL_CODE_PUSH_CTXTEMPVAR_X = 0xE0, /* 224 ## */
/* UNUSED - 0xE1 - 0xE3 */
HCL_CODE_PUSH_OBJVAR_X = 0xE4, /* 228 ## */
/* UNUSED - 0xE5 - 0xE7 */
HCL_CODE_STORE_INTO_OBJVAR_X = 0xE8, /* 232 ## */
HCL_CODE_MAKE_ARRAY = 0xE9, /* 233 ## */
HCL_CODE_MAKE_BYTEARRAY = 0xEA, /* 234 ## */
HCL_CODE_MAKE_DIC = 0xEB, /* 235 ## */
HCL_CODE_POP_INTO_OBJVAR_X = 0xEC, /* 236 ## */
HCL_CODE_MAKE_BYTEARRAY = 0xED, /* 237 */
HCL_CODE_POP_INTO_BYTEARRAY = 0xEE, /* 238 */
HCL_CODE_MAKE_DIC = 0xEF, /* 239 */
HCL_CODE_POP_INTO_ARRAY = 0xED, /* 237 ## */
HCL_CODE_POP_INTO_BYTEARRAY = 0xEE, /* 238 ## */
HCL_CODE_POP_INTO_DIC = 0xEF, /* 239 */
HCL_CODE_SEND_MESSAGE_X = 0xF0, /* 240 ## */
HCL_CODE_POP_INTO_DIC = 0xF1, /* 241 */
HCL_CODE_MAKE_DLIST = 0xF2, /* 242 */
HCL_CODE_POP_INTO_DLIST = 0xF3, /* 243 */
HCL_CODE_MAKE_CONS = 0xF1, /* 241 */
HCL_CODE_POP_INTO_CONS = 0xF2, /* 242 */
HCL_CODE_POP_INTO_CONS_END = 0xF3, /* 243 */
HCL_CODE_SEND_MESSAGE_TO_SUPER_X = 0xF4, /* 244 ## */
HCL_CODE_POP_INTO_CONS_CDR = 0xF5, /* 245 */
/* -------------------------------------- */
HCL_CODE_MAKE_ARRAY = 0xF5, /* 245 */
HCL_CODE_POP_INTO_ARRAY = 0xF6, /* 246 */
/* UNUSED 0xF6 */
HCL_CODE_DUP_STACKTOP = 0xF7,
HCL_CODE_POP_STACKTOP = 0xF8,