| blob | 840d54ecb69068b31beffcf7ce2664a313f804d0 |
1 /*
2 * Copyright (C) 2024 Mikulas Patocka
3 *
4 * This file is part of Ajla.
5 *
6 * Ajla is free software: you can redistribute it and/or modify it under the
7 * terms of the GNU General Public License as published by the Free Software
8 * Foundation, either version 3 of the License, or (at your option) any later
9 * version.
10 *
11 * Ajla is distributed in the hope that it will be useful, but WITHOUT ANY
12 * WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
13 * A PARTICULAR PURPOSE. See the GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License along with
16 * Ajla. If not, see <https://www.gnu.org/licenses/>.
17 */
19 #if ARG_MODE == 0
20 #define get_param(ip, n) (!((n) & 1) ? get_lo((ip) + (n) / 2) : get_hi((ip) + (n) / 2))
21 #define param_size(n) (((n) + 1) / 2)
22 #elif ARG_MODE == 1
23 /* A cast to uintptr_t because of gcc optimizer inefficiency */
24 #define get_param(ip, n) ((uintptr_t)(ip)[n])
25 #define param_size(n) (n)
26 #elif ARG_MODE == 2
27 #define get_param(ip, n) get_unaligned_32(&(ip)[(n) * 2])
28 #define param_size(n) ((n) * 2)
29 #endif
31 #define get_i_param(n) get_param(ip + 1, n)
32 #define ADVANCE_I_PARAM(n) ADVANCE_IP(1 + param_size(n))
35 #ifdef EMIT_FUNCTIONS
36 static const code_t attr_cold *cat(free_parameters_,ARG_MODE)(frame_s *fp, const code_t *ip, frame_t n_entries)
37 {
38 while (n_entries--) {
39 if (get_param(ip, 1) & OPCODE_FLAG_FREE_ARGUMENT)
40 frame_free_and_clear(fp, get_param(ip, 0));
41 ADVANCE_IP(param_size(2));
42 }
43 return ip;
44 }
45 #endif
48 #define move_scalar(utype) \
49 do { \
50 frame_t slot_1 = get_i_param(0); \
51 frame_t slot_r = get_i_param(1); \
52 ajla_assert(!frame_test_flag(fp, slot_r), (file_line, "scalar move: flag already set for destination slot %"PRIuMAX"", (uintmax_t)slot_r));\
53 barrier_aliasing(); \
54 if (unlikely(frame_test_and_clear_flag(fp, slot_1))) { \
55 frame_set_pointer(fp, slot_r, *frame_pointer(fp, slot_1));\
56 pointer_poison(frame_pointer(fp, slot_1)); \
57 } else { \
58 *frame_slot(fp, slot_r, utype) = \
59 *frame_slot(fp, slot_1, utype); \
60 } \
61 barrier_aliasing(); \
62 ADVANCE_I_PARAM(2); \
63 } while (0)
65 #define copy_scalar(utype) \
66 do { \
67 frame_t slot_1 = get_i_param(0); \
68 frame_t slot_r = get_i_param(1); \
69 ajla_assert(!frame_test_flag(fp, slot_r), (file_line, "scalar copy: flag already set for destination slot %"PRIuMAX"", (uintmax_t)slot_r));\
70 barrier_aliasing(); \
71 if (unlikely(frame_test_flag(fp, slot_1))) { \
72 pointer_t ptr = *frame_pointer(fp, slot_1); \
73 frame_set_pointer(fp, slot_r, ptr); \
74 pointer_reference_owned(ptr); \
75 } else { \
76 *frame_slot(fp, slot_r, utype) = \
77 *frame_slot(fp, slot_1, utype); \
78 } \
79 barrier_aliasing(); \
80 ADVANCE_I_PARAM(2); \
81 } while (0)
84 #define DEFINE_FIXED_REAL_BINARY_OPCODE(tc, type, op) \
85 DEFINE_OPCODE( \
86 cat3(OPCODE_,tc,OP) + \
87 cat4(OPCODE_,tc,OP_,op) * cat3(OPCODE_,tc,OP_MULT) + \
88 cat4(OPCODE_,tc,TYPE_,type) * cat3(OPCODE_,tc,TYPE_MULT),\
89 cat7(tc,binary_,op,_,type,_,ARG_MODE), \
90 frame_t slot_1 = get_i_param(0); \
91 frame_t slot_2 = get_i_param(1); \
92 frame_t slot_r = get_i_param(2); \
93 ajla_assert(slot_r == slot_1 || slot_r == slot_2 || !frame_test_flag(fp, slot_r), (file_line, "fixed binary: flag already set for destination slot %"PRIuMAX"", (uintmax_t)slot_r));\
94 if (unlikely(frame_test_2(fp, slot_1, slot_2))) { \
95 goto cat(escape_fixed_binary_thunk_,ARG_MODE); \
96 } else { \
97 const void *val1; \
98 const void *val2; \
99 void *result; \
100 val1 = frame_var(fp, slot_1); \
101 val2 = frame_var(fp, slot_2); \
102 result = frame_var(fp, slot_r); \
103 barrier_aliasing(); \
104 if (unlikely(!cat5(tc,binary_,op,_,type)(val1, val2, result))) {\
105 barrier_aliasing(); \
106 goto cat(escape_fixed_binary_thunk_,ARG_MODE); \
107 } \
108 barrier_aliasing(); \
109 ADVANCE_I_PARAM(4); \
110 } \
111 )
113 #define DEFINE_FIXED_REAL_UNARY_OPCODE(tc, type, op) \
114 DEFINE_OPCODE( \
115 cat3(OPCODE_,tc,OP) + \
116 cat4(OPCODE_,tc,OP_,op) * cat3(OPCODE_,tc,OP_MULT) + \
117 cat4(OPCODE_,tc,TYPE_,type) * cat3(OPCODE_,tc,TYPE_MULT),\
118 cat7(tc,unary_,op,_,type,_,ARG_MODE), \
119 frame_t slot_1 = get_i_param(0); \
120 frame_t slot_r = get_i_param(1); \
121 ajla_assert(slot_r == slot_1 || !frame_test_flag(fp, slot_r), (file_line, "fixed unary: flag already set for destination slot %"PRIuMAX"", (uintmax_t)slot_r));\
122 if (unlikely(frame_test_flag(fp, slot_1))) { \
123 goto cat(escape_fixed_unary_thunk_,ARG_MODE); \
124 } else { \
125 const void *val1; \
126 void *result; \
127 val1 = frame_var(fp, slot_1); \
128 result = frame_var(fp, slot_r); \
129 barrier_aliasing(); \
130 cat5(tc,unary_,op,_,type)(val1, result); \
131 barrier_aliasing(); \
132 ADVANCE_I_PARAM(3); \
133 } \
134 )
136 #define DEFINE_FIXED_TO_INT(type, utype) \
137 DEFINE_OPCODE( \
138 OPCODE_FIXED_OP + \
139 OPCODE_FIXED_OP_to_int * OPCODE_FIXED_OP_MULT + \
140 cat(OPCODE_FIXED_TYPE_,type) * OPCODE_FIXED_TYPE_MULT, \
141 cat4(FIXED_unary_to_int_,type,_,ARG_MODE), \
142 frame_t slot_1 = get_i_param(0); \
143 frame_t slot_r = get_i_param(1); \
144 if (unlikely(frame_test_flag(fp, slot_1))) { \
145 goto cat(escape_convert_thunk_,ARG_MODE); \
146 } else { \
147 type val1; \
148 int_default_t r; \
149 barrier_aliasing(); \
150 val1 = *frame_slot(fp, slot_1, type); \
151 r = (int_default_t)val1; \
152 if (unlikely(r != val1)) \
153 frame_set_pointer(fp, slot_r, convert_fixed_to_mpint(val1, false));\
154 else \
155 *frame_slot(fp, slot_r, int_default_t) = r; \
156 barrier_aliasing(); \
157 ADVANCE_I_PARAM(3); \
158 } \
159 )
161 #define DEFINE_FIXED_UTO_INT(type, utype) \
162 DEFINE_OPCODE( \
163 OPCODE_FIXED_OP + \
164 OPCODE_FIXED_OP_uto_int * OPCODE_FIXED_OP_MULT + \
165 cat(OPCODE_FIXED_TYPE_,type) * OPCODE_FIXED_TYPE_MULT, \
166 cat4(FIXED_unary_uto_int_,type,_,ARG_MODE), \
167 frame_t slot_1 = get_i_param(0); \
168 frame_t slot_r = get_i_param(1); \
169 if (unlikely(frame_test_flag(fp, slot_1))) { \
170 goto cat(escape_convert_thunk_,ARG_MODE); \
171 } else { \
172 utype val1; \
173 int_default_t r; \
174 barrier_aliasing(); \
175 val1 = *frame_slot(fp, slot_1, utype); \
176 r = (int_default_t)val1; \
177 if (unlikely((utype)r != val1) || unlikely(r < 0)) \
178 frame_set_pointer(fp, slot_r, convert_fixed_to_mpint(val1, true));\
179 else \
180 *frame_slot(fp, slot_r, int_default_t) = r; \
181 barrier_aliasing(); \
182 ADVANCE_I_PARAM(3); \
183 } \
184 )
186 #define DEFINE_FIXED_FROM_INT(type, utype) \
187 DEFINE_OPCODE( \
188 OPCODE_FIXED_OP + \
189 OPCODE_FIXED_OP_from_int * OPCODE_FIXED_OP_MULT + \
190 cat(OPCODE_FIXED_TYPE_,type) * OPCODE_FIXED_TYPE_MULT, \
191 cat4(FIXED_unary_from_int_,type,_,ARG_MODE), \
192 frame_t slot_1 = get_i_param(0); \
193 frame_t slot_r = get_i_param(1); \
194 if (unlikely(frame_test_flag(fp, slot_1))) { \
195 goto cat(escape_convert_thunk_,ARG_MODE); \
196 } else { \
197 int_default_t val1; \
198 type r; \
199 barrier_aliasing(); \
200 val1 = *frame_slot(fp, slot_1, int_default_t); \
201 r = (type)val1; \
202 if (unlikely(r != val1)) \
203 frame_set_pointer(fp, slot_r, pointer_error(error_ajla(EC_SYNC, AJLA_ERROR_DOESNT_FIT), fp, ip pass_file_line));\
204 else \
205 *frame_slot(fp, slot_r, type) = r; \
206 barrier_aliasing(); \
207 ADVANCE_I_PARAM(3); \
208 } \
209 )
211 #define DEFINE_FIXED_UFROM_INT(type, utype) \
212 DEFINE_OPCODE( \
213 OPCODE_FIXED_OP + \
214 OPCODE_FIXED_OP_ufrom_int * OPCODE_FIXED_OP_MULT + \
215 cat(OPCODE_FIXED_TYPE_,type) * OPCODE_FIXED_TYPE_MULT, \
216 cat4(FIXED_unary_ufrom_int_,type,_,ARG_MODE), \
217 frame_t slot_1 = get_i_param(0); \
218 frame_t slot_r = get_i_param(1); \
219 if (unlikely(frame_test_flag(fp, slot_1))) { \
220 goto cat(escape_convert_thunk_,ARG_MODE); \
221 } else { \
222 int_default_t val1; \
223 utype r; \
224 barrier_aliasing(); \
225 val1 = *frame_slot(fp, slot_1, int_default_t); \
226 r = (utype)val1; \
227 if (unlikely((int_default_t)r != val1) || unlikely(val1 < 0))\
228 frame_set_pointer(fp, slot_r, pointer_error(error_ajla(EC_SYNC, AJLA_ERROR_DOESNT_FIT), fp, ip pass_file_line));\
229 else \
230 *frame_slot(fp, slot_r, type) = r; \
231 barrier_aliasing(); \
232 ADVANCE_I_PARAM(3); \
233 } \
234 )
236 #define DEFINE_SCALAR_MOVE_OPCODE(tc, type) \
237 DEFINE_OPCODE( \
238 cat3(OPCODE_,tc,OP) + \
239 cat3(OPCODE_,tc,OP_move) * cat3(OPCODE_,tc,OP_MULT) + \
240 cat4(OPCODE_,tc,TYPE_,type) * cat3(OPCODE_,tc,TYPE_MULT),\
241 cat5(tc,move_,type,_,ARG_MODE), \
242 move_scalar(type); \
243 )
245 #define DEFINE_SCALAR_COPY_OPCODE(tc, type) \
246 DEFINE_OPCODE( \
247 cat3(OPCODE_,tc,OP) + \
248 cat3(OPCODE_,tc,OP_copy) * cat3(OPCODE_,tc,OP_MULT) + \
249 cat4(OPCODE_,tc,TYPE_,type) * cat3(OPCODE_,tc,TYPE_MULT),\
250 cat5(tc,copy_,type,_,ARG_MODE), \
251 copy_scalar(type); \
252 )
254 #define DEFINE_FIXED_LDC_OPCODE(cls, type, utype, opc, shrt) \
255 DEFINE_OPCODE( \
256 OPCODE_##cls##_OP + \
257 OPCODE_##cls##_OP_##opc * OPCODE_##cls##_OP_MULT + \
258 cat(OPCODE_##cls##_TYPE_,type) * OPCODE_##cls##_TYPE_MULT,\
259 cat6(fixed_,opc,_,type,_,ARG_MODE), \
260 frame_t slot; \
261 utype *val; \
262 ip_t sz; \
263 slot = get_i_param(0); \
264 ajla_assert(!frame_test_flag(fp, slot), (file_line, "ldc fixed: flag already set for destination slot %"PRIuMAX"", (uintmax_t)slot));\
265 val = frame_slot(fp, slot, utype); \
266 barrier_aliasing(); \
267 sz = cat(fixed_ldc_,type)(val, ip + 1 + param_size(1), shrt); \
268 barrier_aliasing(); \
269 ADVANCE_I_PARAM(1); \
270 ADVANCE_IP(sz); \
271 )
273 #define DEFINE_FIXED_OPCODES(n, type, utype, sz, bits) \
274 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, add) \
275 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, subtract) \
276 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, multiply) \
277 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, divide) \
278 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, udivide) \
279 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, modulo) \
280 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, umodulo) \
281 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, power) \
282 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, and) \
283 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, or) \
284 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, xor) \
285 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, shl) \
286 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, shr) \
287 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, ushr) \
288 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, rol) \
289 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, ror) \
290 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, bts) \
291 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, btr) \
292 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, btc) \
293 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, equal) \
294 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, not_equal)\
295 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, less) \
296 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, less_equal)\
297 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, uless) \
298 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, uless_equal)\
299 DEFINE_FIXED_REAL_BINARY_OPCODE(FIXED_, type, bt) \
300 DEFINE_FIXED_REAL_UNARY_OPCODE(FIXED_, type, not) \
301 DEFINE_FIXED_REAL_UNARY_OPCODE(FIXED_, type, neg) \
302 DEFINE_FIXED_REAL_UNARY_OPCODE(FIXED_, type, inc) \
303 DEFINE_FIXED_REAL_UNARY_OPCODE(FIXED_, type, dec) \
304 DEFINE_FIXED_REAL_UNARY_OPCODE(FIXED_, type, bswap) \
305 DEFINE_FIXED_REAL_UNARY_OPCODE(FIXED_, type, brev) \
306 DEFINE_FIXED_REAL_UNARY_OPCODE(FIXED_, type, bsf) \
307 DEFINE_FIXED_REAL_UNARY_OPCODE(FIXED_, type, bsr) \
308 DEFINE_FIXED_REAL_UNARY_OPCODE(FIXED_, type, popcnt) \
309 DEFINE_FIXED_TO_INT(type, utype) \
310 DEFINE_FIXED_UTO_INT(type, utype) \
311 DEFINE_FIXED_FROM_INT(type, utype) \
312 DEFINE_FIXED_UFROM_INT(type, utype) \
313 DEFINE_SCALAR_MOVE_OPCODE(FIXED_, type) \
314 DEFINE_SCALAR_COPY_OPCODE(FIXED_, type) \
315 DEFINE_FIXED_LDC_OPCODE(FIXED, type, utype, ldc, false)
317 for_all_fixed(DEFINE_FIXED_OPCODES)
319 #if TYPE_FIXED_N >= 3
320 DEFINE_FIXED_LDC_OPCODE(FIXED, int32_t, uint32_t, ldc16, true)
321 #if TYPE_FIXED_N >= 4
322 DEFINE_FIXED_LDC_OPCODE(FIXED, int64_t, uint64_t, ldc16, true)
323 #if TYPE_FIXED_N >= 5
324 DEFINE_FIXED_LDC_OPCODE(FIXED, int128_t, uint128_t, ldc16, true)
325 #endif
326 #endif
327 #endif
330 #define DEFINE_REAL_TO_INT(type, op) \
331 DEFINE_OPCODE( \
332 OPCODE_REAL_OP + \
333 cat(OPCODE_REAL_OP_,op) * OPCODE_REAL_OP_MULT + \
334 cat(OPCODE_REAL_TYPE_,type) * OPCODE_REAL_TYPE_MULT, \
335 cat6(REAL_unary_,op,_,type,_,ARG_MODE), \
336 frame_t slot_1 = get_i_param(0); \
337 frame_t slot_r = get_i_param(1); \
338 if (unlikely(frame_test_flag(fp, slot_1))) { \
339 goto cat(escape_convert_thunk_,ARG_MODE); \
340 } else { \
341 bool ret; \
342 barrier_aliasing(); \
343 ret = cat4(REAL_unary_,op,_,type)(frame_slot(fp, slot_1, type), frame_slot(fp, slot_r, int_default_t));\
344 barrier_aliasing(); \
345 if (unlikely(!ret)) \
346 frame_set_pointer(fp, slot_r, convert_real_to_mpint(fp, slot_1, frame_get_type_of_local(fp, slot_1)));\
347 ADVANCE_I_PARAM(3); \
348 } \
349 )
351 #define DEFINE_REAL_FROM_INT(type, op) \
352 DEFINE_OPCODE( \
353 OPCODE_REAL_OP + \
354 cat(OPCODE_REAL_OP_,op) * OPCODE_REAL_OP_MULT + \
355 cat(OPCODE_REAL_TYPE_,type) * OPCODE_REAL_TYPE_MULT, \
356 cat6(REAL_unary_,op,_,type,_,ARG_MODE), \
357 frame_t slot_1 = get_i_param(0); \
358 frame_t slot_r = get_i_param(1); \
359 if (unlikely(frame_test_flag(fp, slot_1))) { \
360 goto cat(escape_convert_thunk_,ARG_MODE); \
361 } else { \
362 barrier_aliasing(); \
363 cat4(REAL_unary_,op,_,type)(frame_slot(fp, slot_1, int_default_t), frame_slot(fp, slot_r, type));\
364 barrier_aliasing(); \
365 ADVANCE_I_PARAM(3); \
366 } \
367 )
370 #define DEFINE_REAL_OPCODES(n, type, ntype, pack, unpack)\
371 DEFINE_FIXED_REAL_BINARY_OPCODE(REAL_, type, add) \
372 DEFINE_FIXED_REAL_BINARY_OPCODE(REAL_, type, subtract) \
373 DEFINE_FIXED_REAL_BINARY_OPCODE(REAL_, type, multiply) \
374 DEFINE_FIXED_REAL_BINARY_OPCODE(REAL_, type, divide) \
375 DEFINE_FIXED_REAL_BINARY_OPCODE(REAL_, type, modulo) \
376 DEFINE_FIXED_REAL_BINARY_OPCODE(REAL_, type, power) \
377 DEFINE_FIXED_REAL_BINARY_OPCODE(REAL_, type, ldexp) \
378 DEFINE_FIXED_REAL_BINARY_OPCODE(REAL_, type, atan2) \
379 DEFINE_FIXED_REAL_BINARY_OPCODE(REAL_, type, equal) \
380 DEFINE_FIXED_REAL_BINARY_OPCODE(REAL_, type, not_equal) \
381 DEFINE_FIXED_REAL_BINARY_OPCODE(REAL_, type, less) \
382 DEFINE_FIXED_REAL_BINARY_OPCODE(REAL_, type, less_equal)\
383 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, neg) \
384 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, sqrt) \
385 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, cbrt) \
386 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, sin) \
387 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, cos) \
388 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, tan) \
389 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, asin) \
390 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, acos) \
391 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, atan) \
392 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, sinh) \
393 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, cosh) \
394 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, tanh) \
395 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, asinh) \
396 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, acosh) \
397 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, atanh) \
398 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, exp2) \
399 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, exp) \
400 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, exp10) \
401 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, log2) \
402 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, log) \
403 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, log10) \
404 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, round) \
405 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, ceil) \
406 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, floor) \
407 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, trunc) \
408 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, fract) \
409 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, mantissa) \
410 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, exponent) \
411 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, next_number)\
412 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, prev_number)\
413 DEFINE_REAL_TO_INT(type, to_int) \
414 DEFINE_REAL_FROM_INT(type, from_int) \
415 DEFINE_FIXED_REAL_UNARY_OPCODE(REAL_, type, is_exception)\
416 DEFINE_SCALAR_MOVE_OPCODE(REAL_, type) \
417 DEFINE_SCALAR_COPY_OPCODE(REAL_, type) \
418 DEFINE_FIXED_LDC_OPCODE(REAL, type, type, ldc, false)
420 for_all_real(DEFINE_REAL_OPCODES, for_all_empty)
423 DEFINE_LABEL(cat(escape_fixed_binary_thunk_,ARG_MODE),
424 void *ex;
425 ASM_PREVENT_CSE;
426 ex = thunk_fixed_operator(fp, ip, get_i_param(0), get_i_param(1), get_i_param(2), get_i_param(3));
427 if (ex == POINTER_FOLLOW_THUNK_GO)
428 ADVANCE_I_PARAM(4);
429 else if (unlikely(ex != POINTER_FOLLOW_THUNK_RETRY))
430 RELOAD_EX_POSITION(ex);
431 )
434 DEFINE_LABEL(cat(escape_fixed_unary_thunk_,ARG_MODE),
435 void *ex;
436 ASM_PREVENT_CSE;
437 ex = thunk_fixed_operator(fp, ip, get_i_param(0), NO_FRAME_T, get_i_param(1), get_i_param(2));
438 if (ex == POINTER_FOLLOW_THUNK_GO)
439 ADVANCE_I_PARAM(3);
440 else if (unlikely(ex != POINTER_FOLLOW_THUNK_RETRY))
441 RELOAD_EX_POSITION(ex);
442 )
445 DEFINE_LABEL(cat(escape_convert_thunk_,ARG_MODE),
446 void *ex;
447 ASM_PREVENT_CSE;
448 ex = thunk_convert(fp, ip, get_i_param(0), get_i_param(1), get_i_param(2));
449 if (ex == POINTER_FOLLOW_THUNK_GO)
450 ADVANCE_I_PARAM(3);
451 else if (unlikely(ex != POINTER_FOLLOW_THUNK_RETRY))
452 RELOAD_EX_POSITION(ex);
453 )
456 START_BLOCK(
457 bool (attr_fastcall *function_int_binary)(const mpint_t *s1, const mpint_t *s2, mpint_t *r, ajla_error_t *err);
458 bool (attr_fastcall *function_int_binary_logical)(const mpint_t *s1, const mpint_t *s2, ajla_flat_option_t *r, ajla_error_t *err);
459 bool (attr_fastcall *function_int_unary)(const mpint_t *s1, mpint_t *r, ajla_error_t *err);
460 )
462 #define DEFINE_INT_BINARY_OPCODE(type, op) \
463 DEFINE_OPCODE( \
464 OPCODE_INT_OP + \
465 cat(OPCODE_INT_OP_,op) * OPCODE_INT_OP_MULT + \
466 cat(OPCODE_INT_TYPE_,type) * OPCODE_INT_TYPE_MULT, \
467 cat6(int_binary_,op,_,type,_,ARG_MODE), \
468 frame_t slot_1 = get_i_param(0); \
469 frame_t slot_2 = get_i_param(1); \
470 frame_t slot_r = get_i_param(2); \
471 ajla_assert(slot_r == slot_1 || slot_r == slot_2 || !frame_test_flag(fp, slot_r), (file_line, "int binary: flag already set for destination slot %"PRIuMAX"", (uintmax_t)slot_r));\
472 if (unlikely(frame_test_2(fp, slot_1, slot_2))) { \
473 cat6(escape_int_binary_,op,_,type,_,ARG_MODE): \
474 function_int_binary = cat(mpint_,op); \
475 goto cat(escape_int_binary_thunk_,ARG_MODE); \
476 } else { \
477 const void *val1; \
478 const void *val2; \
479 void *result; \
480 val1 = frame_var(fp, slot_1); \
481 val2 = frame_var(fp, slot_2); \
482 result = frame_var(fp, slot_r); \
483 barrier_aliasing(); \
484 if (unlikely(!cat4(INT_binary_,op,_,type)(val1, val2, result))) {\
485 barrier_aliasing(); \
486 goto cat6(escape_int_binary_,op,_,type,_,ARG_MODE);\
487 } \
488 barrier_aliasing(); \
489 ADVANCE_I_PARAM(4); \
490 } \
491 )
493 #define DEFINE_INT_BINARY_LOGICAL_OPCODE(type, op) \
494 DEFINE_OPCODE( \
495 OPCODE_INT_OP + \
496 cat(OPCODE_INT_OP_,op) * OPCODE_INT_OP_MULT + \
497 cat(OPCODE_INT_TYPE_,type) * OPCODE_INT_TYPE_MULT, \
498 cat6(int_binary_,op,_,type,_,ARG_MODE), \
499 frame_t slot_1 = get_i_param(0); \
500 frame_t slot_2 = get_i_param(1); \
501 frame_t slot_r = get_i_param(2); \
502 ajla_assert(slot_r == slot_1 || slot_r == slot_2 || !frame_test_flag(fp, slot_r), (file_line, "int logical: flag already set for destination slot %"PRIuMAX"", (uintmax_t)slot_r));\
503 if (unlikely(frame_test_2(fp, slot_1, slot_2))) { \
504 cat6(escape_int_binary_logical_,op,_,type,_,ARG_MODE): \
505 function_int_binary_logical = cat(mpint_,op); \
506 goto cat(escape_int_binary_logical_thunk_,ARG_MODE); \
507 } else { \
508 const void *val1; \
509 const void *val2; \
510 void *result; \
511 val1 = frame_var(fp, slot_1); \
512 val2 = frame_var(fp, slot_2); \
513 result = frame_var(fp, slot_r); \
514 barrier_aliasing(); \
515 if (unlikely(!cat4(INT_binary_,op,_,type)(val1, val2, result))) {\
516 barrier_aliasing(); \
517 goto cat6(escape_int_binary_logical_,op,_,type,_,ARG_MODE);\
518 } \
519 barrier_aliasing(); \
520 ADVANCE_I_PARAM(4); \
521 } \
522 )
524 #define DEFINE_INT_UNARY_OPCODE(type, op) \
525 DEFINE_OPCODE( \
526 OPCODE_INT_OP + \
527 cat(OPCODE_INT_OP_,op) * OPCODE_INT_OP_MULT + \
528 cat(OPCODE_INT_TYPE_,type) * OPCODE_INT_TYPE_MULT, \
529 cat6(int_binary_,op,_,type,_,ARG_MODE), \
530 frame_t slot_1 = get_i_param(0); \
531 frame_t slot_r = get_i_param(1); \
532 ajla_assert(slot_r == slot_1 || !frame_test_flag(fp, slot_r), (file_line, "int unary: flag already set for destination slot %"PRIuMAX"", (uintmax_t)slot_r));\
533 if (unlikely(frame_test_flag(fp, slot_1))) { \
534 cat6(escape_int_unary_,op,_,type,_,ARG_MODE): \
535 function_int_unary = cat(mpint_,op); \
536 goto cat(escape_int_unary_thunk_,ARG_MODE); \
537 } else { \
538 const void *val1; \
539 void *result; \
540 val1 = frame_var(fp, slot_1); \
541 result = frame_var(fp, slot_r); \
542 barrier_aliasing(); \
543 if (unlikely(!cat4(INT_unary_,op,_,type)(val1, result))) {\
544 barrier_aliasing(); \
545 goto cat6(escape_int_unary_,op,_,type,_,ARG_MODE);\
546 } \
547 barrier_aliasing(); \
548 ADVANCE_I_PARAM(3); \
549 } \
550 )
552 #define DEFINE_INT_TO_INT(type) \
553 DEFINE_OPCODE( \
554 OPCODE_INT_OP + \
555 OPCODE_INT_OP_to_int * OPCODE_INT_OP_MULT + \
556 cat(OPCODE_INT_TYPE_,type) * OPCODE_INT_TYPE_MULT, \
557 cat4(INT_unary_to_int_,type,_,ARG_MODE), \
558 frame_t slot_1 = get_i_param(0); \
559 frame_t slot_r = get_i_param(1); \
560 if (unlikely(frame_test_flag(fp, slot_1))) { \
561 goto cat(escape_convert_thunk_,ARG_MODE); \
562 } else { \
563 type val1; \
564 int_default_t r; \
565 barrier_aliasing(); \
566 val1 = *frame_slot(fp, slot_1, type); \
567 r = (int_default_t)val1; \
568 if (unlikely(r != val1)) \
569 frame_set_pointer(fp, slot_r, convert_fixed_to_mpint(val1, false));\
570 else \
571 *frame_slot(fp, slot_r, int_default_t) = r; \
572 barrier_aliasing(); \
573 ADVANCE_I_PARAM(3); \
574 } \
575 )
577 #define DEFINE_INT_FROM_INT(typeid, type) \
578 DEFINE_OPCODE( \
579 OPCODE_INT_OP + \
580 OPCODE_INT_OP_from_int * OPCODE_INT_OP_MULT + \
581 cat(OPCODE_INT_TYPE_,type) * OPCODE_INT_TYPE_MULT, \
582 cat4(INT_unary_from_int_,type,_,ARG_MODE), \
583 frame_t slot_1 = get_i_param(0); \
584 frame_t slot_r = get_i_param(1); \
585 if (unlikely(frame_test_flag(fp, slot_1))) { \
586 goto cat(escape_convert_thunk_,ARG_MODE); \
587 } else { \
588 int_default_t val1; \
589 type r; \
590 barrier_aliasing(); \
591 val1 = *frame_slot(fp, slot_1, int_default_t); \
592 r = (type)val1; \
593 if (unlikely(r != val1)) \
594 frame_set_pointer(fp, slot_r, convert_fixed_to_mpint(val1, false));\
595 else \
596 *frame_slot(fp, slot_r, type) = r; \
597 barrier_aliasing(); \
598 ADVANCE_I_PARAM(3); \
599 } \
600 )
602 #define DEFINE_INT_LDC_OPCODE(type, opc, shrt) \
603 DEFINE_OPCODE( \
604 OPCODE_INT_OP + \
605 OPCODE_INT_OP_##opc * OPCODE_INT_OP_MULT + \
606 cat(OPCODE_INT_TYPE_,type) * OPCODE_INT_TYPE_MULT, \
607 cat6(int_,opc,_,type,_,ARG_MODE), \
608 frame_t slot; \
609 type *val; \
610 ip_t sz; \
611 slot = get_i_param(0); \
612 ajla_assert(!frame_test_flag(fp, slot), (file_line, "ldc int: flag already set for destination slot %"PRIuMAX"", (uintmax_t)slot));\
613 val = frame_slot(fp, slot, type); \
614 barrier_aliasing(); \
615 sz = cat(int_ldc_,type)(val, ip + 1 + param_size(1), shrt); \
616 barrier_aliasing(); \
617 ADVANCE_I_PARAM(1); \
618 ADVANCE_IP(sz); \
619 )
621 #define DEFINE_INT_OPCODES(typeid, s, u, sz, bits) \
622 DEFINE_INT_BINARY_OPCODE(s, add) \
623 DEFINE_INT_BINARY_OPCODE(s, subtract) \
624 DEFINE_INT_BINARY_OPCODE(s, multiply) \
625 DEFINE_INT_BINARY_OPCODE(s, divide) \
626 DEFINE_INT_BINARY_OPCODE(s, modulo) \
627 DEFINE_INT_BINARY_OPCODE(s, power) \
628 DEFINE_INT_BINARY_OPCODE(s, and) \
629 DEFINE_INT_BINARY_OPCODE(s, or) \
630 DEFINE_INT_BINARY_OPCODE(s, xor) \
631 DEFINE_INT_BINARY_OPCODE(s, shl) \
632 DEFINE_INT_BINARY_OPCODE(s, shr) \
633 DEFINE_INT_BINARY_OPCODE(s, bts) \
634 DEFINE_INT_BINARY_OPCODE(s, btr) \
635 DEFINE_INT_BINARY_OPCODE(s, btc) \
636 DEFINE_INT_BINARY_LOGICAL_OPCODE(s, equal) \
637 DEFINE_INT_BINARY_LOGICAL_OPCODE(s, not_equal) \
638 DEFINE_INT_BINARY_LOGICAL_OPCODE(s, less) \
639 DEFINE_INT_BINARY_LOGICAL_OPCODE(s, less_equal) \
640 DEFINE_INT_BINARY_LOGICAL_OPCODE(s, bt) \
641 DEFINE_INT_UNARY_OPCODE(s, not) \
642 DEFINE_INT_UNARY_OPCODE(s, neg) \
643 DEFINE_INT_UNARY_OPCODE(s, inc) \
644 DEFINE_INT_UNARY_OPCODE(s, dec) \
645 DEFINE_INT_UNARY_OPCODE(s, bsf) \
646 DEFINE_INT_UNARY_OPCODE(s, bsr) \
647 DEFINE_INT_UNARY_OPCODE(s, popcnt) \
648 DEFINE_INT_TO_INT(s) \
649 DEFINE_INT_FROM_INT(typeid, s) \
650 DEFINE_SCALAR_MOVE_OPCODE(INT_, s) \
651 DEFINE_SCALAR_COPY_OPCODE(INT_, s) \
652 DEFINE_INT_LDC_OPCODE(s, ldc, false) \
653 DEFINE_INT_LDC_OPCODE(s, ldc16, true)
655 for_all_int(DEFINE_INT_OPCODES, for_all_empty)
657 DEFINE_LABEL(cat(escape_int_binary_thunk_,ARG_MODE),
658 void *ex;
659 ASM_PREVENT_CSE;
660 ex = thunk_int_binary_operator(fp, ip, get_i_param(0), get_i_param(1), get_i_param(2), get_i_param(3), function_int_binary);
661 if (ex == POINTER_FOLLOW_THUNK_GO)
662 ADVANCE_I_PARAM(4);
663 else if (unlikely(ex != POINTER_FOLLOW_THUNK_RETRY))
664 RELOAD_EX_POSITION(ex);
665 )
667 DEFINE_LABEL(cat(escape_int_binary_logical_thunk_,ARG_MODE),
668 void *ex;
669 ASM_PREVENT_CSE;
670 ex = thunk_int_binary_logical_operator(fp, ip, get_i_param(0), get_i_param(1), get_i_param(2), get_i_param(3), function_int_binary_logical);
671 if (ex == POINTER_FOLLOW_THUNK_GO)
672 ADVANCE_I_PARAM(4);
673 else if (ex != POINTER_FOLLOW_THUNK_RETRY)
674 RELOAD_EX_POSITION(ex);
675 )
677 DEFINE_LABEL(cat(escape_int_unary_thunk_,ARG_MODE),
678 void *ex;
679 ASM_PREVENT_CSE;
680 ex = thunk_int_unary_operator(fp, ip, get_i_param(0), get_i_param(1), get_i_param(2), function_int_unary);
681 if (ex == POINTER_FOLLOW_THUNK_GO)
682 ADVANCE_I_PARAM(3);
683 else if (unlikely(ex != POINTER_FOLLOW_THUNK_RETRY))
684 RELOAD_EX_POSITION(ex);
685 )
687 #define file_inc "ipret-a1.inc"
688 #include "for-fix.inc"
690 #define file_inc "ipret-a2.inc"
691 #include "for-int.inc"
693 #define file_inc "ipret-a3.inc"
694 #include "for-real.inc"
696 END_BLOCK()
699 #define DEFINE_BOOL_BINARY_OPCODE(op, operator) \
700 DEFINE_OPCODE( \
701 OPCODE_BOOL_OP + \
702 cat(OPCODE_BOOL_OP_,op) * OPCODE_BOOL_OP_MULT, \
703 cat4(bool_binary_,op,_,ARG_MODE), \
704 frame_t slot_1 = get_i_param(0); \
705 frame_t slot_2 = get_i_param(1); \
706 frame_t slot_r = get_i_param(2); \
707 \
708 if (unlikely(frame_test_2(fp, slot_1, slot_2))) { \
709 ajla_assert(slot_r == slot_1 || slot_r == slot_2 || !frame_test_flag(fp, slot_r), (file_line, "bool binary: flag already set for destination slot %"PRIuMAX"", (uintmax_t)slot_r));\
710 goto cat(escape_bool_binary_thunk_,ARG_MODE); \
711 } else { \
712 ajla_flat_option_t val1; \
713 ajla_flat_option_t val2; \
714 ajla_flat_option_t result; \
715 barrier_aliasing(); \
716 val1 = *frame_slot(fp, slot_1, ajla_flat_option_t); \
717 val2 = *frame_slot(fp, slot_2, ajla_flat_option_t); \
718 result = val1 operator val2; \
719 *frame_slot(fp, slot_r, ajla_flat_option_t) = result; \
720 barrier_aliasing(); \
721 ADVANCE_I_PARAM(4); \
722 } \
723 )
725 #define DEFINE_BOOL_UNARY_OPCODE(op, operator) \
726 DEFINE_OPCODE( \
727 OPCODE_BOOL_OP + \
728 cat(OPCODE_BOOL_OP_,op) * OPCODE_BOOL_OP_MULT, \
729 cat4(bool_unary_,op,_,ARG_MODE), \
730 frame_t slot_1 = get_i_param(0); \
731 frame_t slot_r = get_i_param(1); \
732 \
733 ajla_assert(slot_r == slot_1 || !frame_test_flag(fp, slot_r), (file_line, "bool unary: flag already set for destination slot %"PRIuMAX"", (uintmax_t)slot_r));\
734 if (unlikely(frame_test_flag(fp, slot_1))) { \
735 goto cat(escape_bool_unary_thunk_,ARG_MODE); \
736 } else { \
737 ajla_flat_option_t val1; \
738 ajla_flat_option_t result; \
739 barrier_aliasing(); \
740 val1 = *frame_slot(fp, slot_1, ajla_flat_option_t); \
741 result = val1 operator; \
742 *frame_slot(fp, slot_r, ajla_flat_option_t) = result; \
743 barrier_aliasing(); \
744 ADVANCE_I_PARAM(3); \
745 } \
746 )
748 DEFINE_BOOL_BINARY_OPCODE(and, &)
749 DEFINE_BOOL_BINARY_OPCODE(or, |)
750 DEFINE_BOOL_BINARY_OPCODE(equal, ==)
751 DEFINE_BOOL_BINARY_OPCODE(not_equal, ^)
752 DEFINE_BOOL_BINARY_OPCODE(less, <)
753 DEFINE_BOOL_BINARY_OPCODE(less_equal, <=)
754 DEFINE_BOOL_UNARY_OPCODE(not, ^ 1)
756 DEFINE_LABEL(cat(escape_bool_binary_thunk_,ARG_MODE),
757 void *ex;
758 ASM_PREVENT_CSE;
759 ex = thunk_bool_operator(fp, ip, get_i_param(0), get_i_param(1), get_i_param(2), get_i_param(3));
760 if (ex == POINTER_FOLLOW_THUNK_GO)
761 ADVANCE_I_PARAM(4);
762 else if (unlikely(ex != POINTER_FOLLOW_THUNK_RETRY))
763 RELOAD_EX_POSITION(ex);
764 )
766 DEFINE_LABEL(cat(escape_bool_unary_thunk_,ARG_MODE),
767 void *ex;
768 ASM_PREVENT_CSE;
769 ex = thunk_bool_operator(fp, ip, get_i_param(0), NO_FRAME_T, get_i_param(1), get_i_param(2));
770 if (ex == POINTER_FOLLOW_THUNK_GO)
771 ADVANCE_I_PARAM(3);
772 else if (unlikely(ex != POINTER_FOLLOW_THUNK_RETRY))
773 RELOAD_EX_POSITION(ex);
774 )
777 DEFINE_OPCODE_START_LBL(OPCODE_BOOL_OP + OPCODE_BOOL_OP_move, cat(bool_move_,ARG_MODE))
778 #ifdef EMIT_CODE
779 move_scalar(ajla_flat_option_t);
780 #endif
781 DEFINE_OPCODE_END(OPCODE_BOOL_OP + OPCODE_BOOL_OP_move)
783 DEFINE_OPCODE_START_LBL(OPCODE_BOOL_OP + OPCODE_BOOL_OP_copy, cat(bool_copy_,ARG_MODE))
784 #ifdef EMIT_CODE
785 copy_scalar(ajla_flat_option_t);
786 #endif
787 DEFINE_OPCODE_END(OPCODE_BOOL_OP + OPCODE_BOOL_OP_copy)
790 DEFINE_OPCODE_START(OPCODE_INT_LDC_LONG)
791 #ifdef EMIT_CODE
792 frame_t slot;
793 ip_t sz;
794 slot = get_i_param(0);
795 sz = ipret_int_ldc_long(fp, slot, ip + 1 + param_size(1));
796 ADVANCE_I_PARAM(1);
797 ADVANCE_IP(sz);
798 #endif
799 DEFINE_OPCODE_END(OPCODE_INT_LDC_LONG)
802 DEFINE_OPCODE_START(OPCODE_IS_EXCEPTION)
803 #ifdef EMIT_CODE
804 frame_t slot_1 = get_i_param(0);
805 frame_t slot_r = get_i_param(1);
806 ajla_assert(slot_r == slot_1 || !frame_test_flag(fp, slot_r), (file_line, "is exception: flag already set for destination slot %"PRIuMAX"", (uintmax_t)slot_r));
807 if (!frame_variable_is_flat(fp, slot_1)) {
808 void *ex = is_thunk_operator(fp, ip, slot_1, slot_r, get_i_param(2));
809 if (ex == POINTER_FOLLOW_THUNK_GO)
810 ADVANCE_I_PARAM(3);
811 else if (unlikely(ex != POINTER_FOLLOW_THUNK_RETRY))
812 RELOAD_EX_POSITION(ex);
813 } else {
814 barrier_aliasing();
815 *frame_slot(fp, slot_r, ajla_flat_option_t) = 0;
816 barrier_aliasing();
817 ADVANCE_I_PARAM(3);
818 }
819 #endif
820 DEFINE_OPCODE_END(OPCODE_IS_EXCEPTION)
822 DEFINE_OPCODE_START(OPCODE_EXCEPTION_CLASS)
823 #ifdef EMIT_CODE
824 void *ex;
825 ex = thunk_get_param(fp, ip, get_i_param(0), get_i_param(1), get_i_param(2), 0);
826 if (likely(ex == POINTER_FOLLOW_THUNK_GO))
827 ADVANCE_I_PARAM(3);
828 else if (unlikely(ex != POINTER_FOLLOW_THUNK_RETRY))
829 RELOAD_EX_POSITION(ex);
830 #endif
831 DEFINE_OPCODE_END(OPCODE_EXCEPTION_CLASS)
833 DEFINE_OPCODE_START(OPCODE_EXCEPTION_TYPE)
834 #ifdef EMIT_CODE
835 void *ex;
836 ex = thunk_get_param(fp, ip, get_i_param(0), get_i_param(1), get_i_param(2), 1);
837 if (likely(ex == POINTER_FOLLOW_THUNK_GO))
838 ADVANCE_I_PARAM(3);
839 else if (unlikely(ex != POINTER_FOLLOW_THUNK_RETRY))
840 RELOAD_EX_POSITION(ex);
841 #endif
842 DEFINE_OPCODE_END(OPCODE_EXCEPTION_TYPE)
844 DEFINE_OPCODE_START(OPCODE_EXCEPTION_AUX)
845 #ifdef EMIT_CODE
846 void *ex;
847 ex = thunk_get_param(fp, ip, get_i_param(0), get_i_param(1), get_i_param(2), 2);
848 if (likely(ex == POINTER_FOLLOW_THUNK_GO))
849 ADVANCE_I_PARAM(3);
850 else if (unlikely(ex != POINTER_FOLLOW_THUNK_RETRY))
851 RELOAD_EX_POSITION(ex);
852 #endif
853 DEFINE_OPCODE_END(OPCODE_EXCEPTION_AUX)
855 DEFINE_OPCODE_START(OPCODE_SYSTEM_PROPERTY)
856 #ifdef EMIT_CODE
857 void *ex;
858 ex = ipret_get_system_property(fp, ip, get_i_param(0), get_i_param(1));
859 if (likely(ex == POINTER_FOLLOW_THUNK_GO))
860 ADVANCE_I_PARAM(3);
861 else if (unlikely(ex != POINTER_FOLLOW_THUNK_RETRY))
862 RELOAD_EX_POSITION(ex);
863 #endif
864 DEFINE_OPCODE_END(OPCODE_SYSTEM_PROPERTY)
867 DEFINE_OPCODE_START(OPCODE_FLAT_MOVE)
868 #ifdef EMIT_CODE
869 frame_t slot_1 = get_i_param(0);
870 frame_t slot_r = get_i_param(1);
871 if (likely(frame_variable_is_flat(fp, slot_1))) {
872 memcpy(frame_var(fp, slot_r), frame_var(fp, slot_1), frame_get_type_of_local(fp, slot_1)->size);
873 } else {
874 pointer_t ptr = frame_get_pointer_reference(fp, slot_1, true);
875 frame_set_pointer(fp, slot_r, ptr);
876 }
877 ADVANCE_I_PARAM(2);
878 #endif
879 DEFINE_OPCODE_END(OPCODE_FLAT_MOVE)
881 DEFINE_OPCODE_START(OPCODE_FLAT_COPY)
882 #ifdef EMIT_CODE
883 frame_t slot_1 = get_i_param(0);
884 frame_t slot_r = get_i_param(1);
885 if (likely(frame_variable_is_flat(fp, slot_1))) {
886 memcpy(frame_var(fp, slot_r), frame_var(fp, slot_1), frame_get_type_of_local(fp, slot_1)->size);
887 } else {
888 pointer_t ptr = frame_get_pointer_reference(fp, slot_1, false);
889 frame_set_pointer(fp, slot_r, ptr);
890 }
891 ADVANCE_I_PARAM(2);
892 #endif
893 DEFINE_OPCODE_END(OPCODE_FLAT_COPY)
895 DEFINE_OPCODE_START(OPCODE_REF_MOVE)
896 #ifdef EMIT_CODE
897 frame_t slot_1 = get_i_param(0);
898 frame_t slot_r = get_i_param(1);
899 pointer_t ptr = frame_get_pointer_reference(fp, slot_1, true);
900 pointer_poison(frame_pointer(fp, slot_1));
901 frame_set_pointer(fp, slot_r, ptr);
902 ADVANCE_I_PARAM(2);
903 #endif
904 DEFINE_OPCODE_END(OPCODE_REF_MOVE)
906 DEFINE_OPCODE_START(OPCODE_REF_MOVE_CLEAR)
907 #ifdef EMIT_CODE
908 frame_t slot_1 = get_i_param(0);
909 frame_t slot_r = get_i_param(1);
910 pointer_t ptr = frame_get_pointer_reference(fp, slot_1, true);
911 frame_set_pointer(fp, slot_r, ptr);
912 ADVANCE_I_PARAM(2);
913 #endif
914 DEFINE_OPCODE_END(OPCODE_REF_MOVE_CLEAR)
916 DEFINE_OPCODE_START(OPCODE_REF_COPY)
917 #ifdef EMIT_CODE
918 frame_t slot_1 = get_i_param(0);
919 frame_t slot_r = get_i_param(1);
920 pointer_t ptr = frame_get_pointer_reference(fp, slot_1, false);
921 frame_set_pointer(fp, slot_r, ptr);
922 ADVANCE_I_PARAM(2);
923 #endif
924 DEFINE_OPCODE_END(OPCODE_REF_COPY)
926 DEFINE_OPCODE_START(OPCODE_BOX_MOVE_CLEAR)
927 #ifdef EMIT_CODE
928 frame_t slot_1 = get_i_param(0);
929 frame_t slot_r = get_i_param(1);
930 pointer_t ptr = ipret_copy_variable_to_pointer(fp, slot_1, true);
931 *frame_pointer(fp, slot_1) = pointer_empty();
932 frame_set_pointer(fp, slot_r, ptr);
933 ADVANCE_I_PARAM(2);
934 #endif
935 DEFINE_OPCODE_END(OPCODE_BOX_MOVE_CLEAR)
937 DEFINE_OPCODE_START(OPCODE_BOX_COPY)
938 #ifdef EMIT_CODE
939 frame_t slot_1 = get_i_param(0);
940 frame_t slot_r = get_i_param(1);
941 pointer_t ptr = ipret_copy_variable_to_pointer(fp, slot_1, false);
942 frame_set_pointer(fp, slot_r, ptr);
943 ADVANCE_I_PARAM(2);
944 #endif
945 DEFINE_OPCODE_END(OPCODE_BOX_COPY)
947 DEFINE_OPCODE_START(OPCODE_TAKE_BORROWED)
948 #ifdef EMIT_CODE
949 frame_t slot = get_i_param(0);
950 if (!frame_test_and_set_flag(fp, slot)) {
951 pointer_t ptr = *frame_pointer(fp, slot);
952 pointer_reference_owned(ptr);
953 }
954 ADVANCE_I_PARAM(1);
955 #endif
956 DEFINE_OPCODE_END(OPCODE_TAKE_BORROWED)
959 DEFINE_OPCODE_START(OPCODE_DEREFERENCE)
960 #ifdef EMIT_CODE
961 frame_t slot = get_i_param(0);
962 #if 0
963 {
964 struct data *fn = get_frame(fp)->function;
965 const struct type *type = frame_get_type_of_local(fp, slot);
966 bool may_be_borrowed = da(fn,function)->local_variables[slot].may_be_borrowed;
967 if (!frame_test_flag(fp, slot) && !may_be_borrowed && !TYPE_IS_FLAT(type))
968 internal(file_line, "dereference: %s: the value is unexpectedly borrowed", da(fn,function)->function_name);
969 }
970 #endif
971 frame_free(fp, slot);
972 pointer_poison(frame_pointer(fp, slot));
973 ADVANCE_I_PARAM(1);
974 #endif
975 DEFINE_OPCODE_END(OPCODE_DEREFERENCE)
977 DEFINE_OPCODE_START(OPCODE_DEREFERENCE_CLEAR)
978 #ifdef EMIT_CODE
979 frame_t slot = get_i_param(0);
980 #if 0
981 {
982 struct data *fn = get_frame(fp)->function;
983 const struct type *type = frame_get_type_of_local(fp, slot);
984 bool may_be_borrowed = da(fn,function)->local_variables[slot].may_be_borrowed;
985 if (!frame_test_flag(fp, slot) && !may_be_borrowed && !TYPE_IS_FLAT(type))
986 internal(file_line, "dereference clear: %s: the value is unexpectedly borrowed", da(fn,function)->function_name);
987 }
988 #endif
989 frame_free_and_clear(fp, slot);
990 ADVANCE_I_PARAM(1);
991 #endif
992 DEFINE_OPCODE_END(OPCODE_DEREFERENCE_CLEAR)
994 DEFINE_OPCODE_START(OPCODE_EVAL)
995 #ifdef EMIT_CODE
996 frame_t slot = get_i_param(0);
997 if (frame_test_flag(fp, slot)) {
998 pointer_t *ptr = frame_pointer(fp, slot);
999 struct data attr_unused *result;
1000 /*cat(eval_again_,ARG_MODE):*/
1001 pointer_follow(ptr, true, result, PF_WAIT, fp, ip,
1002 RELOAD_EX_POSITION(ex_),
1003 goto cat(eval_skip_,ARG_MODE));
1004 /*
1005 if (unlikely(da_tag(result) == DATA_TAG_array_incomplete)) {
1006 ptr = &da(result,array_incomplete)->next;
1007 goto cat(eval_again_,ARG_MODE);
1008 }
1009 */
1010 cat(eval_skip_,ARG_MODE):;
1011 }
1012 ADVANCE_I_PARAM(1);
1013 #endif
1014 DEFINE_OPCODE_END(OPCODE_EVAL)
1017 DEFINE_OPCODE_START(OPCODE_ESCAPE_NONFLAT)
1018 #ifdef EMIT_CODE
1019 frame_t n = get_i_param(0);
1020 ADVANCE_I_PARAM(1);
1021 ADVANCE_IP(n * ARG_MODE);
1022 #endif
1023 DEFINE_OPCODE_END(OPCODE_ESCAPE_NONFLAT)
1025 DEFINE_OPCODE_START(OPCODE_CHECKPOINT)
1026 #ifdef EMIT_CODE
1027 const code_t attr_unused *orig_ip = ip;
1028 frame_t attr_unused id;
1029 ip_t len;
1030 if (SIZEOF_IP_T == 2) {
1031 id = ip[1];
1032 ADVANCE_IP(2);
1033 } else if (SIZEOF_IP_T == 4) {
1034 id = get_unaligned_32(&ip[1]);
1035 ADVANCE_IP(3);
1036 } else {
1037 not_reached();
1038 }
1039 len = get_param(ip, 0);
1040 ADVANCE_IP((len + 1) * ARG_MODE);
1042 if (unlikely(tick_elapsed(&ts)) && likely(frame_execution_control(fp) != NULL)) {
1043 ipret_checkpoint_forced;
1044 } else {
1045 #ifdef HAVE_CODEGEN
1046 struct data *fn = get_frame(fp)->function;
1047 code_return_t r;
1048 void *new_fp;
1049 ip_t new_ip;
1050 struct data *codegen;
1051 if (unlikely(load_relaxed(&da(fn,function)->codegen_failed)))
1052 goto cat(checkpoint_exit_,ARG_MODE);
1053 #if 1
1054 pointer_follow(&da(fn,function)->codegen, false, codegen, PF_WAIT, fp, orig_ip,
1055 RELOAD_EX_POSITION(ex_),
1056 store_relaxed(&da(fn,function)->codegen_failed, 1);
1057 goto cat(checkpoint_exit_,ARG_MODE);
1058 );
1059 #else
1060 pointer_follow(&da(fn,function)->codegen, false, codegen, PF_SPARK, NULL, 0,
1061 /*debug("sparked: %s %p", da(fn,function)->function_name, ex_);*/
1062 SUBMIT_EX(ex_);
1063 goto cat(checkpoint_exit_,ARG_MODE),
1064 store_relaxed(&da(fn,function)->codegen_failed, 1);
1065 goto cat(checkpoint_exit_,ARG_MODE);
1066 );
1067 #endif
1069 /*for (frame_t l = MIN_USEABLE_SLOT; l < function_n_variables(fn); l++) {
1070 if (da(fn,function)->local_variables_flags[l].must_be_flat) {
1071 if (unlikely(frame_test_flag(fp, l)))
1072 goto cat(checkpoint_exit_,ARG_MODE);
1073 }
1074 }*/
1076 /*debug("running optimized code: %s, %p, %x, %p, %p, %p, %u, %p", da(fn,function)->function_name, da(codegen,codegen)->unoptimized_code_base, id, da(codegen,codegen)->unoptimized_code[id], fp, &cg_upcall_vector, ts, da(codegen,codegen)->unoptimized_code[id]);*/
1077 /*debug("fp[0] = %lx", *(long *)((char *)fp + 0));
1078 debug("fp[8] = %lx", *(long *)((char *)fp + 8));
1079 debug("fp[16] = %lx", *(long *)((char *)fp + 16));
1080 debug("fp[24] = %lx", *(long *)((char *)fp + 24));
1081 debug("fp[32] = %lx", *(long *)((char *)fp + 32));
1082 debug("fp[40] = %lx", *(long *)((char *)fp + 40));*/
1083 /*{
1084 uintptr_t *stub = (void *)da(codegen,codegen)->unoptimized_code[id];
1085 debug("entry: %p, %lx %lx %lx %lx", stub, stub[0], stub[1], stub[2], stub[3]);
1086 }*/
1087 /*__asm__ volatile("nopr %r6");*/
1088 /*__asm__ volatile("xnop");*/
1089 /*__asm__ volatile("cover");*/
1090 /*debug("calling: %p, %p, %lx, %lx", da(codegen,codegen)->unoptimized_code[id], codegen_entry, ((long *)codegen_entry)[0], ((long *)codegen_entry)[1]);*/
1091 /*debug("calling: %p, %p, %lx, %lx", da(codegen,codegen)->unoptimized_code[id], codegen_entry, ((long *)((char *)codegen_entry - 2))[0], ((long *)((char *)codegen_entry - 2))[1]);*/
1092 r = codegen_entry(fp, &cg_upcall_vector, ts, da(codegen,codegen)->unoptimized_code[id]);
1093 #if defined(ARCH_X86_32) || defined(ARCH_ARM32) || defined(ARCH_MIPS32) || defined(ARCH_POWER32) || defined(ARCH_SPARC32)
1094 #if defined(C_LITTLE_ENDIAN) || defined(ARCH_MIPS_N32)
1095 new_fp = num_to_ptr(r & 0xffffffffU);
1096 new_ip = r >> 32;
1097 #else
1098 new_fp = num_to_ptr(r >> 32);
1099 new_ip = r & 0xffffffffU;
1100 #endif
1101 #else
1102 new_fp = r.fp;
1103 new_ip = r.ip;
1104 #endif
1105 /*debug("ran optimized code: %s, %p, %lx -> %p, %x", da(fn,function)->function_name, fp, (unsigned long)(ip - da(fn,function)->code), new_fp, new_ip);*/
1106 if (unlikely(new_ip == (ip_t)-1)) {
1107 /*debug("reload on optimized code: %p", new_fp);*/
1108 RELOAD_EX_POSITION(new_fp);
1109 } else {
1110 /*if (fp != new_fp) debug("switching function: %s -> %s", da(fn,function)->function_name, da(get_frame(new_fp)->function,function)->function_name);*/
1111 fp = new_fp;
1112 ip = da(get_frame(fp)->function,function)->code + new_ip;
1113 if (unlikely(profiling_escapes)) {
1114 profile_counter_t profiling_counter;
1115 fn = get_frame(fp)->function;
1116 profiling_counter = load_relaxed(&da(fn,function)->escape_data[new_ip].counter);
1117 profiling_counter++;
1118 store_relaxed(&da(fn,function)->escape_data[new_ip].counter, profiling_counter);
1119 }
1120 }
1121 #endif
1122 goto cat(checkpoint_exit_,ARG_MODE);
1123 cat(checkpoint_exit_,ARG_MODE):;
1124 }
1125 #endif
1126 DEFINE_OPCODE_END(OPCODE_CHECKPOINT)
1129 #if ARG_MODE == 0
1130 DEFINE_OPCODE_START(OPCODE_JMP)
1131 #ifdef EMIT_CODE
1132 if (SIZEOF_IP_T == 2) {
1133 int16_t offset = ip[1];
1134 ADVANCE_IP(2);
1135 ip = cast_ptr(const code_t *, cast_ptr(const char *, ip) + offset);
1136 } else if (SIZEOF_IP_T == 4) {
1137 int32_t offset = get_unaligned_32(&ip[1]);
1138 ADVANCE_IP(3);
1139 ip = cast_ptr(const code_t *, cast_ptr(const char *, ip) + offset);
1140 } else {
1141 not_reached();
1142 }
1143 #endif
1144 DEFINE_OPCODE_END(OPCODE_JMP)
1145 #endif
1147 #if ARG_MODE == 0 && SIZEOF_IP_T > 2
1148 DEFINE_OPCODE_START(OPCODE_JMP_BACK_16)
1149 #ifdef EMIT_CODE
1150 uint16_t offset;
1152 offset = ip[1];
1153 ip = cast_ptr(const code_t *, cast_ptr(const char *, ip) - offset);
1154 #endif
1155 DEFINE_OPCODE_END(OPCODE_JMP_BACK_16)
1156 #endif
1158 DEFINE_OPCODE_START(OPCODE_JMP_FALSE)
1159 #ifdef EMIT_CODE
1160 int32_t offset;
1161 frame_t slot;
1162 ajla_flat_option_t val1;
1164 slot = get_i_param(0);
1165 if (unlikely(frame_test_flag(fp, slot))) {
1166 void *ex = thunk_bool_jump(fp, ip, slot);
1167 if (ex != POINTER_FOLLOW_THUNK_RETRY) {
1168 if (likely(ex != POINTER_FOLLOW_THUNK_EXCEPTION)) {
1169 RELOAD_EX_POSITION(ex);
1170 } else {
1171 if (SIZEOF_IP_T == 2) {
1172 offset = ip[1 + param_size(1) + 1];
1173 ADVANCE_I_PARAM(1);
1174 ADVANCE_IP(2);
1175 } else if (SIZEOF_IP_T == 4) {
1176 offset = get_unaligned_32(&ip[1 + param_size(1) + 2]);
1177 ADVANCE_I_PARAM(1);
1178 ADVANCE_IP(4);
1179 } else {
1180 not_reached();
1181 }
1182 ip = cast_ptr(const code_t *, cast_ptr(const char *, ip) + offset);
1183 goto cat(jmp_false_exception_,ARG_MODE);
1184 }
1185 }
1186 }
1187 barrier_aliasing();
1188 val1 = *frame_slot(fp, slot, ajla_flat_option_t);
1189 barrier_aliasing();
1190 if (SIZEOF_IP_T == 2) {
1191 offset = ip[1 + param_size(1)];
1192 ADVANCE_I_PARAM(1);
1193 ADVANCE_IP(2);
1194 } else if (SIZEOF_IP_T == 4) {
1195 offset = get_unaligned_32(&ip[1 + param_size(1)]);
1196 ADVANCE_I_PARAM(1);
1197 ADVANCE_IP(4);
1198 } else {
1199 not_reached();
1200 }
1201 if (!val1)
1202 ip = cast_ptr(const code_t *, cast_ptr(const char *, ip) + offset);
1204 cat(jmp_false_exception_,ARG_MODE):;
1205 #endif
1206 DEFINE_OPCODE_END(OPCODE_JMP_FALSE)
1208 #if ARG_MODE == 0
1209 DEFINE_OPCODE_START(OPCODE_LABEL)
1210 #ifdef EMIT_CODE
1211 ADVANCE_IP(1);
1212 #endif
1213 DEFINE_OPCODE_END(OPCODE_LABEL)
1214 #endif
1217 START_BLOCK(
1218 pointer_t *direct_data;
1219 pointer_t indirect_data;
1220 arg_t n_arguments;
1221 frame_t result_slot;
1222 struct thunk *function_error;
1223 )
1225 DEFINE_OPCODE_START(OPCODE_LOAD_FN)
1226 #ifdef EMIT_CODE
1227 struct data *new_reference;
1228 pointer_t result_ptr;
1230 n_arguments = get_i_param(0);
1231 result_slot = get_i_param(1);
1232 direct_data = da(get_frame(fp)->function,function)->local_directory[get_i_param(2)];
1233 indirect_data = pointer_empty(); /* avoid warning */
1235 ADVANCE_I_PARAM(3);
1237 cat(fn_copy_arguments_,ARG_MODE):
1239 new_reference = data_alloc_function_reference_mayfail(n_arguments, &ajla_error pass_file_line);
1240 if (unlikely(!new_reference)) {
1241 function_error = thunk_alloc_exception_error(ajla_error, NULL, fp, ip pass_file_line);
1242 if (!direct_data)
1243 pointer_dereference(indirect_data);
1244 /*cat(fn_set_error_,ARG_MODE):*/
1245 ip = cat(free_parameters_,ARG_MODE)(fp, ip, n_arguments);
1246 result_ptr = pointer_thunk(function_error);
1247 } else {
1248 arg_t i;
1249 if (direct_data) {
1250 da(new_reference,function_reference)->is_indirect = false;
1251 da(new_reference,function_reference)->u.direct = direct_data;
1252 } else {
1253 da(new_reference,function_reference)->is_indirect = true;
1254 da(new_reference,function_reference)->u.indirect = indirect_data;
1255 }
1256 for (i = 0; i < n_arguments; i++) {
1257 ipret_fill_function_reference_from_slot(new_reference, i, fp, get_param(ip, 0), (get_param(ip, 1) & OPCODE_FLAG_FREE_ARGUMENT) != 0);
1258 ADVANCE_IP(param_size(2));
1259 }
1260 result_ptr = pointer_data(new_reference);
1261 }
1263 frame_set_pointer(fp, result_slot, result_ptr);
1264 #endif
1265 DEFINE_OPCODE_END(OPCODE_LOAD_FN)
1267 DEFINE_OPCODE_START(OPCODE_CURRY)
1268 #ifdef EMIT_CODE
1269 frame_t fn_ref_slot;
1271 n_arguments = get_i_param(0);
1272 result_slot = get_i_param(1);
1274 fn_ref_slot = get_i_param(2);
1275 direct_data = NULL;
1276 indirect_data = frame_get_pointer_reference(fp, fn_ref_slot, (get_i_param(3) & OPCODE_FLAG_FREE_ARGUMENT) != 0);
1278 ADVANCE_I_PARAM(4);
1280 goto cat(fn_copy_arguments_,ARG_MODE);
1281 #endif
1282 DEFINE_OPCODE_END(OPCODE_CURRY)
1284 END_BLOCK()
1286 START_BLOCK(
1287 arg_t n_arguments;
1288 arg_t n_return_values;
1289 struct thunk *function_error;
1290 struct data *function;
1291 const code_t *orig_ip;
1292 frame_s *new_fp;
1293 arg_t i;
1294 pointer_t *direct_function;
1295 pointer_t indirect_function;
1296 unsigned char mode;
1297 )
1298 DEFINE_OPCODE_START(OPCODE_CALL)
1299 #ifdef EMIT_CODE
1300 pointer_t *function_ptr;
1302 mode = CALL_MODE_NORMAL;
1303 cat(call_from_mode_,ARG_MODE):
1305 n_arguments = get_i_param(0);
1306 n_return_values = get_i_param(1);
1307 function_ptr = da(get_frame(fp)->function,function)->local_directory[get_i_param(2)];
1309 pointer_follow(function_ptr, false, function, PF_WAIT, fp, ip,
1310 RELOAD_EX_POSITION(ex_),
1311 function_error = thunk_;
1312 thunk_reference(function_error);
1313 ADVANCE_I_PARAM(3);
1314 goto cat(call_set_error_,ARG_MODE);
1315 );
1317 ajla_assert(da(function,function)->n_arguments == n_arguments && da(function,function)->n_return_values == n_return_values,
1318 (file_line, "call %s->%s: the number of arguments does not match: %lu != %lu || %lu != %lu",
1319 da(get_frame(fp)->function,function)->function_name, da(function,function)->function_name,
1320 (unsigned long)da(function,function)->n_arguments, (unsigned long)n_arguments,
1321 (unsigned long)da(function,function)->n_return_values, (unsigned long)n_return_values));
1323 ADVANCE_I_PARAM(3);
1325 new_fp = frame_build(fp, function, &ajla_error);
1326 if (unlikely(!new_fp)) {
1327 cat(call_allocation_error_,ARG_MODE):
1328 function_error = thunk_alloc_exception_error(ajla_error, NULL, fp, ip pass_file_line);
1329 cat(call_set_error_,ARG_MODE):
1330 ip = cat(free_parameters_,ARG_MODE)(fp, ip, n_arguments);
1331 pointer_reference_owned_multiple(pointer_thunk(function_error), n_return_values - 1);
1332 i = n_return_values;
1333 while (1) {
1334 frame_t slot_r = get_max_param(ip, 0);
1335 ADVANCE_IP(max_param_size(1) + 1);
1336 frame_set_pointer(fp, slot_r, pointer_thunk(function_error));
1337 if (!--i)
1338 break;
1339 }
1340 } else {
1341 fp = frame_up(new_fp);
1342 frame_init(new_fp, function, get_frame(fp)->timestamp, mode);
1344 i = 0;
1345 cat(call_copy_arguments_,ARG_MODE):
1346 for (; i < da(function,function)->n_arguments; i++) {
1347 frame_t src_slot = get_param(ip, 0);
1348 frame_t dst_slot = da(function,function)->args[i].slot;
1349 unsigned char src_flag = (unsigned char)get_param(ip, 1);
1350 bool may_be_borrowed = da(function,function)->args[i].may_be_borrowed;
1351 if (may_be_borrowed && src_flag & OPCODE_CALL_MAY_LEND && !pointer_is_thunk(*frame_pointer(fp, src_slot))) {
1352 *frame_pointer(new_fp, dst_slot) = *frame_pointer(fp, src_slot);
1353 } else if (may_be_borrowed && src_flag & OPCODE_CALL_MAY_GIVE && !frame_test_flag(fp, src_slot) && !pointer_is_thunk(*frame_pointer(fp, src_slot))) {
1354 *frame_pointer(new_fp, dst_slot) = *frame_pointer(fp, src_slot);
1355 *frame_pointer(fp, src_slot) = pointer_empty();
1356 } else {
1357 ipret_copy_variable(fp, src_slot, new_fp, dst_slot, (src_flag & OPCODE_FLAG_FREE_ARGUMENT) != 0);
1358 }
1359 ADVANCE_IP(param_size(2));
1360 }
1361 get_frame(new_fp)->previous_ip = frame_ip(fp, ip);
1363 fp = new_fp;
1364 ip = &da(function,function)->code[0];
1366 if (unlikely(mode == CALL_MODE_SPARK)) {
1367 ipret_checkpoint_forced;
1368 }
1369 }
1370 #endif
1371 DEFINE_OPCODE_END(OPCODE_CALL)
1373 DEFINE_OPCODE_START(OPCODE_CALL_STRICT)
1374 #ifdef EMIT_CODE
1375 mode = CALL_MODE_STRICT;
1376 goto cat(call_from_mode_,ARG_MODE);
1377 #endif
1378 DEFINE_OPCODE_END(OPCODE_CALL_STRICT)
1380 DEFINE_OPCODE_START(OPCODE_CALL_SPARK)
1381 #ifdef EMIT_CODE
1382 mode = CALL_MODE_SPARK;
1383 goto cat(call_from_mode_,ARG_MODE);
1384 #endif
1385 DEFINE_OPCODE_END(OPCODE_CALL_SPARK)
1387 DEFINE_OPCODE_START(OPCODE_CALL_INDIRECT)
1388 #ifdef EMIT_CODE
1389 frame_t fn_ref_slot;
1390 bool deref;
1391 pointer_t *ptr;
1393 mode = CALL_MODE_NORMAL;
1394 cat(call_indirect_from_mode_,ARG_MODE):
1396 orig_ip = ip;
1397 n_arguments = get_i_param(0);
1398 n_return_values = get_i_param(1);
1399 fn_ref_slot = get_i_param(2);
1400 deref = (get_i_param(3) & OPCODE_FLAG_FREE_ARGUMENT) != 0;
1401 ADVANCE_I_PARAM(4);
1403 ptr = frame_pointer(fp, fn_ref_slot);
1404 while (1) {
1405 pointer_follow(ptr, false, function, PF_WAIT, fp, orig_ip,
1406 RELOAD_EX_POSITION(ex_),
1407 function_error = thunk_;
1408 thunk_reference(function_error);
1409 if (deref)
1410 frame_free_and_clear(fp, fn_ref_slot);
1411 goto cat(call_set_error_,ARG_MODE)
1412 );
1413 if (!da(function,function_reference)->is_indirect)
1414 break;
1415 ptr = &da(function,function_reference)->u.indirect;
1416 }
1417 ptr = da(function,function_reference)->u.direct;
1418 pointer_follow(ptr, false, function, PF_WAIT, fp, orig_ip,
1419 RELOAD_EX_POSITION(ex_),
1420 function_error = thunk_;
1421 thunk_reference(function_error);
1422 if (deref)
1423 frame_free_and_clear(fp, fn_ref_slot);
1424 goto cat(call_set_error_,ARG_MODE)
1425 );
1427 new_fp = frame_build(fp, function, &ajla_error);
1428 if (unlikely(!new_fp)) {
1429 if (deref)
1430 frame_free_and_clear(fp, fn_ref_slot);
1431 goto cat(call_allocation_error_,ARG_MODE);
1432 } else {
1433 fp = frame_up(new_fp);
1434 frame_init(new_fp, function, get_frame(fp)->timestamp, mode);
1436 i = da(function,function)->n_arguments - n_arguments;
1438 copy_from_function_reference_to_frame(new_fp, pointer_get_data(*frame_pointer(fp, fn_ref_slot)), i, deref && frame_test_flag(fp, fn_ref_slot));
1439 if (deref)
1440 frame_free_and_clear(fp, fn_ref_slot);
1442 goto cat(call_copy_arguments_,ARG_MODE);
1443 }
1444 #endif
1445 DEFINE_OPCODE_END(OPCODE_CALL_INDIRECT)
1447 DEFINE_OPCODE_START(OPCODE_CALL_INDIRECT_STRICT)
1448 #ifdef EMIT_CODE
1449 mode = CALL_MODE_STRICT;
1450 goto cat(call_indirect_from_mode_,ARG_MODE);
1451 #endif
1452 DEFINE_OPCODE_END(OPCODE_CALL_INDIRECT_STRICT)
1454 DEFINE_OPCODE_START(OPCODE_CALL_INDIRECT_SPARK)
1455 #ifdef EMIT_CODE
1456 mode = CALL_MODE_SPARK;
1457 goto cat(call_indirect_from_mode_,ARG_MODE);
1458 #endif
1459 DEFINE_OPCODE_END(OPCODE_CALL_INDIRECT_SPARK)
1461 DEFINE_OPCODE_START(OPCODE_CALL_LAZY)
1462 #ifdef EMIT_CODE
1463 struct data *function_reference;
1464 struct thunk **results;
1466 n_arguments = get_i_param(0);
1467 n_return_values = get_i_param(1);
1468 direct_function = da(get_frame(fp)->function,function)->local_directory[get_i_param(2)];
1469 indirect_function = pointer_empty(); /* avoid warning */
1471 ADVANCE_I_PARAM(3);
1473 cat(call_lazy_copy_arguments_,ARG_MODE):
1474 results = mem_alloc_array_mayfail(mem_alloc_mayfail, struct thunk **, 0, 0, n_return_values, sizeof(struct thunk *), &ajla_error);
1475 if (unlikely(!results)) {
1476 if (!direct_function)
1477 pointer_dereference(indirect_function);
1478 goto cat(call_allocation_error_,ARG_MODE);
1479 }
1481 if (!(function_reference = data_alloc_function_reference_mayfail(n_arguments, &ajla_error pass_file_line))) {
1482 if (!direct_function)
1483 pointer_dereference(indirect_function);
1484 mem_free(results);
1485 goto cat(call_allocation_error_,ARG_MODE);
1486 }
1487 if (direct_function) {
1488 da(function_reference,function_reference)->is_indirect = false;
1489 da(function_reference,function_reference)->u.direct = direct_function;
1490 } else {
1491 da(function_reference,function_reference)->is_indirect = true;
1492 da(function_reference,function_reference)->u.indirect = indirect_function;
1493 }
1495 if (!thunk_alloc_function_call(pointer_data(function_reference), n_return_values, results, &ajla_error)) {
1496 if (!direct_function)
1497 pointer_dereference(indirect_function);
1498 mem_free(results);
1499 data_free_r1(function_reference);
1500 goto cat(call_allocation_error_,ARG_MODE);
1501 }
1503 for (i = 0; i < n_arguments; i++) {
1504 frame_t src_slot = get_param(ip, 0);
1505 unsigned char src_flag = (unsigned char)get_param(ip, 1);
1506 ipret_fill_function_reference_from_slot(function_reference, i, fp, src_slot, (src_flag & OPCODE_FLAG_FREE_ARGUMENT) != 0);
1507 ADVANCE_IP(param_size(2));
1508 }
1510 for (i = 0; i < n_return_values; i++) {
1511 frame_t slot_r = get_max_param(ip, 0);
1512 frame_set_pointer(fp, slot_r, pointer_thunk(results[i]));
1513 ADVANCE_IP(max_param_size(1) + 1);
1514 }
1516 mem_free(results);
1517 #endif
1518 DEFINE_OPCODE_END(OPCODE_CALL_LAZY)
1520 DEFINE_OPCODE_START(OPCODE_CALL_INDIRECT_LAZY)
1521 #ifdef EMIT_CODE
1522 frame_t fn_ref_slot;
1523 bool deref;
1525 n_arguments = get_i_param(0);
1526 n_return_values = get_i_param(1);
1527 fn_ref_slot = get_i_param(2);
1528 deref = (get_i_param(3) & OPCODE_FLAG_FREE_ARGUMENT) != 0;
1529 ADVANCE_I_PARAM(4);
1531 indirect_function = frame_get_pointer_reference(fp, fn_ref_slot, deref);
1532 direct_function = NULL;
1534 goto cat(call_lazy_copy_arguments_,ARG_MODE);
1535 #endif
1536 DEFINE_OPCODE_END(OPCODE_CALL_INDIRECT_LAZY)
1538 DEFINE_OPCODE_START(OPCODE_CALL_CACHE)
1539 #ifdef EMIT_CODE
1540 struct ipret_call_cache_arg *arguments;
1541 frame_t *return_values;
1542 void *ex;
1544 cat(call_cache_,ARG_MODE):
1545 orig_ip = ip;
1546 n_arguments = get_i_param(0);
1547 n_return_values = get_i_param(1);
1548 direct_function = da(get_frame(fp)->function,function)->local_directory[get_i_param(2)];
1549 ADVANCE_I_PARAM(3);
1551 pointer_follow(direct_function, false, function, PF_WAIT, fp, orig_ip,
1552 RELOAD_EX_POSITION(ex_),
1553 function_error = thunk_;
1554 thunk_reference(function_error);
1555 goto cat(call_set_error_,ARG_MODE);
1556 );
1557 ajla_assert(da(function,function)->n_arguments == n_arguments && da(function,function)->n_return_values == n_return_values,
1558 (file_line, "call_cache: the number of arguments does not match: %lu != %lu || %lu != %lu",
1559 (unsigned long)da(function,function)->n_arguments, (unsigned long)n_arguments,
1560 (unsigned long)da(function,function)->n_return_values, (unsigned long)n_return_values));
1562 arguments = mem_alloc_array_mayfail(mem_alloc_mayfail, struct ipret_call_cache_arg *, 0, 0, n_arguments, sizeof(struct ipret_call_cache_arg), &ajla_error);
1563 if (!arguments) {
1564 goto cat(call_allocation_error_,ARG_MODE);
1565 }
1566 return_values = mem_alloc_array_mayfail(mem_alloc_mayfail, frame_t *, 0, 0, n_return_values, sizeof(frame_t), &ajla_error);
1567 if (!return_values) {
1568 mem_free(arguments);
1569 goto cat(call_allocation_error_,ARG_MODE);
1570 }
1572 for (i = 0; i < n_arguments; i++) {
1573 frame_t src_slot = get_param(ip, 0);
1574 unsigned char src_flag = (unsigned char)get_param(ip, 1);
1575 arguments[i].f_arg = NULL;
1576 arguments[i].slot = src_slot;
1577 arguments[i].deref = (src_flag & OPCODE_FLAG_FREE_ARGUMENT) != 0;
1578 ADVANCE_IP(param_size(2));
1579 }
1581 for (i = 0; i < n_return_values; i++) {
1582 frame_t slot_r = get_max_param(ip, 0);
1583 return_values[i] = slot_r;
1584 ADVANCE_IP(max_param_size(1) + 1);
1585 }
1587 ex = ipret_call_cache(fp, orig_ip, direct_function, arguments, return_values, NO_FRAME_T);
1588 if (unlikely(ex != POINTER_FOLLOW_THUNK_GO)) {
1589 RELOAD_EX_POSITION(ex);
1590 }
1591 #endif
1592 DEFINE_OPCODE_END(OPCODE_CALL_CACHE)
1594 DEFINE_OPCODE_START(OPCODE_CALL_SAVE)
1595 #ifdef EMIT_CODE
1596 goto cat(call_cache_,ARG_MODE);
1597 #endif
1598 DEFINE_OPCODE_END(OPCODE_CALL_SAVE)
1600 DEFINE_OPCODE_START(OPCODE_CALL_INDIRECT_CACHE)
1601 #ifdef EMIT_CODE
1602 struct ipret_call_cache_arg *arguments;
1603 frame_t *return_values;
1604 void *ex;
1606 frame_t fn_ref_slot;
1607 bool deref;
1608 pointer_t *ptr;
1609 arg_t n_curried_arguments;
1611 cat(call_indirect_cache_,ARG_MODE):
1612 orig_ip = ip;
1613 n_arguments = get_i_param(0);
1614 n_return_values = get_i_param(1);
1615 fn_ref_slot = get_i_param(2);
1616 deref = (get_i_param(3) & OPCODE_FLAG_FREE_ARGUMENT) != 0;
1617 ADVANCE_I_PARAM(4);
1619 n_curried_arguments = 0;
1620 ptr = frame_pointer(fp, fn_ref_slot);
1621 while (1) {
1622 pointer_follow(ptr, false, function, PF_WAIT, fp, orig_ip,
1623 RELOAD_EX_POSITION(ex_),
1624 function_error = thunk_;
1625 thunk_reference(function_error);
1626 if (deref)
1627 frame_free_and_clear(fp, fn_ref_slot);
1628 goto cat(call_set_error_,ARG_MODE)
1629 );
1630 n_curried_arguments += da(function,function_reference)->n_curried_arguments;
1631 if (!da(function,function_reference)->is_indirect)
1632 break;
1633 ptr = &da(function,function_reference)->u.indirect;
1634 }
1635 ptr = da(function,function_reference)->u.direct;
1636 pointer_follow(ptr, false, function, PF_WAIT, fp, orig_ip,
1637 RELOAD_EX_POSITION(ex_),
1638 function_error = thunk_;
1639 thunk_reference(function_error);
1640 if (deref)
1641 frame_free_and_clear(fp, fn_ref_slot);
1642 goto cat(call_set_error_,ARG_MODE)
1643 );
1645 arguments = mem_alloc_array_mayfail(mem_alloc_mayfail, struct ipret_call_cache_arg *, 0, 0, n_curried_arguments + n_arguments, sizeof(struct ipret_call_cache_arg), &ajla_error);
1646 if (!arguments) {
1647 if (deref)
1648 frame_free_and_clear(fp, fn_ref_slot);
1649 goto cat(call_allocation_error_,ARG_MODE);
1650 }
1651 return_values = mem_alloc_array_mayfail(mem_alloc_mayfail, frame_t *, 0, 0, n_return_values, sizeof(frame_t), &ajla_error);
1652 if (!return_values) {
1653 mem_free(arguments);
1654 if (deref)
1655 frame_free_and_clear(fp, fn_ref_slot);
1656 goto cat(call_allocation_error_,ARG_MODE);
1657 }
1659 i = n_curried_arguments;
1660 function = pointer_get_data(*frame_pointer(fp, fn_ref_slot));
1661 while (1) {
1662 arg_t j;
1663 j = da(function,function_reference)->n_curried_arguments;
1664 while (j--) {
1665 i--;
1666 arguments[i].f_arg = &da(function,function_reference)->arguments[j];
1667 arguments[i].deref = false;
1668 }
1669 if (!da(function,function_reference)->is_indirect)
1670 break;
1671 function = pointer_get_data(da(function,function_reference)->u.indirect);
1672 }
1674 for (i = n_curried_arguments; i < n_curried_arguments + n_arguments; i++) {
1675 frame_t src_slot = get_param(ip, 0);
1676 unsigned char src_flag = (unsigned char)get_param(ip, 1);
1677 arguments[i].f_arg = NULL;
1678 arguments[i].slot = src_slot;
1679 arguments[i].deref = (src_flag & OPCODE_FLAG_FREE_ARGUMENT) != 0;
1680 ADVANCE_IP(param_size(2));
1681 }
1683 for (i = 0; i < n_return_values; i++) {
1684 frame_t slot_r = get_max_param(ip, 0);
1685 return_values[i] = slot_r;
1686 ADVANCE_IP(max_param_size(1) + 1);
1687 }
1689 ex = ipret_call_cache(fp, orig_ip, ptr, arguments, return_values, deref ? fn_ref_slot : NO_FRAME_T);
1690 if (unlikely(ex != POINTER_FOLLOW_THUNK_GO)) {
1691 RELOAD_EX_POSITION(ex);
1692 }
1693 #endif
1694 DEFINE_OPCODE_END(OPCODE_CALL_INDIRECT_CACHE)
1696 DEFINE_OPCODE_START(OPCODE_CALL_INDIRECT_SAVE)
1697 #ifdef EMIT_CODE
1698 goto cat(call_indirect_cache_,ARG_MODE);
1699 #endif
1700 DEFINE_OPCODE_END(OPCODE_CALL_INDIRECT_SAVE)
1702 END_BLOCK()
1704 DEFINE_OPCODE_START(OPCODE_RETURN)
1705 #ifdef EMIT_CODE
1706 struct data *function;
1707 frame_s *previous_fp;
1708 const code_t *previous_ip;
1709 arg_t i, n;
1711 /*ADVANCE_I_PARAM(0);*/
1713 function = get_frame(fp)->function;
1714 previous_fp = frame_up(fp);
1715 if (unlikely(frame_is_top(previous_fp))) {
1716 struct execution_control *ex;
1717 void *exx;
1718 struct thunk *t;
1719 struct stack_bottom *sb = frame_stack_bottom(previous_fp);
1720 ex = sb->ex;
1721 if (!ex) {
1722 frame_t src_slot = get_i_param(0);
1723 sb->ret = ipret_copy_variable_to_pointer(fp, src_slot, true);
1724 goto exit_ipret;
1725 }
1726 t = ex->thunk;
1727 n = da(function,function)->n_return_values;
1728 i = 0;
1729 do {
1730 frame_t src_slot = get_i_param(i * 2);
1731 frame_t flags = get_i_param(i * 2 + 1);
1732 t->u.function_call.results[i].ptr = ipret_copy_variable_to_pointer(fp, src_slot, (flags & OPCODE_FLAG_FREE_ARGUMENT) != 0);
1733 } while (++i < n);
1734 exx = thunk_terminate(t, n);
1735 #if 0
1736 if (exx != POINTER_FOLLOW_THUNK_EXIT)
1737 task_submit(exx, true);
1738 goto exit_ipret;
1739 #else
1740 RELOAD_EX_POSITION(exx);
1741 #endif
1742 }
1744 get_frame(previous_fp)->timestamp = get_frame(fp)->timestamp;
1745 previous_ip = &da(get_frame(previous_fp)->function,function)->code[get_frame(fp)->previous_ip];
1747 n = da(function,function)->n_return_values;
1748 i = 0;
1749 do {
1750 frame_t src_slot, dst_slot, flags;
1751 src_slot = get_i_param(i * 2);
1752 flags = get_i_param(i * 2 + 1);
1753 dst_slot = (frame_t)get_max_param(previous_ip, 0);
1754 previous_ip += max_param_size(1) + 1;
1755 ipret_copy_variable(fp, src_slot, previous_fp, dst_slot, (flags & OPCODE_FLAG_FREE_ARGUMENT) != 0);
1756 } while (++i < n);
1758 fp = previous_fp;
1759 ip = previous_ip;
1760 #endif
1761 DEFINE_OPCODE_END(OPCODE_RETURN)
1764 DEFINE_OPCODE_START(OPCODE_STRUCTURED)
1765 #ifdef EMIT_CODE
1766 const code_t *orig_ip = ip;
1768 frame_t struc, elem;
1769 pointer_t *struc_ptr;
1770 unsigned char *struc_flat;
1771 const struct type *t;
1772 bool optimize_elem_is_flat;
1774 unsigned char type;
1775 frame_t arg;
1777 pointer_t thunk_ptr;
1779 elem = get_i_param(1);
1780 optimize_elem_is_flat = frame_variable_is_flat(fp, elem);
1782 cat(structured_retry_,ARG_MODE):
1783 struc = get_i_param(0);
1784 ADVANCE_I_PARAM(2);
1786 t = frame_get_type_of_local(fp, struc);
1787 if (frame_variable_is_flat(fp, struc)) {
1788 if (!optimize_elem_is_flat) {
1789 frame_set_pointer(fp, struc, flat_to_data(frame_get_type_of_local(fp, struc), frame_var(fp, struc)));
1790 struc_flat = NULL;
1791 struc_ptr = frame_pointer(fp, struc);
1792 } else {
1793 struc_flat = frame_var(fp, struc);
1794 struc_ptr = NULL; /* avoid warning */
1795 }
1796 } else {
1797 struc_flat = NULL;
1798 struc_ptr = frame_pointer(fp, struc);
1799 }
1801 do {
1802 array_index_t array_index = index_invalid(); /* avoid warning */
1803 struct data *data = NULL; /* avoid warning */
1805 type = (unsigned char)get_param(ip, 0);
1806 arg = get_param(ip, 1);
1807 ADVANCE_IP(param_size(3));
1809 if ((type & OPCODE_STRUCTURED_MASK) == OPCODE_STRUCTURED_ARRAY) {
1810 void *ex = ipret_get_index(fp, orig_ip, fp, arg, NULL, &array_index, &thunk_ptr pass_file_line);
1811 if (unlikely(ex != POINTER_FOLLOW_THUNK_GO)) {
1812 if (ex == POINTER_FOLLOW_THUNK_EXCEPTION)
1813 goto cat(structured_error_,ARG_MODE);
1814 RELOAD_EX_POSITION(ex);
1815 }
1816 }
1818 if (struc_flat) {
1819 switch (type & OPCODE_STRUCTURED_MASK) {
1820 case OPCODE_STRUCTURED_RECORD: {
1821 const struct flat_record_definition_entry *e;
1822 ajla_assert(arg < flat_record_n_slots(type_def(t,flat_record)), (file_line, "structured flat record: invalid index: %"PRIuMAX" >= %"PRIuMAX"", (uintmax_t)arg, (uintmax_t)flat_record_n_slots(type_def(t,flat_record))));
1823 e = &type_def(t,flat_record)->entries[arg];
1824 t = e->subtype;
1825 struc_flat += e->flat_offset;
1826 break;
1827 }
1828 case OPCODE_STRUCTURED_OPTION: {
1829 thunk_ptr = pointer_error(error_ajla(EC_SYNC, AJLA_ERROR_OPTION_DOESNT_MATCH), fp, ip pass_file_line);
1830 goto cat(structured_error_,ARG_MODE);
1831 }
1832 case OPCODE_STRUCTURED_ARRAY: {
1833 if (unlikely(index_ge_int(array_index, type_def(t,flat_array)->n_elements))) {
1834 index_free(&array_index);
1835 thunk_ptr = pointer_error(error_ajla(EC_SYNC, AJLA_ERROR_INDEX_OUT_OF_RANGE), fp, ip pass_file_line);
1836 goto cat(structured_error_,ARG_MODE);
1837 }
1838 t = type_def(t,flat_array)->base;
1839 struc_flat += t->size * index_to_int(array_index);
1840 index_free(&array_index);
1841 break;
1842 }
1843 default:
1844 internal(file_line, "structured flat: invalid structure type %02x", type);
1845 }
1846 } else {
1847 cat(structured_restart_pointer_follow_,ARG_MODE):
1848 pointer_follow(struc_ptr, false, data, PF_WAIT, fp, orig_ip,
1849 if ((type & OPCODE_STRUCTURED_MASK) == OPCODE_STRUCTURED_ARRAY)
1850 index_free(&array_index);
1851 RELOAD_EX_POSITION(ex_),
1852 if ((type & OPCODE_STRUCTURED_MASK) == OPCODE_STRUCTURED_ARRAY)
1853 index_free(&array_index);
1854 goto cat(structured_read_to_the_end_,ARG_MODE);
1855 );
1856 if (unlikely(!data_is_writable(data))) {
1857 struct_clone(struc_ptr);
1858 goto cat(structured_restart_pointer_follow_,ARG_MODE);
1859 }
1860 switch (type & OPCODE_STRUCTURED_MASK) {
1861 case OPCODE_STRUCTURED_RECORD: {
1862 const struct record_definition *def = type_def(da(data,record)->definition,record);
1863 ajla_assert(arg < def->n_slots, (file_line, "structured record: invalid index: %"PRIuMAX" >= %"PRIuMAX"", (uintmax_t)arg, (uintmax_t)def->n_slots));
1864 t = def->types[arg];
1865 struc_ptr = frame_pointer(da_record_frame(data), arg);
1867 if (type & OPCODE_STRUCTURED_FLAG_END) {
1868 if (frame_variable_is_flat(fp, elem)) {
1869 if (TYPE_IS_FLAT(t)) {
1870 frame_free(da_record_frame(data), arg);
1871 struc_flat = frame_var(da_record_frame(data), arg);
1872 goto cat(structured_write_flat_,ARG_MODE);
1873 }
1874 } else {
1875 if (!frame_test_and_set_flag(da_record_frame(data), arg))
1876 goto cat(structured_write_ptr_,ARG_MODE);
1877 }
1878 }
1880 if (!frame_test_flag(da_record_frame(data), arg)) {
1881 struc_flat = frame_var(da_record_frame(data), arg);
1882 if (unlikely(!optimize_elem_is_flat)) {
1883 frame_set_pointer(da_record_frame(data), arg, flat_to_data(t, struc_flat));
1884 struc_flat = NULL;
1885 }
1886 }
1887 break;
1888 }
1889 case OPCODE_STRUCTURED_OPTION: {
1890 if (unlikely(da(data,option)->option != arg)) {
1891 if (likely((type & OPCODE_STRUCTURED_FLAG_END) != 0)) {
1892 da(data,option)->option = arg;
1893 } else {
1894 thunk_ptr = pointer_error(error_ajla(EC_SYNC, AJLA_ERROR_OPTION_DOESNT_MATCH), fp, ip pass_file_line);
1895 cat(structured_error_,ARG_MODE):
1896 if (struc_flat) {
1897 pointer_dereference(thunk_ptr);
1898 optimize_elem_is_flat = false;
1899 ip = orig_ip;
1900 goto cat(structured_retry_,ARG_MODE);
1901 } else {
1902 pointer_dereference(*struc_ptr);
1903 *struc_ptr = thunk_ptr;
1904 goto cat(structured_read_to_the_end_,ARG_MODE);
1905 }
1906 }
1907 }
1908 struc_ptr = &da(data,option)->pointer;
1909 break;
1910 }
1911 case OPCODE_STRUCTURED_ARRAY: {
1912 unsigned array_flags;
1913 if (unlikely(da_tag(data) == DATA_TAG_array_incomplete)) {
1914 array_index_t len_first;
1916 if (array_incomplete_collapse(struc_ptr))
1917 goto cat(structured_restart_pointer_follow_,ARG_MODE);
1919 len_first = array_len(pointer_get_data(da(data,array_incomplete)->first));
1920 if (!index_ge_index(array_index, len_first)) {
1921 index_free(&len_first);
1922 struc_ptr = &da(data,array_incomplete)->first;
1923 goto cat(structured_restart_pointer_follow_,ARG_MODE);
1924 } else {
1925 index_sub(&array_index, len_first);
1926 index_free(&len_first);
1927 struc_ptr = &da(data,array_incomplete)->next;
1928 goto cat(structured_restart_pointer_follow_,ARG_MODE);
1929 }
1930 }
1931 if (!optimize_elem_is_flat) {
1932 array_flags = ARRAY_MODIFY_NEED_PTR;
1933 } else if (type & OPCODE_STRUCTURED_FLAG_END) {
1934 array_flags = ARRAY_MODIFY_NEED_FLAT;
1935 t = frame_get_type_of_local(fp, elem);
1936 } else {
1937 array_flags = 0;
1938 }
1939 if (unlikely(!array_modify(struc_ptr, array_index, array_flags, &struc_ptr, &struc_flat, &t, fp, ip))) {
1940 goto cat(structured_read_to_the_end_,ARG_MODE);
1941 }
1942 break;
1943 }
1944 default:
1945 internal(file_line, "structured: invalid structure type %02x", type);
1946 }
1947 }
1948 } while (!(type & OPCODE_STRUCTURED_FLAG_END));
1949 if (struc_flat) {
1950 cat(structured_write_flat_,ARG_MODE):
1951 memcpy_fast(struc_flat, frame_var(fp, elem), frame_get_type_of_local(fp, elem)->size);
1952 } else {
1953 /* The pointer may be empty if we moved from an option without data to an option with data */
1954 if (likely(!pointer_is_empty(*struc_ptr)))
1955 pointer_dereference(*struc_ptr);
1956 if (frame_variable_is_flat(fp, elem)) {
1957 *struc_ptr = flat_to_data(frame_get_type_of_local(fp, elem), frame_var(fp, elem));
1958 } else {
1959 cat(structured_write_ptr_,ARG_MODE):
1960 *struc_ptr = frame_get_pointer_reference(fp, elem, (type & OPCODE_STRUCTURED_FREE_VARIABLE) != 0);
1961 }
1962 }
1963 if (false) {
1964 do {
1965 type = (unsigned char)get_param(ip, 0);
1966 arg = get_param(ip, 1);
1967 ADVANCE_IP(param_size(3));
1968 cat(structured_read_to_the_end_,ARG_MODE):;
1969 } while (!(type & OPCODE_STRUCTURED_FLAG_END));
1970 if (type & OPCODE_STRUCTURED_FREE_VARIABLE)
1971 frame_free(fp, elem);
1972 }
1973 #endif
1974 DEFINE_OPCODE_END(OPCODE_STRUCTURED)
1976 DEFINE_OPCODE_START(OPCODE_RECORD_CREATE)
1977 #ifdef EMIT_CODE
1978 frame_t result_slot;
1979 arg_t n_entries, i, ii;
1980 const struct type *t;
1981 const struct record_definition *def;
1983 result_slot = get_i_param(0);
1984 n_entries = get_i_param(1);
1985 ADVANCE_I_PARAM(2);
1987 t = frame_get_type_of_local(fp, result_slot);
1988 if (t->tag == TYPE_TAG_flat_record) {
1989 const code_t *backup_ip;
1990 def = type_def(type_def(t,flat_record)->base,record);
1991 backup_ip = ip;
1992 for (i = 0, ii = 0; i < n_entries; i++, ii++) {
1993 frame_t var_slot, record_slot;
1994 flat_size_t flat_offset;
1995 const struct type *flat_type;
1997 while (unlikely(record_definition_is_elided(def, ii)))
1998 ii++;
2000 var_slot = get_param(ip, 0);
2002 if (unlikely(!frame_variable_is_flat(fp, var_slot))) {
2003 ip = backup_ip;
2004 goto cat(create_record_no_flat_,ARG_MODE);
2005 }
2006 record_slot = record_definition_slot(def, ii);
2007 flat_offset = type_def(t,flat_record)->entries[record_slot].flat_offset;
2008 flat_type = type_def(t,flat_record)->entries[record_slot].subtype;
2009 ajla_assert(type_is_equal(frame_get_type_of_local(fp, var_slot), flat_type), (file_line, "record create (flat): copying between different types (%u,%u,%u) -> (%u,%u,%u)", frame_get_type_of_local(fp, var_slot)->tag, frame_get_type_of_local(fp, var_slot)->size, frame_get_type_of_local(fp, var_slot)->align, flat_type->tag, flat_type->size, flat_type->align));
2010 memcpy_fast(frame_var(fp, result_slot) + flat_offset, frame_var(fp, var_slot), flat_type->size);
2011 ADVANCE_IP(param_size(2));
2012 }
2013 ajla_assert(!frame_test_flag(fp, result_slot), (file_line, "record create (flat): flag already set for destination slot %"PRIuMAX"", (uintmax_t)result_slot));
2014 } else {
2015 struct data *result;
2016 def = type_def(t,record);
2017 cat(create_record_no_flat_,ARG_MODE):
2018 result = data_alloc_record_mayfail(def, &ajla_error pass_file_line);
2019 if (unlikely(!result)) {
2020 ip = cat(free_parameters_,ARG_MODE)(fp, ip, n_entries);
2021 frame_set_pointer(fp, result_slot, pointer_error(ajla_error, fp, ip pass_file_line));
2022 break;
2023 }
2024 memset(da_record_frame(result), 0, bitmap_slots(def->n_slots) * slot_size);
2025 for (i = 0, ii = 0; i < n_entries; i++, ii++) {
2026 frame_t var_slot, record_slot;
2027 const struct type *rec_type, *var_type;
2029 while (unlikely(record_definition_is_elided(def, ii)))
2030 ii++;
2032 var_slot = get_param(ip, 0);
2033 record_slot = record_definition_slot(def, ii);
2034 rec_type = def->types[record_slot];
2035 var_type = frame_get_type_of_local(fp, var_slot);
2037 if (!frame_variable_is_flat(fp, var_slot)) {
2038 pointer_t ptr = frame_get_pointer_reference(fp, var_slot, (get_param(ip, 1) & OPCODE_FLAG_FREE_ARGUMENT) != 0);
2039 frame_set_pointer(da_record_frame(result), record_slot, ptr);
2040 } else if (TYPE_IS_FLAT(rec_type)) {
2041 ajla_assert(type_is_equal(var_type, rec_type), (file_line, "record create: copying between different types (%u,%u,%u) -> (%u,%u,%u)", var_type->tag, var_type->size, var_type->align, rec_type->tag, rec_type->size, rec_type->align));
2042 memcpy_fast(frame_var(da_record_frame(result), record_slot), frame_var(fp, var_slot), rec_type->size);
2043 } else {
2044 pointer_t ptr = flat_to_data(var_type, frame_var(fp, var_slot));
2045 frame_set_pointer(da_record_frame(result), record_slot, ptr);
2046 }
2048 ADVANCE_IP(param_size(2));
2049 }
2050 frame_set_pointer(fp, result_slot, pointer_data(result));
2051 }
2052 #endif
2053 DEFINE_OPCODE_END(OPCODE_RECORD_CREATE)
2055 DEFINE_OPCODE_START(OPCODE_RECORD_LOAD)
2056 #ifdef EMIT_CODE
2057 frame_t record, record_slot, result;
2058 unsigned flags;
2059 const struct type *t;
2060 record = get_i_param(0);
2061 record_slot = get_i_param(1);
2062 result = get_i_param(2);
2063 flags = get_i_param(3);
2065 t = frame_get_type_of_local(fp, record);
2066 if (t->tag == TYPE_TAG_flat_record && !frame_test_flag(fp, record)) {
2067 const struct flat_record_definition_entry *ft = &type_def(t,flat_record)->entries[record_slot];
2068 if (likely(TYPE_IS_FLAT(frame_get_type_of_local(fp, result)))) {
2069 memcpy_fast(frame_var(fp, result), frame_var(fp, record) + ft->flat_offset, ft->subtype->size);
2070 } else {
2071 pointer_t ptr = flat_to_data(ft->subtype, frame_var(fp, record) + ft->flat_offset);
2072 frame_set_pointer(fp, result, ptr);
2073 }
2074 } else {
2075 const struct type *rtype, *etype;
2076 struct data *data;
2077 frame_s *fr;
2078 pointer_follow(frame_pointer(fp, record), true, data, unlikely(flags & OPCODE_OP_FLAG_STRICT) ? PF_WAIT : PF_NOEVAL, fp, ip,
2079 if (!(flags & OPCODE_OP_FLAG_STRICT)) {
2080 ex_ = ipret_record_load_create_thunk(fp, ip, record, record_slot, result);
2081 if (ex_ == POINTER_FOLLOW_THUNK_GO)
2082 goto cat(record_load_end_,ARG_MODE);
2083 }
2084 RELOAD_EX_POSITION(ex_),
2085 thunk_reference(thunk_);
2086 frame_set_pointer(fp, result, pointer_thunk(thunk_));
2087 goto cat(record_load_end_,ARG_MODE);
2088 );
2089 rtype = da(data,record)->definition;
2090 etype = type_def(rtype,record)->types[record_slot];
2091 fr = da_record_frame(data);
2092 if (!frame_test_flag(fr, record_slot)) {
2093 if (likely(TYPE_IS_FLAT(frame_get_type_of_local(fp, result)))) {
2094 memcpy_fast(frame_var(fp, result), frame_var(fr, record_slot), etype->size);
2095 } else {
2096 pointer_t ptr = flat_to_data(etype, frame_var(fr, record_slot));
2097 frame_set_pointer(fp, result, ptr);
2098 }
2099 } else {
2100 pointer_reference_maybe(fp, result, frame_pointer(fr, record_slot), flags);
2101 }
2102 }
2104 cat(record_load_end_,ARG_MODE):
2105 ADVANCE_I_PARAM(4);
2106 #endif
2107 DEFINE_OPCODE_END(OPCODE_RECORD_CREATE)
2109 DEFINE_OPCODE_START(OPCODE_OPTION_CREATE_EMPTY_FLAT)
2110 #ifdef EMIT_CODE
2111 frame_t slot_r = get_i_param(0);
2112 ajla_flat_option_t opt = (ajla_flat_option_t)get_i_param(1);
2113 ajla_assert(!frame_test_flag(fp, slot_r), (file_line, "option create empty flat: flag already set for destination slot %"PRIuMAX"", (uintmax_t)slot_r));
2114 barrier_aliasing();
2115 *frame_slot(fp, slot_r, ajla_flat_option_t) = opt;
2116 barrier_aliasing();
2117 ADVANCE_I_PARAM(2);
2118 #endif
2119 DEFINE_OPCODE_END(OPCODE_OPTION_CREATE_EMPTY_FLAT)
2121 DEFINE_OPCODE_START(OPCODE_OPTION_CREATE_EMPTY)
2122 #ifdef EMIT_CODE
2123 struct data *d;
2124 frame_t slot_r;
2126 d = data_alloc(option, &ajla_error);
2127 slot_r = get_i_param(0);
2128 if (likely(d != NULL)) {
2129 da(d,option)->option = get_i_param(1);
2130 da(d,option)->pointer = pointer_empty();
2131 frame_set_pointer(fp, slot_r, pointer_data(d));
2132 } else {
2133 frame_set_pointer(fp, slot_r, pointer_error(ajla_error, fp, ip pass_file_line));
2134 }
2135 ADVANCE_I_PARAM(2);
2136 #endif
2137 DEFINE_OPCODE_END(OPCODE_OPTION_CREATE_EMPTY)
2139 DEFINE_OPCODE_START(OPCODE_OPTION_CREATE)
2140 #ifdef EMIT_CODE
2141 struct data *d;
2142 frame_t slot_1, slot_r;
2143 pointer_t ptr;
2145 slot_1 = get_i_param(2);
2146 if (!frame_variable_is_flat(fp, slot_1)) {
2147 ptr = frame_get_pointer_reference(fp, slot_1, (get_i_param(3) & OPCODE_FLAG_FREE_ARGUMENT) != 0);
2148 } else {
2149 ptr = flat_to_data(frame_get_type_of_local(fp, slot_1), frame_var(fp, slot_1));
2150 }
2152 d = data_alloc(option, &ajla_error);
2153 slot_r = get_i_param(0);
2154 if (likely(d != NULL)) {
2155 da(d,option)->option = get_i_param(1);
2156 da(d,option)->pointer = ptr;
2157 frame_set_pointer(fp, slot_r, pointer_data(d));
2158 } else {
2159 pointer_dereference(ptr);
2160 frame_set_pointer(fp, slot_r, pointer_error(ajla_error, fp, ip pass_file_line));
2161 }
2162 ADVANCE_I_PARAM(4);
2163 #endif
2164 DEFINE_OPCODE_END(OPCODE_OPTION_CREATE)
2166 DEFINE_OPCODE_START(OPCODE_OPTION_LOAD)
2167 #ifdef EMIT_CODE
2168 frame_t option, option_idx, result;
2169 unsigned flags;
2170 struct data *data;
2171 pointer_t ptr;
2173 option = get_i_param(0);
2174 option_idx = get_i_param(1);
2175 result = get_i_param(2);
2176 flags = get_i_param(3);
2178 if (unlikely(frame_variable_is_flat(fp, option)))
2179 goto cat(option_load_mismatch,ARG_MODE);
2181 pointer_follow(frame_pointer(fp, option), true, data, unlikely(flags & OPCODE_OP_FLAG_STRICT) ? PF_WAIT : PF_NOEVAL, fp, ip,
2182 if (!(flags & OPCODE_OP_FLAG_STRICT)) {
2183 ex_ = ipret_option_load_create_thunk(fp, ip, option, option_idx, result);
2184 if (ex_ == POINTER_FOLLOW_THUNK_GO)
2185 goto cat(option_load_end_,ARG_MODE);
2186 }
2187 RELOAD_EX_POSITION(ex_),
2188 thunk_reference(thunk_);
2189 frame_set_pointer(fp, result, pointer_thunk(thunk_));
2190 goto cat(option_load_end_,ARG_MODE);
2191 );
2193 if (unlikely(da(data,option)->option != option_idx)) {
2194 cat(option_load_mismatch,ARG_MODE):
2195 ptr = pointer_error(error_ajla(EC_SYNC, AJLA_ERROR_OPTION_DOESNT_MATCH), fp, ip pass_file_line);
2196 frame_set_pointer(fp, result, ptr);
2197 } else {
2198 pointer_reference_maybe(fp, result, &da(data,option)->pointer, flags);
2199 }
2201 cat(option_load_end_,ARG_MODE):
2202 ADVANCE_I_PARAM(4);
2203 #endif
2204 DEFINE_OPCODE_END(OPCODE_OPTION_LOAD)
2207 START_BLOCK(
2208 frame_t slot_1;
2209 ajla_option_t option;
2210 )
2212 DEFINE_OPCODE_START(OPCODE_OPTION_TEST_FLAT)
2213 #ifdef EMIT_CODE
2214 slot_1 = get_i_param(0);
2216 if (!frame_test_flag(fp, slot_1)) {
2217 barrier_aliasing();
2218 option = *frame_slot(fp, slot_1, ajla_flat_option_t);
2219 barrier_aliasing();
2220 goto cat(option_test_store_result_,ARG_MODE);
2221 }
2222 goto cat(option_test_,ARG_MODE);
2223 #endif
2224 DEFINE_OPCODE_END(OPCODE_OPTION_TEST_FLAT)
2226 DEFINE_OPCODE_START(OPCODE_OPTION_TEST)
2227 #ifdef EMIT_CODE
2228 frame_t slot_r;
2229 pointer_t ptr;
2230 struct data *data;
2232 slot_1 = get_i_param(0);
2233 cat(option_test_,ARG_MODE):
2234 ptr = *frame_pointer(fp, slot_1);
2235 if (unlikely(pointer_is_thunk(ptr))) {
2236 void *ex;
2237 ajla_assert(!frame_test_flag(fp, get_i_param(2)), (file_line, "option test: flag already set for destination slot %"PRIuMAX"", (uintmax_t)get_i_param(2)));
2238 ex = thunk_option_test(fp, ip, slot_1, get_i_param(1), get_i_param(2));
2239 if (ex == POINTER_FOLLOW_THUNK_GO) {
2240 ADVANCE_I_PARAM(3);
2241 break;
2242 } else if (unlikely(ex != POINTER_FOLLOW_THUNK_RETRY)) {
2243 RELOAD_EX_POSITION(ex);
2244 }
2245 break;
2246 }
2247 data = pointer_get_data(ptr);
2248 option = da(data,option)->option;
2249 cat(option_test_store_result_,ARG_MODE):
2250 slot_r = get_i_param(2);
2251 barrier_aliasing();
2252 ajla_assert(!frame_test_flag(fp, slot_r), (file_line, "option test: flag already set for destination slot %"PRIuMAX"", (uintmax_t)slot_r));
2253 *frame_slot(fp, slot_r, ajla_flat_option_t) = option == (ajla_option_t)get_i_param(1);
2254 barrier_aliasing();
2255 ADVANCE_I_PARAM(3);
2256 #endif
2257 DEFINE_OPCODE_END(OPCODE_OPTION_TEST)
2259 DEFINE_OPCODE_START(OPCODE_OPTION_ORD_FLAT)
2260 #ifdef EMIT_CODE
2261 slot_1 = get_i_param(0);
2263 if (!frame_test_flag(fp, slot_1)) {
2264 barrier_aliasing();
2265 option = *frame_slot(fp, slot_1, ajla_flat_option_t);
2266 barrier_aliasing();
2267 goto cat(option_ord_store_result_,ARG_MODE);
2268 }
2269 goto cat(option_ord_,ARG_MODE);
2270 #endif
2271 DEFINE_OPCODE_END(OPCODE_OPTION_ORD_FLAT)
2273 DEFINE_OPCODE_START(OPCODE_OPTION_ORD)
2274 #ifdef EMIT_CODE
2275 frame_t slot_r;
2276 pointer_t ptr;
2277 struct data *data;
2279 slot_1 = get_i_param(0);
2280 cat(option_ord_,ARG_MODE):
2281 ptr = *frame_pointer(fp, slot_1);
2282 if (unlikely(pointer_is_thunk(ptr))) {
2283 void *ex;
2284 ajla_assert(!frame_test_flag(fp, get_i_param(1)), (file_line, "option ord: flag already set for destination slot %"PRIuMAX"", (uintmax_t)get_i_param(2)));
2285 ex = thunk_option_ord(fp, ip, slot_1, get_i_param(1));
2286 if (ex == POINTER_FOLLOW_THUNK_GO) {
2287 ADVANCE_I_PARAM(2);
2288 break;
2289 } else if (unlikely(ex != POINTER_FOLLOW_THUNK_RETRY)) {
2290 RELOAD_EX_POSITION(ex);
2291 }
2292 break;
2293 }
2294 data = pointer_get_data(ptr);
2295 option = da(data,option)->option;
2296 cat(option_ord_store_result_,ARG_MODE):
2297 slot_r = get_i_param(1);
2298 barrier_aliasing();
2299 ajla_assert(!frame_test_flag(fp, slot_r), (file_line, "option ord: flag already set for destination slot %"PRIuMAX"", (uintmax_t)slot_r));
2300 *frame_slot(fp, slot_r, int_default_t) = option;
2301 barrier_aliasing();
2302 ADVANCE_I_PARAM(2);
2303 #endif
2304 DEFINE_OPCODE_END(OPCODE_OPTION_ORD)
2306 END_BLOCK()
2309 DEFINE_OPCODE_START(OPCODE_ARRAY_CREATE)
2310 #ifdef EMIT_CODE
2311 frame_t result_slot;
2312 size_t n_entries;
2313 struct data *total;
2315 result_slot = get_i_param(0);
2316 n_entries = get_i_param(1);
2317 ADVANCE_I_PARAM(2);
2319 ajla_assert(n_entries != 0, (file_line, "array create: zero entries"));
2321 total = NULL;
2322 while (1) {
2323 size_t n, i;
2324 struct data *a;
2325 const struct type *type = frame_get_type_of_local(fp, get_param(ip, 0));
2326 bool flat = frame_variable_is_flat(fp, get_param(ip, 0));
2327 for (n = 1; n < n_entries; n++) {
2328 if (frame_variable_is_flat(fp, get_param(ip, n * 2)) != flat)
2329 break;
2330 if (unlikely((int_default_t)(n + 1) < zero))
2331 break;
2332 }
2333 do {
2334 if (flat)
2335 a = data_alloc_array_flat_mayfail(type, n, n, false, &ajla_error pass_file_line);
2336 else
2337 a = data_alloc_array_pointers_mayfail(n, n, &ajla_error pass_file_line);
2338 } while (unlikely(!a) && (n >>= 1));
2339 if (unlikely(!a)) {
2340 if (total)
2341 data_dereference(total);
2342 goto cat(array_create_error_,ARG_MODE);
2343 }
2344 n_entries -= n;
2345 if (flat) {
2346 unsigned char *flat_ptr = da_array_flat(a);
2347 for (i = 0; i < n; i++) {
2348 frame_t var_slot = get_param(ip, 0);
2349 memcpy_fast(flat_ptr, frame_var(fp, var_slot), type->size);
2350 flat_ptr += type->size;
2351 ADVANCE_IP(param_size(2));
2352 }
2353 } else {
2354 for (i = 0; i < n; i++) {
2355 frame_t var_slot = get_param(ip, 0);
2356 pointer_t ptr = frame_get_pointer_reference(fp, var_slot, (get_param(ip, 1) & OPCODE_FLAG_FREE_ARGUMENT) != 0);
2357 da(a,array_pointers)->pointer[i] = ptr;
2358 ADVANCE_IP(param_size(2));
2359 }
2360 }
2361 if (likely(!total)) {
2362 total = a;
2363 } else {
2364 total = array_join(total, a, &ajla_error);
2365 if (unlikely(!total)) {
2366 cat(array_create_error_,ARG_MODE):
2367 ip = cat(free_parameters_,ARG_MODE)(fp, ip, n_entries);
2368 frame_set_pointer(fp, result_slot, pointer_error(ajla_error, fp, ip pass_file_line));
2369 break;
2370 }
2371 }
2372 if (likely(!n_entries)) {
2373 frame_set_pointer(fp, result_slot, pointer_data(total));
2374 break;
2375 }
2376 }
2377 #endif
2378 DEFINE_OPCODE_END(OPCODE_ARRAY_CREATE)
2380 DEFINE_OPCODE_START(OPCODE_ARRAY_CREATE_EMPTY_FLAT)
2381 #ifdef EMIT_CODE
2382 frame_t result_slot;
2383 struct data *a;
2384 const struct type *type = da_type(get_frame(fp)->function, get_i_param(1));
2385 TYPE_TAG_VALIDATE(type->tag);
2387 a = data_alloc_array_flat_mayfail(type, 0, 0, false, &ajla_error pass_file_line);
2388 result_slot = get_i_param(0);
2389 frame_set_pointer(fp, result_slot, likely(a != NULL) ? pointer_data(a) : pointer_error(ajla_error, fp, ip pass_file_line));
2390 ADVANCE_I_PARAM(2);
2391 #endif
2392 DEFINE_OPCODE_END(OPCODE_ARRAY_CREATE_EMPTY_FLAT)
2394 DEFINE_OPCODE_START(OPCODE_ARRAY_CREATE_EMPTY)
2395 #ifdef EMIT_CODE
2396 frame_t result_slot;
2397 struct data *a;
2399 a = data_alloc_array_pointers_mayfail(0, 0, &ajla_error pass_file_line);
2400 result_slot = get_i_param(0);
2401 frame_set_pointer(fp, result_slot, likely(a != NULL) ? pointer_data(a) : pointer_error(ajla_error, fp, ip pass_file_line));
2402 ADVANCE_I_PARAM(1);
2403 #endif
2404 DEFINE_OPCODE_END(OPCODE_ARRAY_CREATE_EMPTY)
2406 DEFINE_OPCODE_START(OPCODE_ARRAY_FILL)
2407 #ifdef EMIT_CODE
2408 frame_t content_slot, length_slot, result_slot;
2409 unsigned char content_flag;
2410 array_index_t length;
2411 pointer_t result_ptr;
2412 void *ex;
2414 content_slot = get_i_param(0);
2415 content_flag = get_i_param(1);
2416 length_slot = get_i_param(2);
2417 result_slot = get_i_param(3);
2419 ex = ipret_get_index(fp, ip, fp, length_slot, NULL, &length, &result_ptr pass_file_line);
2420 if (unlikely(ex != POINTER_FOLLOW_THUNK_GO)) {
2421 if (ex == POINTER_FOLLOW_THUNK_EXCEPTION) {
2422 if (content_flag & OPCODE_FLAG_FREE_ARGUMENT)
2423 frame_free_and_clear(fp, content_slot);
2424 goto cat(array_fill_error_,ARG_MODE);
2425 }
2426 RELOAD_EX_POSITION(ex);
2427 }
2429 if (!frame_variable_is_flat(fp, content_slot)) {
2430 pointer_t ptr = frame_get_pointer_reference(fp, content_slot, (content_flag & OPCODE_FLAG_FREE_ARGUMENT) != 0);
2431 if (unlikely((content_flag & OPCODE_ARRAY_FILL_FLAG_SPARSE) != 0)) {
2432 result_ptr = array_create_sparse(length, ptr);
2433 } else {
2434 result_ptr = array_create(length, NULL, NULL, ptr);
2435 }
2436 } else {
2437 const struct type *type = frame_get_type_of_local(fp, content_slot);
2438 barrier_aliasing();
2439 if (unlikely((content_flag & OPCODE_ARRAY_FILL_FLAG_SPARSE) != 0) && likely(index_ge_int(length, 1))) {
2440 pointer_t ptr = flat_to_data(type, frame_var(fp, content_slot));
2441 result_ptr = array_create_sparse(length, ptr);
2442 } else {
2443 if (TYPE_IS_FLAT(frame_get_type_of_local(fp, result_slot))) {
2444 unsigned char *result = frame_var(fp, result_slot);
2445 int_default_t l = index_to_int(length);
2446 index_free(&length);
2447 while (l--) {
2448 result = mempcpy(result, frame_var(fp, content_slot), type->size);
2449 }
2450 goto cat(array_exit_,ARG_MODE);
2451 } else {
2452 result_ptr = array_create(length, type, frame_var(fp, content_slot), pointer_empty());
2453 }
2454 }
2455 barrier_aliasing();
2456 }
2458 cat(array_fill_error_,ARG_MODE):
2459 frame_set_pointer(fp, result_slot, result_ptr);
2461 cat(array_exit_,ARG_MODE):
2462 ADVANCE_I_PARAM(4);
2463 #endif
2464 DEFINE_OPCODE_END(OPCODE_ARRAY_FILL)
2466 DEFINE_OPCODE_START(OPCODE_ARRAY_STRING)
2467 #ifdef EMIT_CODE
2468 frame_t result_slot, length;
2469 pointer_t result_ptr;
2471 result_slot = get_i_param(0);
2472 length = get_i_param(1);
2473 ADVANCE_I_PARAM(2);
2475 if (unlikely((int_default_t)length < (int_default_t)zero) ||
2476 unlikely((frame_t)(int_default_t)length != length)) {
2477 result_ptr = pointer_error(error_ajla(EC_ASYNC, AJLA_ERROR_SIZE_OVERFLOW), fp, ip pass_file_line);
2478 } else {
2479 result_ptr = array_string(length, type_get_fixed(0, true), cast_ptr(unsigned char *, ip));
2480 }
2481 frame_set_pointer(fp, result_slot, result_ptr);
2483 ADVANCE_IP((length + 1) >> 1);
2484 #endif
2485 DEFINE_OPCODE_END(OPCODE_ARRAY_STRING)
2487 DEFINE_OPCODE_START(OPCODE_ARRAY_UNICODE)
2488 #ifdef EMIT_CODE
2489 frame_t result_slot, length;
2490 pointer_t result_ptr;
2492 result_slot = get_i_param(0);
2493 length = get_i_param(1);
2494 ADVANCE_I_PARAM(2);
2496 if (unlikely((int_default_t)length < (int_default_t)zero) ||
2497 unlikely((frame_t)(int_default_t)length != length)) {
2498 result_ptr = pointer_error(error_ajla(EC_ASYNC, AJLA_ERROR_SIZE_OVERFLOW), fp, ip pass_file_line);
2499 } else {
2500 result_ptr = array_string(length, type_get_int(2), cast_ptr(unsigned char *, ip));
2501 }
2502 frame_set_pointer(fp, result_slot, result_ptr);
2504 ADVANCE_IP(length * 2);
2505 #endif
2506 DEFINE_OPCODE_END(OPCODE_ARRAY_STRING)
2508 DEFINE_OPCODE_START(OPCODE_ARRAY_LOAD)
2509 #ifdef EMIT_CODE
2510 frame_t array, idx, result;
2511 unsigned flags;
2512 const struct type *t, *t_elem;
2513 void *ex;
2514 array_index_t array_index;
2515 pointer_t ptr;
2516 unsigned char *flat;
2518 array = get_i_param(0);
2519 idx = get_i_param(1);
2520 result = get_i_param(2);
2521 flags = get_i_param(3);
2523 ex = ipret_get_index(fp, ip, fp, idx, NULL, &array_index, &ptr pass_file_line);
2524 if (unlikely(ex != POINTER_FOLLOW_THUNK_GO)) {
2525 if (ex == POINTER_FOLLOW_THUNK_EXCEPTION)
2526 goto cat(array_load_set_ptr_,ARG_MODE);
2527 RELOAD_EX_POSITION(ex);
2528 }
2530 t = frame_get_type_of_local(fp, array);
2531 if (t->tag == TYPE_TAG_flat_array && !frame_test_flag(fp, array)) {
2532 const struct flat_array_definition *def = type_def(t,flat_array);
2533 if (unlikely(index_ge_int(array_index, def->n_elements))) {
2534 if (unlikely((flags & OPCODE_ARRAY_INDEX_IN_RANGE) != 0))
2535 internal(file_line, "array_load: flat array index out of range");
2536 index_free(&array_index);
2537 ptr = pointer_error(error_ajla(EC_SYNC, AJLA_ERROR_INDEX_OUT_OF_RANGE), fp, ip pass_file_line);
2538 goto cat(array_load_set_ptr_,ARG_MODE);
2539 }
2540 t_elem = def->base;
2541 flat = frame_var(fp, array) + t_elem->size * index_to_int(array_index);
2542 index_free(&array_index);
2543 goto cat(array_load_set_flat_,ARG_MODE);
2544 } else {
2545 pointer_t *array_ptr = frame_pointer(fp, array);
2546 pointer_t *pptr;
2547 struct data *data;
2549 cat(array_restart_pointer_follow_,ARG_MODE):
2550 pointer_follow(array_ptr, false, data, unlikely(flags & OPCODE_OP_FLAG_STRICT) ? PF_WAIT : PF_NOEVAL, fp, ip,
2551 index_free(&array_index);
2552 if (!(flags & OPCODE_OP_FLAG_STRICT)) {
2553 ex_ = ipret_array_load_create_thunk(fp, ip, array, idx, result);
2554 if (ex_ == POINTER_FOLLOW_THUNK_GO)
2555 goto cat(array_load_end_,ARG_MODE);
2556 }
2557 RELOAD_EX_POSITION(ex_),
2558 index_free(&array_index);
2559 thunk_reference(thunk_);
2560 ptr = pointer_thunk(thunk_);
2561 goto cat(array_load_set_ptr_,ARG_MODE);
2562 );
2564 if (unlikely(da_tag(data) == DATA_TAG_array_incomplete)) {
2565 array_index_t len_first;
2567 if (array_ptr == frame_pointer(fp, array)) {
2568 if (!frame_test_and_set_flag(fp, array))
2569 data_reference(data);
2570 if (array_incomplete_collapse(array_ptr))
2571 goto cat(array_restart_pointer_follow_,ARG_MODE);
2572 }
2574 len_first = array_len(pointer_get_data(da(data,array_incomplete)->first));
2575 if (!index_ge_index(array_index, len_first)) {
2576 index_free(&len_first);
2577 data = pointer_get_data(da(data,array_incomplete)->first);
2578 } else {
2579 index_sub(&array_index, len_first);
2580 index_free(&len_first);
2581 array_ptr = &da(data,array_incomplete)->next;
2582 goto cat(array_restart_pointer_follow_,ARG_MODE);
2583 }
2584 }
2586 if (unlikely(!array_read(data, array_index, &pptr, &flat, &t_elem, NULL))) {
2587 if (unlikely((flags & OPCODE_ARRAY_INDEX_IN_RANGE) != 0))
2588 internal(file_line, "array_load: array index out of range");
2589 ptr = pointer_error(error_ajla(EC_SYNC, AJLA_ERROR_INDEX_OUT_OF_RANGE), fp, ip pass_file_line);
2590 goto cat(array_load_set_ptr_,ARG_MODE);
2591 }
2592 if (pptr) {
2593 pointer_reference_maybe(fp, result, pptr, flags);
2594 goto cat(array_load_end_,ARG_MODE);
2595 } else {
2596 cat(array_load_set_flat_,ARG_MODE):
2597 if (likely(TYPE_IS_FLAT(frame_get_type_of_local(fp, result)))) {
2598 memcpy_fast(frame_var(fp, result), flat, t_elem->size);
2599 goto cat(array_load_end_,ARG_MODE);
2600 } else {
2601 ptr = flat_to_data(t_elem, flat);
2602 }
2603 }
2604 }
2606 cat(array_load_set_ptr_,ARG_MODE):
2607 frame_set_pointer(fp, result, ptr);
2609 cat(array_load_end_,ARG_MODE):
2610 ADVANCE_I_PARAM(4);
2611 #endif
2612 DEFINE_OPCODE_END(OPCODE_ARRAY_LOAD)
2614 DEFINE_OPCODE_START(OPCODE_ARRAY_LEN)
2615 #ifdef EMIT_CODE
2616 frame_t slot_a, slot_r;
2617 unsigned flags;
2618 void *ex;
2620 slot_a = get_i_param(0);
2621 slot_r = get_i_param(1);
2622 flags = get_i_param(2);
2624 ex = ipret_array_len(fp, ip, slot_r, slot_a, flags);
2625 if (unlikely(ex != POINTER_FOLLOW_THUNK_GO))
2626 RELOAD_EX_POSITION(ex);
2628 ADVANCE_I_PARAM(3);
2629 #endif
2630 DEFINE_OPCODE_END(OPCODE_ARRAY_LEN)
2632 DEFINE_OPCODE_START(OPCODE_ARRAY_LEN_GREATER_THAN)
2633 #ifdef EMIT_CODE
2634 frame_t slot_a, slot_l, slot_r;
2635 unsigned flags;
2636 void *ex;
2638 slot_a = get_i_param(0);
2639 slot_l = get_i_param(1);
2640 slot_r = get_i_param(2);
2641 flags = get_i_param(3);
2643 ex = ipret_array_len_greater_than(fp, ip, slot_r, slot_a, slot_l, flags);
2644 if (unlikely(ex != POINTER_FOLLOW_THUNK_GO))
2645 RELOAD_EX_POSITION(ex);
2647 ADVANCE_I_PARAM(4);
2648 #endif
2649 DEFINE_OPCODE_END(OPCODE_ARRAY_LEN_GREATER_THAN)
2651 DEFINE_OPCODE_START(OPCODE_ARRAY_SUB)
2652 #ifdef EMIT_CODE
2653 frame_t slot_a, slot_start, slot_end, slot_r;
2654 unsigned flags;
2655 void *ex;
2657 slot_a = get_i_param(0);
2658 slot_start = get_i_param(1);
2659 slot_end = get_i_param(2);
2660 slot_r = get_i_param(3);
2661 flags = get_i_param(4);
2663 ex = ipret_array_sub(fp, ip, slot_r, slot_a, slot_start, slot_end, flags);
2664 if (unlikely(ex != POINTER_FOLLOW_THUNK_GO))
2665 RELOAD_EX_POSITION(ex);
2667 ADVANCE_I_PARAM(5);
2668 #endif
2669 DEFINE_OPCODE_END(OPCODE_ARRAY_SUB)
2671 DEFINE_OPCODE_START(OPCODE_ARRAY_SKIP)
2672 #ifdef EMIT_CODE
2673 frame_t slot_a, slot_start, slot_r;
2674 unsigned flags;
2675 void *ex;
2677 slot_a = get_i_param(0);
2678 slot_start = get_i_param(1);
2679 slot_r = get_i_param(2);
2680 flags = get_i_param(3);
2682 ex = ipret_array_skip(fp, ip, slot_r, slot_a, slot_start, flags);
2683 if (unlikely(ex != POINTER_FOLLOW_THUNK_GO))
2684 RELOAD_EX_POSITION(ex);
2686 ADVANCE_I_PARAM(4);
2687 #endif
2688 DEFINE_OPCODE_END(OPCODE_ARRAY_SKIP)
2690 DEFINE_OPCODE_START(OPCODE_ARRAY_APPEND)
2691 #ifdef EMIT_CODE
2692 frame_t slot_r, slot_1, slot_2;
2693 unsigned flags;
2694 void *ex;
2696 slot_r = get_i_param(0);
2697 flags = get_i_param(1);
2698 slot_1 = get_i_param(2);
2699 slot_2 = get_i_param(3);
2701 ex = ipret_array_append(fp, ip, slot_r, slot_1, slot_2, flags);
2702 if (unlikely(ex != POINTER_FOLLOW_THUNK_GO))
2703 RELOAD_EX_POSITION(ex);
2705 ADVANCE_I_PARAM(4);
2706 #endif
2707 DEFINE_OPCODE_END(OPCODE_ARRAY_APPEND)
2709 DEFINE_OPCODE_START(OPCODE_ARRAY_APPEND_ONE_FLAT)
2710 #ifdef EMIT_CODE
2711 frame_t slot_r, slot_1, slot_2;
2712 unsigned flags;
2713 void *ex;
2715 slot_r = get_i_param(0);
2716 flags = get_i_param(1);
2717 slot_1 = get_i_param(2);
2718 slot_2 = get_i_param(3);
2720 ex = ipret_array_append_one_flat(fp, ip, slot_r, slot_1, slot_2, flags);
2721 if (unlikely(ex != POINTER_FOLLOW_THUNK_GO))
2722 RELOAD_EX_POSITION(ex);
2724 ADVANCE_I_PARAM(4);
2725 #endif
2726 DEFINE_OPCODE_END(OPCODE_ARRAY_APPEND_ONE_FLAT)
2728 DEFINE_OPCODE_START(OPCODE_ARRAY_APPEND_ONE)
2729 #ifdef EMIT_CODE
2730 frame_t slot_r, slot_1, slot_2;
2731 unsigned flags;
2732 void *ex;
2734 slot_r = get_i_param(0);
2735 flags = get_i_param(1);
2736 slot_1 = get_i_param(2);
2737 slot_2 = get_i_param(3);
2739 ex = ipret_array_append_one(fp, ip, slot_r, slot_1, slot_2, flags);
2740 if (unlikely(ex != POINTER_FOLLOW_THUNK_GO))
2741 RELOAD_EX_POSITION(ex);
2743 ADVANCE_I_PARAM(4);
2744 #endif
2745 DEFINE_OPCODE_END(OPCODE_ARRAY_APPEND_ONE)
2747 DEFINE_OPCODE_START(OPCODE_ARRAY_FLATTEN)
2748 #ifdef EMIT_CODE
2749 frame_t slot_r, slot_1;
2750 unsigned flags;
2751 void *ex;
2753 slot_r = get_i_param(0);
2754 flags = get_i_param(1);
2755 slot_1 = get_i_param(2);
2757 ex = ipret_array_flatten(fp, ip, slot_r, slot_1, flags);
2758 if (unlikely(ex != POINTER_FOLLOW_THUNK_GO))
2759 RELOAD_EX_POSITION(ex);
2761 ADVANCE_I_PARAM(3);
2762 #endif
2763 DEFINE_OPCODE_END(OPCODE_ARRAY_FLATTEN)
2766 #if ARG_MODE == 0
2767 DEFINE_OPCODE_START(OPCODE_IO)
2768 #ifdef EMIT_CODE
2769 unsigned char io_code, n_outputs, n_inputs, n_params;
2770 void *ex;
2772 io_code = get_i_param(0);
2773 n_outputs = get_i_param(1);
2774 n_inputs = get_i_param(2);
2775 n_params = get_i_param(3);
2777 ex = ipret_io(fp, ip, io_code, n_outputs, n_inputs, n_params);
2778 if (ex != POINTER_FOLLOW_THUNK_GO) {
2779 RELOAD_EX_POSITION(ex);
2780 } else {
2781 ADVANCE_IP(3 + 2 * (n_outputs + n_inputs + n_params));
2782 }
2783 #endif
2784 DEFINE_OPCODE_END(OPCODE_IO)
2785 #endif
2787 #if ARG_MODE == 0
2788 DEFINE_OPCODE_START(OPCODE_INTERNAL_FUNCTION)
2789 #ifdef EMIT_CODE
2790 void *ex = function_call_internal(fp, ip);
2791 if (ex != POINTER_FOLLOW_THUNK_RETRY) {
2792 RELOAD_EX_POSITION(ex);
2793 }
2794 #endif
2795 DEFINE_OPCODE_END(OPCODE_INTERNAL_FUNCTION)
2796 #endif
2798 #if ARG_MODE == 0
2799 DEFINE_OPCODE_START(OPCODE_UNREACHABLE)
2800 #ifdef EMIT_CODE
2801 internal(file_line, "unreachable code");
2802 #endif
2803 DEFINE_OPCODE_END(OPCODE_UNREACHABLE)
2804 #endif
2806 #if ARG_MODE == 0
2807 DEFINE_OPCODE_START(OPCODE_EXIT_THREAD)
2808 #ifdef EMIT_CODE
2809 struct execution_control *ex = frame_execution_control(fp);
2810 pointer_t *var_ptr = frame_pointer(fp, get_i_param(0));
2811 struct data attr_unused *data;
2813 pointer_follow(var_ptr, true, data, PF_WAIT, fp, ip,
2814 RELOAD_EX_POSITION(ex_),
2815 ajla_assert_lo(thunk_tag(thunk_) == THUNK_TAG_EXCEPTION, (file_line, "exit_thread: invalid thunk tag %u", thunk_tag(thunk_)));
2816 goto exit_ipret_thunk;
2817 );
2819 exit_ipret_thunk:
2820 ajla_assert_lo(ex->thunk == NULL, (file_line, "exit_thread: non-NULL thunk %p", ex->thunk));
2821 ex->current_frame = fp;
2822 ex->current_ip = frame_ip(fp, ip);
2823 execution_control_terminate(ex, *var_ptr);
2824 goto exit_ipret;
2825 #endif
2826 DEFINE_OPCODE_END(OPCODE_EXIT_THREAD)
2827 #endif
2830 #undef move_scalar
2831 #undef copy_scalar
2833 #undef get_param
2834 #undef param_size
2835 #undef get_i_param
2836 #undef ADVANCE_I_PARAM
2838 #undef ARG_MODE
2839 #undef DEFINE_OPCODE_START