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