diff --git a/lib/comp.c b/lib/comp.c index 30685ee..0021d75 100644 --- a/lib/comp.c +++ b/lib/comp.c @@ -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: diff --git a/lib/comp2.c b/lib/comp2.c index 86654f7..3f36bc4 100644 --- a/lib/comp2.c +++ b/lib/comp2.c @@ -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; diff --git a/lib/decode.c b/lib/decode.c index 5f9fcc1..8ed806e 100644 --- a/lib/decode.c +++ b/lib/decode.c @@ -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: diff --git a/lib/exec.c b/lib/exec.c index dc96fa9..f22c887 100644 --- a/lib/exec.c +++ b/lib/exec.c @@ -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; } diff --git a/lib/hcl-prv.h b/lib/hcl-prv.h index 290669b..c6accf2 100644 --- a/lib/hcl-prv.h +++ b/lib/hcl-prv.h @@ -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,