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-2026 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 //! @section Synopsis
23 //!
24 //! LONG REAL definitions.
25
26 #if !defined (__A68G_DOUBLE_H__)
27 #define __A68G_DOUBLE_H__
28
29 #if (A68G_LEVEL >= 3)
30
31 #define MODCHK(p, m, c) (!(MODULAR_MATH (p) && (m == M_LONG_BITS)) && (c))
32
33 #if defined (HAVE_IEEE_754)
34 #define CHECK_DOUBLE_REAL(p, u) PRELUDE_ERROR (!finite_double (u), p, ERROR_INFINITE, M_LONG_REAL)
35 #define CHECK_DOUBLE_COMPLEX(p, u, v)\
36 PRELUDE_ERROR (isinf_double (u), p, ERROR_INFINITE, M_LONG_REAL);\
37 PRELUDE_ERROR (isinf_double (v), p, ERROR_INFINITE, M_LONG_REAL);
38 #else
39 #define CHECK_DOUBLE_REAL(p, u) {;}
40 #define CHECK_DOUBLE_COMPLEX(p, u, v) {;}
41 #endif
42
43 #define LONG_INT_BASE (9223372036854775808.0q)
44 #define HW(z) ((z).u[1])
45 #define LW(z) ((z).u[0])
46 #define D_NEG(d) ((HW(d) & D_SIGN) != 0)
47 #define D_LT(u, v) (HW (u) < HW (v) ? A68G_TRUE : (HW (u) == HW (v) ? LW (u) < LW (v) : A68G_FALSE))
48
49 #define RADIX (65536)
50 #define RADIX_Q (65536.0q)
51 #define CONST_2_UP_112_Q (5192296858534827628530496329220096.0q)
52
53 #define IS_ZERO(u) (HW (u) == 0 && LW (u) == 0)
54 #define IS_NEG_ZERO(u) (HW (u) == D_SIGN && LW (u) == 0)
55 #define EQ(u, v) (HW (u) == HW (v) && LW (u) == LW (v))
56 #define GT(u, v) (HW (u) != HW (v) ? HW (u) > HW (v) : LW (u) > LW (v))
57 #define GE(u, v) (HW (u) != HW (v) ? HW (u) >= HW (v) : LW (u) >= LW (v))
58
59 #define acos_double acosq
60 #define acosh_double acoshq
61 #define asin_double asinq
62 #define asinh_double asinhq
63 #define atan2_double atan2q
64 #define atan_double atanq
65 #define atanh_double atanhq
66 #define cacos_double cacosq
67 #define cacosh_double cacoshq
68 #define casin_double casinq
69 #define casinh_double casinhq
70 #define catan_double catanq
71 #define catanh_double catanhq
72 #define cbrt_double cbrtq
73 #define ccos_double ccosq
74 #define ccosh_double ccoshq
75 #define cexp_double cexpq
76 #define cimag_double cimagq
77 #define clog_double clogq
78 #define cos_double cosq
79 #define cosh_double coshq
80 #define creal_double crealq
81 #define csin_double csinq
82 #define csinh_double csinhq
83 #define csqrt_double csqrtq
84 #define ctan_double ctanq
85 #define ctanh_double ctanhq
86 #define erfc_double erfcq
87 #define erf_double erfq
88 #define exp_double expq
89 #define fabs_double fabsq
90 #define finite_double finiteq
91 #define floor_double floorq
92 #define fmod_double fmodq
93 #define isinf_double isinfq
94 #define lgamma_double lgammaq
95 #define log10_double log10q
96 #define log_double logq
97 #define pow_double powq
98 #define sin_double sinq
99 #define sinh_double sinhq
100 #define sqrt_double sqrtq
101 #define tan_double tanq
102 #define tanh_double tanhq
103 #define tgamma_double tgammaq
104 #define trunc_double truncq
105
106 #define ABSQ(n) ((n) >= 0.0q ? (n) : -(n))
107
108 #define POP_LONG_COMPLEX(p, re, im) {\
109 POP_OBJECT (p, im, A68G_LONG_REAL);\
110 POP_OBJECT (p, re, A68G_LONG_REAL);\
111 }
112
113 #define set_lw(z, k) {LW(z) = k; HW(z) = 0;}
114 #define set_hw(z, k) {LW(z) = 0; HW(z) = k;}
115 #define set_hwlw(z, h, l) {LW (z) = l; HW (z) = h;}
116 #define D_ZERO(z) (HW (z) == 0 && LW (z) == 0)
117
118 #define add_double(p, m, w, u, v) {\
119 DOUBLE_NUM_T _ww_;\
120 LW (_ww_) = LW (u) + LW (v);\
121 HW (_ww_) = HW (u) + HW (v);\
122 PRELUDE_ERROR (MODCHK (p, m, HW (_ww_) < HW (v)), p, ERROR_MATH, (m));\
123 if (LW (_ww_) < LW (v)) {\
124 HW (_ww_)++;\
125 PRELUDE_ERROR (MODCHK (p, m, HW (_ww_) < 1), p, ERROR_MATH, (m));\
126 }\
127 w = _ww_;\
128 }
129
130 #define sub_double(p, m, w, u, v) {\
131 DOUBLE_NUM_T _ww_;\
132 LW (_ww_) = LW (u) - LW (v);\
133 HW (_ww_) = HW (u) - HW (v);\
134 PRELUDE_ERROR (MODCHK (p, m, HW (_ww_) > HW (u)), p, ERROR_MATH, (m));\
135 if (LW (_ww_) > LW (u)) {\
136 PRELUDE_ERROR (MODCHK (p, m, HW (_ww_) == 0), p, ERROR_MATH, (m));\
137 HW (_ww_)--;\
138 }\
139 w = _ww_;\
140 }
141
142 static inline DOUBLE_NUM_T dble (DOUBLE_T x)
143 {
144 DOUBLE_NUM_T w;
145 w.f = x;
146 return w;
147 }
148
149 static inline int sign_double_int (DOUBLE_NUM_T w)
150 {
151 if (D_ZERO (w)) {
152 return 0;
153 } else if (IS_NEG_ZERO (w)) {
154 return 0;
155 } else if (D_NEG (w)) {
156 return -1;
157 } else {
158 return 1;
159 }
160 }
161
162 static inline int sign_double (DOUBLE_NUM_T w)
163 {
164 if (w.f < 0.0q) {
165 return -1;
166 } else if (w.f == 0.0q) {
167 return 0;
168 } else {
169 return 1;
170 }
171 }
172
173 static inline DOUBLE_NUM_T abs_double_int (DOUBLE_NUM_T z)
174 {
175 DOUBLE_NUM_T w;
176 LW (w) = LW (z);
177 HW (w) = HW (z) & (~D_SIGN);
178 return w;
179 }
180
181 static inline DOUBLE_NUM_T abs_double_zero (DOUBLE_NUM_T z)
182 {
183 if (IS_NEG_ZERO (z)) {
184 return abs_double_int (z);
185 } else {
186 return z;
187 }
188 }
189
190 static inline DOUBLE_NUM_T neg_double_int (DOUBLE_NUM_T z)
191 {
192 DOUBLE_NUM_T w;
193 LW (w) = LW (z);
194 if (D_NEG (z)) {
195 HW (w) = HW (z) & (~D_SIGN);
196 } else {
197 HW (w) = HW (z) | D_SIGN;
198 }
199 return w;
200 }
201
202 void m64to128 (DOUBLE_NUM_T *, UNSIGNED_T, UNSIGNED_T);
203 void m128to128 (NODE_T *, MOID_T *, DOUBLE_NUM_T *, DOUBLE_NUM_T, DOUBLE_NUM_T);
204 DOUBLE_NUM_T double_udiv (NODE_T *, MOID_T *, DOUBLE_NUM_T, DOUBLE_NUM_T, int);
205 DOUBLE_NUM_T double_uadd (NODE_T *, MOID_T *, DOUBLE_NUM_T, DOUBLE_NUM_T);
206 DOUBLE_NUM_T double_usub (NODE_T *, MOID_T *, DOUBLE_NUM_T, DOUBLE_NUM_T);
207 DOUBLE_NUM_T double_umul (NODE_T *, MOID_T *, DOUBLE_NUM_T, DOUBLE_NUM_T);
208 DOUBLE_NUM_T double_sadd (NODE_T *, DOUBLE_NUM_T, DOUBLE_NUM_T);
209 DOUBLE_NUM_T double_ssub (NODE_T *, DOUBLE_NUM_T, DOUBLE_NUM_T);
210 DOUBLE_NUM_T double_smul (NODE_T *, DOUBLE_NUM_T, DOUBLE_NUM_T);
211 DOUBLE_NUM_T double_sdiv (NODE_T *, DOUBLE_NUM_T, DOUBLE_NUM_T, int);
212
213 int sign_double_int (DOUBLE_NUM_T);
214 int sign_double (DOUBLE_NUM_T);
215 int string_to_double_int (NODE_T *, A68G_LONG_INT *, char *);
216 DOUBLE_T a68g_hypot_double (DOUBLE_T, DOUBLE_T);
217 DOUBLE_T string_to_double (char *, char **);
218 DOUBLE_T inverf_double (DOUBLE_T);
219 DOUBLE_NUM_T abs_double_int (DOUBLE_NUM_T);
220 DOUBLE_NUM_T bits_to_double_int (NODE_T *, char *);
221 DOUBLE_NUM_T dble_double (NODE_T *, REAL_T);
222 DOUBLE_NUM_T double_int_to_double (NODE_T *, DOUBLE_NUM_T);
223 DOUBLE_NUM_T double_strtou (NODE_T *, char *);
224 DOUBLE_NUM_T double_udiv (NODE_T *, MOID_T *, DOUBLE_NUM_T, DOUBLE_NUM_T, int);
225 DOUBLE_T a68g_mininf_double (void);
226 DOUBLE_T a68g_posinf_double (void);
227 void deltagammainc_double (DOUBLE_T *, DOUBLE_T *, DOUBLE_T, DOUBLE_T, DOUBLE_T, DOUBLE_T);
228
229 GPROC genie_infinity_double;
230 GPROC genie_minus_infinity_double;
231 GPROC genie_gamma_inc_g_double;
232 GPROC genie_gamma_inc_f_double;
233 GPROC genie_gamma_inc_h_double;
234 GPROC genie_gamma_inc_gf_double;
235 GPROC genie_abs_double_compl;
236 GPROC genie_abs_double_int;
237 GPROC genie_abs_double;
238 GPROC genie_acos_double_compl;
239 GPROC genie_acosdg_double;
240 GPROC genie_acosh_double_compl;
241 GPROC genie_acosh_double;
242 GPROC genie_acos_double;
243 GPROC genie_acotdg_double;
244 GPROC genie_acot_double;
245 GPROC genie_asec_double;
246 GPROC genie_asecdg_double;
247 GPROC genie_acsc_double;
248 GPROC genie_acscdg_double;
249 GPROC genie_add_double_compl;
250 GPROC genie_add_double_bits;
251 GPROC genie_add_double_int;
252 GPROC genie_add_double;
253 GPROC genie_add_double;
254 GPROC genie_and_double_bits;
255 GPROC genie_arg_double_compl;
256 GPROC genie_asin_double_compl;
257 GPROC genie_asindg_double;
258 GPROC genie_asindg_double;
259 GPROC genie_asinh_double_compl;
260 GPROC genie_asinh_double;
261 GPROC genie_asin_double;
262 GPROC genie_atan2dg_double;
263 GPROC genie_atan2_double;
264 GPROC genie_atan_double_compl;
265 GPROC genie_atandg_double;
266 GPROC genie_atanh_double_compl;
267 GPROC genie_atanh_double;
268 GPROC genie_atan_double;
269 GPROC genie_bin_double_int;
270 GPROC genie_clear_double_bits;
271 GPROC genie_conj_double_compl;
272 GPROC genie_cas_double;
273 GPROC genie_cos_double_compl;
274 GPROC genie_cosdg_double;
275 GPROC genie_cosdg_double;
276 GPROC genie_cosh_double_compl;
277 GPROC genie_cosh_double;
278 GPROC genie_cospi_double;
279 GPROC genie_cos_double;
280 GPROC genie_cotdg_double;
281 GPROC genie_cotpi_double;
282 GPROC genie_cot_double;
283 GPROC genie_sec_double;
284 GPROC genie_secdg_double;
285 GPROC genie_csc_double;
286 GPROC genie_cscdg_double;
287 GPROC genie_curt_double;
288 GPROC genie_divab_double_compl;
289 GPROC genie_divab_double;
290 GPROC genie_divab_double;
291 GPROC genie_div_double_compl;
292 GPROC genie_div_double_int;
293 GPROC genie_double_bits_pack;
294 GPROC genie_double_max_bits;
295 GPROC genie_double_max_int;
296 GPROC genie_double_max_real;
297 GPROC genie_double_min_real;
298 GPROC genie_double_small_real;
299 GPROC genie_double_zeroin;
300 GPROC genie_elem_double_bits;
301 GPROC genie_entier_double;
302 GPROC genie_eq_double_compl;
303 GPROC genie_eq_double_bits;
304 GPROC genie_eq_double_int;
305 GPROC genie_eq_double_int;
306 GPROC genie_eq_double;
307 GPROC genie_eq_double;
308 GPROC genie_eq_double;
309 GPROC genie_eq_double;
310 GPROC genie_erfc_double;
311 GPROC genie_erf_double;
312 GPROC genie_exp_double_compl;
313 GPROC genie_exp_double;
314 GPROC genie_gamma_double;
315 GPROC genie_ge_double_bits;
316 GPROC genie_ge_double_int;
317 GPROC genie_ge_double_int;
318 GPROC genie_ge_double;
319 GPROC genie_ge_double;
320 GPROC genie_ge_double;
321 GPROC genie_ge_double;
322 GPROC genie_gt_double_bits;
323 GPROC genie_gt_double_int;
324 GPROC genie_gt_double_int;
325 GPROC genie_gt_double;
326 GPROC genie_gt_double;
327 GPROC genie_gt_double;
328 GPROC genie_gt_double;
329 GPROC genie_i_double_compl;
330 GPROC genie_i_int_double_compl;
331 GPROC genie_im_double_compl;
332 GPROC genie_inverfc_double;
333 GPROC genie_inverf_double;
334 GPROC genie_le_double_bits;
335 GPROC genie_le_double_int;
336 GPROC genie_le_double_int;
337 GPROC genie_lengthen_bits_to_double_bits;
338 GPROC genie_lengthen_double_compl_to_long_mp_complex;
339 GPROC genie_lengthen_complex_to_double_compl;
340 GPROC genie_lengthen_double_int_to_mp;
341 GPROC genie_lengthen_int_to_double_int;
342 GPROC genie_lengthen_double_to_mp;
343 GPROC genie_lengthen_real_to_double;
344 GPROC genie_le_double;
345 GPROC genie_le_double;
346 GPROC genie_le_double;
347 GPROC genie_le_double;
348 GPROC genie_ln_double_compl;
349 GPROC genie_lngamma_double;
350 GPROC genie_ln_double;
351 GPROC genie_log_double;
352 GPROC genie_lt_double_bits;
353 GPROC genie_lt_double_int;
354 GPROC genie_lt_double_int;
355 GPROC genie_lt_double;
356 GPROC genie_lt_double;
357 GPROC genie_lt_double;
358 GPROC genie_lt_double;
359 GPROC genie_minusab_double_compl;
360 GPROC genie_minusab_double_int;
361 GPROC genie_minusab_double_int;
362 GPROC genie_minusab_double;
363 GPROC genie_minusab_double;
364 GPROC genie_minus_double_compl;
365 GPROC genie_minus_double_int;
366 GPROC genie_minus_double;
367 GPROC genie_modab_double_int;
368 GPROC genie_modab_double_int;
369 GPROC genie_mod_double_bits;
370 GPROC genie_mod_double_int;
371 GPROC genie_mul_double_compl;
372 GPROC genie_mul_double_int;
373 GPROC genie_mul_double;
374 GPROC genie_mul_double;
375 GPROC genie_ne_double_compl;
376 GPROC genie_ne_double_bits;
377 GPROC genie_ne_double_int;
378 GPROC genie_ne_double_int;
379 GPROC genie_ne_double_int;
380 GPROC genie_ne_double_int;
381 GPROC genie_ne_double;
382 GPROC genie_ne_double;
383 GPROC genie_ne_double;
384 GPROC genie_ne_double;
385 GPROC genie_ne_double;
386 GPROC genie_ne_double;
387 GPROC genie_ne_double;
388 GPROC genie_ne_double;
389 GPROC genie_next_random_double;
390 GPROC genie_not_double_bits;
391 GPROC genie_odd_double_int;
392 GPROC genie_or_double_bits;
393 GPROC genie_overab_double_int;
394 GPROC genie_overab_double_int;
395 GPROC genie_over_double_bits;
396 GPROC genie_over_double_int;
397 GPROC genie_over_double;
398 GPROC genie_over_double;
399 GPROC genie_pi_double;
400 GPROC genie_plusab_double_compl;
401 GPROC genie_plusab_double_int;
402 GPROC genie_plusab_double_int;
403 GPROC genie_plusab_double;
404 GPROC genie_pow_double_compl_int;
405 GPROC genie_pow_double_int_int;
406 GPROC genie_pow_double;
407 GPROC genie_pow_double_int;
408 GPROC genie_re_double_compl;
409 GPROC genie_rol_double_bits;
410 GPROC genie_ror_double_bits;
411 GPROC genie_round_double;
412 GPROC genie_set_double_bits;
413 GPROC genie_shl_double_bits;
414 GPROC genie_shorten_double_compl_to_complex;
415 GPROC genie_shorten_double_bits_to_bits;
416 GPROC genie_shorten_long_int_to_int;
417 GPROC genie_shorten_long_mp_complex_to_double_compl;
418 GPROC genie_shorten_mp_to_double_int;
419 GPROC genie_shorten_mp_to_double;
420 GPROC genie_shorten_double_to_real;
421 GPROC genie_shr_double_bits;
422 GPROC genie_sign_double_int;
423 GPROC genie_sign_double;
424 GPROC genie_sin_double_compl;
425 GPROC genie_sindg_double;
426 GPROC genie_sinh_double_compl;
427 GPROC genie_sinh_double;
428 GPROC genie_sinpi_double;
429 GPROC genie_sin_double;
430 GPROC genie_sqrt_double_compl;
431 GPROC genie_sqrt_double;
432 GPROC genie_sqrt_double;
433 GPROC genie_sqrt_double;
434 GPROC genie_sub_double_compl;
435 GPROC genie_sub_double_bits;
436 GPROC genie_sub_double_int;
437 GPROC genie_sub_double;
438 GPROC genie_sub_double;
439 GPROC genie_tan_double_compl;
440 GPROC genie_tandg_double;
441 GPROC genie_tanh_double_compl;
442 GPROC genie_tanh_double;
443 GPROC genie_tanpi_double;
444 GPROC genie_tan_double;
445 GPROC genie_timesab_double_compl;
446 GPROC genie_timesab_double_int;
447 GPROC genie_timesab_double_int;
448 GPROC genie_timesab_double;
449 GPROC genie_timesab_double;
450 GPROC genie_times_double_bits;
451 GPROC genie_widen_double_int_to_double;
452 GPROC genie_xor_double_bits;
453 GPROC genie_beta_inc_cf_double;
454 GPROC genie_beta_double;
455 GPROC genie_ln_beta_double;
456 GPROC genie_gamma_inc_double;
457 GPROC genie_zero_double_int;
458
459 #endif
460
461 #endif
|
© 2002-2026 J.M. van der Veer (jmvdveer@xs4all.nl)
|
