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

added the until loop

Browse Source
This commit is contained in:
hyung-hwan
2016-10-12 07:30:54 +00:00
parent eddf0f7925
commit 5c92919c6a
6 changed files with 83 additions and 60 deletions
Download Patch File Download Diff File Expand all files Collapse all files

58
hcl/lib/comp.c
View File

@ -240,8 +240,6 @@ static int emit_single_param_instruction (hcl_t* hcl, int cmd, hcl_oow_t param_1
case BCODE_POP_INTO_OBJECT_0:
case HCL_CODE_JUMP_FORWARD_0:
case HCL_CODE_JUMP_BACKWARD_0:
case BCODE_JUMP_IF_TRUE_0:
case HCL_CODE_JUMP_FORWARD_IF_FALSE_0:
case HCL_CODE_CALL_0:
if (param_1 < 4)
{
@ -256,6 +254,10 @@ static int emit_single_param_instruction (hcl_t* hcl, int cmd, hcl_oow_t param_1
goto write_long;
}
case HCL_CODE_JUMP_FORWARD_IF_TRUE:
case HCL_CODE_JUMP_FORWARD_IF_FALSE:
case HCL_CODE_JUMP2_FORWARD_IF_TRUE:
case HCL_CODE_JUMP2_FORWARD_IF_FALSE:
case HCL_CODE_JUMP2_FORWARD:
case HCL_CODE_JUMP2_BACKWARD:
case HCL_CODE_PUSH_INTLIT:
@ -545,6 +547,8 @@ enum
COP_EMIT_RETURN,
COP_EMIT_SET,
COP_POST_UNTIL_BODY,
COP_POST_UNTIL_COND,
COP_POST_WHILE_BODY,
COP_POST_WHILE_COND
};
@ -845,7 +849,7 @@ static int compile_set (hcl_t* hcl, hcl_oop_t src)
return 0;
}
static int compile_while (hcl_t* hcl, hcl_oop_t src)
static int compile_while (hcl_t* hcl, hcl_oop_t src, int next_cop)
{
/* (while (xxxx) ... ) */
hcl_oop_t obj, cond;
@ -855,7 +859,8 @@ static int compile_while (hcl_t* hcl, hcl_oop_t src)
obj = HCL_CONS_CDR(src);
HCL_ASSERT (HCL_BRANDOF(hcl,src) == HCL_BRAND_CONS);
HCL_ASSERT (HCL_CONS_CAR(src) == hcl->_while);
HCL_ASSERT (HCL_CONS_CAR(src) == hcl->_until || HCL_CONS_CAR(src) == hcl->_while);
HCL_ASSERT (next_cop == COP_POST_UNTIL_COND || next_cop == COP_POST_WHILE_COND);
if (HCL_IS_NIL(hcl, obj))
{
@ -872,11 +877,13 @@ static int compile_while (hcl_t* hcl, hcl_oop_t src)
}
cond_pos = hcl->code.bc.len;
HCL_ASSERT (cond_pos < HCL_SMOOI_MAX);
cond = HCL_CONS_CAR(obj);
obj = HCL_CONS_CDR(obj);
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT, cond); /* 1 */
PUSH_SUBCFRAME (hcl, COP_POST_WHILE_COND, obj); /* 2 */
PUSH_SUBCFRAME (hcl, next_cop, obj); /* 2 */
cf = GET_SUBCFRAME (hcl);
cf->u.post_while.cond_pos = cond_pos;
@ -923,8 +930,12 @@ static int compile_cons_expression (hcl_t* hcl, hcl_oop_t obj)
if (compile_return (hcl, obj) <= -1) return -1;
break;
case HCL_SYNCODE_UNTIL:
if (compile_while (hcl, obj, COP_POST_UNTIL_COND) <= -1) return -1;
break;
case HCL_SYNCODE_WHILE:
if (compile_while (hcl, obj) <= -1) return -1;
if (compile_while (hcl, obj, COP_POST_WHILE_COND) <= -1) return -1;
break;
default:
@ -1164,18 +1175,31 @@ static HCL_INLINE int post_while_cond (hcl_t* hcl)
hcl_cframe_t* cf;
hcl_oow_t jump_inst_pos;
hcl_ooi_t cond_pos;
int jump_inst, next_cop;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (cf->opcode == COP_POST_WHILE_COND);
HCL_ASSERT (cf->opcode == COP_POST_UNTIL_COND || cf->opcode == COP_POST_WHILE_COND);
cond_pos = cf->u.post_while.cond_pos;
jump_inst_pos = hcl->code.bc.len;
HCL_ASSERT (jump_inst_pos < HCL_SMOOI_MAX);
if (emit_single_param_instruction (hcl, HCL_CODE_JUMP_FORWARD_IF_FALSE_0, MAX_CODE_JUMP) <= -1) return -1;
if (cf->opcode == COP_POST_UNTIL_COND)
{
jump_inst = HCL_CODE_JUMP_FORWARD_IF_TRUE;
next_cop = COP_POST_UNTIL_BODY;
}
else
{
jump_inst = HCL_CODE_JUMP_FORWARD_IF_FALSE;
next_cop = COP_POST_WHILE_BODY;
}
if (emit_single_param_instruction (hcl, jump_inst, MAX_CODE_JUMP) <= -1) return -1;
if (emit_byte_instruction (hcl, HCL_CODE_POP_STACKTOP) <= -1) return -1;
SWITCH_TOP_CFRAME (hcl, COP_COMPILE_OBJECT_LIST, cf->operand); /* 1 */
PUSH_SUBCFRAME (hcl, COP_POST_WHILE_BODY, HCL_SMOOI_TO_OOP(jump_inst_pos)); /* 2 */
PUSH_SUBCFRAME (hcl, next_cop, HCL_SMOOI_TO_OOP(jump_inst_pos)); /* 2 */
cf = GET_SUBCFRAME(hcl);
cf->u.post_while.cond_pos = cond_pos;
return 0;
@ -1188,7 +1212,7 @@ static HCL_INLINE int post_while_body (hcl_t* hcl)
hcl_oow_t jump_offset, body_size;
cf = GET_TOP_CFRAME(hcl);
HCL_ASSERT (cf->opcode == COP_POST_WHILE_BODY);
HCL_ASSERT (cf->opcode == COP_POST_UNTIL_BODY || cf->opcode == COP_POST_WHILE_BODY);
HCL_ASSERT (HCL_OOP_IS_SMOOI(cf->operand));
@ -1203,14 +1227,14 @@ static HCL_INLINE int post_while_body (hcl_t* hcl)
}
jip = HCL_OOP_TO_SMOOI(cf->operand);
/* HCL_CODE_LONG_PARAM_SIZE + 1 => size of the long JUMP_FORWARD_IF_FALSE_X instruction */
/* HCL_CODE_LONG_PARAM_SIZE + 1 => size of the long JUMP_FORWARD_IF_FALSE/JUMP_FORWARD_IF_TRUE instruction */
body_size = hcl->code.bc.len - jip - (HCL_BCODE_LONG_PARAM_SIZE + 1);
if (body_size > MAX_CODE_JUMP)
{
/* switch to JUMP2 instruction to allow a bigger jump offset.
* up to twice MAX_CODE_JUMP only */
/* TODO:.... patch_instruction (hcl, jip, HCL_CODE_JUMP2_FORWARD_IF_FALSE); */
patch_instruction (hcl, jip, ((cf->opcode == COP_POST_UNTIL_BODY)? HCL_CODE_JUMP2_FORWARD_IF_TRUE: HCL_CODE_JUMP2_FORWARD_IF_FALSE));
jump_offset = body_size - MAX_CODE_JUMP;
}
else
@ -1437,14 +1461,16 @@ int hcl_compile (hcl_t* hcl, hcl_oop_t obj)
if (emit_set (hcl) <= -1) goto oops;
break;
case COP_POST_WHILE_COND:
if (post_while_cond (hcl) <= -1) goto oops;
break;
case COP_POST_UNTIL_BODY:
case COP_POST_WHILE_BODY:
if (post_while_body (hcl) <= -1) goto oops;
break;
case COP_POST_UNTIL_COND:
case COP_POST_WHILE_COND:
if (post_while_cond (hcl) <= -1) goto oops;
break;
default:
HCL_DEBUG1 (hcl, "Internal error - invalid compiler opcode %d\n", cf->opcode);
hcl->errnum = HCL_EINTERN;

