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
