a68g-double.h
You can download the current version of Algol 68 Genie and its documentation here.
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 .
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 .
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_16 (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 QUAD_WORD_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 QUAD_WORD_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 QUAD_WORD_T dble (DOUBLE_T x)
87 {
88 QUAD_WORD_T w;
89 w.f = x;
90 return w;
91 }
92
93 static inline int sign_int_16 (QUAD_WORD_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_real_16 (QUAD_WORD_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 QUAD_WORD_T inline abs_int_16 (QUAD_WORD_T z)
116 {
117 QUAD_WORD_T w;
118 LW (w) = LW (z);
119 HW (w) = HW (z) & (~D_SIGN);
120 return w;
121 }
122
123 static inline QUAD_WORD_T inline neg_int_16 (QUAD_WORD_T z)
124 {
125 QUAD_WORD_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_int_16 (QUAD_WORD_T);
136 extern int sign_real_16 (QUAD_WORD_T);
137 extern int string_to_int_16 (NODE_T *, A68_LONG_INT *, char *);
138 extern DOUBLE_T a68_double_hypot (DOUBLE_T, DOUBLE_T);
139 extern DOUBLE_T a68_strtoq (char *, char **);
140 extern DOUBLE_T inverf_real_16 (DOUBLE_T);
141 extern QUAD_WORD_T abs_int_16 (QUAD_WORD_T);
142 extern QUAD_WORD_T bits_to_int_16 (NODE_T *, char *);
143 extern QUAD_WORD_T dble_16 (NODE_T *, REAL_T);
144 extern QUAD_WORD_T int_16_to_real_16 (NODE_T *, QUAD_WORD_T);
145 extern QUAD_WORD_T double_strtou (NODE_T *, char *);
146 extern QUAD_WORD_T double_udiv (NODE_T *, MOID_T *, QUAD_WORD_T, QUAD_WORD_T, int);
147 extern DOUBLE_T a68_dneginf (void);
148 extern DOUBLE_T a68_dposinf (void);
149 extern void deltagammainc_16 (DOUBLE_T *, DOUBLE_T *, DOUBLE_T, DOUBLE_T, DOUBLE_T, DOUBLE_T);
150
151 extern GPROC genie_infinity_real_16;
152 extern GPROC genie_minus_infinity_real_16;
153 extern GPROC genie_gamma_inc_g_real_16;
154 extern GPROC genie_gamma_inc_f_real_16;
155 extern GPROC genie_gamma_inc_h_real_16;
156 extern GPROC genie_gamma_inc_gf_real_16;
157 extern GPROC genie_abs_complex_32;
158 extern GPROC genie_abs_int_16;
159 extern GPROC genie_abs_real_16;
160 extern GPROC genie_acos_complex_32;
161 extern GPROC genie_acosdg_real_16;
162 extern GPROC genie_acosh_complex_32;
163 extern GPROC genie_acosh_real_16;
164 extern GPROC genie_acos_real_16;
165 extern GPROC genie_acotdg_real_16;
166 extern GPROC genie_acot_real_16;
167 extern GPROC genie_asec_real_16;
168 extern GPROC genie_acsc_real_16;
169 extern GPROC genie_add_complex_32;
170 extern GPROC genie_add_double_bits;
171 extern GPROC genie_add_int_16;
172 extern GPROC genie_add_real_16;
173 extern GPROC genie_add_real_16;
174 extern GPROC genie_and_double_bits;
175 extern GPROC genie_arg_complex_32;
176 extern GPROC genie_asin_complex_32;
177 extern GPROC genie_asindg_real_16;
178 extern GPROC genie_asindg_real_16;
179 extern GPROC genie_asinh_complex_32;
180 extern GPROC genie_asinh_real_16;
181 extern GPROC genie_asin_real_16;
182 extern GPROC genie_atan2dg_real_16;
183 extern GPROC genie_atan2_real_16;
184 extern GPROC genie_atan_complex_32;
185 extern GPROC genie_atandg_real_16;
186 extern GPROC genie_atanh_complex_32;
187 extern GPROC genie_atanh_real_16;
188 extern GPROC genie_atan_real_16;
189 extern GPROC genie_bin_int_16;
190 extern GPROC genie_clear_double_bits;
191 extern GPROC genie_conj_complex_32;
192 extern GPROC genie_cos_complex_32;
193 extern GPROC genie_cosdg_real_16;
194 extern GPROC genie_cosdg_real_16;
195 extern GPROC genie_cosh_complex_32;
196 extern GPROC genie_cosh_real_16;
197 extern GPROC genie_cospi_real_16;
198 extern GPROC genie_cos_real_16;
199 extern GPROC genie_cotdg_real_16;
200 extern GPROC genie_cotpi_real_16;
201 extern GPROC genie_cot_real_16;
202 extern GPROC genie_sec_real_16;
203 extern GPROC genie_csc_real_16;
204 extern GPROC genie_curt_real_16;
205 extern GPROC genie_divab_complex_32;
206 extern GPROC genie_divab_real_16;
207 extern GPROC genie_divab_real_16;
208 extern GPROC genie_div_complex_32;
209 extern GPROC genie_div_int_16;
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_real_16;
219 extern GPROC genie_eq_complex_32;
220 extern GPROC genie_eq_double_bits;
221 extern GPROC genie_eq_int_16;
222 extern GPROC genie_eq_int_16;
223 extern GPROC genie_eq_real_16;
224 extern GPROC genie_eq_real_16;
225 extern GPROC genie_eq_real_16;
226 extern GPROC genie_eq_real_16;
227 extern GPROC genie_erfc_real_16;
228 extern GPROC genie_erf_real_16;
229 extern GPROC genie_exp_complex_32;
230 extern GPROC genie_exp_real_16;
231 extern GPROC genie_gamma_real_16;
232 extern GPROC genie_ge_double_bits;
233 extern GPROC genie_ge_int_16;
234 extern GPROC genie_ge_int_16;
235 extern GPROC genie_ge_real_16;
236 extern GPROC genie_ge_real_16;
237 extern GPROC genie_ge_real_16;
238 extern GPROC genie_ge_real_16;
239 extern GPROC genie_gt_double_bits;
240 extern GPROC genie_gt_int_16;
241 extern GPROC genie_gt_int_16;
242 extern GPROC genie_gt_real_16;
243 extern GPROC genie_gt_real_16;
244 extern GPROC genie_gt_real_16;
245 extern GPROC genie_gt_real_16;
246 extern GPROC genie_i_complex_32;
247 extern GPROC genie_i_int_complex_32;
248 extern GPROC genie_im_complex_32;
249 extern GPROC genie_inverfc_real_16;
250 extern GPROC genie_inverf_real_16;
251 extern GPROC genie_le_double_bits;
252 extern GPROC genie_le_int_16;
253 extern GPROC genie_le_int_16;
254 extern GPROC genie_lengthen_bits_to_double_bits;
255 extern GPROC genie_lengthen_complex_32_to_long_mp_complex;
256 extern GPROC genie_lengthen_complex_to_complex_32;
257 extern GPROC genie_lengthen_int_16_to_mp;
258 extern GPROC genie_lengthen_int_to_int_16;
259 extern GPROC genie_lengthen_real_16_to_mp;
260 extern GPROC genie_lengthen_real_to_real_16;
261 extern GPROC genie_le_real_16;
262 extern GPROC genie_le_real_16;
263 extern GPROC genie_le_real_16;
264 extern GPROC genie_le_real_16;
265 extern GPROC genie_ln_complex_32;
266 extern GPROC genie_lngamma_real_16;
267 extern GPROC genie_ln_real_16;
268 extern GPROC genie_log_real_16;
269 extern GPROC genie_lt_double_bits;
270 extern GPROC genie_lt_int_16;
271 extern GPROC genie_lt_int_16;
272 extern GPROC genie_lt_real_16;
273 extern GPROC genie_lt_real_16;
274 extern GPROC genie_lt_real_16;
275 extern GPROC genie_lt_real_16;
276 extern GPROC genie_minusab_complex_32;
277 extern GPROC genie_minusab_int_16;
278 extern GPROC genie_minusab_int_16;
279 extern GPROC genie_minusab_real_16;
280 extern GPROC genie_minusab_real_16;
281 extern GPROC genie_minus_complex_32;
282 extern GPROC genie_minus_int_16;
283 extern GPROC genie_minus_real_16;
284 extern GPROC genie_modab_int_16;
285 extern GPROC genie_modab_int_16;
286 extern GPROC genie_mod_double_bits;
287 extern GPROC genie_mod_int_16;
288 extern GPROC genie_mul_complex_32;
289 extern GPROC genie_mul_int_16;
290 extern GPROC genie_mul_real_16;
291 extern GPROC genie_mul_real_16;
292 extern GPROC genie_ne_complex_32;
293 extern GPROC genie_ne_double_bits;
294 extern GPROC genie_ne_int_16;
295 extern GPROC genie_ne_int_16;
296 extern GPROC genie_ne_int_16;
297 extern GPROC genie_ne_int_16;
298 extern GPROC genie_ne_real_16;
299 extern GPROC genie_ne_real_16;
300 extern GPROC genie_ne_real_16;
301 extern GPROC genie_ne_real_16;
302 extern GPROC genie_ne_real_16;
303 extern GPROC genie_ne_real_16;
304 extern GPROC genie_ne_real_16;
305 extern GPROC genie_ne_real_16;
306 extern GPROC genie_next_random_real_16;
307 extern GPROC genie_not_double_bits;
308 extern GPROC genie_odd_int_16;
309 extern GPROC genie_or_double_bits;
310 extern GPROC genie_overab_int_16;
311 extern GPROC genie_overab_int_16;
312 extern GPROC genie_over_double_bits;
313 extern GPROC genie_over_int_16;
314 extern GPROC genie_over_real_16;
315 extern GPROC genie_over_real_16;
316 extern GPROC genie_pi_double;
317 extern GPROC genie_plusab_complex_32;
318 extern GPROC genie_plusab_int_16;
319 extern GPROC genie_plusab_int_16;
320 extern GPROC genie_plusab_real_16;
321 extern GPROC genie_pow_complex_32_int;
322 extern GPROC genie_pow_int_16_int;
323 extern GPROC genie_pow_real_16;
324 extern GPROC genie_pow_real_16_int;
325 extern GPROC genie_re_complex_32;
326 extern GPROC genie_rol_double_bits;
327 extern GPROC genie_ror_double_bits;
328 extern GPROC genie_round_real_16;
329 extern GPROC genie_set_double_bits;
330 extern GPROC genie_shl_double_bits;
331 extern GPROC genie_shorten_complex_32_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_complex_32;
335 extern GPROC genie_shorten_mp_to_int_16;
336 extern GPROC genie_shorten_mp_to_real_16;
337 extern GPROC genie_shorten_real_16_to_real;
338 extern GPROC genie_shr_double_bits;
339 extern GPROC genie_sign_int_16;
340 extern GPROC genie_sign_real_16;
341 extern GPROC genie_sin_complex_32;
342 extern GPROC genie_sindg_real_16;
343 extern GPROC genie_sinh_complex_32;
344 extern GPROC genie_sinh_real_16;
345 extern GPROC genie_sinpi_real_16;
346 extern GPROC genie_sin_real_16;
347 extern GPROC genie_sqrt_complex_32;
348 extern GPROC genie_sqrt_double;
349 extern GPROC genie_sqrt_real_16;
350 extern GPROC genie_sqrt_real_16;
351 extern GPROC genie_sub_complex_32;
352 extern GPROC genie_sub_double_bits;
353 extern GPROC genie_sub_int_16;
354 extern GPROC genie_sub_real_16;
355 extern GPROC genie_sub_real_16;
356 extern GPROC genie_tan_complex_32;
357 extern GPROC genie_tandg_real_16;
358 extern GPROC genie_tanh_complex_32;
359 extern GPROC genie_tanh_real_16;
360 extern GPROC genie_tanpi_real_16;
361 extern GPROC genie_tan_real_16;
362 extern GPROC genie_timesab_complex_32;
363 extern GPROC genie_timesab_int_16;
364 extern GPROC genie_timesab_int_16;
365 extern GPROC genie_timesab_real_16;
366 extern GPROC genie_timesab_real_16;
367 extern GPROC genie_times_double_bits;
368 extern GPROC genie_widen_int_16_to_real_16;
369 extern GPROC genie_xor_double_bits;
370 extern GPROC genie_beta_inc_cf_real_16;
371 extern GPROC genie_beta_real_16;
372 extern GPROC genie_ln_beta_real_16;
373 extern GPROC genie_gamma_inc_real_16;
374 extern GPROC genie_zero_int_16;
375
376 #endif
377
378 #endif
jmvdveer@xs4all.nl