22
hcl/lib/decode.c
View File

@ -268,28 +268,24 @@ int hcl_decode (hcl_t* hcl, hcl_ooi_t start, hcl_ooi_t end)
LOG_INST_1 (hcl, "jump_backward %zu", (hcl_oow_t)(bcode & 0x3)); /* low 2 bits */
break;
case BCODE_JUMP_IF_TRUE_X:
case HCL_CODE_JUMP_FORWARD_IF_TRUE:
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "jump_if_true %zu", b1);
LOG_INST_1 (hcl, "jump_forward_if_true %zu", b1);
break;
case BCODE_JUMP_IF_TRUE_0:
case BCODE_JUMP_IF_TRUE_1:
case BCODE_JUMP_IF_TRUE_2:
case BCODE_JUMP_IF_TRUE_3:
LOG_INST_1 (hcl, "jump_if_true %zu", (hcl_oow_t)(bcode & 0x3)); /* low 2 bits */
case HCL_CODE_JUMP2_FORWARD_IF_TRUE:
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "jump2_forward_if_true %zu", b1);
break;
case HCL_CODE_JUMP_FORWARD_IF_FALSE_X:
case HCL_CODE_JUMP_FORWARD_IF_FALSE:
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "jump_forward_if_false %zu", b1);
break;
case HCL_CODE_JUMP_FORWARD_IF_FALSE_0:
case HCL_CODE_JUMP_FORWARD_IF_FALSE_1:
case HCL_CODE_JUMP_FORWARD_IF_FALSE_2:
case HCL_CODE_JUMP_FORWARD_IF_FALSE_3:
LOG_INST_1 (hcl, "jump_forward_if_false %zu", (hcl_oow_t)(bcode & 0x3)); /* low 2 bits */
case HCL_CODE_JUMP2_FORWARD_IF_FALSE:
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "jump2_forward_if_false %zu", b1);
break;
case HCL_CODE_JUMP2_FORWARD:

