ipret.c

   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