?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
codegen: use gen_frame_store for for bswap and brev
[ajla.git] / ipret.c
blob174af854593820d70c9f859c366a299969001079
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 */
18
19 #include "ajla.h"
20
21 #ifndef FILE_OMIT
22
23 #include "mem_al.h"
24 #include "data.h"
25 #include "array.h"
26 #include "code-op.h"
27 #include "funct.h"
28 #include "arithm-b.h"
29 #include "arithm-i.h"
30 #include "arithm-r.h"
31 #include "tick.h"
32 #include "task.h"
33 #include "ipfn.h"
34 #include "ipio.h"
35 #include "util.h"
36 #include "codegen.h"
37
38 #include "ipret.h"
39
40 #if defined(HAVE_COMPUTED_GOTO) && !defined(DEBUG_TRACE)
41 #define COMPUTED_GOTO
42 /*#define COMPUTED_GOTO_RELATIVE*/
43 #endif
44
45 #if defined(C_LITTLE_ENDIAN)
46 #define get_lo(p) (((const unsigned char *)(p))[0])
47 #elif defined(C_BIG_ENDIAN)
48 #define get_lo(p) (((const unsigned char *)(p))[1])
49 #else
50 #define get_lo(p) (*(p) & 0xff)
51 #endif
52
53 #if defined(C_LITTLE_ENDIAN)
54 #define get_hi(p) (((const unsigned char *)(p))[1])
55 #elif defined(C_BIG_ENDIAN)
56 #define get_hi(p) (((const unsigned char *)(p))[0])
57 #else
58 #define get_hi(p) (*(p) >> 8)
59 #endif
60
61 #define ADVANCE_IP(n) (ip += (n))
62
63
64 #define op_add(type, utype, op1, op2) op1 + op2
65 #define op_subtract(type, utype, op1, op2) op1 - op2
66 #define op_multiply(type, utype, op1, op2) op1 * op2
67 #define op_divide(type, utype, op1, op2) op1 / op2
68 /* EMX has a bug - fmod doesn't return NaN */
69 #if defined(_MSC_VER)
70 #define op_modulo(type, utype, op1, op2) (!isnan_any(type, op1, op2) && cat(isfinite_,type)(op1) && !cat(isfinite_,type)(op2) ? op1 :\
71 !isnan_any(type, op1, op2) && op1 == 0 && op2 != 0 ? op1 :\
72 cat(mathfunc_,type)(fmod)(op1, op2))
73 #elif defined(HAVE_BUGGY_FMOD)
74 #define op_modulo(type, utype, op1, op2) (op2 == 0 ? 0./0. : cat(mathfunc_,type)(fmod)(op1, op2))
75 #else
76 #define op_modulo(type, utype, op1, op2) cat(mathfunc_,type)(fmod)(op1, op2)
77 #endif
78 #define op_atan2(type, utype, op1, op2) cat(mathfunc_,type)(atan2)(op1, op2)
79 #define op_and(type, utype, op1, op2) op1 & op2
80 #define op_or(type, utype, op1, op2) op1 | op2
81 #define op_xor(type, utype, op1, op2) op1 ^ op2
82 #define op_shl(type, utype, op1, op2) op1 << (op2 & (sizeof(utype) * 8 - 1))
83 #define op_shr(type, utype, op1, op2) \
84 RIGHT_SHIFT_KEEPS_SIGN || (type)op1 >= 0 ? \
85 (utype)((type)op1 >> (op2 & (sizeof(utype) * 8 - 1))) \
86 : \
87 ~(~(utype)op1 >> (op2 & (sizeof(utype) * 8 - 1)))
88 #define op_ushr(type, utype, op1, op2) op1 >> (op2 & (sizeof(utype) * 8 - 1))
89 #define op_equal(type, utype, op1, op2) op1 == op2
90 #define op_not_equal(type, utype, op1, op2) op1 != op2
91 #define op_less(type, utype, op1, op2) (type)op1 < (type)op2
92 #define op_less_equal(type, utype, op1, op2) (type)op1 <= (type)op2
93 #define op_uless(type, utype, op1, op2) op1 < op2
94 #define op_uless_equal(type, utype, op1, op2) op1 <= op2
95 #define op_not(type, utype, op1) ~op1
96 #define op_neg(type, utype, op1) -op1
97 #define op_inc(type, utype, op1) op1 + 1
98 #define op_dec(type, utype, op1) op1 - 1
99 #define op_sqrt(type, utype, op1) cat(mathfunc_,type)(sqrt)(op1)
100 #define op_cbrt(type, utype, op1) cat(mathfunc_,type)(cbrt)(op1)
101 #define op_sin(type, utype, op1) cat(mathfunc_,type)(sin)(op1)
102 #define op_cos(type, utype, op1) cat(mathfunc_,type)(cos)(op1)
103 #define op_tan(type, utype, op1) cat(mathfunc_,type)(tan)(op1)
104 #define op_asin(type, utype, op1) cat(mathfunc_,type)(asin)(op1)
105 #define op_acos(type, utype, op1) cat(mathfunc_,type)(acos)(op1)
106 #define op_atan(type, utype, op1) cat(mathfunc_,type)(atan)(op1)
107 #define op_sinh(type, utype, op1) cat(mathfunc_,type)(sinh)(op1)
108 #define op_cosh(type, utype, op1) cat(mathfunc_,type)(cosh)(op1)
109 #define op_tanh(type, utype, op1) cat(mathfunc_,type)(tanh)(op1)
110 #define op_asinh(type, utype, op1) cat(mathfunc_,type)(asinh)(op1)
111 #define op_acosh(type, utype, op1) cat(mathfunc_,type)(acosh)(op1)
112 #define op_atanh(type, utype, op1) cat(mathfunc_,type)(atanh)(op1)
113 #define op_exp2(type, utype, op1) cat(mathfunc_,type)(exp2)(op1)
114 #define op_exp(type, utype, op1) cat(mathfunc_,type)(exp)(op1)
115 #define op_exp10(type, utype, op1) cat(mathfunc_,type)(exp10)(op1)
116 #define op_log2(type, utype, op1) cat(mathfunc_,type)(log2)(op1)
117 #define op_log(type, utype, op1) cat(mathfunc_,type)(log)(op1)
118 #define op_log10(type, utype, op1) cat(mathfunc_,type)(log10)(op1)
119 #define op_round(type, utype, op1) cat(mathfunc_,type)(rint)(op1)
120 #define op_ceil(type, utype, op1) cat(mathfunc_,type)(ceil)(op1)
121 #define op_floor(type, utype, op1) cat(mathfunc_,type)(floor)(op1)
122 #define op_trunc(type, utype, op1) cat(mathfunc_,type)(trunc)(op1)
123 #define op_fract(type, utype, op1) cat(mathfunc_,type)(fract)(op1)
124 #define op_mantissa(type, utype, op1) cat(mathfunc_,type)(mantissa)(op1)
125 #define op_exponent(type, utype, op1) cat(mathfunc_,type)(exponent)(op1)
126
127 #define generate_fixed_binary(type, utype, op) \
128 static ipret_inline bool cat4(FIXED_binary_,op,_,type) \
129 (const utype *op1, const utype *op2, utype *res)\
130 { \
131 *(utype *)res = cat(op_,op)(type, utype, (*(const utype *)op1), (*(const utype *)op2));\
132 return true; \
133 }
134
135 #define generate_fixed_binary_logical(type, utype, op) \
136 static ipret_inline bool cat4(FIXED_binary_,op,_,type) \
137 (const utype *op1, const utype *op2, ajla_flat_option_t *res)\
138 { \
139 *(ajla_flat_option_t *)res = cat(op_,op)(type, utype, (*(const utype *)op1), (*(const utype *)op2));\
140 return true; \
141 }
142
143 #define generate_fixed_unary(type, utype, op) \
144 static ipret_inline void cat4(FIXED_unary_,op,_,type) \
145 (const utype *op1, utype *res) \
146 { \
147 *(utype *)res = cat(op_,op)(type, utype, (*(utype *)op1)); \
148 }
149
150 #define generate_fixed_ldc(type, utype, sz, bits) \
151 static ipret_inline ip_t cat(fixed_ldc_,type) \
152 (utype *res, const code_t *ip, bool small)\
153 { \
154 if (small && sz > 2) { \
155 *res = (utype)(int16_t)ip[0]; \
156 return 1; \
157 } \
158 *res = (utype)cat(get_unaligned_,bits)(ip); \
159 return (sz + 1) / 2; \
160 }
161
162 #define generate_fixed_functions(n, type, utype, sz, bits) \
163 generate_fixed_binary(type, utype, add) \
164 generate_fixed_binary(type, utype, subtract) \
165 generate_fixed_binary(type, utype, multiply) \
166 generate_fixed_binary(type, utype, and) \
167 generate_fixed_binary(type, utype, or) \
168 generate_fixed_binary(type, utype, xor) \
169 generate_fixed_binary(type, utype, shl) \
170 generate_fixed_binary(type, utype, shr) \
171 generate_fixed_binary(type, utype, ushr) \
172 generate_fixed_binary_logical(type, utype, equal) \
173 generate_fixed_binary_logical(type, utype, not_equal) \
174 generate_fixed_binary_logical(type, utype, less) \
175 generate_fixed_binary_logical(type, utype, less_equal) \
176 generate_fixed_binary_logical(type, utype, uless) \
177 generate_fixed_binary_logical(type, utype, uless_equal) \
178 generate_fixed_unary(type, utype, not) \
179 generate_fixed_unary(type, utype, neg) \
180 generate_fixed_unary(type, utype, inc) \
181 generate_fixed_unary(type, utype, dec) \
182 generate_fixed_ldc(type, utype, sz, bits)
183 for_all_fixed(generate_fixed_functions)
184 #undef generate_fixed_functions
185
186
187 #define generate_int_binary(type, utype, op, operator) \
188 static ipret_inline bool \
189 cat4(INT_binary_,op,_,type)(const void *op1, const void *op2, void *res)\
190 { \
191 *cast_ptr(type *, res) = \
192 *cast_ptr(const type *, op1) operator \
193 *cast_ptr(const type *, op2); \
194 return true; \
195 }
196
197 #define generate_int_binary_logical(type, utype, op, operator) \
198 static ipret_inline bool \
199 cat4(INT_binary_,op,_,type)(const void *op1, const void *op2, ajla_flat_option_t *res)\
200 { \
201 *res = *cast_ptr(const type *, op1) operator \
202 *cast_ptr(const type *, op2); \
203 return true; \
204 }
205
206 #define generate_int_ldc(type, utype, bits) \
207 static ipret_inline ip_t cat(int_ldc_,type) \
208 (type *res, const code_t *ip, bool small)\
209 { \
210 return cat(fixed_ldc_,type)(cast_ptr(utype *, res), ip, small); \
211 }
212
213
214 #define generate_int_functions(typeid, type, utype, sz, bits) \
215 generate_int_binary(type, utype, and, &) \
216 generate_int_binary(type, utype, or, |) \
217 generate_int_binary(type, utype, xor, ^) \
218 generate_int_binary_logical(type, utype, equal, ==) \
219 generate_int_binary_logical(type, utype, not_equal, !=) \
220 generate_int_binary_logical(type, utype, less, <) \
221 generate_int_binary_logical(type, utype, less_equal, <=) \
222 generate_int_ldc(type, utype, bits)
223 for_all_int(generate_int_functions, for_all_empty)
224 #undef generate_int_binary_functions
225
226
227 #if defined(use_is_macros)
228 #ifdef HAVE_REAL_GNUC
229 #define isnan_any(type, a, b) (unlikely(isunordered(b, a)))
230 #else
231 #define isnan_any(type, a, b) (unlikely(isunordered(a, b)))
232 #endif
233 #else
234 #define isnan_any(type, a, b) (unlikely(cat(isnan_,type)(a)) || unlikely(cat(isnan_,type)(b)))
235 #endif
236
237 #if REAL_MASK & 0x1
238 static attr_always_inline bool do_nextafter_real16_t(real16_t attr_unused x, int attr_unused dir, real16_t attr_unused *res)
239 {
240 return false;
241 }
242 #endif
243
244 #if REAL_MASK & 0x2
245 static attr_always_inline bool do_nextafter_real32_t(real32_t attr_unused x, int attr_unused dir, real32_t attr_unused *res)
246 {
247 #ifdef HAVE_NEXTAFTERF
248 *res = nextafterf(x, HUGE_VALF * dir);
249 return true;
250 #else
251 return false;
252 #endif
253 }
254 #endif
255
256 #if REAL_MASK & 0x4
257 static attr_always_inline bool do_nextafter_real64_t(real64_t attr_unused x, int attr_unused dir, real64_t attr_unused *res)
258 {
259 #ifdef HAVE_NEXTAFTER
260 *res = nextafter(x, HUGE_VAL * dir);
261 return true;
262 #else
263 return false;
264 #endif
265 }
266 #endif
267
268 #if REAL_MASK & 0x8
269 static attr_always_inline bool do_nextafter_real80_t(real80_t attr_unused x, int dir, real80_t attr_unused *res)
270 {
271 #ifdef HAVE_NEXTAFTERL
272 *res = nextafterl(x, HUGE_VALL * dir);
273 return true;
274 #else
275 return false;
276 #endif
277 }
278 #endif
279
280 #if REAL_MASK & 0x10
281 static attr_always_inline bool do_nextafter_real128_t(real128_t attr_unused x, int dir, real128_t attr_unused *res)
282 {
283 #ifndef HAVE_NATIVE_FLOAT128
284 #ifdef HAVE_NEXTAFTERL
285 *res = nextafterl(x, HUGE_VALL * dir);
286 return true;
287 #else
288 return false;
289 #endif
290 #else
291 *res = nextafterq(x, HUGE_VAL * dir);
292 return true;
293 #endif
294 }
295 #endif
296
297 #define generate_real_binary(type, ntype, pack, unpack, op) \
298 static ipret_inline bool cat4(REAL_binary_,op,_,type) \
299 (const type *op1, const type *op2, type *res)\
300 { \
301 *res = pack(cat(op_,op)(ntype, ntype, (unpack(*op1)), (unpack(*op2))));\
302 return true; \
303 }
304
305 #define generate_real_binary_logical(type, ntype, pack, unpack, op) \
306 static ipret_inline bool cat4(REAL_binary_,op,_,type) \
307 (const type *op1, const type *op2, ajla_flat_option_t *res)\
308 { \
309 ntype o1 = unpack(*op1); \
310 ntype o2 = unpack(*op2); \
311 if (isnan_any(ntype, o1, o2)) \
312 return false; \
313 *res = cat(op_real_,op)(ntype, ntype, o1, o2); \
314 return true; \
315 }
316
317 #define generate_real_unary(n, type, ntype, pack, unpack, op, op_n) \
318 static ipret_inline void cat4(REAL_unary_,op,_,type) \
319 (const type *op1, type *res) \
320 { \
321 if (!n && REAL16_T_IS_UINT16_T) { \
322 if (!op_n) { \
323 *(uint16_t *)res = *(uint16_t *)op1 ^ 0x8000U; \
324 return; \
325 } \
326 } \
327 *res = pack(cat(op_,op)(type, type, (unpack(*op1)))); \
328 }
329
330 /* EMX has a bug - modf(infinity) return NaN instead of 0. */
331 #ifdef HAVE_BUGGY_MODF
332 #define need_modf_hack true
333 #else
334 #define need_modf_hack false
335 #endif
336
337 #define generate_real_fns(n, type, ntype, pack, unpack) \
338 static ipret_inline bool cat(REAL_binary_power_,type) \
339 (const type *op1, const type *op2, type *res)\
340 { \
341 ntype o1 = unpack(*op1); \
342 ntype o2 = unpack(*op2); \
343 ntype r; \
344 if (unlikely(isnan_any(ntype, o1, o2))) \
345 return false; \
346 r = cat(mathfunc_,type)(pow)(o1, o2); \
347 *res = pack(r); \
348 return true; \
349 } \
350 static ipret_inline bool cat(REAL_binary_ldexp_,type) \
351 (const type *op1, const type *op2, type *res)\
352 { \
353 ntype m; \
354 ntype o1 = unpack(*op1); \
355 ntype o2 = unpack(*op2); \
356 if (unlikely(isnan_any(ntype, o1, o2))) \
357 return false; \
358 if (likely(o2 >= (ntype)sign_bit(int)) && likely(o2 <= (ntype)signed_maximum(int)) && likely(o2 == (int)o2)) {\
359 *res = pack(cat(mathfunc_,type)(ldexp)(o1, (int)o2)); \
360 } else { \
361 m = cat(mathfunc_,type)(exp2)(o2); \
362 m *= o1; \
363 *res = pack(m); \
364 } \
365 return true; \
366 } \
367 static ipret_inline void cat(REAL_unary_fract_,type) \
368 (const type *op1, type *res) \
369 { \
370 ntype m = unpack(*op1); \
371 union { \
372 ntype i; \
373 float f; \
374 } u; \
375 if (need_modf_hack) { \
376 if (likely(!cat(isnan_,ntype)(m)) && unlikely(!cat(isfinite_,ntype)(m))) {\
377 *res = pack(m >= 0 ? 0. : -0.); \
378 return; \
379 } \
380 } \
381 *res = pack(cat(mathfunc_,type)(modf)(m, (void *)&u)); \
382 } \
383 static ipret_inline void cat(REAL_unary_mantissa_,type) \
384 (const type *op1, type *res) \
385 { \
386 int i; \
387 *res = pack(cat(mathfunc_,type)(frexp)(unpack(*op1), &i)); \
388 } \
389 static ipret_inline void cat(REAL_unary_exponent_,type) \
390 (const type *op1, type *res) \
391 { \
392 int i; \
393 ntype m = cat(mathfunc_,type)(frexp)(unpack(*op1), &i); \
394 if (unlikely(cat(isnan_,ntype)(m))) { \
395 *res = pack(m); \
396 return; \
397 } \
398 if (unlikely(!cat(isfinite_,ntype)(m))) { \
399 *res = pack((ntype)0.); \
400 return; \
401 } \
402 *res = pack((ntype)i); \
403 } \
404 static ipret_inline type cat(REAL_unary_next_prev_number_,type) \
405 (type op1, int dir) \
406 { \
407 int ex, bit; \
408 volatile ntype m, mm, n1; \
409 volatile type res, o; \
410 if (unlikely(cat(isnan_,type)(op1))) \
411 return op1; \
412 n1 = unpack(op1); \
413 if (unlikely(!cat(isfinite_,type)(op1))) { \
414 if ((n1 >= 0) == (dir >= 0)) \
415 return op1; \
416 m = cat(mathfunc_,ntype)(ldexp)(1, cat(bits_,type)) - 1;\
417 while (1) { \
418 mm = m * 2; \
419 res = pack(mm); \
420 if (unlikely(!cat(isfinite_,type)(res))) \
421 break; \
422 m = mm; \
423 } \
424 return pack(m * -dir); \
425 } \
426 if (unlikely(!n1)) { \
427 res = pack(1); \
428 o = pack(1); \
429 while (1) { \
430 o = pack(unpack(o) * 0.5); \
431 m = unpack(o); \
432 if (m == 0) \
433 break; \
434 res = o; \
435 } \
436 return pack(unpack(res) * dir); \
437 } \
438 m = cat(mathfunc_,type)(frexp)(n1, &ex); \
439 bit = cat(bits_,type); \
440 again: \
441 mm = m + cat(mathfunc_,ntype)(ldexp)(dir, -bit); \
442 o = pack(cat(mathfunc_,ntype)(ldexp)(mm, ex)); \
443 res = o; \
444 if (unpack(res) == n1) { \
445 bit--; \
446 goto again; \
447 } \
448 return res; \
449 } \
450 static ipret_inline void cat(REAL_unary_next_number_,type) \
451 (const type *op1, type *res) \
452 { \
453 if (cat(do_nextafter_,type)(*op1, 1, res)) \
454 return; \
455 *res = cat(REAL_unary_next_prev_number_,type)(*op1, 1); \
456 } \
457 static ipret_inline void cat(REAL_unary_prev_number_,type) \
458 (const type *op1, type *res) \
459 { \
460 if (cat(do_nextafter_,type)(*op1, -1, res)) \
461 return; \
462 *res = cat(REAL_unary_next_prev_number_,type)(*op1, -1); \
463 }
464
465 #define generate_real_unary_logical(n, type, ntype, pack, unpack, op, op_n)\
466 static ipret_inline void cat4(REAL_unary_,op,_,type) \
467 (const type *op1, ajla_flat_option_t *res)\
468 { \
469 *res = cat(isnan_,type)(*op1); \
470 }
471
472 #define op_real_equal op_equal
473 #if defined(use_is_macros) && defined(ARCH_X86)
474 #define op_real_not_equal(type, utype, op1, op2) islessgreater(op1, op2)
475 #else
476 #define op_real_not_equal op_not_equal
477 #endif
478 #if defined(use_is_macros)
479 #define op_real_less(type, utype, op1, op2) isless(op1, op2)
480 #else
481 #define op_real_less op_less
482 #endif
483 #if defined(use_is_macros)
484 #define op_real_less_equal(type, utype, op1, op2) islessequal(op1, op2)
485 #else
486 #define op_real_less_equal op_less_equal
487 #endif
488
489 #define generate_real_ldc(n, rtype, ntype, pack, unpack) \
490 static ipret_inline size_t cat(fixed_ldc_,rtype) \
491 (rtype *res, const code_t *ip, bool attr_unused shrt)\
492 { \
493 memcpy(res, ip, sizeof(rtype)); \
494 return round_up(sizeof(rtype), sizeof(code_t)) / sizeof(code_t);\
495 }
496
497 #define generate_real_int(type, ntype, pack, unpack) \
498 static ipret_inline bool cat(REAL_unary_to_int_,type)(const type *val, int_default_t *r)\
499 { \
500 ntype val1; \
501 val1 = unpack(*val); \
502 if (likely(val1 > (ntype)sign_bit(int_default_t)) && likely(val1 < (ntype)signed_maximum(int_default_t))) {\
503 *r = val1; \
504 return true; \
505 } \
506 return false; \
507 } \
508 static ipret_inline void cat(REAL_unary_from_int_,type)(const int_default_t *val, type *r)\
509 { \
510 *r = pack(*val); \
511 }
512
513 #define generate_real_functions(n, type, ntype, pack, unpack) \
514 generate_real_binary(type, ntype, pack, unpack, add) \
515 generate_real_binary(type, ntype, pack, unpack, subtract) \
516 generate_real_binary(type, ntype, pack, unpack, multiply) \
517 generate_real_binary(type, ntype, pack, unpack, divide) \
518 generate_real_binary(type, ntype, pack, unpack, modulo) \
519 generate_real_binary(type, ntype, pack, unpack, atan2) \
520 generate_real_binary_logical(type, ntype, pack, unpack, equal) \
521 generate_real_binary_logical(type, ntype, pack, unpack, not_equal) \
522 generate_real_binary_logical(type, ntype, pack, unpack, less) \
523 generate_real_binary_logical(type, ntype, pack, unpack, less_equal) \
524 generate_real_unary(n, type, ntype, pack, unpack, neg, 0) \
525 generate_real_unary(n, type, ntype, pack, unpack, sqrt, 1) \
526 generate_real_unary(n, type, ntype, pack, unpack, cbrt, 1) \
527 generate_real_unary(n, type, ntype, pack, unpack, sin, 1) \
528 generate_real_unary(n, type, ntype, pack, unpack, cos, 1) \
529 generate_real_unary(n, type, ntype, pack, unpack, tan, 1) \
530 generate_real_unary(n, type, ntype, pack, unpack, asin, 1) \
531 generate_real_unary(n, type, ntype, pack, unpack, acos, 1) \
532 generate_real_unary(n, type, ntype, pack, unpack, atan, 1) \
533 generate_real_unary(n, type, ntype, pack, unpack, sinh, 1) \
534 generate_real_unary(n, type, ntype, pack, unpack, cosh, 1) \
535 generate_real_unary(n, type, ntype, pack, unpack, tanh, 1) \
536 generate_real_unary(n, type, ntype, pack, unpack, asinh, 1) \
537 generate_real_unary(n, type, ntype, pack, unpack, acosh, 1) \
538 generate_real_unary(n, type, ntype, pack, unpack, atanh, 1) \
539 generate_real_unary(n, type, ntype, pack, unpack, exp2, 1) \
540 generate_real_unary(n, type, ntype, pack, unpack, exp, 1) \
541 generate_real_unary(n, type, ntype, pack, unpack, exp10, 1) \
542 generate_real_unary(n, type, ntype, pack, unpack, log2, 1) \
543 generate_real_unary(n, type, ntype, pack, unpack, log, 1) \
544 generate_real_unary(n, type, ntype, pack, unpack, log10, 1) \
545 generate_real_unary(n, type, ntype, pack, unpack, round, 1) \
546 generate_real_unary(n, type, ntype, pack, unpack, ceil, 1) \
547 generate_real_unary(n, type, ntype, pack, unpack, floor, 1) \
548 generate_real_unary(n, type, ntype, pack, unpack, trunc, 1) \
549 generate_real_fns(n, type, ntype, pack, unpack) \
550 generate_real_int(type, ntype, pack, unpack) \
551 generate_real_unary_logical(n, type, ntype, pack, unpack, is_exception, 0)\
552 generate_real_ldc(n, type, ntype, pack, unpack)
553
554 for_all_real(generate_real_functions, for_all_empty)
555 #undef generate_real_functions
556
557
558 static inline frame_s *frame_build(frame_s *fp, struct data *function, ajla_error_t *mayfail)
559 {
560 frame_t new_frame_slots = da(function,function)->frame_slots;
561 if (likely(new_frame_slots <= get_frame(fp)->available_slots)) {
562 frame_s *new_fp = cast_ptr(frame_s *, cast_ptr(char *, fp) - new_frame_slots * slot_size);
563 get_frame(new_fp)->available_slots = get_frame(fp)->available_slots - new_frame_slots;
564 get_frame(new_fp)->function = function;
565 return new_fp;
566 } else {
567 return stack_expand(fp, function, mayfail);
568 }
569 }
570
571
572 #define ipret_checkpoint_forced \
573 do { \
574 void *ex_ = ipret_tick(fp, ip); \
575 RELOAD_EX_POSITION(ex_); \
576 } while (0)
577
578
579 #define OPCODE_ARG_MODE(opcode) ((opcode) + ARG_MODE * OPCODE_MODE_MULT)
580
581 #define EMIT_FUNCTIONS
582 #include "ipret.inc"
583
584 void attr_hot_fastcall run(frame_s *fp_, ip_t ip_)
585 {
586 ajla_error_t ajla_error;
587 tick_stamp_t ts;
588 #if defined(DEBUG) && !defined(COMPUTED_GOTO)
589 const code_t *last_stack[20];
590 #endif
591
592 register frame_s *fp
593 #if ((defined(INLINE_ASM_GCC_I386) && !defined(__PIC__)) || defined(INLINE_ASM_GCC_X32)) && defined(__OPTIMIZE__) && defined(HAVE_REAL_GNUC)
594 /*
595 * GCC usually uses ebp for the variable fp. It is bad choice because
596 * ebp can't be used as a base register without immediate offset. So,
597 * the assembler adds offset 0 to every instruction using ebp as base.
598 * Doing two additions and one shift in one instruction is too much and
599 * it causes performance drop on both Intel and AMD architectures.
600 */
601 __asm__("ebx")
602 #endif
603 #if defined(INLINE_ASM_GCC_X86_64) && defined(__OPTIMIZE__) && defined(HAVE_REAL_GNUC)
604 /*__asm__("rbx")*/
605 #endif
606 #if defined(INLINE_ASM_GCC_ARM_THUMB2) && defined(__OPTIMIZE__) && defined(HAVE_REAL_GNUC)
607 /* peg this to a register in lower bank to reduce code size and improve performance */
608 __asm__("r6")
609 #endif
610 ;
611 register const code_t *ip
612 #if defined(INLINE_ASM_GCC_ARM_THUMB2) && defined(__OPTIMIZE__) && defined(HAVE_REAL_GNUC) && 0
613 /* don't use it for now, it causes too much register pressure */
614 __asm__("r5")
615 #endif
616 ;
617 code_t code;
618
619 #ifdef COMPUTED_GOTO
620 const void *next_label;
621 #ifdef COMPUTED_GOTO_RELATIVE
622 static const int dispatch[OPCODE_MODE_MULT * ARG_MODE_N - (OPCODE_MODE_MULT - OPCODE_N)] = {
623 #define DEFINE_OPCODE_START_LBL(opcode, lbl) \
624 [OPCODE_ARG_MODE(opcode)] = (const char *)&&cat(label_,lbl) - (const char *)&&label_unknown,
625 #else
626 static const void *dispatch[OPCODE_MODE_MULT * ARG_MODE_N - (OPCODE_MODE_MULT - OPCODE_N)] = {
627 #define DEFINE_OPCODE_START_LBL(opcode, lbl) \
628 [OPCODE_ARG_MODE(opcode)] = &&cat(label_,lbl),
629 #endif
630 #include "ipret.inc"
631 #ifdef COMPUTED_GOTO_RELATIVE
632 };
633 #else
634 };
635 #endif
636 #endif
637
638 #if defined(DEBUG) && !defined(COMPUTED_GOTO)
639 memset(last_stack, 0, sizeof last_stack);
640 #endif
641
642 fp = fp_;
643 ip = &da(get_frame(fp)->function,function)->code[ip_];
644 tick_start(&ts);
645
646 #define RELOAD_EX_POSITION(ex) \
647 do { \
648 if ((ex) != POINTER_FOLLOW_THUNK_EXIT) { \
649 ajla_assert((ex) != POINTER_FOLLOW_THUNK_RETRY && (ex) != POINTER_FOLLOW_THUNK_EXCEPTION && (ex) != POINTER_FOLLOW_THUNK_GO, (file_line, "RELOAD_EX_POSITION: invalid pointer: %p", (ex)));\
650 fp = cast_ptr(struct execution_control *, (ex))->current_frame;\
651 ip = da(get_frame(fp)->function,function)->code + cast_ptr(struct execution_control *, (ex))->current_ip;\
652 tick_start(&ts); \
653 goto next_code; \
654 } else { \
655 goto exit_ipret; \
656 } \
657 } while (0)
658
659 #ifdef COMPUTED_GOTO
660
661 #ifdef COMPUTED_GOTO_RELATIVE
662 #define GOTO_NEXT(opcode) \
663 code = *ip; \
664 next_label = (const char *)&&label_unknown + dispatch[code & OPCODE_MASK];\
665 ASM_PREVENT_JOIN(OPCODE_ARG_MODE(opcode)); \
666 goto *(void *)next_label;
667 #else
668 #define GOTO_NEXT(opcode) \
669 code = *ip; \
670 next_label = dispatch[code & OPCODE_MASK]; \
671 ASM_PREVENT_JOIN(OPCODE_ARG_MODE(opcode)); \
672 goto *(void *)next_label;
673 #endif
674
675 next_code:
676 #define ARG_MODE 0
677 GOTO_NEXT(-1);
678 #undef ARG_MODE
679
680 #define EMIT_CODE
681 #define START_BLOCK(declarations) { declarations
682 #define END_BLOCK() }
683 #define DEFINE_LABEL(lbl, code) \
684 lbl: do { \
685 code \
686 } while (0); \
687 GOTO_NEXT(-2);
688 #define DEFINE_OPCODE_START_LBL(opcode, lbl) \
689 cat(label_,lbl): do {
690 #define DEFINE_OPCODE_END(opcode) \
691 } while (0); \
692 GOTO_NEXT(OPCODE_ARG_MODE(opcode));
693 #include "ipret.inc"
694
695 #ifdef COMPUTED_GOTO_RELATIVE
696 label_unknown:
697 internal(file_line, "run: invalid opcode %04x", (int)code);
698 #endif
699
700 #else
701 next_code:
702 code = *ip;
703 #if defined(DEBUG) && !defined(COMPUTED_GOTO)
704 memmove(last_stack + 1, last_stack, (sizeof last_stack) - sizeof(*last_stack));
705 last_stack[0] = ip;
706 #endif
707 #ifdef DEBUG_TRACE
708 if (unlikely(load_relaxed(&trace_enabled))) {
709 struct stack_trace st;
710 const char *fn = "";
711 unsigned ln = 0;
712 stack_trace_capture(&st, fp, ip, 1);
713 if (st.trace_n >= 1) {
714 fn = st.trace[0].function_name;
715 ln = st.trace[0].line;
716 }
717 #define xip(n) (frame_ip(fp, ip) + n >= da(get_frame(fp)->function,function)->code_size ? 0xffff : ip[n])
718 trace("%-24s %-5u %-32s at %u %p %p %04x %04x %04x %04x %04x %04x %04x %04x", fn, ln, decode_opcode(code, true), frame_ip(fp, ip), fp, frame_execution_control(fp), xip(1), xip(2), xip(3), xip(4), xip(5), xip(6), xip(7), xip(8));
719 #undef xip
720 stack_trace_free(&st);
721 }
722 #endif
723 switch (code & OPCODE_MASK) {
724 #define EMIT_CODE
725 #define START_BLOCK(declarations) { declarations
726 #define END_BLOCK() }
727 #define DEFINE_LABEL(lbl, code) \
728 lbl: { \
729 code \
730 } \
731 break;
732 #define DEFINE_OPCODE_START_LBL(opcode, lbl) \
733 case OPCODE_ARG_MODE(opcode): {
734 #define DEFINE_OPCODE_END(opcode) \
735 } \
736 break;
737 #include "ipret.inc"
738 default:
739 #if defined(HAVE___BUILTIN_UNREACHABLE) && !defined(DEBUG)
740 __builtin_unreachable();
741 #else
742 {
743 ip_t l = ip - da(get_frame(fp)->function,function)->code;
744 ip_t x;
745 for (x = 0; x <= l; x++) {
746 code_t v = da(get_frame(fp)->function,function)->code[x];
747 const char *opc = decode_opcode(v, true);
748 char c = ' ';
749 #if defined(DEBUG) && !defined(COMPUTED_GOTO)
750 size_t lso;
751 for (lso = 0; lso < n_array_elements(last_stack); lso++)
752 if (&da(get_frame(fp)->function,function)->code[x] == last_stack[lso])
753 c = '*';
754 #endif
755 if (opc)
756 debug("%c %04x (%s)", c, v, opc);
757 else
758 debug("%c %04x", c, v);
759 }
760 internal(file_line, "run: invalid opcode %04x (mode %x, int %x, real %x, bool %x, extra %x)", code, OPCODE_MODE_MULT, OPCODE_INT_OP, OPCODE_REAL_OP, OPCODE_BOOL_OP, OPCODE_EXTRA);
761 }
762 #endif
763 }
764 goto next_code;
765 #endif
766
767 exit_ipret:;
768 }
769
770
771 #ifdef HAVE_CODEGEN
772
773 static void cg_upcall_mem_copy(void *dest, const void *src, size_t size)
774 {
775 memcpy(dest, src, size);
776 }
777
778 static void cg_upcall_mem_clear(void *ptr, size_t len)
779 {
780 memset(ptr, 0, len);
781 }
782
783 static void cg_upcall_pointer_dereference(pointer_t_upcall ptr)
784 {
785 pointer_dereference(ptr);
786 }
787
788 static void cg_upcall_pointer_reference_owned(pointer_t_upcall ptr)
789 {
790 pointer_reference_owned(ptr);
791 }
792
793 static pointer_t cg_upcall_flat_to_data(frame_s *fp, uintptr_t slot, const unsigned char *flat)
794 {
795 const struct type *type = frame_get_type_of_local(fp, slot);
796 return flat_to_data(type, flat);
797 }
798
799 static unsigned char *cg_upcall_data_alloc_function_reference_mayfail(uintptr_t n_curried_arguments)
800 {
801 ajla_error_t sink;
802 return cast_ptr(unsigned char *, data_alloc_function_reference_mayfail(n_curried_arguments, &sink pass_file_line));
803 }
804
805 static unsigned char *cg_upcall_data_alloc_record_mayfail(frame_s *fp, uintptr_t slot)
806 {
807 ajla_error_t sink;
808 const struct type *type = frame_get_type_of_local(fp, slot);
809 return cast_ptr(unsigned char *, data_alloc_record_mayfail(type_def(type,record), &sink pass_file_line));
810 }
811
812 static unsigned char *cg_upcall_data_alloc_option_mayfail(void)
813 {
814 ajla_error_t sink;
815 return cast_ptr(unsigned char *, data_alloc(option, &sink));
816 }
817
818 static unsigned char *cg_upcall_data_alloc_array_flat_tag_mayfail(uintptr_t tag, int_default_t_upcall n_entries)
819 {
820 ajla_error_t sink;
821 const struct type *type = type_get_from_tag(tag);
822 return cast_ptr(unsigned char *, data_alloc_array_flat_mayfail(type, n_entries, n_entries, false, &sink pass_file_line));
823 }
824
825 static unsigned char *cg_upcall_data_alloc_array_flat_slot_mayfail(frame_s *fp, uintptr_t slot, int_default_t_upcall n_entries)
826 {
827 ajla_error_t sink;
828 const struct type *type = frame_get_type_of_local(fp, slot);
829 return cast_ptr(unsigned char *, data_alloc_array_flat_mayfail(type, n_entries, n_entries, false, &sink pass_file_line));
830 }
831
832 static unsigned char *cg_upcall_data_alloc_array_flat_types_ptr_mayfail(frame_s *fp, uintptr_t local_type, int_default_t_upcall n_entries)
833 {
834 ajla_error_t sink;
835 const struct type *type = da_type(get_frame(fp)->function, local_type);
836 return cast_ptr(unsigned char *, data_alloc_array_flat_mayfail(type, n_entries, n_entries, false, &sink pass_file_line));
837 }
838
839 static unsigned char *cg_upcall_data_alloc_array_pointers_mayfail(int_default_t_upcall n_allocated, int_default_t_upcall n_used)
840 {
841 ajla_error_t sink;
842 return cast_ptr(unsigned char *, data_alloc_array_pointers_mayfail(n_allocated, n_used, &sink pass_file_line));
843 }
844
845 static pointer_t cg_upcall_array_create_flat(frame_s *fp, int_default_t_upcall length, uintptr_t content_slot)
846 {
847 array_index_t idx;
848 const struct type *content_type = frame_get_type_of_local(fp, content_slot);
849 index_from_int(&idx, length);
850 return array_create(idx, content_type, frame_var(fp, content_slot), pointer_empty());
851 }
852
853 static pointer_t cg_upcall_array_create_pointers(frame_s *fp, uintptr_t ip_offset, uintptr_t length_slot, pointer_t_upcall ptr)
854 {
855 array_index_t idx;
856 int_default_t length = *frame_slot(fp, length_slot, int_default_t);
857 if (unlikely(length < 0)) {
858 code_t *ip;
859 pointer_dereference(ptr);
860 ip = da(get_frame(fp)->function,function)->code + ip_offset;
861 return pointer_error(error_ajla(EC_SYNC, AJLA_ERROR_NEGATIVE_INDEX), fp, ip pass_file_line);
862 }
863 index_from_int(&idx, length);
864 return array_create(idx, NULL, NULL, ptr);
865 }
866
867 static pointer_t cg_upcall_array_create_sparse(int_default_t_upcall length, pointer_t_upcall ptr)
868 {
869 array_index_t idx;
870 index_from_int(&idx, length);
871 return array_create_sparse(idx, ptr);
872 }
873
874 static pointer_t cg_upcall_array_sub(pointer_t_upcall array, int_default_t_upcall start, int_default_t_upcall end, bool deref)
875 {
876 pointer_t res_ptr;
877 ajla_error_t err;
878 struct data *d, *s;
879 array_index_t idx_start, idx_end, idx_len, idx_array_len;
880 if (unlikely((start | end) < 0))
881 goto fail1;
882 if (unlikely(start > end))
883 goto fail1;
884 if (unlikely(pointer_is_thunk(array)))
885 goto fail1;
886 index_from_int(&idx_start, start);
887 index_from_int(&idx_end, end);
888 index_from_int(&idx_len, end - start);
889 d = pointer_get_data(array);
890 if (unlikely(da_tag(d) == DATA_TAG_array_incomplete))
891 goto fail2;
892 idx_array_len = array_len(d);
893 if (unlikely(!index_ge_index(idx_array_len, idx_end))) {
894 index_free(&idx_array_len);
895 goto fail2;
896 }
897 index_free(&idx_array_len);
898 index_free(&idx_end);
899 s = array_sub(d, idx_start, idx_len, deref, &err);
900 if (unlikely(!s)) {
901 res_ptr = pointer_error(err, NULL, 0 pass_file_line);
902 } else {
903 res_ptr = pointer_data(s);
904 }
905 return res_ptr;
906 fail2:
907 index_free(&idx_start);
908 index_free(&idx_end);
909 index_free(&idx_len);
910 fail1:
911 return pointer_empty();
912 }
913
914 static pointer_t cg_upcall_array_skip(pointer_t_upcall array, int_default_t_upcall start, bool deref)
915 {
916 pointer_t res_ptr;
917 ajla_error_t err;
918 struct data *d, *s;
919 array_index_t idx_start, idx_array_len;
920 if (unlikely(start < 0))
921 goto fail1;
922 if (unlikely(pointer_is_thunk(array)))
923 goto fail1;
924 d = pointer_get_data(array);
925 if (unlikely(da_tag(d) == DATA_TAG_array_incomplete))
926 goto fail1;
927 index_from_int(&idx_start, start);
928 idx_array_len = array_len(d);
929 if (unlikely(!index_ge_index(idx_array_len, idx_start))) {
930 goto fail2;
931 }
932 index_sub_int(&idx_array_len, start);
933 s = array_sub(d, idx_start, idx_array_len, deref, &err);
934 if (unlikely(!s)) {
935 res_ptr = pointer_error(err, NULL, 0 pass_file_line);
936 } else {
937 res_ptr = pointer_data(s);
938 }
939 return res_ptr;
940 fail2:
941 index_free(&idx_array_len);
942 index_free(&idx_start);
943 fail1:
944 return pointer_empty();
945 }
946
947 static pointer_t cg_upcall_array_join(pointer_t_upcall ptr1, pointer_t_upcall ptr2)
948 {
949 ajla_error_t err;
950 struct data *d1 = pointer_get_data(ptr1);
951 struct data *d2 = pointer_get_data(ptr2);
952 struct data *d = array_join(d1, d2, &err);
953 if (unlikely(!d))
954 return pointer_error(err, NULL, NULL pass_file_line);
955 return pointer_data(d);
956 }
957
958 static void *cg_upcall_ipret_io(frame_s *fp, uintptr_t ip_offset, uintptr_t code_params)
959 {
960 void *ret;
961 code_t *ip = da(get_frame(fp)->function,function)->code + ip_offset;
962 unsigned char io_code = code_params >> 24;
963 unsigned char n_outputs = code_params >> 16;
964 unsigned char n_inputs = code_params >> 8;
965 unsigned char n_params = code_params;
966 /*debug("cg_upcall_ipret_io start: %p, %u %u %u %u", ip, io_code, n_outputs, n_inputs, n_params);*/
967 ret = ipret_io(fp, ip, io_code, n_outputs, n_inputs, n_params);
968 /*debug("cg_upcall_ipret_io end: %u %u %u %u -> %p", io_code, n_outputs, n_inputs, n_params, ret);*/
969 return ret;
970 }
971
972 static pointer_t cg_upcall_ipret_copy_variable_to_pointer(frame_s *src_fp, uintptr_t src_slot, bool deref)
973 {
974 return ipret_copy_variable_to_pointer(src_fp, src_slot, deref);
975 }
976
977 static int_default_t cg_upcall_ipret_system_property(int_default_t_upcall idx)
978 {
979 return ipret_system_property(idx);
980 }
981
982
983 #define f(n, s, u, sz, bits) \
984 static bool cat(FIXED_uto_int_,s)(const u *v1, int_default_t *r) \
985 { \
986 int_default_t ret; \
987 ret = (int_default_t)*v1; \
988 if (unlikely((u)ret != *v1) || unlikely(ret < 0)) \
989 return false; \
990 *r = ret; \
991 return true; \
992 } \
993 static bool cat(FIXED_ufrom_int_,s)(const int_default_t *v1, u *r) \
994 { \
995 u ret; \
996 ret = (u)*v1; \
997 if (unlikely((int_default_t)ret != *v1) || unlikely(*v1 < 0)) \
998 return false; \
999 *r = ret; \
1000 return true; \
1001 }
1002 for_all_fixed(f)
1003 #undef f
1004
1005 #ifdef DEBUG_UPCALL
1006 static void cg_upcall_debug(unsigned long x1, unsigned long x2, unsigned long x3, unsigned long x4)
1007 {
1008 debug("cg upcall: %lx, %lx, %lx, %lx", x1, x2, x3, x4);
1009 }
1010 #endif
1011
1012 #endif
1013
1014 #define nf(n, t) NULL,
1015
1016 struct cg_upcall_vector_s cg_upcall_vector = {
1017 0,
1018 #ifdef HAVE_CODEGEN
1019 cg_upcall_mem_copy,
1020 cg_upcall_mem_clear,
1021 cg_upcall_pointer_dereference,
1022 cg_upcall_pointer_reference_owned,
1023 cg_upcall_flat_to_data,
1024 cg_upcall_data_alloc_function_reference_mayfail,
1025 cg_upcall_data_alloc_record_mayfail,
1026 cg_upcall_data_alloc_option_mayfail,
1027 cg_upcall_data_alloc_array_flat_tag_mayfail,
1028 cg_upcall_data_alloc_array_flat_slot_mayfail,
1029 cg_upcall_data_alloc_array_flat_types_ptr_mayfail,
1030 cg_upcall_data_alloc_array_pointers_mayfail,
1031 cg_upcall_array_create_flat,
1032 cg_upcall_array_create_pointers,
1033 cg_upcall_array_create_sparse,
1034 cg_upcall_array_sub,
1035 cg_upcall_array_skip,
1036 cg_upcall_array_join,
1037 cg_upcall_ipret_io,
1038 cg_upcall_ipret_copy_variable_to_pointer,
1039 cg_upcall_ipret_system_property,
1040 cat(FIXED_binary_add_,TYPE_INT_MAX),
1041 cat(FIXED_binary_subtract_,TYPE_INT_MAX),
1042 #define f(n, s, u, sz, bits) \
1043 cat(FIXED_binary_multiply_,s),
1044 for_all_fixed(f)
1045 #undef f
1046 #define f(n, s, u, sz, bits) \
1047 cat(FIXED_binary_divide_,s),
1048 for_all_fixed(f)
1049 #undef f
1050 #define f(n, s, u, sz, bits) \
1051 cat(FIXED_binary_udivide_,s),
1052 for_all_fixed(f)
1053 #undef f
1054 #define f(n, s, u, sz, bits) \
1055 cat(FIXED_binary_modulo_,s),
1056 for_all_fixed(f)
1057 #undef f
1058 #define f(n, s, u, sz, bits) \
1059 cat(FIXED_binary_umodulo_,s),
1060 for_all_fixed(f)
1061 #undef f
1062 #define f(n, s, u, sz, bits) \
1063 cat(FIXED_binary_power_,s),
1064 for_all_fixed(f)
1065 #undef f
1066 cat(FIXED_binary_shl_,TYPE_INT_MAX),
1067 cat(FIXED_binary_shr_,TYPE_INT_MAX),
1068 cat(FIXED_binary_ushr_,TYPE_INT_MAX),
1069 cat(FIXED_binary_rol_,TYPE_INT_MAX),
1070 cat(FIXED_binary_ror_,TYPE_INT_MAX),
1071 cat(FIXED_binary_bts_,TYPE_INT_MAX),
1072 cat(FIXED_binary_btr_,TYPE_INT_MAX),
1073 cat(FIXED_binary_btc_,TYPE_INT_MAX),
1074 cat(FIXED_binary_less_,TYPE_INT_MAX),
1075 cat(FIXED_binary_less_equal_,TYPE_INT_MAX),
1076 cat(FIXED_binary_uless_,TYPE_INT_MAX),
1077 cat(FIXED_binary_uless_equal_,TYPE_INT_MAX),
1078 cat(FIXED_binary_bt_,TYPE_INT_MAX),
1079 cat(FIXED_unary_neg_,TYPE_INT_MAX),
1080 cat(FIXED_unary_inc_,TYPE_INT_MAX),
1081 cat(FIXED_unary_dec_,TYPE_INT_MAX),
1082 #define f(n, s, u, sz, bits) \
1083 cat(FIXED_unary_bswap_,s),
1084 for_all_fixed(f)
1085 #undef f
1086 #define f(n, s, u, sz, bits) \
1087 cat(FIXED_unary_brev_,s),
1088 for_all_fixed(f)
1089 #undef f
1090 #define f(n, s, u, sz, bits) \
1091 cat(FIXED_unary_bsf_,s),
1092 for_all_fixed(f)
1093 #undef f
1094 #define f(n, s, u, sz, bits) \
1095 cat(FIXED_unary_bsr_,s),
1096 for_all_fixed(f)
1097 #undef f
1098 #define f(n, s, u, sz, bits) \
1099 cat(FIXED_unary_popcnt_,s),
1100 for_all_fixed(f)
1101 #undef f
1102 #define f(n, s, u, sz, bits) \
1103 cat(FIXED_uto_int_,s),
1104 for_all_fixed(f)
1105 #undef f
1106 #define f(n, s, u, sz, bits) \
1107 cat(FIXED_ufrom_int_,s),
1108 for_all_fixed(f)
1109 #undef f
1110 cat(INT_binary_add_,TYPE_INT_MAX),
1111 cat(INT_binary_subtract_,TYPE_INT_MAX),
1112 #define f(n, s, u, sz, bits) \
1113 cat(INT_binary_multiply_,s),
1114 for_all_int(f, for_all_empty)
1115 #undef f
1116 #define f(n, s, u, sz, bits) \
1117 cat(INT_binary_divide_,s),
1118 for_all_int(f, for_all_empty)
1119 #undef f
1120 #define f(n, s, u, sz, bits) \
1121 cat(INT_binary_modulo_,s),
1122 for_all_int(f, for_all_empty)
1123 #undef f
1124 #define f(n, s, u, sz, bits) \
1125 cat(INT_binary_power_,s),
1126 for_all_int(f, for_all_empty)
1127 #undef f
1128 cat(INT_binary_shl_,TYPE_INT_MAX),
1129 cat(INT_binary_shr_,TYPE_INT_MAX),
1130 cat(INT_binary_bts_,TYPE_INT_MAX),
1131 cat(INT_binary_btr_,TYPE_INT_MAX),
1132 cat(INT_binary_btc_,TYPE_INT_MAX),
1133 cat(INT_binary_bt_,TYPE_INT_MAX),
1134 cat(INT_unary_neg_,TYPE_INT_MAX),
1135 cat(INT_unary_inc_,TYPE_INT_MAX),
1136 cat(INT_unary_dec_,TYPE_INT_MAX),
1137 #define f(n, s, u, sz, bits) \
1138 cat(INT_unary_bsf_,s),
1139 for_all_int(f, for_all_empty)
1140 #undef f
1141 #define f(n, s, u, sz, bits) \
1142 cat(INT_unary_bsr_,s),
1143 for_all_int(f, for_all_empty)
1144 #undef f
1145 #define f(n, s, u, sz, bits) \
1146 cat(INT_unary_popcnt_,s),
1147 for_all_int(f, for_all_empty)
1148 #undef f
1149 #define f(n, t, nt, pack, unpack) \
1150 cat(REAL_binary_add_,t),
1151 for_all_real(f, nf)
1152 #undef f
1153 #define f(n, t, nt, pack, unpack) \
1154 cat(REAL_binary_subtract_,t),
1155 for_all_real(f, nf)
1156 #undef f
1157 #define f(n, t, nt, pack, unpack) \
1158 cat(REAL_binary_multiply_,t),
1159 for_all_real(f, nf)
1160 #undef f
1161 #define f(n, t, nt, pack, unpack) \
1162 cat(REAL_binary_divide_,t),
1163 for_all_real(f, nf)
1164 #undef f
1165 #define f(n, t, nt, pack, unpack) \
1166 cat(REAL_binary_modulo_,t),
1167 for_all_real(f, nf)
1168 #undef f
1169 #define f(n, t, nt, pack, unpack) \
1170 cat(REAL_binary_power_,t),
1171 for_all_real(f, nf)
1172 #undef f
1173 #define f(n, t, nt, pack, unpack) \
1174 cat(REAL_binary_ldexp_,t),
1175 for_all_real(f, nf)
1176 #undef f
1177 #define f(n, t, nt, pack, unpack) \
1178 cat(REAL_binary_atan2_,t),
1179 for_all_real(f, nf)
1180 #undef f
1181 #define f(n, t, nt, pack, unpack) \
1182 cat(REAL_binary_equal_,t),
1183 for_all_real(f, nf)
1184 #undef f
1185 #define f(n, t, nt, pack, unpack) \
1186 cat(REAL_binary_not_equal_,t),
1187 for_all_real(f, nf)
1188 #undef f
1189 #define f(n, t, nt, pack, unpack) \
1190 cat(REAL_binary_less_,t),
1191 for_all_real(f, nf)
1192 #undef f
1193 #define f(n, t, nt, pack, unpack) \
1194 cat(REAL_binary_less_equal_,t),
1195 for_all_real(f, nf)
1196 #undef f
1197 #define f(n, t, nt, pack, unpack) \
1198 cat(REAL_unary_neg_,t),
1199 for_all_real(f, nf)
1200 #undef f
1201 #define f(n, t, nt, pack, unpack) \
1202 cat(REAL_unary_sqrt_,t),
1203 for_all_real(f, nf)
1204 #undef f
1205 #define f(n, t, nt, pack, unpack) \
1206 cat(REAL_unary_cbrt_,t),
1207 for_all_real(f, nf)
1208 #undef f
1209 #define f(n, t, nt, pack, unpack) \
1210 cat(REAL_unary_sin_,t),
1211 for_all_real(f, nf)
1212 #undef f
1213 #define f(n, t, nt, pack, unpack) \
1214 cat(REAL_unary_cos_,t),
1215 for_all_real(f, nf)
1216 #undef f
1217 #define f(n, t, nt, pack, unpack) \
1218 cat(REAL_unary_tan_,t),
1219 for_all_real(f, nf)
1220 #undef f
1221 #define f(n, t, nt, pack, unpack) \
1222 cat(REAL_unary_asin_,t),
1223 for_all_real(f, nf)
1224 #undef f
1225 #define f(n, t, nt, pack, unpack) \
1226 cat(REAL_unary_acos_,t),
1227 for_all_real(f, nf)
1228 #undef f
1229 #define f(n, t, nt, pack, unpack) \
1230 cat(REAL_unary_atan_,t),
1231 for_all_real(f, nf)
1232 #undef f
1233 #define f(n, t, nt, pack, unpack) \
1234 cat(REAL_unary_sinh_,t),
1235 for_all_real(f, nf)
1236 #undef f
1237 #define f(n, t, nt, pack, unpack) \
1238 cat(REAL_unary_cosh_,t),
1239 for_all_real(f, nf)
1240 #undef f
1241 #define f(n, t, nt, pack, unpack) \
1242 cat(REAL_unary_tanh_,t),
1243 for_all_real(f, nf)
1244 #undef f
1245 #define f(n, t, nt, pack, unpack) \
1246 cat(REAL_unary_asinh_,t),
1247 for_all_real(f, nf)
1248 #undef f
1249 #define f(n, t, nt, pack, unpack) \
1250 cat(REAL_unary_acosh_,t),
1251 for_all_real(f, nf)
1252 #undef f
1253 #define f(n, t, nt, pack, unpack) \
1254 cat(REAL_unary_atanh_,t),
1255 for_all_real(f, nf)
1256 #undef f
1257 #define f(n, t, nt, pack, unpack) \
1258 cat(REAL_unary_exp2_,t),
1259 for_all_real(f, nf)
1260 #undef f
1261 #define f(n, t, nt, pack, unpack) \
1262 cat(REAL_unary_exp_,t),
1263 for_all_real(f, nf)
1264 #undef f
1265 #define f(n, t, nt, pack, unpack) \
1266 cat(REAL_unary_exp10_,t),
1267 for_all_real(f, nf)
1268 #undef f
1269 #define f(n, t, nt, pack, unpack) \
1270 cat(REAL_unary_log2_,t),
1271 for_all_real(f, nf)
1272 #undef f
1273 #define f(n, t, nt, pack, unpack) \
1274 cat(REAL_unary_log_,t),
1275 for_all_real(f, nf)
1276 #undef f
1277 #define f(n, t, nt, pack, unpack) \
1278 cat(REAL_unary_log10_,t),
1279 for_all_real(f, nf)
1280 #undef f
1281 #define f(n, t, nt, pack, unpack) \
1282 cat(REAL_unary_round_,t),
1283 for_all_real(f, nf)
1284 #undef f
1285 #define f(n, t, nt, pack, unpack) \
1286 cat(REAL_unary_ceil_,t),
1287 for_all_real(f, nf)
1288 #undef f
1289 #define f(n, t, nt, pack, unpack) \
1290 cat(REAL_unary_floor_,t),
1291 for_all_real(f, nf)
1292 #undef f
1293 #define f(n, t, nt, pack, unpack) \
1294 cat(REAL_unary_trunc_,t),
1295 for_all_real(f, nf)
1296 #undef f
1297 #define f(n, t, nt, pack, unpack) \
1298 cat(REAL_unary_fract_,t),
1299 for_all_real(f, nf)
1300 #undef f
1301 #define f(n, t, nt, pack, unpack) \
1302 cat(REAL_unary_mantissa_,t),
1303 for_all_real(f, nf)
1304 #undef f
1305 #define f(n, t, nt, pack, unpack) \
1306 cat(REAL_unary_exponent_,t),
1307 for_all_real(f, nf)
1308 #undef f
1309 #define f(n, t, nt, pack, unpack) \
1310 cat(REAL_unary_next_number_,t),
1311 for_all_real(f, nf)
1312 #undef f
1313 #define f(n, t, nt, pack, unpack) \
1314 cat(REAL_unary_prev_number_,t),
1315 for_all_real(f, nf)
1316 #undef f
1317 #define f(n, t, nt, pack, unpack) \
1318 cat(REAL_unary_to_int_,t),
1319 for_all_real(f, nf)
1320 #undef f
1321 #define f(n, t, nt, pack, unpack) \
1322 cat(REAL_unary_from_int_,t),
1323 for_all_real(f, nf)
1324 #undef f
1325 #define f(n, t, nt, pack, unpack) \
1326 cat(REAL_unary_is_exception_,t),
1327 for_all_real(f, nf)
1328 #undef f
1329 #endif
1330 #ifdef DEBUG_UPCALL
1331 cg_upcall_debug,
1332 #endif
1333 };
1334
1335 void name(ipret_init)(void)
1336 {
1337 #if 0
1338 unsigned __int128 a = ((unsigned __int128)0x285C1889155FULL << 64) + 0xC6DCBCCF1106E0C5ULL;
1339 unsigned __int128 b = 0x374AC42721E9E9BFULL;
1340 unsigned __int128 c = 1;
1341 char *s;
1342 FIXED_binary_power_int128_t(&a, &b, &c);
1343 s = str_from_signed(c, 16);
1344 debug("%s", s);
1345 mem_free(s);
1346 #endif
1347 tick_stamp_ptr = &tick_stamp;
1348 }
1349
1350 void name(ipret_done)(void)
1351 {
1352 }
1353
1354 #endif
Ajla - a purely functional programming language