31
hcl/lib/exec.c
View File

@ -1497,27 +1497,28 @@ static int execute (hcl_t* hcl)
hcl->ip -= (bcode & 0x3); /* low 2 bits */
break;
case BCODE_JUMP_IF_TRUE_X:
case BCODE_JUMP_IF_TRUE_0:
case BCODE_JUMP_IF_TRUE_1:
case BCODE_JUMP_IF_TRUE_2:
case BCODE_JUMP_IF_TRUE_3:
HCL_LOG0 (hcl, HCL_LOG_IC | HCL_LOG_FATAL, "<<<<<<<<<<<<<< JUMP NOT IMPLEMENTED YET >>>>>>>>>>>>\n");
hcl->errnum = HCL_ENOIMPL;
return -1;
case HCL_CODE_JUMP_FORWARD_IF_TRUE:
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "jump_forward_if_true %zu", b1);
if (HCL_STACK_GETTOP(hcl) == hcl->_true) hcl->ip += b1;
break;
case HCL_CODE_JUMP_FORWARD_IF_FALSE_X:
case HCL_CODE_JUMP2_FORWARD_IF_TRUE:
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "jump2_forward_if_true %zu", b1);
if (HCL_STACK_GETTOP(hcl) == hcl->_true) hcl->ip += MAX_CODE_JUMP + b1;
break;
case HCL_CODE_JUMP_FORWARD_IF_FALSE:
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "jump_forward_if_false %zu", b1);
if (HCL_STACK_GETTOP(hcl) == hcl->_false) hcl->ip += b1;
break;
case HCL_CODE_JUMP_FORWARD_IF_FALSE_0:
case HCL_CODE_JUMP_FORWARD_IF_FALSE_1:
case HCL_CODE_JUMP_FORWARD_IF_FALSE_2:
case HCL_CODE_JUMP_FORWARD_IF_FALSE_3:
LOG_INST_1 (hcl, "jump_forward_if_false %zu", (hcl_oow_t)(bcode & 0x3));
if (HCL_STACK_GETTOP(hcl) == hcl->_false) hcl->ip += (bcode & 0x3); /* low 2 bits */
case HCL_CODE_JUMP2_FORWARD_IF_FALSE:
FETCH_PARAM_CODE_TO (hcl, b1);
LOG_INST_1 (hcl, "jump2_forward_if_false %zu", b1);
if (HCL_STACK_GETTOP(hcl) == hcl->_false) hcl->ip += MAX_CODE_JUMP + b1;
break;
case HCL_CODE_JUMP2_FORWARD:

1
hcl/lib/gc.c
View File

@ -41,6 +41,7 @@ static struct
{ 5, { 'q','u','o','t','e' }, HCL_SYNCODE_QUOTE, HCL_OFFSETOF(hcl_t,_quote) },
{ 6, { 'r','e','t','u','r','n'}, HCL_SYNCODE_RETURN, HCL_OFFSETOF(hcl_t,_return) },
{ 3, { 's','e','t' }, HCL_SYNCODE_SET, HCL_OFFSETOF(hcl_t,_set) },
{ 5, { 'u','n','t','i','l' }, HCL_SYNCODE_UNTIL, HCL_OFFSETOF(hcl_t,_until) },
{ 5, { 'w','h','i','l','e' }, HCL_SYNCODE_WHILE, HCL_OFFSETOF(hcl_t,_while) }
};

29
hcl/lib/hcl-prv.h
View File

