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-2024 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 (A68_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) ? A68_TRUE : (HW (u) == HW (v) ? LW (u) < LW (v) : A68_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 DBLEQ(z) ((dble_double (A68 (f_entry), (z))).f)
107
108 #define ABSQ(n) ((n) >= 0.0q ? (n) : -(n))
109
110 #define POP_LONG_COMPLEX(p, re, im) {\
111 POP_OBJECT (p, im, A68_LONG_REAL);\
112 POP_OBJECT (p, re, A68_LONG_REAL);\
113 }
114
115 #define set_lw(z, k) {LW(z) = k; HW(z) = 0;}
116 #define set_hw(z, k) {LW(z) = 0; HW(z) = k;}
117 #define set_hwlw(z, h, l) {LW (z) = l; HW (z) = h;}
118 #define D_ZERO(z) (HW (z) == 0 && LW (z) == 0)
119
120 #define add_double(p, m, w, u, v) {\
121 DOUBLE_NUM_T _ww_;\
122 LW (_ww_) = LW (u) + LW (v);\
123 HW (_ww_) = HW (u) + HW (v);\
124 PRELUDE_ERROR (MODCHK (p, m, HW (_ww_) < HW (v)), p, ERROR_MATH, (m));\
125 if (LW (_ww_) < LW (v)) {\
126 HW (_ww_)++;\
127 PRELUDE_ERROR (MODCHK (p, m, HW (_ww_) < 1), p, ERROR_MATH, (m));\
128 }\
129 w = _ww_;\
130 }
131
132 #define sub_double(p, m, w, u, v) {\
133 DOUBLE_NUM_T _ww_;\
134 LW (_ww_) = LW (u) - LW (v);\
135 HW (_ww_) = HW (u) - HW (v);\
136 PRELUDE_ERROR (MODCHK (p, m, HW (_ww_) > HW (u)), p, ERROR_MATH, (m));\
137 if (LW (_ww_) > LW (u)) {\
138 PRELUDE_ERROR (MODCHK (p, m, HW (_ww_) == 0), p, ERROR_MATH, (m));\
139 HW (_ww_)--;\
140 }\
141 w = _ww_;\
142 }
143
144 static inline DOUBLE_NUM_T dble (DOUBLE_T x)
145 {
146 DOUBLE_NUM_T w;
147 w.f = x;
148 return w;
149 }
150
151 static inline int sign_double_int (DOUBLE_NUM_T w)
152 {
153 if (D_ZERO (w)) {
154 return 0;
155 } else if (IS_NEG_ZERO (w)) {
156 return 0;
157 } else if (D_NEG (w)) {
158 return -1;
159 } else {
160 return 1;
161 }
162 }
163
164 static inline int sign_double (DOUBLE_NUM_T w)
165 {
166 if (w.f < 0.0q) {
167 return -1;
168 } else if (w.f == 0.0q) {
169 return 0;
170 } else {
171 return 1;
172 }
173 }
174
175 static inline DOUBLE_NUM_T abs_double_int (DOUBLE_NUM_T z)
176 {
177 DOUBLE_NUM_T w;
178 LW (w) = LW (z);
179 HW (w) = HW (z) & (~D_SIGN);
180 return w;
181 }
182
183 static inline DOUBLE_NUM_T abs_double_zero (DOUBLE_NUM_T z)
184 {
185 if (IS_NEG_ZERO (z)) {
186 return abs_double_int (z);
187 } else {
188 return z;
189 }
190 }
191
192 static inline DOUBLE_NUM_T neg_double_int (DOUBLE_NUM_T z)
193 {
194 DOUBLE_NUM_T w;
195 LW (w) = LW (z);
196 if (D_NEG (z)) {
197 HW (w) = HW (z) & (~D_SIGN);
198 } else {
199 HW (w) = HW (z) | D_SIGN;
200 }
201 return w;
202 }
203
204 void m64to128 (DOUBLE_NUM_T *, UNSIGNED_T, UNSIGNED_T);
205 void m128to128 (NODE_T *, MOID_T *, DOUBLE_NUM_T *, DOUBLE_NUM_T, DOUBLE_NUM_T);
206 DOUBLE_NUM_T double_udiv (NODE_T *, MOID_T *, DOUBLE_NUM_T, DOUBLE_NUM_T, int);
207 DOUBLE_NUM_T double_uadd (NODE_T *, MOID_T *, DOUBLE_NUM_T, DOUBLE_NUM_T);
208 DOUBLE_NUM_T double_usub (NODE_T *, MOID_T *, DOUBLE_NUM_T, DOUBLE_NUM_T);
209 DOUBLE_NUM_T double_umul (NODE_T *, MOID_T *, DOUBLE_NUM_T, DOUBLE_NUM_T);
210 DOUBLE_NUM_T double_sadd (NODE_T *, DOUBLE_NUM_T, DOUBLE_NUM_T);
211 DOUBLE_NUM_T double_ssub (NODE_T *, DOUBLE_NUM_T, DOUBLE_NUM_T);
212 DOUBLE_NUM_T double_smul (NODE_T *, DOUBLE_NUM_T, DOUBLE_NUM_T);
213 DOUBLE_NUM_T double_sdiv (NODE_T *, DOUBLE_NUM_T, DOUBLE_NUM_T, int);
214
215 int sign_double_int (DOUBLE_NUM_T);
216 int sign_double (DOUBLE_NUM_T);
217 int string_to_double_int (NODE_T *, A68_LONG_INT *, char *);
218 DOUBLE_T a68_hypot_double (DOUBLE_T, DOUBLE_T);
219 DOUBLE_T string_to_double (char *, char **);
220 DOUBLE_T inverf_double (DOUBLE_T);
221 DOUBLE_NUM_T abs_double_int (DOUBLE_NUM_T);
222 DOUBLE_NUM_T bits_to_double_int (NODE_T *, char *);
223 DOUBLE_NUM_T dble_double (NODE_T *, REAL_T);
224 DOUBLE_NUM_T double_int_to_double (NODE_T *, DOUBLE_NUM_T);
225 DOUBLE_NUM_T double_strtou (NODE_T *, char *);
226 DOUBLE_NUM_T double_udiv (NODE_T *, MOID_T *, DOUBLE_NUM_T, DOUBLE_NUM_T, int);
227 DOUBLE_T a68_neginf_double (void);
228 DOUBLE_T a68_posinf_double (void);
229 void deltagammainc_double (DOUBLE_T *, DOUBLE_T *, DOUBLE_T, DOUBLE_T, DOUBLE_T, DOUBLE_T);
230
231 GPROC genie_infinity_double;
232 GPROC genie_minus_infinity_double;
233 GPROC genie_gamma_inc_g_double;
234 GPROC genie_gamma_inc_f_double;
235 GPROC genie_gamma_inc_h_double;
236 GPROC genie_gamma_inc_gf_double;
237 GPROC genie_abs_double_compl;
238 GPROC genie_abs_double_int;
239 GPROC genie_abs_double;
240 GPROC genie_acos_double_compl;
241 GPROC genie_acosdg_double;
242 GPROC genie_acosh_double_compl;
243 GPROC genie_acosh_double;
244 GPROC genie_acos_double;
245 GPROC genie_acotdg_double;
246 GPROC genie_acot_double;
247 GPROC genie_asec_double;
248 GPROC genie_asecdg_double;
249 GPROC genie_acsc_double;
250 GPROC genie_acscdg_double;
251 GPROC genie_add_double_compl;
252 GPROC genie_add_double_bits;
253 GPROC genie_add_double_int;
254 GPROC genie_add_double;
255 GPROC genie_add_double;
256 GPROC genie_and_double_bits;
257 GPROC genie_arg_double_compl;
258 GPROC genie_asin_double_compl;
259 GPROC genie_asindg_double;
260 GPROC genie_asindg_double;
261 GPROC genie_asinh_double_compl;
262 GPROC genie_asinh_double;
263 GPROC genie_asin_double;
264 GPROC genie_atan2dg_double;
265 GPROC genie_atan2_double;
266 GPROC genie_atan_double_compl;
267 GPROC genie_atandg_double;
268 GPROC genie_atanh_double_compl;
269 GPROC genie_atanh_double;
270 GPROC genie_atan_double;
271 GPROC genie_bin_double_int;
272 GPROC genie_clear_double_bits;
273 GPROC genie_conj_double_compl;
274 GPROC genie_cas_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_gamma_double;
317 GPROC genie_ge_double_bits;
318 GPROC genie_ge_double_int;
319 GPROC genie_ge_double_int;
320 GPROC genie_ge_double;
321 GPROC genie_ge_double;
322 GPROC genie_ge_double;
323 GPROC genie_ge_double;
324 GPROC genie_gt_double_bits;
325 GPROC genie_gt_double_int;
326 GPROC genie_gt_double_int;
327 GPROC genie_gt_double;
328 GPROC genie_gt_double;
329 GPROC genie_gt_double;
330 GPROC genie_gt_double;
331 GPROC genie_i_double_compl;
332 GPROC genie_i_int_double_compl;
333 GPROC genie_im_double_compl;
334 GPROC genie_inverfc_double;
335 GPROC genie_inverf_double;
336 GPROC genie_le_double_bits;
337 GPROC genie_le_double_int;
338 GPROC genie_le_double_int;
339 GPROC genie_lengthen_bits_to_double_bits;
340 GPROC genie_lengthen_double_compl_to_long_mp_complex;
341 GPROC genie_lengthen_complex_to_double_compl;
342 GPROC genie_lengthen_double_int_to_mp;
343 GPROC genie_lengthen_int_to_double_int;
344 GPROC genie_lengthen_double_to_mp;
345 GPROC genie_lengthen_real_to_double;
346 GPROC genie_le_double;
347 GPROC genie_le_double;
348 GPROC genie_le_double;
349 GPROC genie_le_double;
350 GPROC genie_ln_double_compl;
351 GPROC genie_lngamma_double;
352 GPROC genie_ln_double;
353 GPROC genie_log_double;
354 GPROC genie_lt_double_bits;
355 GPROC genie_lt_double_int;
356 GPROC genie_lt_double_int;
357 GPROC genie_lt_double;
358 GPROC genie_lt_double;
359 GPROC genie_lt_double;
360 GPROC genie_lt_double;
361 GPROC genie_minusab_double_compl;
362 GPROC genie_minusab_double_int;
363 GPROC genie_minusab_double_int;
364 GPROC genie_minusab_double;
365 GPROC genie_minusab_double;
366 GPROC genie_minus_double_compl;
367 GPROC genie_minus_double_int;
368 GPROC genie_minus_double;
369 GPROC genie_modab_double_int;
370 GPROC genie_modab_double_int;
371 GPROC genie_mod_double_bits;
372 GPROC genie_mod_double_int;
373 GPROC genie_mul_double_compl;
374 GPROC genie_mul_double_int;
375 GPROC genie_mul_double;
376 GPROC genie_mul_double;
377 GPROC genie_ne_double_compl;
378 GPROC genie_ne_double_bits;
379 GPROC genie_ne_double_int;
380 GPROC genie_ne_double_int;
381 GPROC genie_ne_double_int;
382 GPROC genie_ne_double_int;
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_ne_double;
390 GPROC genie_ne_double;
391 GPROC genie_next_random_double;
392 GPROC genie_not_double_bits;
393 GPROC genie_odd_double_int;
394 GPROC genie_or_double_bits;
395 GPROC genie_overab_double_int;
396 GPROC genie_overab_double_int;
397 GPROC genie_over_double_bits;
398 GPROC genie_over_double_int;
399 GPROC genie_over_double;
400 GPROC genie_over_double;
401 GPROC genie_pi_double;
402 GPROC genie_plusab_double_compl;
403 GPROC genie_plusab_double_int;
404 GPROC genie_plusab_double_int;
405 GPROC genie_plusab_double;
406 GPROC genie_pow_double_compl_int;
407 GPROC genie_pow_double_int_int;
408 GPROC genie_pow_double;
409 GPROC genie_pow_double_int;
410 GPROC genie_re_double_compl;
411 GPROC genie_rol_double_bits;
412 GPROC genie_ror_double_bits;
413 GPROC genie_round_double;
414 GPROC genie_set_double_bits;
415 GPROC genie_shl_double_bits;
416 GPROC genie_shorten_double_compl_to_complex;
417 GPROC genie_shorten_double_bits_to_bits;
418 GPROC genie_shorten_long_int_to_int;
419 GPROC genie_shorten_long_mp_complex_to_double_compl;
420 GPROC genie_shorten_mp_to_double_int;
421 GPROC genie_shorten_mp_to_double;
422 GPROC genie_shorten_double_to_real;
423 GPROC genie_shr_double_bits;
424 GPROC genie_sign_double_int;
425 GPROC genie_sign_double;
426 GPROC genie_sin_double_compl;
427 GPROC genie_sindg_double;
428 GPROC genie_sinh_double_compl;
429 GPROC genie_sinh_double;
430 GPROC genie_sinpi_double;
431 GPROC genie_sin_double;
432 GPROC genie_sqrt_double_compl;
433 GPROC genie_sqrt_double;
434 GPROC genie_sqrt_double;
435 GPROC genie_sqrt_double;
436 GPROC genie_sub_double_compl;
437 GPROC genie_sub_double_bits;
438 GPROC genie_sub_double_int;
439 GPROC genie_sub_double;
440 GPROC genie_sub_double;
441 GPROC genie_tan_double_compl;
442 GPROC genie_tandg_double;
443 GPROC genie_tanh_double_compl;
444 GPROC genie_tanh_double;
445 GPROC genie_tanpi_double;
446 GPROC genie_tan_double;
447 GPROC genie_timesab_double_compl;
448 GPROC genie_timesab_double_int;
449 GPROC genie_timesab_double_int;
450 GPROC genie_timesab_double;
451 GPROC genie_timesab_double;
452 GPROC genie_times_double_bits;
453 GPROC genie_widen_double_int_to_double;
454 GPROC genie_xor_double_bits;
455 GPROC genie_beta_inc_cf_double;
456 GPROC genie_beta_double;
457 GPROC genie_ln_beta_double;
458 GPROC genie_gamma_inc_double;
459 GPROC genie_zero_double_int;
460
461 #endif
462
463 #endif
|
© 2002-2024 J.M. van der Veer (jmvdveer@xs4all.nl)
|
