quipu mercurial repository
Revision | d41626f4db00eb3069228d695e786a7ee5af73bb (tree) |
---|---|
Time | 2018-07-17 08:45:56 |
Author | Agustina Arzille <avarzille@rise...> |
Commiter | Agustina Arzille |
Fix conditional environment captures
@@ -1,6 +1,5 @@ | ||
1 | 1 | #include <cstring> |
2 | 2 | #include <cstdio> |
3 | -#include "builtins.h" | |
4 | 3 | #include "quipu.h" |
5 | 4 | |
6 | 5 | QP_DECLS_BEGIN |
@@ -14,8 +14,8 @@ | ||
14 | 14 | "nop\0dup\0pop\0ret\0is\0not\0cons\0list\0car\0cdr\0cadr\0nputcar\0" |
15 | 15 | "nputcdr\0apply\0tapply\0loadt\0loadnil\0load0\0load1\0loadi8\0loada0\0" |
16 | 16 | "loada1\0loadc00\0loadc01\0loadp0\0loadp1\0mkcont\0closure\0tryend\0" |
17 | - "raise\0raise2\0ldcaller\0prepfrm\0vargc\0vargc.l\0jmp\0jmp.l\0brt\0" | |
18 | - "brt.l\0brn\0brn.l\0brneq\0brneq.l\0tcall\0tcall.l\0call\0call.l\0" | |
17 | + "raise\0raise2\0ldcaller\0prepfrm\0captenv\0vargc\0vargc.l\0jmp\0jmp.l\0" | |
18 | + "brt\0brt.l\0brn\0brn.l\0brneq\0brneq.l\0tcall\0tcall.l\0call\0call.l\0" | |
19 | 19 | "recur\0recur.l\0trecur\0trecur.l\0setc\0setc.l\0seta\0seta.l\0setp\0" |
20 | 20 | "setp.l\0setg\0setg.l\0loadc\0loadc.l\0loada\0loada.l\0loadp\0loadp.l\0" |
21 | 21 | "loadg\0loadg.l\0loadv\0loadv.l\0loadx\0loadx.l\0bind\0bind.l\0mkframe\0" |
@@ -64,62 +64,63 @@ | ||
64 | 64 | { 180, 0 }, // raise2 |
65 | 65 | { 187, 0 }, // ldcaller |
66 | 66 | { 196, 0 }, // prepfrm |
67 | - { 204, 1 }, // vargc | |
68 | - { 210, 1 | BC_LONG_FORM }, // vargc.l | |
69 | - { 218, 1 | BC_BRANCH_FORM }, // jmp | |
70 | - { 222, 1 | BC_BRANCH_FORM | BC_LONG_FORM }, // jmp.l | |
71 | - { 228, 1 | BC_BRANCH_FORM }, // brt | |
72 | - { 232, 1 | BC_BRANCH_FORM | BC_LONG_FORM }, // brt.l | |
73 | - { 238, 1 | BC_BRANCH_FORM }, // brn | |
74 | - { 242, 1 | BC_BRANCH_FORM | BC_LONG_FORM }, // brn.l | |
75 | - { 248, 1 | BC_BRANCH_FORM }, // brneq | |
76 | - { 254, 1 | BC_BRANCH_FORM | BC_LONG_FORM }, // brneq.l | |
77 | - { 262, 1 | BC_CALL_FORM }, // tcall | |
78 | - { 268, 1 | BC_CALL_FORM | BC_LONG_FORM }, // tcall.l | |
79 | - { 276, 1 | BC_CALL_FORM }, // call | |
80 | - { 281, 1 | BC_CALL_FORM | BC_LONG_FORM }, // call.l | |
81 | - { 288, 1 | BC_CALL_FORM }, // recur | |
82 | - { 294, 1 | BC_CALL_FORM | BC_LONG_FORM }, // recur.l | |
83 | - { 302, 1 | BC_CALL_FORM }, // trecur | |
84 | - { 309, 1 | BC_CALL_FORM | BC_LONG_FORM }, // trecur.l | |
85 | - { 318, 2 }, // setc | |
86 | - { 323, 2 | BC_LONG_FORM }, // setc.l | |
87 | - { 330, 1 }, // seta | |
88 | - { 335, 1 | BC_LONG_FORM }, // seta.l | |
89 | - { 342, 2 }, // setp | |
90 | - { 347, 2 | BC_LONG_FORM }, // setp.l | |
91 | - { 354, 1 }, // setg | |
92 | - { 359, 1 | BC_LONG_FORM }, // setg.l | |
93 | - { 366, 2 | BC_LOAD_FORM | BC_PURE_FORM }, // loadc | |
94 | - { 372, 2 | BC_LOAD_FORM | BC_PURE_FORM | BC_LONG_FORM }, // loadc.l | |
95 | - { 380, 1 | BC_LOAD_FORM | BC_PURE_FORM }, // loada | |
96 | - { 386, 1 | BC_LOAD_FORM | BC_PURE_FORM | BC_LONG_FORM }, // loada.l | |
97 | - { 394, 2 | BC_LOAD_FORM | BC_PURE_FORM }, // loadp | |
98 | - { 400, 2 | BC_LOAD_FORM | BC_PURE_FORM | BC_LONG_FORM }, // loadp.l | |
99 | - { 408, 1 | BC_LOAD_FORM }, // loadg | |
100 | - { 414, 1 | BC_LOAD_FORM | BC_LONG_FORM }, // loadg.l | |
101 | - { 422, 1 | BC_LOAD_FORM | BC_PURE_FORM }, // loadv | |
102 | - { 428, 1 | BC_LOAD_FORM | BC_PURE_FORM | BC_LONG_FORM }, // loadv.l | |
103 | - { 436, 1 | BC_LOAD_FORM }, // loadx | |
104 | - { 442, 1 | BC_LOAD_FORM | BC_LONG_FORM }, // loadx.l | |
105 | - { 450, 1 }, // bind | |
106 | - { 455, 1 | BC_LONG_FORM }, // bind.l | |
107 | - { 462, 1 }, // mkframe | |
108 | - { 470, 1 | BC_LONG_FORM }, // mkframe.l | |
109 | - { 480, 1 }, // unwind | |
110 | - { 487, 1 | BC_LONG_FORM }, // unwind.l | |
111 | - { 496, 1 | BC_BRANCH_FORM }, // trybegin | |
112 | - { 505, 1 | BC_BRANCH_FORM | BC_LONG_FORM }, // trybegin.l | |
113 | - { 516, 1 }, // setapop | |
114 | - { 524, 1 | BC_LONG_FORM }, // setapop.l | |
115 | - { 534, 1 | BC_BRANCH_FORM }, // irtjmp | |
116 | - { 541, 1 | BC_BRANCH_FORM | BC_LONG_FORM }, // irtjmp.l | |
117 | - { 550, 2 }, // optargs | |
118 | - { 558, 2 | BC_LONG_FORM }, // optargs.l | |
119 | - { 568, 1 }, // brbound | |
120 | - { 576, 1 | BC_LONG_FORM }, // brbound.l | |
121 | - { 586, 3 }, // kwargs | |
122 | - { 593, 3 | BC_LONG_FORM }, // kwargs.l | |
67 | + { 204, 0 }, // captenv | |
68 | + { 212, 1 }, // vargc | |
69 | + { 218, 1 | BC_LONG_FORM }, // vargc.l | |
70 | + { 226, 1 | BC_BRANCH_FORM }, // jmp | |
71 | + { 230, 1 | BC_BRANCH_FORM | BC_LONG_FORM }, // jmp.l | |
72 | + { 236, 1 | BC_BRANCH_FORM }, // brt | |
73 | + { 240, 1 | BC_BRANCH_FORM | BC_LONG_FORM }, // brt.l | |
74 | + { 246, 1 | BC_BRANCH_FORM }, // brn | |
75 | + { 250, 1 | BC_BRANCH_FORM | BC_LONG_FORM }, // brn.l | |
76 | + { 256, 1 | BC_BRANCH_FORM }, // brneq | |
77 | + { 262, 1 | BC_BRANCH_FORM | BC_LONG_FORM }, // brneq.l | |
78 | + { 270, 1 | BC_CALL_FORM }, // tcall | |
79 | + { 276, 1 | BC_CALL_FORM | BC_LONG_FORM }, // tcall.l | |
80 | + { 284, 1 | BC_CALL_FORM }, // call | |
81 | + { 289, 1 | BC_CALL_FORM | BC_LONG_FORM }, // call.l | |
82 | + { 296, 1 | BC_CALL_FORM }, // recur | |
83 | + { 302, 1 | BC_CALL_FORM | BC_LONG_FORM }, // recur.l | |
84 | + { 310, 1 | BC_CALL_FORM }, // trecur | |
85 | + { 317, 1 | BC_CALL_FORM | BC_LONG_FORM }, // trecur.l | |
86 | + { 326, 2 }, // setc | |
87 | + { 331, 2 | BC_LONG_FORM }, // setc.l | |
88 | + { 338, 1 }, // seta | |
89 | + { 343, 1 | BC_LONG_FORM }, // seta.l | |
90 | + { 350, 2 }, // setp | |
91 | + { 355, 2 | BC_LONG_FORM }, // setp.l | |
92 | + { 362, 1 }, // setg | |
93 | + { 367, 1 | BC_LONG_FORM }, // setg.l | |
94 | + { 374, 2 | BC_LOAD_FORM | BC_PURE_FORM }, // loadc | |
95 | + { 380, 2 | BC_LOAD_FORM | BC_PURE_FORM | BC_LONG_FORM }, // loadc.l | |
96 | + { 388, 1 | BC_LOAD_FORM | BC_PURE_FORM }, // loada | |
97 | + { 394, 1 | BC_LOAD_FORM | BC_PURE_FORM | BC_LONG_FORM }, // loada.l | |
98 | + { 402, 2 | BC_LOAD_FORM | BC_PURE_FORM }, // loadp | |
99 | + { 408, 2 | BC_LOAD_FORM | BC_PURE_FORM | BC_LONG_FORM }, // loadp.l | |
100 | + { 416, 1 | BC_LOAD_FORM }, // loadg | |
101 | + { 422, 1 | BC_LOAD_FORM | BC_LONG_FORM }, // loadg.l | |
102 | + { 430, 1 | BC_LOAD_FORM | BC_PURE_FORM }, // loadv | |
103 | + { 436, 1 | BC_LOAD_FORM | BC_PURE_FORM | BC_LONG_FORM }, // loadv.l | |
104 | + { 444, 1 | BC_LOAD_FORM }, // loadx | |
105 | + { 450, 1 | BC_LOAD_FORM | BC_LONG_FORM }, // loadx.l | |
106 | + { 458, 1 }, // bind | |
107 | + { 463, 1 | BC_LONG_FORM }, // bind.l | |
108 | + { 470, 1 }, // mkframe | |
109 | + { 478, 1 | BC_LONG_FORM }, // mkframe.l | |
110 | + { 488, 1 }, // unwind | |
111 | + { 495, 1 | BC_LONG_FORM }, // unwind.l | |
112 | + { 504, 1 | BC_BRANCH_FORM }, // trybegin | |
113 | + { 513, 1 | BC_BRANCH_FORM | BC_LONG_FORM }, // trybegin.l | |
114 | + { 524, 1 }, // setapop | |
115 | + { 532, 1 | BC_LONG_FORM }, // setapop.l | |
116 | + { 542, 1 | BC_BRANCH_FORM }, // irtjmp | |
117 | + { 549, 1 | BC_BRANCH_FORM | BC_LONG_FORM }, // irtjmp.l | |
118 | + { 558, 2 }, // optargs | |
119 | + { 566, 2 | BC_LONG_FORM }, // optargs.l | |
120 | + { 576, 1 }, // brbound | |
121 | + { 584, 1 | BC_LONG_FORM }, // brbound.l | |
122 | + { 594, 3 }, // kwargs | |
123 | + { 601, 3 | BC_LONG_FORM }, // kwargs.l | |
123 | 124 | { 0, 0 } |
124 | 125 | }; |
125 | 126 |
@@ -40,6 +40,7 @@ | ||
40 | 40 | OP_RAISE2, |
41 | 41 | OP_LDCALLER, |
42 | 42 | OP_PREPFRM, |
43 | + OP_CAPTENV, | |
43 | 44 | // Opcodes with long forms. |
44 | 45 | OP_VARGC, |
45 | 46 | OP_VARGCL, |
@@ -74,9 +74,8 @@ | ||
74 | 74 | enum |
75 | 75 | { |
76 | 76 | flg_outer_ref = 0x01, |
77 | - flg_captured = 0x02, | |
78 | - flg_toplevel = 0x04, | |
79 | - flg_kwargs = 0x08 | |
77 | + flg_toplevel = 0x02, | |
78 | + flg_kwargs = 0x04 | |
80 | 79 | }; |
81 | 80 | |
82 | 81 | class frame_data |
@@ -126,7 +125,8 @@ | ||
126 | 125 | whl_block *whl = nullptr; |
127 | 126 | std::vector<frame_data> frames; |
128 | 127 | uint32_t rflags = 0; |
129 | - unsigned int exc_depth = 0; | |
128 | + uint32_t exc_depth = 0; | |
129 | + uint32_t capt_cnt = 0; | |
130 | 130 | int min_argc; |
131 | 131 | int max_argc; |
132 | 132 | object ldargs[4]; |
@@ -994,7 +994,7 @@ | ||
994 | 994 | else |
995 | 995 | { |
996 | 996 | auto& f = this->frames[this->frames.size () - depth - 1]; |
997 | - if (this->rflags & flg_captured) | |
997 | + if (this->capt_cnt > 0) | |
998 | 998 | this->emit (ixs[3], intobj (f.acc), intobj (loc)); |
999 | 999 | else |
1000 | 1000 | this->emit (ixs[0], intobj (f.acc + loc)); |
@@ -1021,6 +1021,48 @@ | ||
1021 | 1021 | return (r); |
1022 | 1022 | } |
1023 | 1023 | |
1024 | +static int | |
1025 | +compile_if_helper (bc_compiler& bc, object env, bool tail, object x) | |
1026 | +{ | |
1027 | + object tst = xcar (x); | |
1028 | + object then = xcadr (x); | |
1029 | + object els = xcddr (x); | |
1030 | + | |
1031 | + int r = bc.compile_cond (env, false, tst) & ~EVR_SE; | |
1032 | + | |
1033 | + if (qp_unlikely (evr_nlexit_p (r))) | |
1034 | + return (r); | |
1035 | + else if (qp_unlikely (r == EVR_ATOM)) | |
1036 | + return (bc.compile_in (env, tail, then)); | |
1037 | + else if (qp_unlikely (r == EVR_NIL)) | |
1038 | + return (xcdr (els) == NIL ? bc.compile_in (env, tail, xcar (els)) : | |
1039 | + bc.compile_if (env, tail, els)); | |
1040 | + | |
1041 | + int el = bc.next_label (), endl = bc.next_label (); | |
1042 | + auto c1 = bc.capt_cnt; | |
1043 | + bc.emit (OPX_(BRN), intobj (el)); | |
1044 | + r = bc.compile_in (env, tail, then); | |
1045 | + | |
1046 | + if (evr_nlexit_p (r)) | |
1047 | + ; | |
1048 | + else if (tail) | |
1049 | + bc.emit (OPX_(RET)); | |
1050 | + else | |
1051 | + bc.emit (OPX_(JMP), intobj (endl)); | |
1052 | + | |
1053 | + bc.mark_label (el); | |
1054 | + auto c2 = bc.capt_cnt; | |
1055 | + | |
1056 | + if (xcdr (els) != NIL) | |
1057 | + bc.compile_if (env, tail, els); | |
1058 | + else | |
1059 | + bc.compile_in (env, tail, xcar (els)); | |
1060 | + | |
1061 | + bc.mark_label (endl); | |
1062 | + return (c1 != 0 || ((c1 == c2 && c2 == bc.capt_cnt) || | |
1063 | + (c1 != c2 && c2 != bc.capt_cnt)) ? EVR_NONE : -1); | |
1064 | +} | |
1065 | + | |
1024 | 1066 | int bc_compiler::compile_if (object env, bool tail, object x) |
1025 | 1067 | { |
1026 | 1068 | if (!xcons_p (x) || !xcons_p (xcdr (x))) |
@@ -1028,38 +1070,46 @@ | ||
1028 | 1070 | else if (xcdr (x) == NIL) |
1029 | 1071 | specform_error (this->interp, "if", SPECFORM_TOOFEW); |
1030 | 1072 | |
1031 | - object tst = xcar (x); | |
1032 | - object then = xcadr (x); | |
1033 | - object els = xcddr (x); | |
1034 | - | |
1035 | - int r = this->compile_cond (env, false, tst) & ~EVR_SE; | |
1036 | - | |
1037 | - if (qp_unlikely (evr_nlexit_p (r))) | |
1038 | - return (r); | |
1039 | - else if (qp_unlikely (r == EVR_ATOM)) | |
1040 | - return (this->compile_in (env, tail, then)); | |
1041 | - else if (qp_unlikely (r == EVR_NIL)) | |
1042 | - return (xcdr (els) == NIL ? this->compile_in (env, tail, xcar (els)) : | |
1043 | - this->compile_if (env, tail, els)); | |
1073 | + if (!tail && this->capt_cnt == 0) | |
1074 | + { | |
1075 | + size_t pos = this->code.size (); | |
1076 | + int r = compile_if_helper (*this, env, tail, x); | |
1077 | + if (r >= 0) | |
1078 | + return (r); | |
1044 | 1079 | |
1045 | - int el = this->next_label (), endl = this->next_label (); | |
1046 | - this->emit (OPX_(BRN), intobj (el)); | |
1047 | - r = this->compile_in (env, tail, then); | |
1080 | + this->code.erase (this->code.begin () + pos, this->code.end ()); | |
1081 | + this->code.push_back (OPX_(CAPTENV)); | |
1082 | + this->capt_cnt = 1; | |
1083 | + } | |
1048 | 1084 | |
1049 | - if (evr_nlexit_p (r)) | |
1050 | - ; | |
1051 | - else if (tail) | |
1052 | - this->emit (OPX_(RET)); | |
1085 | + return (compile_if_helper (*this, env, tail, x)); | |
1086 | +} | |
1087 | + | |
1088 | +static int | |
1089 | +compile_while_helper (bc_compiler& bc, object env, | |
1090 | + object body, int r, size_t pos, whl_block& blk) | |
1091 | +{ | |
1092 | + auto c1 = bc.capt_cnt; | |
1093 | + | |
1094 | + if (r == EVR_ATOM) | |
1095 | + { | |
1096 | + r = bc.compile_in (env, false, body); | |
1097 | + bc.emit (OPX_(POP)); | |
1098 | + } | |
1053 | 1099 | else |
1054 | - this->emit (OPX_(JMP), intobj (endl)); | |
1100 | + { | |
1101 | + bc.code.insert (bc.code.begin () + pos, OPX_(LOADT)); | |
1102 | + bc.emit (OPX_(BRN), intobj (blk.end_lbl)); | |
1103 | + bc.emit (OPX_(POP)); | |
1104 | + r = bc.compile_in (env, false, body); | |
1105 | + } | |
1055 | 1106 | |
1056 | - this->mark_label (el); | |
1057 | - if (xcdr (els) != NIL) | |
1058 | - this->compile_if (env, tail, els); | |
1059 | - else | |
1060 | - this->compile_in (env, tail, xcar (els)); | |
1107 | + if (c1 == 0 && bc.capt_cnt) | |
1108 | + return (-1); | |
1109 | + else if (!evr_nlexit_p (r)) | |
1110 | + bc.emit (OPX_(IRTJMP), intobj (blk.top_lbl)); | |
1061 | 1111 | |
1062 | - this->mark_label (endl); | |
1112 | + bc.mark_label (blk.end_lbl); | |
1063 | 1113 | return (EVR_NONE); |
1064 | 1114 | } |
1065 | 1115 |
@@ -1079,39 +1129,36 @@ | ||
1079 | 1129 | } |
1080 | 1130 | else if (evr_nlexit_p (r)) |
1081 | 1131 | return (r); |
1082 | - else if (r == EVR_ATOM) | |
1132 | + else if (this->capt_cnt == 0) | |
1083 | 1133 | { |
1084 | - r = this->compile_in (env, false, body); | |
1085 | - this->emit (OPX_(POP)); | |
1086 | - } | |
1087 | - else | |
1088 | - { | |
1089 | - this->code.insert (this->code.begin () + pos, OPX_(LOADT)); | |
1090 | - this->emit (OPX_(BRN), intobj (blk.end_lbl)); | |
1091 | - this->emit (OPX_(POP)); | |
1092 | - r = this->compile_in (env, false, body); | |
1134 | + size_t cur = this->code.size (); | |
1135 | + if (compile_while_helper (*this, env, body, r, pos, blk) >= 0) | |
1136 | + return (EVR_NONE); | |
1137 | + else if (r != EVR_ATOM) | |
1138 | + this->code.erase (this->code.begin () + pos); | |
1139 | + | |
1140 | + this->code.erase (this->code.begin () + cur, this->code.end ()); | |
1141 | + this->code.insert (this->code.begin () + pos++, OPX_(CAPTENV)); | |
1142 | + this->capt_cnt = 1; | |
1093 | 1143 | } |
1094 | 1144 | |
1095 | - if (!evr_nlexit_p (r)) | |
1096 | - this->emit (OPX_(IRTJMP), intobj (blk.top_lbl)); | |
1097 | - | |
1098 | - this->mark_label (blk.end_lbl); | |
1099 | - return (EVR_NONE); | |
1145 | + return (compile_while_helper (*this, env, body, r, pos, blk)); | |
1100 | 1146 | } |
1101 | 1147 | |
1102 | -int bc_compiler::compile_short_circuit (object env, bool tail, | |
1148 | +static int | |
1149 | +compile_sc_helper (bc_compiler& bc, object env, bool tail, | |
1103 | 1150 | object forms, object dfl, object branch) |
1104 | 1151 | { |
1105 | 1152 | if (!xcons_p (forms)) |
1106 | - specform_error (this->interp, dfl == QP_S(t) ? | |
1153 | + specform_error (bc.interp, dfl == QP_S(t) ? | |
1107 | 1154 | "and" : "or", SPECFORM_DOTTED); |
1108 | 1155 | else if (forms == NIL) |
1109 | - return (this->compile_in (env, tail, dfl)); | |
1156 | + return (bc.compile_in (env, tail, dfl)); | |
1110 | 1157 | else if (xcdr (forms) == NIL) |
1111 | - return (this->compile_in (env, tail, xcar (forms))); | |
1158 | + return (bc.compile_in (env, tail, xcar (forms))); | |
1112 | 1159 | |
1113 | 1160 | object cf = xcar (forms); |
1114 | - int r = this->compile_cond (env, false, cf, false), rm = r & ~EVR_SE; | |
1161 | + int r = bc.compile_cond (env, false, cf, false), rm = r & ~EVR_SE; | |
1115 | 1162 | |
1116 | 1163 | if (qp_unlikely (r == EVR_IRET)) |
1117 | 1164 | return (r); |
@@ -1119,24 +1166,42 @@ | ||
1119 | 1166 | { // Constant form. |
1120 | 1167 | if ((rm == EVR_NIL && dfl != QP_S(t)) || (rm == EVR_ATOM && dfl != NIL)) |
1121 | 1168 | // Skip constant form. |
1122 | - return (this->compile_short_circuit (env, | |
1169 | + return (bc.compile_short_circuit (env, | |
1123 | 1170 | tail, xcdr (forms), dfl, branch)); |
1124 | 1171 | else if ((r & EVR_SE) == 0) |
1125 | - this->compile_in (env, true, cf); | |
1172 | + bc.compile_in (env, true, cf); | |
1126 | 1173 | |
1127 | 1174 | // nil argument in 'and' form, or non-nil argument in 'or' form. |
1128 | 1175 | return (r); |
1129 | 1176 | } |
1130 | 1177 | |
1131 | - int end = this->next_label (); | |
1132 | - this->emit (OPX_(DUP)); | |
1133 | - this->emit (branch, intobj (end)); | |
1134 | - this->emit (OPX_(POP)); | |
1135 | - this->compile_short_circuit (env, tail, xcdr (forms), dfl, branch); | |
1136 | - this->mark_label (end); | |
1178 | + int end = bc.next_label (); | |
1179 | + bc.emit (OPX_(DUP)); | |
1180 | + bc.emit (branch, intobj (end)); | |
1181 | + bc.emit (OPX_(POP)); | |
1182 | + bc.compile_short_circuit (env, tail, xcdr (forms), dfl, branch); | |
1183 | + bc.mark_label (end); | |
1137 | 1184 | return (EVR_NONE); |
1138 | 1185 | } |
1139 | 1186 | |
1187 | +int bc_compiler::compile_short_circuit (object env, bool tail, | |
1188 | + object forms, object dfl, object branch) | |
1189 | +{ | |
1190 | + size_t pos = this->code.size (); | |
1191 | + auto ce = this->capt_cnt; | |
1192 | + int r = compile_sc_helper (*this, env, tail, forms, dfl, branch); | |
1193 | + | |
1194 | + if (!tail && ce == 0 && this->capt_cnt) | |
1195 | + { | |
1196 | + this->code.erase (this->code.begin () + pos, this->code.end ()); | |
1197 | + this->code.push_back (OPX_(CAPTENV)); | |
1198 | + this->capt_cnt = 1; | |
1199 | + r = compile_sc_helper (*this, env, tail, forms, dfl, branch); | |
1200 | + } | |
1201 | + | |
1202 | + return (r); | |
1203 | +} | |
1204 | + | |
1140 | 1205 | int bc_compiler::compile_arglist (object env, object expr) |
1141 | 1206 | { |
1142 | 1207 | int ret = 0; |
@@ -1368,22 +1433,45 @@ | ||
1368 | 1433 | return (true); |
1369 | 1434 | } |
1370 | 1435 | |
1436 | +static bool | |
1437 | +compile_try_helper (bc_compiler& bc, object env, object expr) | |
1438 | +{ | |
1439 | + int clbl = bc.next_label (), end = bc.next_label (); | |
1440 | + bc.emit (OPX_(TRYBEGIN), intobj (clbl)); | |
1441 | + ++bc.exc_depth; | |
1442 | + auto c1 = bc.capt_cnt; | |
1443 | + | |
1444 | + if (!evr_nlexit_p (bc.compile_in (env, false, xcadr (expr)))) | |
1445 | + { | |
1446 | + bc.emit (OPX_(TRYEND)); | |
1447 | + bc.emit (OPX_(JMP), intobj (end)); | |
1448 | + } | |
1449 | + | |
1450 | + --bc.exc_depth; | |
1451 | + bc.mark_label (clbl); | |
1452 | + | |
1453 | + auto c2 = bc.capt_cnt; | |
1454 | + bc.compile_in (env, false, xcar (xcddr (expr))); | |
1455 | + bc.mark_label (end); | |
1456 | + | |
1457 | + return ((c1 == c2 && c2 == bc.capt_cnt) || | |
1458 | + (c1 != c2 && c2 != bc.capt_cnt)); | |
1459 | +} | |
1460 | + | |
1371 | 1461 | void bc_compiler::compile_try (object env, bool, object expr) |
1372 | 1462 | { |
1373 | - int clbl = this->next_label (), end = this->next_label (); | |
1374 | - this->emit (OPX_(TRYBEGIN), intobj (clbl)); | |
1375 | - ++this->exc_depth; | |
1463 | + if (this->capt_cnt == 0) | |
1464 | + { | |
1465 | + size_t pos = this->code.size (); | |
1466 | + if (compile_try_helper (*this, env, expr)) | |
1467 | + return; | |
1376 | 1468 | |
1377 | - if (!evr_nlexit_p (this->compile_in (env, false, xcadr (expr)))) | |
1378 | - { | |
1379 | - this->emit (OPX_(TRYEND)); | |
1380 | - this->emit (OPX_(JMP), intobj (end)); | |
1469 | + this->code.erase (this->code.begin () + pos, this->code.end ()); | |
1470 | + this->code.push_back (OPX_(CAPTENV)); | |
1471 | + this->capt_cnt = 1; | |
1381 | 1472 | } |
1382 | 1473 | |
1383 | - --this->exc_depth; | |
1384 | - this->mark_label (clbl); | |
1385 | - this->compile_in (env, false, xcar (xcddr (expr))); | |
1386 | - this->mark_label (end); | |
1474 | + compile_try_helper (*this, env, expr); | |
1387 | 1475 | } |
1388 | 1476 | |
1389 | 1477 | static const object LOAD_OPS[] = |
@@ -1451,7 +1539,7 @@ | ||
1451 | 1539 | if (bc.rflags & flg_outer_ref) |
1452 | 1540 | { |
1453 | 1541 | this->emit (OPX_(CLOSURE)); |
1454 | - this->rflags |= flg_captured; | |
1542 | + ++this->capt_cnt; | |
1455 | 1543 | } |
1456 | 1544 | |
1457 | 1545 | return (EVR_ATOM_SE); |
@@ -1561,7 +1649,7 @@ | ||
1561 | 1649 | this->emit (OPX_(LOADNIL)); |
1562 | 1650 | this->emit (OPX_(MKCONT), intobj (2)); |
1563 | 1651 | this->emit (tail ? OPX_(TCALL) : OPX_(CALL), intobj (1)); |
1564 | - this->rflags |= flg_captured; | |
1652 | + ++this->capt_cnt; | |
1565 | 1653 | break; |
1566 | 1654 | } |
1567 | 1655 |
@@ -2036,7 +2124,7 @@ | ||
2036 | 2124 | bc.emit (OPX_(BIND), xcar (bindings)); |
2037 | 2125 | continue; |
2038 | 2126 | } |
2039 | - else if (!(bc.rflags & bc_compiler::flg_captured)) | |
2127 | + else if (bc.capt_cnt == 0) | |
2040 | 2128 | bc.emit (OPX_(SETAPOP), intobj (nlex + bc.cur_f().acc)); |
2041 | 2129 | else |
2042 | 2130 | { |
@@ -2085,12 +2173,12 @@ | ||
2085 | 2173 | if (nlex > 0) |
2086 | 2174 | syms[nlex - 1].cdr = prev; |
2087 | 2175 | |
2088 | - if (bc.rflags & bc_compiler::flg_captured) | |
2176 | + if (bc.capt_cnt != 0) | |
2089 | 2177 | { |
2090 | 2178 | bc.pop_f (); |
2091 | 2179 | --bc.cur_f().stkdisp; |
2092 | 2180 | bc.code.resize (psize); |
2093 | - bc.rflags &= ~bc_compiler::flg_captured; | |
2181 | + bc.capt_cnt = 0; | |
2094 | 2182 | syms->car = ctvs->car = NIL; |
2095 | 2183 | nlex = nctv = 0; |
2096 | 2184 | return (false); |
@@ -2142,7 +2230,7 @@ | ||
2142 | 2230 | this->ct_env = t2.as_obj (); |
2143 | 2231 | |
2144 | 2232 | nargs = count_let_nlex (bindings); |
2145 | - if ((this->rflags & flg_captured) != 0 || dbind || nargs > 0xff || | |
2233 | + if (this->capt_cnt != 0 || dbind || nargs > 0xff || | |
2146 | 2234 | !let_expand_fast (*this, bindings, t1.as_obj (), |
2147 | 2235 | ctvs, nlex, nctv, nargs)) |
2148 | 2236 | let_expand_seq (*this, bindings, t1.as_obj (), ctvs, nlex, nctv, nargs); |
@@ -272,16 +272,17 @@ | ||
272 | 272 | P_(APPLY), P_(TAPPLY), P_(LOADT), P_(LOADNIL), P_(LOAD0), P_(LOAD1), |
273 | 273 | P_(LOADI8), P_(LOADA0), P_(LOADA1), P_(LOADC00), P_(LOADC01), P_(LOADP0), |
274 | 274 | P_(LOADP1), P_(MKCONT), P_(CLOSURE), P_(TRYEND), P_(RAISE), P_(RAISE2), |
275 | - P_(LDCALLER), P_(PREPFRM), P_(VARGC), P_(VARGCL), P_(JMP), P_(JMPL), | |
276 | - P_(BRT), P_(BRTL), P_(BRN), P_(BRNL), P_(BRNEQ), P_(BRNEQL), P_(TCALL), | |
277 | - P_(TCALLL), P_(CALL), P_(CALLL), P_(RECUR), P_(RECURL), P_(TRECUR), | |
278 | - P_(TRECURL), P_(SETC), P_(SETCL), P_(SETA), P_(SETAL), P_(SETP), | |
279 | - P_(SETPL), P_(SETG), P_(SETGL), P_(LOADC), P_(LOADCL), P_(LOADA), | |
280 | - P_(LOADAL), P_(LOADP), P_(LOADPL), P_(LOADG), P_(LOADGL), P_(LOADV), | |
281 | - P_(LOADVL), P_(LOADX), P_(LOADXL), P_(BIND), P_(BINDL), P_(MKFRAME), | |
282 | - P_(MKFRAMEL), P_(UNWIND), P_(UNWINDL), P_(TRYBEGIN), P_(TRYBEGINL), | |
283 | - P_(SETAPOP), P_(SETAPOPL), P_(IRTJMP), P_(IRTJMPL), P_(OPTARGS), | |
284 | - P_(OPTARGSL), P_(BRBOUND), P_(BRBOUNDL), P_(KWARGS), P_(KWARGSL) | |
275 | + P_(LDCALLER), P_(PREPFRM), P_(CAPTENV), P_(VARGC), P_(VARGCL), P_(JMP), | |
276 | + P_(JMPL), P_(BRT), P_(BRTL), P_(BRN), P_(BRNL), P_(BRNEQ), P_(BRNEQL), | |
277 | + P_(TCALL), P_(TCALLL), P_(CALL), P_(CALLL), P_(RECUR), P_(RECURL), | |
278 | + P_(TRECUR), P_(TRECURL), P_(SETC), P_(SETCL), P_(SETA), P_(SETAL), | |
279 | + P_(SETP), P_(SETPL), P_(SETG), P_(SETGL), P_(LOADC), P_(LOADCL), | |
280 | + P_(LOADA), P_(LOADAL), P_(LOADP), P_(LOADPL), P_(LOADG), P_(LOADGL), | |
281 | + P_(LOADV), P_(LOADVL), P_(LOADX), P_(LOADXL), P_(BIND), P_(BINDL), | |
282 | + P_(MKFRAME), P_(MKFRAMEL), P_(UNWIND), P_(UNWINDL), P_(TRYBEGIN), | |
283 | + P_(TRYBEGINL), P_(SETAPOP), P_(SETAPOPL), P_(IRTJMP), P_(IRTJMPL), | |
284 | + P_(OPTARGS), P_(OPTARGSL), P_(BRBOUND), P_(BRBOUNDL), P_(KWARGS), | |
285 | + P_(KWARGSL) | |
285 | 286 | }; |
286 | 287 | |
287 | 288 | # undef P_ |
@@ -855,6 +856,10 @@ | ||
855 | 856 | U_PUSH (retval); |
856 | 857 | NEXT_OP; |
857 | 858 | |
859 | + OP_(CAPTENV): | |
860 | + captenv (interp, lastf); | |
861 | + NEXT_OP; | |
862 | + | |
858 | 863 | OP_(CLOSURE): |
859 | 864 | { |
860 | 865 | function *fp = as_fct (alloc_fct (interp)); |
@@ -17,6 +17,7 @@ | ||
17 | 17 | #include "xtime.h" |
18 | 18 | #include "continuation.h" |
19 | 19 | #include "bytecode.h" |
20 | +#include "builtins.h" | |
20 | 21 | #include "event.h" |
21 | 22 | |
22 | 23 | QP_DECLS_BEGIN |
@@ -31,6 +31,7 @@ | ||
31 | 31 | raise2 0 0 |
32 | 32 | ldcaller 0 0 |
33 | 33 | prepfrm 0 0 |
34 | +captenv 0 0 | |
34 | 35 | vargc 1 0 |
35 | 36 | vargc.l 1 long |
36 | 37 | jmp 1 branch |