@ -436,8 +436,10 @@ SHORT INSTRUCTION CODE LONG INSTRUCTION C
68-71 0100 01XX JUMP_FORWARD 196 1100 0100 XXXXXXXX JUMP_FORWARD_X
72-75 0100 10XX JUMP_BACKWARD 200 1100 1000 XXXXXXXX JUMP_BACKWARD_X
76-79 0100 11XX JUMP_IF_TRUE 204 1100 1100 XXXXXXXX JUMP_IF_TRUE_X
80-83 0101 00XX JUMP_IF_FALSE 208 1101 0000 XXXXXXXX JUMP_IF_FALSE_X
76-79 0100 11XX UNUSED 204 1100 1100 XXXXXXXX JUMP_FORWARD_IF_TRUE
205 1100 1101 XXXXXXXX JUMP2_FORWARD_IF_TRUE
80-83 0101 00XX UNUSED 208 1101 0000 XXXXXXXX JUMP_FORWARD_IF_FALSE
209 1101 0001 XXXXXXXX JUMP2_FORWARD_IF_FALSE
84-87 0101 01XX CALL 212 1101 0100 XXXXXXXX CALL_X
@ -560,20 +562,11 @@ enum hcl_bcode_t
HCL_CODE_JUMP_FORWARD_2 = 0x46, /* 70 */
HCL_CODE_JUMP_FORWARD_3 = 0x47, /* 71 */
HCL_CODE_JUMP_BACKWARD_0 = 0x48,
HCL_CODE_JUMP_BACKWARD_1 = 0x49,
HCL_CODE_JUMP_BACKWARD_2 = 0x4A,
HCL_CODE_JUMP_BACKWARD_3 = 0x4B,
HCL_CODE_JUMP_BACKWARD_0 = 0x48, /* 72 */
HCL_CODE_JUMP_BACKWARD_1 = 0x49, /* 73 */
HCL_CODE_JUMP_BACKWARD_2 = 0x4A, /* 74 */
HCL_CODE_JUMP_BACKWARD_3 = 0x4B, /* 75 */
BCODE_JUMP_IF_TRUE_0 = 0x4C,
BCODE_JUMP_IF_TRUE_1 = 0x4D,
BCODE_JUMP_IF_TRUE_2 = 0x4E,
BCODE_JUMP_IF_TRUE_3 = 0x4F,
HCL_CODE_JUMP_FORWARD_IF_FALSE_0 = 0x50, /* 80 */
HCL_CODE_JUMP_FORWARD_IF_FALSE_1 = 0x51, /* 81 */
HCL_CODE_JUMP_FORWARD_IF_FALSE_2 = 0x52, /* 82 */
HCL_CODE_JUMP_FORWARD_IF_FALSE_3 = 0x53, /* 83 */
HCL_CODE_CALL_0 = 0x54, /* 84 */
HCL_CODE_CALL_1 = 0x55, /* 85 */
@ -641,7 +634,7 @@ enum hcl_bcode_t
HCL_CODE_JUMP_FORWARD_X = 0xC4, /* 196 */
HCL_CODE_JUMP_BACKWARD_X = 0xC8, /* 200 */
BCODE_JUMP_IF_TRUE_X = 0xCC, /* 204 */
HCL_CODE_JUMP_FORWARD_IF_TRUE_X = 0xCC, /* 204 */
HCL_CODE_JUMP_FORWARD_IF_FALSE_X = 0xD0, /* 208 */
HCL_CODE_CALL_X = 0xD4, /* 212 */
@ -661,6 +654,10 @@ enum hcl_bcode_t
HCL_CODE_JUMP2_FORWARD = 0xC5, /* 197 */
HCL_CODE_JUMP2_BACKWARD = 0xC9, /* 201 */
HCL_CODE_JUMP_FORWARD_IF_TRUE = 0xCC, /* 204 */
HCL_CODE_JUMP2_FORWARD_IF_TRUE = 0xCD, /* 205 */
HCL_CODE_JUMP_FORWARD_IF_FALSE = 0xD0, /* 208 */
HCL_CODE_JUMP2_FORWARD_IF_FALSE = 0xD1, /* 209 */
BCODE_PUSH_RECEIVER = 0x81, /* 129 */
HCL_CODE_PUSH_NIL = 0x82, /* 130 */

2
hcl/lib/hcl.h
View File

@ -839,6 +839,7 @@ struct hcl_t
hcl_oop_t _quote; /* symbol */
hcl_oop_t _return; /* symbol */
hcl_oop_t _set; /* symbol */
hcl_oop_t _until; /* symbol */
hcl_oop_t _while; /* symbol */
/* == NEVER CHANGE THE ORDER OF FIELDS BELOW == */
@ -1025,6 +1026,7 @@ enum
HCL_SYNCODE_QUOTE,
HCL_SYNCODE_RETURN,
HCL_SYNCODE_SET,
HCL_SYNCODE_UNTIL,
HCL_SYNCODE_WHILE
};