enhanced the new compiler to produce working bytecodes for the #() list
This commit is contained in:
		| @ -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_TRUE: | ||||||
| 		case HCL_CODE_JUMP2_FORWARD_IF_FALSE: | 		case HCL_CODE_JUMP2_FORWARD_IF_FALSE: | ||||||
| 		case HCL_CODE_JUMP2_FORWARD: | 		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_JUMP2_BACKWARD: | ||||||
| 		case HCL_CODE_PUSH_INTLIT: | 		case HCL_CODE_PUSH_INTLIT: | ||||||
| 		case HCL_CODE_PUSH_NEGINTLIT: | 		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, jump_offset <= MAX_CODE_JUMP * 2); | ||||||
|  |  | ||||||
| 		HCL_ASSERT (hcl, hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_FORWARD_X || | 		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_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 */ | 		/* JUMP2 instructions are chosen to be greater than its JUMP counterpart by 1 */ | ||||||
| 		patch_instruction (hcl, jip, hcl->code.bc.ptr[jip] + 1);  | 		patch_instruction (hcl, jip, hcl->code.bc.ptr[jip] + 1);  | ||||||
| @ -688,11 +694,11 @@ enum | |||||||
| 	COP_EMIT_MAKE_ARRAY, | 	COP_EMIT_MAKE_ARRAY, | ||||||
| 	COP_EMIT_MAKE_BYTEARRAY, | 	COP_EMIT_MAKE_BYTEARRAY, | ||||||
| 	COP_EMIT_MAKE_DIC, | 	COP_EMIT_MAKE_DIC, | ||||||
| 	COP_EMIT_MAKE_DLIST, | 	COP_EMIT_MAKE_CONS, | ||||||
| 	COP_EMIT_POP_INTO_ARRAY, | 	COP_EMIT_POP_INTO_ARRAY, | ||||||
| 	COP_EMIT_POP_INTO_BYTEARRAY, | 	COP_EMIT_POP_INTO_BYTEARRAY, | ||||||
| 	COP_EMIT_POP_INTO_DIC, | 	COP_EMIT_POP_INTO_DIC, | ||||||
| 	COP_EMIT_POP_INTO_DLIST, | 	COP_EMIT_POP_INTO_CONS, | ||||||
|  |  | ||||||
| 	COP_EMIT_LAMBDA, | 	COP_EMIT_LAMBDA, | ||||||
| 	COP_EMIT_POP_STACKTOP, | 	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. | 	/* NOTE: cframe management functions don't use the object memory. | ||||||
| 	 *       many operations can be performed without taking GC into account */ | 	 *       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); | 	nargs = hcl_countcons(hcl, obj); | ||||||
| 	if (nargs > MAX_CODE_PARAM)  | 	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 */ | 	/* patch the argument count in the operand field of the COP_EMIT_MAKE_ARRAY frame */ | ||||||
| 	cf = GET_TOP_CFRAME(hcl); | 	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); | 	cf->operand = HCL_SMOOI_TO_OOP(nargs); | ||||||
|  |  | ||||||
| 	return 0; | 	return 0; | ||||||
| @ -2080,7 +2086,7 @@ static int compile_qlist (hcl_t* hcl) | |||||||
| 			/*cf->u.qlist_list.index = oldidx + 1;*/ | 			/*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; | 	return 0; | ||||||
| @ -2577,16 +2583,16 @@ static HCL_INLINE int emit_make_dic (hcl_t* hcl) | |||||||
| 	return n; | 	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; | 	hcl_cframe_t* cf; | ||||||
| 	int n; | 	int n; | ||||||
|  |  | ||||||
| 	cf = GET_TOP_CFRAME(hcl); | 	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)); | 	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); | 	POP_CFRAME (hcl); | ||||||
| 	return n; | 	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, cf->opcode == COP_EMIT_POP_INTO_ARRAY); | ||||||
| 	HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand)); | 	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); | 	POP_CFRAME (hcl); | ||||||
| 	return n; | 	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, cf->opcode == COP_EMIT_POP_INTO_BYTEARRAY); | ||||||
| 	HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand)); | 	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); | 	POP_CFRAME (hcl); | ||||||
| 	return n; | 	return n; | ||||||
| @ -2636,16 +2642,16 @@ static HCL_INLINE int emit_pop_into_dic (hcl_t* hcl) | |||||||
| 	return n; | 	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; | 	hcl_cframe_t* cf; | ||||||
| 	int n; | 	int n; | ||||||
|  |  | ||||||
| 	cf = GET_TOP_CFRAME(hcl); | 	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)); | 	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); | 	POP_CFRAME (hcl); | ||||||
| 	return n; | 	return n; | ||||||
| @ -2875,8 +2881,8 @@ int hcl_compile (hcl_t* hcl, hcl_oop_t obj) | |||||||
| 				if (emit_make_dic(hcl) <= -1) goto oops; | 				if (emit_make_dic(hcl) <= -1) goto oops; | ||||||
| 				break; | 				break; | ||||||
|  |  | ||||||
| 			case COP_EMIT_MAKE_DLIST: | 			case COP_EMIT_MAKE_CONS: | ||||||
| 				if (emit_make_dlist(hcl) <= -1) goto oops; | 				if (emit_make_cons(hcl) <= -1) goto oops; | ||||||
| 				break; | 				break; | ||||||
|  |  | ||||||
| 			case COP_EMIT_POP_INTO_ARRAY: | 			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; | 				if (emit_pop_into_bytearray(hcl) <= -1) goto oops; | ||||||
| 				break; | 				break; | ||||||
|  |  | ||||||
| 			case COP_EMIT_POP_INTO_DLIST: | 			case COP_EMIT_POP_INTO_CONS: | ||||||
| 				if (emit_pop_into_dlist(hcl) <= -1) goto oops; | 				if (emit_pop_into_cons(hcl) <= -1) goto oops; | ||||||
| 				break; | 				break; | ||||||
|  |  | ||||||
| 			case COP_EMIT_POP_INTO_DIC: | 			case COP_EMIT_POP_INTO_DIC: | ||||||
|  | |||||||
							
								
								
									
										145
									
								
								hcl/lib/comp2.c
									
									
									
									
									
								
							
							
						
						
									
										145
									
								
								hcl/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_TRUE: | ||||||
| 		case HCL_CODE_JUMP2_FORWARD_IF_FALSE: | 		case HCL_CODE_JUMP2_FORWARD_IF_FALSE: | ||||||
| 		case HCL_CODE_JUMP2_FORWARD: | 		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_JUMP2_BACKWARD: | ||||||
| 		case HCL_CODE_PUSH_INTLIT: | 		case HCL_CODE_PUSH_INTLIT: | ||||||
| 		case HCL_CODE_PUSH_NEGINTLIT: | 		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, jump_offset <= MAX_CODE_JUMP * 2); | ||||||
|  |  | ||||||
| 		HCL_ASSERT (hcl, hcl->code.bc.ptr[jip] == HCL_CODE_JUMP_FORWARD_X || | 		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_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 */ | 		/* JUMP2 instructions are chosen to be greater than its JUMP counterpart by 1 */ | ||||||
| 		patch_instruction (hcl, jip, hcl->code.bc.ptr[jip] + 1);  | 		patch_instruction (hcl, jip, hcl->code.bc.ptr[jip] + 1);  | ||||||
| @ -789,11 +795,13 @@ enum | |||||||
| 	COP_EMIT_MAKE_ARRAY, | 	COP_EMIT_MAKE_ARRAY, | ||||||
| 	COP_EMIT_MAKE_BYTEARRAY, | 	COP_EMIT_MAKE_BYTEARRAY, | ||||||
| 	COP_EMIT_MAKE_DIC, | 	COP_EMIT_MAKE_DIC, | ||||||
| 	COP_EMIT_MAKE_DLIST, | 	COP_EMIT_MAKE_CONS, | ||||||
| 	COP_EMIT_POP_INTO_ARRAY, | 	COP_EMIT_POP_INTO_ARRAY, | ||||||
| 	COP_EMIT_POP_INTO_BYTEARRAY, | 	COP_EMIT_POP_INTO_BYTEARRAY, | ||||||
| 	COP_EMIT_POP_INTO_DIC, | 	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_LAMBDA, | ||||||
| 	COP_EMIT_POP_STACKTOP, | 	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_cnode_t* obj, * val; | ||||||
|  |  | ||||||
| 	HCL_ASSERT (hcl, HCL_CNODE_IS_CONS(src)); | 	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); | 	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; | 	return 0; | ||||||
| } | } | ||||||
|  |  | ||||||
| #if 0 |  | ||||||
| static int compile_cons_qlist_expression (hcl_t* hcl, hcl_cnode_t* obj) | static int compile_cons_qlist_expression (hcl_t* hcl, hcl_cnode_t* obj) | ||||||
| { | { | ||||||
| 	/* #( 1 2  3 )  | 	/* #( 1 2  3 )  | ||||||
| 	 * #(1 (+ 2 3) 5) | 	 * #(1 (+ 2 3) 5) --> #(1 5 5) | ||||||
| 	 * */ | 	 * */ | ||||||
| 		 | 	SWITCH_TOP_CFRAME (hcl, COP_EMIT_MAKE_CONS, HCL_NULL); | ||||||
| 	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() */ |  | ||||||
| 	PUSH_SUBCFRAME (hcl, COP_COMPILE_QLIST, obj); | 	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; | 	return 0; | ||||||
| } | } | ||||||
| #endif // QQQQQ |  | ||||||
|  |  | ||||||
| static int compile_cons_xlist_expression (hcl_t* hcl, hcl_cnode_t* obj) | 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; | 					if (compile_cons_dic_expression(hcl, oprnd) <= -1) return -1; | ||||||
| 					break; | 					break; | ||||||
| 				case HCL_CONCODE_QLIST: | 				case HCL_CONCODE_QLIST: | ||||||
| 				#if 0 | 				#if 1 | ||||||
| 					//if (compile_cons_qlist_expression(hcl, oprnd) <= -1) return -1; | 					if (compile_cons_qlist_expression(hcl, oprnd) <= -1) return -1; | ||||||
| 					// break; | 					break; | ||||||
| 				#else | 				#else | ||||||
| 					hcl_setsynerrbfmt (hcl, HCL_SYNERR_INTERN, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "internal error - qlist not implemented"); | 					hcl_setsynerrbfmt (hcl, HCL_SYNERR_INTERN, HCL_CNODE_GET_LOC(oprnd), HCL_NULL, "internal error - qlist not implemented"); | ||||||
| 					return -1; | 					return -1; | ||||||
| @ -2372,30 +2356,29 @@ static int compile_qlist (hcl_t* hcl) | |||||||
| 		hcl_cnode_t* car, * cdr; | 		hcl_cnode_t* car, * cdr; | ||||||
| 		hcl_ooi_t oldidx; | 		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)) | 		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"); | 			/* the last element after . */ | ||||||
| 			return -1; | 			SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, oprnd); | ||||||
|  | 			PUSH_SUBCFRAME (hcl, COP_EMIT_POP_INTO_CONS_CDR, HCL_NULL); | ||||||
| 		} | 		} | ||||||
| #endif | 		else | ||||||
|  |  | ||||||
| 		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) |  | ||||||
| 		{ | 		{ | ||||||
| 			PUSH_SUBCFRAME (hcl, COP_COMPILE_QLIST, cdr); | 			car = HCL_CNODE_CONS_CAR(oprnd); | ||||||
| 			cf = GET_SUBCFRAME(hcl); | 			cdr = HCL_CNODE_CONS_CDR(oprnd); | ||||||
| 			/*cf->u.qlist_list.index = oldidx + 1;*/ |  | ||||||
| 		} |  | ||||||
|  |  | ||||||
| 		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; | 	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, cf->opcode == COP_EMIT_CALL); | ||||||
| 	HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand)); | 	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); | 	POP_CFRAME (hcl); | ||||||
| 	return n; | 	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, cf->opcode == COP_EMIT_MAKE_ARRAY); | ||||||
| 	HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand)); | 	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); | 	POP_CFRAME (hcl); | ||||||
| 	return n; | 	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, cf->opcode == COP_EMIT_MAKE_BYTEARRAY); | ||||||
| 	HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand)); | 	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); | 	POP_CFRAME (hcl); | ||||||
| 	return n; | 	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, cf->opcode == COP_EMIT_MAKE_DIC); | ||||||
| 	HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand)); | 	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); | 	POP_CFRAME (hcl); | ||||||
| 	return n; | 	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; | 	hcl_cframe2_t* cf; | ||||||
| 	int n; | 	int n; | ||||||
|  |  | ||||||
| 	cf = GET_TOP_CFRAME(hcl); | 	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)); | 	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); | 	POP_CFRAME (hcl); | ||||||
| 	return n; | 	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, cf->opcode == COP_EMIT_POP_INTO_ARRAY); | ||||||
| 	HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand)); | 	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); | 	POP_CFRAME (hcl); | ||||||
| 	return n; | 	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, cf->opcode == COP_EMIT_POP_INTO_BYTEARRAY); | ||||||
| 	HCL_ASSERT (hcl, HCL_OOP_IS_SMOOI(cf->operand)); | 	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); | 	POP_CFRAME (hcl); | ||||||
| 	return n; | 	return n; | ||||||
| @ -2948,22 +2931,24 @@ static HCL_INLINE int emit_pop_into_dic (hcl_t* hcl) | |||||||
| 	cf = GET_TOP_CFRAME(hcl); | 	cf = GET_TOP_CFRAME(hcl); | ||||||
| 	HCL_ASSERT (hcl, cf->opcode == COP_EMIT_POP_INTO_DIC); | 	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); | 	POP_CFRAME (hcl); | ||||||
| 	return n; | 	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; | 	hcl_cframe2_t* cf; | ||||||
| 	int n; | 	int n; | ||||||
|  |  | ||||||
| 	cf = GET_TOP_CFRAME(hcl); | 	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)); | 	                 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); | 	POP_CFRAME (hcl); | ||||||
| 	return n; | 	return n; | ||||||
| @ -3178,7 +3163,7 @@ int hcl_compile2 (hcl_t* hcl, hcl_cnode_t* obj) | |||||||
| 				break; | 				break; | ||||||
|  |  | ||||||
| 			case COP_COMPILE_QLIST: | 			case COP_COMPILE_QLIST: | ||||||
| 				if (compile_qlist(hcl)  <= -1) goto oops; | 				if (compile_qlist(hcl) <= -1) goto oops; | ||||||
| 				break; | 				break; | ||||||
|  |  | ||||||
| 			case COP_EMIT_CALL: | 			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; | 				if (emit_make_dic(hcl) <= -1) goto oops; | ||||||
| 				break; | 				break; | ||||||
|  |  | ||||||
| 			case COP_EMIT_MAKE_DLIST: | 			case COP_EMIT_MAKE_CONS: | ||||||
| 				if (emit_make_dlist(hcl) <= -1) goto oops; | 				if (emit_make_cons(hcl) <= -1) goto oops; | ||||||
| 				break; | 				break; | ||||||
|  |  | ||||||
| 			case COP_EMIT_POP_INTO_ARRAY: | 			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; | 				if (emit_pop_into_bytearray(hcl) <= -1) goto oops; | ||||||
| 				break; | 				break; | ||||||
|  |  | ||||||
| 			case COP_EMIT_POP_INTO_DLIST: |  | ||||||
| 				if (emit_pop_into_dlist(hcl) <= -1) goto oops; |  | ||||||
| 				break; |  | ||||||
|  |  | ||||||
| 			case COP_EMIT_POP_INTO_DIC: | 			case COP_EMIT_POP_INTO_DIC: | ||||||
| 				if (emit_pop_into_dic(hcl) <= -1) goto oops; | 				if (emit_pop_into_dic(hcl) <= -1) goto oops; | ||||||
| 				break; | 				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: | 			case COP_EMIT_LAMBDA: | ||||||
| 				if (emit_lambda(hcl) <= -1) goto oops; | 				if (emit_lambda(hcl) <= -1) goto oops; | ||||||
| 				break; | 				break; | ||||||
|  | |||||||
| @ -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); | 				LOG_INST_1 (hcl, "jump2_forward %zu", b1); | ||||||
| 				break; | 				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: | 			case HCL_CODE_JUMP2_BACKWARD: | ||||||
| 				FETCH_PARAM_CODE_TO (hcl, b1); | 				FETCH_PARAM_CODE_TO (hcl, b1); | ||||||
| 				LOG_INST_1 (hcl, "jump2_backward %zu", 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"); | 				LOG_INST_0 (hcl, "pop_into_dic"); | ||||||
| 				break; | 				break; | ||||||
|  |  | ||||||
| 			case HCL_CODE_MAKE_DLIST: | 			case HCL_CODE_MAKE_CONS: | ||||||
| 				FETCH_PARAM_CODE_TO (hcl, b1); | 				LOG_INST_0 (hcl, "make_cons"); | ||||||
| 				LOG_INST_1 (hcl, "make_dlist %zu", b1); |  | ||||||
| 				break; | 				break; | ||||||
|  |  | ||||||
| 			case HCL_CODE_POP_INTO_DLIST: | 			case HCL_CODE_POP_INTO_CONS: | ||||||
| 				LOG_INST_0 (hcl, "pop_into_dlist"); | 				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: | 			case HCL_CODE_DUP_STACKTOP: | ||||||
|  | |||||||
							
								
								
									
										178
									
								
								hcl/lib/exec.c
									
									
									
									
									
								
							
							
						
						
									
										178
									
								
								hcl/lib/exec.c
									
									
									
									
									
								
							| @ -2897,6 +2897,30 @@ static int execute (hcl_t* hcl) | |||||||
| 				hcl->ip += MAX_CODE_JUMP + b1; | 				hcl->ip += MAX_CODE_JUMP + b1; | ||||||
| 				break; | 				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: | 			case HCL_CODE_JUMP2_BACKWARD: | ||||||
| 				FETCH_PARAM_CODE_TO (hcl, b1); | 				FETCH_PARAM_CODE_TO (hcl, b1); | ||||||
| 				LOG_INST_1 (hcl, "jump2_backward %zu", 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 */ | 				t1 = HCL_STACK_GETTOP(hcl); /* value to store */ | ||||||
| 				HCL_STACK_POP (hcl); | 				HCL_STACK_POP (hcl); | ||||||
| 				t2 = HCL_STACK_GETTOP(hcl); /* array */ | 				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; | 				((hcl_oop_oop_t)t2)->slot[b1] = t1; | ||||||
| 				break; | 				break; | ||||||
| 			} | 			} | ||||||
| @ -3273,29 +3303,155 @@ static int execute (hcl_t* hcl) | |||||||
| 				break; | 				break; | ||||||
| 			} | 			} | ||||||
|  |  | ||||||
| 			case HCL_CODE_MAKE_DLIST: | 			case HCL_CODE_MAKE_CONS: | ||||||
| 			{ | 			{ | ||||||
| 				hcl_oop_t t; | 				hcl_oop_t t; | ||||||
|  |  | ||||||
| 				FETCH_PARAM_CODE_TO (hcl, b1); | 				LOG_INST_0 (hcl, "make_cons"); | ||||||
| 				LOG_INST_1 (hcl, "make_dlist %zu", b1); |  | ||||||
|  |  | ||||||
| 				/* create an empty array */ | 				t = hcl_makecons(hcl, hcl->_nil, hcl->_nil); | ||||||
| 				t = hcl_makedlist(hcl, b1, 0); |  | ||||||
| 				if (HCL_UNLIKELY(!t)) goto oops; | 				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; | 				break; | ||||||
| 			} | 			} | ||||||
|  |  | ||||||
| 			case HCL_CODE_POP_INTO_DLIST: | 			case HCL_CODE_POP_INTO_CONS: | ||||||
| 			{ | 			{ | ||||||
| 				hcl_oop_t t1, t2; | 				hcl_oop_t t1, t2, t3; | ||||||
| 				LOG_INST_0 (hcl, "pop_into_dlist"); | 				LOG_INST_0 (hcl, "pop_into_cons"); | ||||||
|  |  | ||||||
| 				t1 = HCL_STACK_GETTOP(hcl); /* value to store */ | 				t1 = HCL_STACK_GETTOP(hcl); /* value to store */ | ||||||
| 				HCL_STACK_POP (hcl); | 				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; | 				break; | ||||||
| 			} | 			} | ||||||
|  |  | ||||||
|  | |||||||
| @ -528,8 +528,12 @@ SHORT INSTRUCTION CODE                                        LONG INSTRUCTION C | |||||||
|                                                               201  1100 1001 XXXXXXXX JUMP2_BACKWARD |                                                               201  1100 1001 XXXXXXXX JUMP2_BACKWARD | ||||||
| 76-79    0100 11XX UNUSED                                     204  1100 1100 XXXXXXXX JUMP_FORWARD_IF_TRUE | 76-79    0100 11XX UNUSED                                     204  1100 1100 XXXXXXXX JUMP_FORWARD_IF_TRUE | ||||||
|                                                               205  1100 1101 XXXXXXXX JUMP2_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 | 80-83    0101 00XX UNUSED                                     208  1101 0000 XXXXXXXX JUMP_FORWARD_IF_FALSE | ||||||
|                                                               209  1101 0001 XXXXXXXX JUMP2_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 | 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_2          = 0x4A, /* 74 */ | ||||||
| 	HCL_CODE_JUMP_BACKWARD_3          = 0x4B, /* 75 */ | 	HCL_CODE_JUMP_BACKWARD_3          = 0x4B, /* 75 */ | ||||||
|  |  | ||||||
| #if 0 | 	/* UNUSED 0x4C - 0x53 */ | ||||||
| 	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 |  | ||||||
|  |  | ||||||
| 	HCL_CODE_CALL_0                   = 0x54, /* 84 */ | 	HCL_CODE_CALL_0                   = 0x54, /* 84 */ | ||||||
| 	HCL_CODE_CALL_1                   = 0x55, /* 85 */ | 	HCL_CODE_CALL_1                   = 0x55, /* 85 */ | ||||||
| @ -746,46 +740,73 @@ enum hcl_bcode_t | |||||||
| 	HCL_CODE_PUSH_NEGINTLIT           = 0xB3, /* 179 */ | 	HCL_CODE_PUSH_NEGINTLIT           = 0xB3, /* 179 */ | ||||||
| 	HCL_CODE_PUSH_CHARLIT             = 0xB4, /* 180 */ | 	HCL_CODE_PUSH_CHARLIT             = 0xB4, /* 180 */ | ||||||
|  |  | ||||||
|  | 	/* UNUSED - 0xB5 - 0xB7 */ | ||||||
|  |  | ||||||
| 	HCL_CODE_STORE_INTO_OBJECT_X      = 0xB8, /* 184 ## */ | 	HCL_CODE_STORE_INTO_OBJECT_X      = 0xB8, /* 184 ## */ | ||||||
| 	HCL_CODE_POP_INTO_OBJECT_X        = 0xBC, /* 188 ## */ | 	HCL_CODE_POP_INTO_OBJECT_X        = 0xBC, /* 188 ## */ | ||||||
| 	HCL_CODE_PUSH_OBJECT_X            = 0xC0, /* 192 ## */ | 	HCL_CODE_PUSH_OBJECT_X            = 0xC0, /* 192 ## */ | ||||||
|  |  | ||||||
|  | 	/* UNUSED - 0xC1 - 0xC3 */ | ||||||
|  |  | ||||||
| 	HCL_CODE_JUMP_FORWARD_X           = 0xC4, /* 196 ## */ | 	HCL_CODE_JUMP_FORWARD_X           = 0xC4, /* 196 ## */ | ||||||
| 	HCL_CODE_JUMP2_FORWARD            = 0xC5, /* 197 */ | 	HCL_CODE_JUMP2_FORWARD            = 0xC5, /* 197 */ | ||||||
|  |  | ||||||
|  | 	/* UNUSED - 0xC6 - 0xC7 */ | ||||||
|  |  | ||||||
| 	HCL_CODE_JUMP_BACKWARD_X          = 0xC8, /* 200 ## */ | 	HCL_CODE_JUMP_BACKWARD_X          = 0xC8, /* 200 ## */ | ||||||
| 	HCL_CODE_JUMP2_BACKWARD           = 0xC9, /* 201 */ | 	HCL_CODE_JUMP2_BACKWARD           = 0xC9, /* 201 */ | ||||||
|  |  | ||||||
|  | 	/* UNUSED - 0xCA - 0xCB */ | ||||||
|  |  | ||||||
| 	HCL_CODE_JUMP_FORWARD_IF_TRUE     = 0xCC, /* 204 ## */ | 	HCL_CODE_JUMP_FORWARD_IF_TRUE     = 0xCC, /* 204 ## */ | ||||||
| 	HCL_CODE_JUMP2_FORWARD_IF_TRUE    = 0xCD, /* 205 */ | 	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_JUMP_FORWARD_IF_FALSE    = 0xD0, /* 208 ## */ | ||||||
| 	HCL_CODE_JUMP2_FORWARD_IF_FALSE   = 0xD1, /* 209 */ | 	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 */ | 	HCL_CODE_CALL_X                   = 0xD4, /* 212 */ | ||||||
|  | 	/* UNUSED - 0xD5 - 0xD7 */ | ||||||
|  |  | ||||||
| 	HCL_CODE_STORE_INTO_CTXTEMPVAR_X  = 0xD8, /* 216 ## */ | 	HCL_CODE_STORE_INTO_CTXTEMPVAR_X  = 0xD8, /* 216 ## */ | ||||||
|  | 	/* UNUSED - 0xD9 - 0xDB */ | ||||||
|  |  | ||||||
| 	HCL_CODE_POP_INTO_CTXTEMPVAR_X    = 0xDC, /* 220 ## */ | 	HCL_CODE_POP_INTO_CTXTEMPVAR_X    = 0xDC, /* 220 ## */ | ||||||
|  | 	/* UNUSED - 0xDD - 0xDF */ | ||||||
|  |  | ||||||
| 	HCL_CODE_PUSH_CTXTEMPVAR_X        = 0xE0, /* 224 ## */ | 	HCL_CODE_PUSH_CTXTEMPVAR_X        = 0xE0, /* 224 ## */ | ||||||
|  | 	/* UNUSED - 0xE1 - 0xE3 */ | ||||||
|  |  | ||||||
| 	HCL_CODE_PUSH_OBJVAR_X            = 0xE4, /* 228 ## */ | 	HCL_CODE_PUSH_OBJVAR_X            = 0xE4, /* 228 ## */ | ||||||
|  | 	/* UNUSED - 0xE5 - 0xE7 */ | ||||||
|  |  | ||||||
| 	HCL_CODE_STORE_INTO_OBJVAR_X      = 0xE8, /* 232 ## */ | 	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_POP_INTO_OBJVAR_X        = 0xEC, /* 236 ## */ | ||||||
|  |  | ||||||
| 	HCL_CODE_MAKE_BYTEARRAY           = 0xED, /* 237 */ | 	HCL_CODE_POP_INTO_ARRAY           = 0xED, /* 237 ## */ | ||||||
| 	HCL_CODE_POP_INTO_BYTEARRAY       = 0xEE, /* 238 */ | 	HCL_CODE_POP_INTO_BYTEARRAY       = 0xEE, /* 238 ## */ | ||||||
| 	HCL_CODE_MAKE_DIC                 = 0xEF, /* 239 */ | 	HCL_CODE_POP_INTO_DIC             = 0xEF, /* 239 */ | ||||||
|  |  | ||||||
| 	HCL_CODE_SEND_MESSAGE_X           = 0xF0, /* 240 ## */ | 	HCL_CODE_SEND_MESSAGE_X           = 0xF0, /* 240 ## */ | ||||||
|  |  | ||||||
| 	HCL_CODE_POP_INTO_DIC             = 0xF1, /* 241 */ | 	HCL_CODE_MAKE_CONS                = 0xF1, /* 241 */ | ||||||
| 	HCL_CODE_MAKE_DLIST               = 0xF2, /* 242 */ | 	HCL_CODE_POP_INTO_CONS            = 0xF2, /* 242 */ | ||||||
| 	HCL_CODE_POP_INTO_DLIST           = 0xF3, /* 243 */ | 	HCL_CODE_POP_INTO_CONS_END        = 0xF3, /* 243 */ | ||||||
|  |  | ||||||
| 	HCL_CODE_SEND_MESSAGE_TO_SUPER_X  = 0xF4, /* 244 ## */ | 	HCL_CODE_SEND_MESSAGE_TO_SUPER_X  = 0xF4, /* 244 ## */ | ||||||
|  |  | ||||||
|  | 	HCL_CODE_POP_INTO_CONS_CDR        = 0xF5, /* 245 */ | ||||||
| 	/* -------------------------------------- */ | 	/* -------------------------------------- */ | ||||||
|  |  | ||||||
| 	HCL_CODE_MAKE_ARRAY               = 0xF5, /* 245 */ | 	/* UNUSED 0xF6 */ | ||||||
| 	HCL_CODE_POP_INTO_ARRAY           = 0xF6, /* 246 */ |  | ||||||
|  |  | ||||||
| 	HCL_CODE_DUP_STACKTOP             = 0xF7, | 	HCL_CODE_DUP_STACKTOP             = 0xF7, | ||||||
| 	HCL_CODE_POP_STACKTOP             = 0xF8, | 	HCL_CODE_POP_STACKTOP             = 0xF8, | ||||||
|  | |||||||
		Reference in New Issue
	
	Block a user