a68g-double.h

     
   1  //! @file a68g-double.h
   2  //! @author J. Marcel van der Veer
   3  //!
   4  //! @section Copyright
   5  //!
   6  //! This file is part of Algol68G - an Algol 68 compiler-interpreter.
   7  //! Copyright 2001-2023 J. Marcel van der Veer [algol68g@xs4all.nl].
   8  //!
   9  //! @section License
  10  //!
  11  //! This program is free software; you can redistribute it and/or modify it 
  12  //! under the terms of the GNU General Public License as published by the 
  13  //! Free Software Foundation; either version 3 of the License, or 
  14  //! (at your option) any later version.
  15  //!
  16  //! This program is distributed in the hope that it will be useful, but 
  17  //! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 
  18  //! or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for 
  19  //! more details. You should have received a copy of the GNU General Public 
  20  //! License along with this program. If not, see [http://www.gnu.org/licenses/].
  21  
  22  #if !defined (__A68G_DOUBLE_H__)
  23  #define __A68G_DOUBLE_H__
  24  
  25  #if (A68_LEVEL >= 3)
  26  
  27  #define MODCHK(p, m, c) (!(MODULAR_MATH (p) && (m == M_LONG_BITS)) && (c))
  28  
  29  
  30  #if defined (HAVE_IEEE_754)
  31  #define CHECK_DOUBLE_REAL(p, u) PRELUDE_ERROR (!finiteq (u), p, ERROR_INFINITE, M_LONG_REAL)
  32  #define CHECK_DOUBLE_COMPLEX(p, u, v)\
  33    PRELUDE_ERROR (isinfq (u), p, ERROR_INFINITE, M_LONG_REAL);\
  34    PRELUDE_ERROR (isinfq (v), p, ERROR_INFINITE, M_LONG_REAL);
  35  #else
  36  #define CHECK_DOUBLE_REAL(p, u) {;}
  37  #define CHECK_DOUBLE_COMPLEX(p, u, v) {;}
  38  #endif
  39  
  40  #define LONG_INT_BASE (9223372036854775808.0q)
  41  #define HW(z) ((z).u[1])
  42  #define LW(z) ((z).u[0])
  43  #define D_NEG(d) ((HW(d) & D_SIGN) != 0)
  44  #define D_LT(u, v) (HW (u) < HW (v) ? A68_TRUE : (HW (u) == HW (v) ? LW (u) < LW (v) : A68_FALSE))
  45  
  46  #define DBLEQ(z) ((dble_double_real (A68 (f_entry), (z))).f)
  47  
  48  #define ABSQ(n) ((n) >= 0.0q ? (n) : -(n))
  49  
  50  #define POP_LONG_COMPLEX(p, re, im) {\
  51    POP_OBJECT (p, im, A68_LONG_REAL);\
  52    POP_OBJECT (p, re, A68_LONG_REAL);\
  53    }
  54  
  55  #define set_lw(z, k) {LW(z) = k; HW(z) = 0;}
  56  #define set_hw(z, k) {LW(z) = 0; HW(z) = k;}
  57  #define set_hwlw(z, h, l) {LW (z) = l; HW (z) = h;}
  58  #define D_ZERO(z) (HW (z) == 0 && LW (z) == 0)
  59  
  60  #define add_double(p, m, w, u, v)\
  61    {\
  62      DOUBLE_NUM_T _ww_;\
  63      LW (_ww_) = LW (u) + LW (v);\
  64      HW (_ww_) = HW (u) + HW (v);\
  65      PRELUDE_ERROR (MODCHK (p, m, HW (_ww_) < HW (v)), p, ERROR_MATH, (m));\
  66      if (LW (_ww_) < LW (v)) {\
  67        HW (_ww_)++;\
  68        PRELUDE_ERROR (MODCHK (p, m, HW (_ww_) < 1), p, ERROR_MATH, (m));\
  69      }\
  70      w = _ww_;\
  71    }
  72  
  73  #define sub_double(p, m, w, u, v)\
  74    {\
  75      DOUBLE_NUM_T _ww_;\
  76      LW (_ww_) = LW (u) - LW (v);\
  77      HW (_ww_) = HW (u) - HW (v);\
  78      PRELUDE_ERROR (MODCHK (p, m, HW (_ww_) > HW (u)), p, ERROR_MATH, (m));\
  79      if (LW (_ww_) > LW (u)) {\
  80        PRELUDE_ERROR (MODCHK (p, m, HW (_ww_) == 0), p, ERROR_MATH, (m));\
  81        HW (_ww_)--;\
  82      }\
  83      w = _ww_;\
  84    }
  85  
  86  static inline DOUBLE_NUM_T dble (DOUBLE_T x)
  87  {
  88    DOUBLE_NUM_T w;
  89    w.f = x;
  90    return w;
  91  }
  92  
  93  static inline int sign_double_int (DOUBLE_NUM_T w)
  94  {
  95    if (D_NEG (w)) {
  96      return -1;
  97    } else if (D_ZERO (w)) {
  98      return 0;
  99    } else {
 100      return 1;
 101    }
 102  }
 103  
 104  static inline int sign_double_real (DOUBLE_NUM_T w)
 105  {
 106    if (w.f < 0.0q) {
 107      return -1;
 108    } else if (w.f == 0.0q) {
 109      return 0;
 110    } else {
 111      return 1;
 112    }
 113  }
 114  
 115  static inline DOUBLE_NUM_T inline abs_double_int (DOUBLE_NUM_T z)
 116  {
 117    DOUBLE_NUM_T w;
 118    LW (w) = LW (z);
 119    HW (w) = HW (z) & (~D_SIGN);
 120    return w;
 121  }
 122  
 123  static inline DOUBLE_NUM_T inline neg_double_int (DOUBLE_NUM_T z)
 124  {
 125    DOUBLE_NUM_T w;
 126    LW (w) = LW (z);
 127    if (D_NEG (z)) {
 128      HW (w) = HW (z) & (~D_SIGN);
 129    } else {
 130      HW (w) = HW (z) | D_SIGN;
 131    }
 132    return w;
 133  }
 134  
 135  extern int sign_double_int (DOUBLE_NUM_T);
 136  extern int sign_double_real (DOUBLE_NUM_T);
 137  extern int string_to_double_int (NODE_T *, A68_LONG_INT *, char *);
 138  extern DOUBLE_T a68_double_hypot (DOUBLE_T, DOUBLE_T);
 139  extern DOUBLE_T string_to_double_real (char *, char **);
 140  extern DOUBLE_T inverf_double_real (DOUBLE_T);
 141  extern DOUBLE_NUM_T abs_double_int (DOUBLE_NUM_T);
 142  extern DOUBLE_NUM_T bits_to_double_int (NODE_T *, char *);
 143  extern DOUBLE_NUM_T dble_double_real (NODE_T *, REAL_T);
 144  extern DOUBLE_NUM_T double_int_to_double_real (NODE_T *, DOUBLE_NUM_T);
 145  extern DOUBLE_NUM_T double_strtou (NODE_T *, char *);
 146  extern DOUBLE_NUM_T double_udiv (NODE_T *, MOID_T *, DOUBLE_NUM_T, DOUBLE_NUM_T, int);
 147  extern DOUBLE_T a68_dneginf (void);
 148  extern DOUBLE_T a68_dposinf (void);
 149  extern void deltagammainc_double_real (DOUBLE_T *, DOUBLE_T *, DOUBLE_T, DOUBLE_T, DOUBLE_T, DOUBLE_T);
 150  
 151  extern GPROC genie_infinity_double_real;
 152  extern GPROC genie_minus_infinity_double_real;
 153  extern GPROC genie_gamma_inc_g_double_real;
 154  extern GPROC genie_gamma_inc_f_double_real;
 155  extern GPROC genie_gamma_inc_h_double_real;
 156  extern GPROC genie_gamma_inc_gf_double_real;
 157  extern GPROC genie_abs_double_compl;
 158  extern GPROC genie_abs_double_int;
 159  extern GPROC genie_abs_double_real;
 160  extern GPROC genie_acos_double_compl;
 161  extern GPROC genie_acosdg_double_real;
 162  extern GPROC genie_acosh_double_compl;
 163  extern GPROC genie_acosh_double_real;
 164  extern GPROC genie_acos_double_real;
 165  extern GPROC genie_acotdg_double_real;
 166  extern GPROC genie_acot_double_real;
 167  extern GPROC genie_asec_double_real;
 168  extern GPROC genie_acsc_double_real;
 169  extern GPROC genie_add_double_compl;
 170  extern GPROC genie_add_double_bits;
 171  extern GPROC genie_add_double_int;
 172  extern GPROC genie_add_double_real;
 173  extern GPROC genie_add_double_real;
 174  extern GPROC genie_and_double_bits;
 175  extern GPROC genie_arg_double_compl;
 176  extern GPROC genie_asin_double_compl;
 177  extern GPROC genie_asindg_double_real;
 178  extern GPROC genie_asindg_double_real;
 179  extern GPROC genie_asinh_double_compl;
 180  extern GPROC genie_asinh_double_real;
 181  extern GPROC genie_asin_double_real;
 182  extern GPROC genie_atan2dg_double_real;
 183  extern GPROC genie_atan2_double_real;
 184  extern GPROC genie_atan_double_compl;
 185  extern GPROC genie_atandg_double_real;
 186  extern GPROC genie_atanh_double_compl;
 187  extern GPROC genie_atanh_double_real;
 188  extern GPROC genie_atan_double_real;
 189  extern GPROC genie_bin_double_int;
 190  extern GPROC genie_clear_double_bits;
 191  extern GPROC genie_conj_double_compl;
 192  extern GPROC genie_cos_double_compl;
 193  extern GPROC genie_cosdg_double_real;
 194  extern GPROC genie_cosdg_double_real;
 195  extern GPROC genie_cosh_double_compl;
 196  extern GPROC genie_cosh_double_real;
 197  extern GPROC genie_cospi_double_real;
 198  extern GPROC genie_cos_double_real;
 199  extern GPROC genie_cotdg_double_real;
 200  extern GPROC genie_cotpi_double_real;
 201  extern GPROC genie_cot_double_real;
 202  extern GPROC genie_sec_double_real;
 203  extern GPROC genie_csc_double_real;
 204  extern GPROC genie_curt_double_real;
 205  extern GPROC genie_divab_double_compl;
 206  extern GPROC genie_divab_double_real;
 207  extern GPROC genie_divab_double_real;
 208  extern GPROC genie_div_double_compl;
 209  extern GPROC genie_div_double_int;
 210  extern GPROC genie_double_bits_pack;
 211  extern GPROC genie_double_max_bits;
 212  extern GPROC genie_double_max_int;
 213  extern GPROC genie_double_max_real;
 214  extern GPROC genie_double_min_real;
 215  extern GPROC genie_double_small_real;
 216  extern GPROC genie_double_zeroin;
 217  extern GPROC genie_elem_double_bits;
 218  extern GPROC genie_entier_double_real;
 219  extern GPROC genie_eq_double_compl;
 220  extern GPROC genie_eq_double_bits;
 221  extern GPROC genie_eq_double_int;
 222  extern GPROC genie_eq_double_int;
 223  extern GPROC genie_eq_double_real;
 224  extern GPROC genie_eq_double_real;
 225  extern GPROC genie_eq_double_real;
 226  extern GPROC genie_eq_double_real;
 227  extern GPROC genie_erfc_double_real;
 228  extern GPROC genie_erf_double_real;
 229  extern GPROC genie_exp_double_compl;
 230  extern GPROC genie_exp_double_real;
 231  extern GPROC genie_gamma_double_real;
 232  extern GPROC genie_ge_double_bits;
 233  extern GPROC genie_ge_double_int;
 234  extern GPROC genie_ge_double_int;
 235  extern GPROC genie_ge_double_real;
 236  extern GPROC genie_ge_double_real;
 237  extern GPROC genie_ge_double_real;
 238  extern GPROC genie_ge_double_real;
 239  extern GPROC genie_gt_double_bits;
 240  extern GPROC genie_gt_double_int;
 241  extern GPROC genie_gt_double_int;
 242  extern GPROC genie_gt_double_real;
 243  extern GPROC genie_gt_double_real;
 244  extern GPROC genie_gt_double_real;
 245  extern GPROC genie_gt_double_real;
 246  extern GPROC genie_i_double_compl;
 247  extern GPROC genie_i_int_double_compl;
 248  extern GPROC genie_im_double_compl;
 249  extern GPROC genie_inverfc_double_real;
 250  extern GPROC genie_inverf_double_real;
 251  extern GPROC genie_le_double_bits;
 252  extern GPROC genie_le_double_int;
 253  extern GPROC genie_le_double_int;
 254  extern GPROC genie_lengthen_bits_to_double_bits;
 255  extern GPROC genie_lengthen_double_compl_to_long_mp_complex;
 256  extern GPROC genie_lengthen_complex_to_double_compl;
 257  extern GPROC genie_lengthen_double_int_to_mp;
 258  extern GPROC genie_lengthen_int_to_double_int;
 259  extern GPROC genie_lengthen_double_real_to_mp;
 260  extern GPROC genie_lengthen_real_to_double_real;
 261  extern GPROC genie_le_double_real;
 262  extern GPROC genie_le_double_real;
 263  extern GPROC genie_le_double_real;
 264  extern GPROC genie_le_double_real;
 265  extern GPROC genie_ln_double_compl;
 266  extern GPROC genie_lngamma_double_real;
 267  extern GPROC genie_ln_double_real;
 268  extern GPROC genie_log_double_real;
 269  extern GPROC genie_lt_double_bits;
 270  extern GPROC genie_lt_double_int;
 271  extern GPROC genie_lt_double_int;
 272  extern GPROC genie_lt_double_real;
 273  extern GPROC genie_lt_double_real;
 274  extern GPROC genie_lt_double_real;
 275  extern GPROC genie_lt_double_real;
 276  extern GPROC genie_minusab_double_compl;
 277  extern GPROC genie_minusab_double_int;
 278  extern GPROC genie_minusab_double_int;
 279  extern GPROC genie_minusab_double_real;
 280  extern GPROC genie_minusab_double_real;
 281  extern GPROC genie_minus_double_compl;
 282  extern GPROC genie_minus_double_int;
 283  extern GPROC genie_minus_double_real;
 284  extern GPROC genie_modab_double_int;
 285  extern GPROC genie_modab_double_int;
 286  extern GPROC genie_mod_double_bits;
 287  extern GPROC genie_mod_double_int;
 288  extern GPROC genie_mul_double_compl;
 289  extern GPROC genie_mul_double_int;
 290  extern GPROC genie_mul_double_real;
 291  extern GPROC genie_mul_double_real;
 292  extern GPROC genie_ne_double_compl;
 293  extern GPROC genie_ne_double_bits;
 294  extern GPROC genie_ne_double_int;
 295  extern GPROC genie_ne_double_int;
 296  extern GPROC genie_ne_double_int;
 297  extern GPROC genie_ne_double_int;
 298  extern GPROC genie_ne_double_real;
 299  extern GPROC genie_ne_double_real;
 300  extern GPROC genie_ne_double_real;
 301  extern GPROC genie_ne_double_real;
 302  extern GPROC genie_ne_double_real;
 303  extern GPROC genie_ne_double_real;
 304  extern GPROC genie_ne_double_real;
 305  extern GPROC genie_ne_double_real;
 306  extern GPROC genie_next_random_double_real;
 307  extern GPROC genie_not_double_bits;
 308  extern GPROC genie_odd_double_int;
 309  extern GPROC genie_or_double_bits;
 310  extern GPROC genie_overab_double_int;
 311  extern GPROC genie_overab_double_int;
 312  extern GPROC genie_over_double_bits;
 313  extern GPROC genie_over_double_int;
 314  extern GPROC genie_over_double_real;
 315  extern GPROC genie_over_double_real;
 316  extern GPROC genie_pi_double;
 317  extern GPROC genie_plusab_double_compl;
 318  extern GPROC genie_plusab_double_int;
 319  extern GPROC genie_plusab_double_int;
 320  extern GPROC genie_plusab_double_real;
 321  extern GPROC genie_pow_double_compl_int;
 322  extern GPROC genie_pow_double_int_int;
 323  extern GPROC genie_pow_double_real;
 324  extern GPROC genie_pow_double_real_int;
 325  extern GPROC genie_re_double_compl;
 326  extern GPROC genie_rol_double_bits;
 327  extern GPROC genie_ror_double_bits;
 328  extern GPROC genie_round_double_real;
 329  extern GPROC genie_set_double_bits;
 330  extern GPROC genie_shl_double_bits;
 331  extern GPROC genie_shorten_double_compl_to_complex;
 332  extern GPROC genie_shorten_double_bits_to_bits;
 333  extern GPROC genie_shorten_long_int_to_int;
 334  extern GPROC genie_shorten_long_mp_complex_to_double_compl;
 335  extern GPROC genie_shorten_mp_to_double_int;
 336  extern GPROC genie_shorten_mp_to_double_real;
 337  extern GPROC genie_shorten_double_real_to_real;
 338  extern GPROC genie_shr_double_bits;
 339  extern GPROC genie_sign_double_int;
 340  extern GPROC genie_sign_double_real;
 341  extern GPROC genie_sin_double_compl;
 342  extern GPROC genie_sindg_double_real;
 343  extern GPROC genie_sinh_double_compl;
 344  extern GPROC genie_sinh_double_real;
 345  extern GPROC genie_sinpi_double_real;
 346  extern GPROC genie_sin_double_real;
 347  extern GPROC genie_sqrt_double_compl;
 348  extern GPROC genie_sqrt_double;
 349  extern GPROC genie_sqrt_double_real;
 350  extern GPROC genie_sqrt_double_real;
 351  extern GPROC genie_sub_double_compl;
 352  extern GPROC genie_sub_double_bits;
 353  extern GPROC genie_sub_double_int;
 354  extern GPROC genie_sub_double_real;
 355  extern GPROC genie_sub_double_real;
 356  extern GPROC genie_tan_double_compl;
 357  extern GPROC genie_tandg_double_real;
 358  extern GPROC genie_tanh_double_compl;
 359  extern GPROC genie_tanh_double_real;
 360  extern GPROC genie_tanpi_double_real;
 361  extern GPROC genie_tan_double_real;
 362  extern GPROC genie_timesab_double_compl;
 363  extern GPROC genie_timesab_double_int;
 364  extern GPROC genie_timesab_double_int;
 365  extern GPROC genie_timesab_double_real;
 366  extern GPROC genie_timesab_double_real;
 367  extern GPROC genie_times_double_bits;
 368  extern GPROC genie_widen_double_int_to_double_real;
 369  extern GPROC genie_xor_double_bits;
 370  extern GPROC genie_beta_inc_cf_double_real;
 371  extern GPROC genie_beta_double_real;
 372  extern GPROC genie_ln_beta_double_real;
 373  extern GPROC genie_gamma_inc_double_real;
 374  extern GPROC genie_zero_double_int;
 375  
 376  #endif
 377  
 378  #endif