1 /* Declarations for arithmetics
2 German comments and names translated into English: Reini Urban 2007-11
3
4 Type hierarchy:
5 Number (N) =
6 Real (R) =
7 Float (F) =
8 Short float (SF)
9 Single float (FF)
10 Double float (DF)
11 Long float (LF)
12 Rational (RA) =
13 Integer (I) =
14 Fixnum (FN)
15 Bignum (BN)
16 Ratio (RT)
17 Complex (C)
18
19 Notes:
20 - Complex may consist of two real parts of different types. If the
21 imaginary part is EQ to 0, it will be converted to a real.
22 (See CLTL p. 195)
23 Pro: (let ((x (sqrt -9.0))) (* x x))
24 (instead of x = #C(0.0 3.0) -> Value #C(-9.0 0.0) )
25 x = #C(0 3.0) -> Value #C(-9.0 0) = -9.0
26 - Coercions with operations of different types:
27 Rational -> Long-float -> Double-float -> Single-float -> Short-float
28 (different from CLTL p. 195)
29 Reason: mathematically
30 (1.0 +- 1e-8) + (1.0 +- 1e-16) = (2.0 +- 1e-8),
31 so (+ 1.0s0 1.0d0) ==> 2.0s0 justified.
32 In short: unavailable accuracy may not be fooled by precision.
33 See also <http://clisp.org/impnotes/num-concepts.html#flocont>.
34 - With Single and Double Float we hold on to the IEEE-Standard (1981),
35 but without such features such as +0,-0, +inf,-inf, gradual underflow,
36 NAN, ..., because COMMON LISP has no use for that.
37 - Long Float accuracy is specified by the place (LONG-FLOAT-DIGITS).
38
39 Data structures:
40
41 Fixnum (FN) : 1 longword, immediate:
42 Bits 30..24: type info and sign.
43 Bits 23..0: Value (together with the sign of the twos
44 complement representation)
45 Mask for the value: */
46 #define FN_value_mask ((oint)wbitm(oint_data_len+oint_data_shift)-(oint)wbit(oint_data_shift))
47 /* Mask for the value and sign: */
48 #define FN_value_vz_mask (FN_value_mask|wbit(sign_bit_o))
49 /* type info for FN >=0: fixnum_type
50 type info for FN <0: */
51 #define fixnum_vz_type (fixnum_type|bit(sign_bit_t))
52 /* (defconstant most-positive-fixnum (- (expt 2 oint_data_len) 1))
53 (defconstant most-negative-fixnum (- (expt 2 oint_data_len)))
54 0 fixnum:
55 #define Fixnum_0 fixnum(0)
56 1 Fixnum:
57 #define Fixnum_1 fixnum(1)
58 -1 Fixnum:
59 #define Fixnum_minus1 type_data_object(fixnum_vz_type,FN_value_mask>>oint_data_shift)
60 most-positive-fixnum: */
61 #define Fixnum_mpos type_data_object(fixnum_type,FN_value_mask>>oint_data_shift)
62 /* most-negative-fixnum: */
63 #define Fixnum_mneg type_data_object(fixnum_vz_type,0)
64 /* maximal needed length of a digit sequence for a fixnum: */
65 #define FN_maxlength ceiling(oint_data_len+1,intDsize)
66 /* maximal needed length (without sign) of a digit sequence for a fixnum: */
67 #define pFN_maxlength ceiling(oint_data_len,intDsize)
68 /* It applies pFN_maxlength <= FN_maxlength <= bn_minlength.
69
70 Longword (L) - only used internally -
71 as longword as signed integer, in two-complement (sint32).
72
73 Bignum (BN) : 1 longword, indirect:
74 Bits 30..24: type info and sign
75 Bits 23..0: pointer X
76 X^.length = length n (uintC), >= bn_minlength
77 X^.data = n Digits (as normalized digit sequence) */
78 #define bn_minlength ceiling(oint_data_len+2,intDsize)
79 /* Because bignums with n < ceiling((oint_data_len+2)/intDsize) digits
80 are integers with maximal intDsize*n < oint_data_len+2 bits, so
81 integers with maximal oint_data_len+1 bits (incl. sign),
82 and they fit into fixnums. 1 <= bn_minlength <= 5.
83
84 Ratio (RT) = a record with two components:
85 NUM = numerator (Integer), DEN = denominator (Integer > 0)
86 with coprime numerator and denominator.
87 (in detail: Bits 30..24 = type info and sign
88 Bits 23..0 = pointer X
89 X^.rt_num = NUM, X^.rt_den = DEN. )
90
91 Rational (RA) = Integer or Ratio.
92
93 For all floating point numbers:
94 sign s, exponent e, mantissa mk-1,...,m0
95 represents the number (-1)^s * 2^(e-_EXP_MID) * [0 . 1 mk-1 ... m0]
96 e=0 is the number 0.0, always with signs=0 (and mantissa =0).
97 _exp_low and _exp_high are bounds (inclusive) for e.
98 Bitnumbers for sign s exponent e mantisse m (= k)
99 SF 1 8 16
100 FF 1 8 23
101 DF 1 11 52
102 LF 1 32 uintDsize*n >= 53
103
104 Short float (SF) : 1 longword, direct:
105 Bits 30..24: typeinfo and sign s.
106 Bits 23..16: exponent e (8 Bits)
107 Bits 15..0: mantissa m (16 Bits)
108 The number 0 is represented by s=0, e=0, m=0. */
109 #define SF_exp_len 8 /* Number of exponent bits */
110 #define SF_mant_len 16 /* Number of mantissa bits */
111 /* Choose the same values as for single float, so that conversion from
112 short float to single float always succeeds without overflow or underflow. */
113 #if 1
114 #define SF_exp_low 1 /* minimal exponent */
115 #define SF_exp_mid 126 /* value representing exponent 0 */
116 #define SF_exp_high 254 /* maximal exponent */
117 #else
118 #define SF_exp_low 1 /* minimal exponent */
119 #define SF_exp_mid bit(SF_exp_len-1) /* value representing exponent 0 */
120 #define SF_exp_high (bit(SF_exp_len)-1) /* maximal exponent */
121 #endif
122 #define SF_exp_shift (SF_mant_len+SF_mant_shift) /* lowest bit of the exponenten in oint */
123 #define SF_mant_shift oint_data_shift /* lowest bit of the mantissa in oint */
124 /* Typeinfo-Byte for SF >=0 : */
125 #define SF_type sfloat_type
126 /* Typeinfo-Byte for SF <0, with set sign-bit: */
127 #define SF_vz_type (sfloat_type|bit(sign_bit_t))
128 /* Creates a single float from sign (0 or -1), exponent and mantissa: */
129 #define make_SF(sign,exp,mant) \
130 type_data_object(SF_type | (bit(sign_bit_t) & (sign)), \
131 (((exp) & (bit(SF_exp_len)-1)) << SF_mant_len) | ((mant) & (bit(SF_mant_len)-1)))
132 /* Short Float 0.0 : */
133 #define SF_0 make_SF(0,0,0)
134 /* Short Float 1.0 : */
135 #define SF_1 make_SF(0,SF_exp_mid+1,bit(SF_mant_len))
136 /* Short Float -1.0 : */
137 #define SF_minus1 make_SF(-1,SF_exp_mid+1,bit(SF_mant_len))
138
139 /* Single float (FF) : 1 longword, indirect:
140 Bits 30..24: type info and sign
141 Bits 23..0: pointer X
142 X^.float_value = 1 longword:
143 Bit 31 = s, Bits 30..23 = e, Bits 22..0 = m.
144 The number 0.0 is represented by s=0, e=0, m=0. */
145 #define FF_exp_len 8 /* Number of exponent bits */
146 #define FF_mant_len 23 /* Number of mantissa bits */
147 /* On platforms with FAST_FLOAT we obey the IEEE 754 values. Choose the same
148 values on other platforms as well, so that
149 1. most-positive-single-float etc. will be platform independent,
150 2. in the FFI, the conversion from a Lisp ffloat to a C 'float' is
151 trivial. */
152 #define FF_exp_low 1
153 #define FF_exp_mid 126 /* It is unclear to me why that is the "middle",
154 but IEEE 754 specifies it like this. */
155 #define FF_exp_high 254 /* Exponent 255 is interpreted as NaN/Inf! */
156 #ifdef TYPECODES
157 /* Typeinfo-Byte for FF >=0 : */
158 #define FF_type ffloat_type
159 /* Typeinfo-Byte for FF <0, with set sign-bit: */
160 #define FF_vz_type (ffloat_type|bit(vorz_bit_t))
161 #endif
162 #ifdef IMMEDIATE_FFLOAT
163 /* Creates a single float from sign (0 or -1), exponent and mantissa: */
164 #define make_FF(sign,exp,mant) \
165 type_data_object(FF_type | (bit(vorz_bit_t) & (sign)), \
166 (ffloat)((sign) << (FF_exp_len+FF_mant_len) \
167 | (((exp) & (bit(FF_exp_len)-1)) << FF_mant_len) \
168 | ((mant) & (bit(FF_mant_len)-1))))
169 /* Single Float 0.0 : */
170 #define FF_0 make_FF(0,0,0)
171 /* Single Float 1.0 : */
172 #define FF_1 make_FF(0,FF_exp_mid+1,bit(FF_mant_len))
173 /* Single Float -1.0 : */
174 #define FF_minus1 make_FF(-1,FF_exp_mid+1,bit(FF_mant_len))
175 #else
176 /* Single Float 0.0 : */
177 #define FF_0 (object)O(FF_zero)
178 /* Single Float 1.0 : */
179 #define FF_1 (object)O(FF_one)
180 /* Single Float -1.0 : */
181 #define FF_minus1 (object)O(FF_minusone)
182 #endif
183
184 /* Double float (DF) : 1 longword, indirect:
185 Bits 30..24: type info and sign
186 Bits 23..0: pointer X
187 X^.float_value = 2 longwords:
188 Bit 63 = s, Bits 62..52 = e, Bits 51..0 = m.
189 The number 0.0 is represented by s=0, e=0, m=0. */
190 #define DF_exp_len 11 /* Number of exponent bits */
191 #define DF_mant_len 52 /* Anzahl der Bits der Mantisse */
192 /* On platforms with FAST_FLOAT we obey the IEEE 754 values. Choose the same
193 values on other platforms as well, so that
194 1. most-positive-double-float etc. will be platform independent,
195 2. in the FFI, the conversion from a Lisp dfloat to a C 'double' is
196 trivial. */
197 #define DF_exp_low 1
198 #define DF_exp_mid 1022 /* It is unclear to me why that is the "middle",
199 but IEEE 754 specifies it like this. */
200 #define DF_exp_high 2046 /* Exponent 2047 is interpreted as NaN/Inf! */
201 #ifdef TYPECODES
202 /* Typeinfo-Byte for DF >=0 : */
203 #define DF_type dfloat_type
204 /* Typeinfo-Byte for DF <0, with set sign-bit: */
205 #define DF_vz_type (dfloat_type|bit(vorz_bit_t))
206 #endif
207 /* Double Float 0.0 : */
208 #define DF_0 (object)O(DF_zero)
209 /* Double Float 1.0 : */
210 #define DF_1 (object)O(DF_one)
211 /* Double Float -1.0 : */
212 #define DF_minus1 (object)O(DF_minusone)
213
214 /* Long float (LF) : 1 longword, indirect:
215 Bits 30..24: type info and sign
216 Bits 23..0: pointer X
217 X^.len = n = Number of following mantissa words, n>=ceiling(53/intDsize)
218 X^.expo = e (32 Bits)
219 X^.data[0] ... X^.data[n-1] = intDsize*n mantissa bits (MSD ... LSD)
220 The number 0.0 is represented by e=0, m=0.
221 For e /= 0 the highest bit is 1.
222 n>=ceiling(53/intDsize), that a LF has not less mantissa bits than a DF. */
223 #define LF_minlen ceiling(53,intDsize)
224 /* Define as 'unsigned int', not 'unsigned long', so that
225 LF_exp_high+1 wraps around to 0 just like the 'expo' field does. */
226 #define LF_exp_low 1
227 #define LF_exp_mid 0x80000000U
228 #define LF_exp_high 0xFFFFFFFFU
229 #ifdef TYPECODES
230 /* Typeinfo-Byte for LF >=0 : */
231 #define LF_type lfloat_type
232 /* Typeinfo-Byte for LF <0, with set sign-Bit: */
233 #define LF_vz_type (lfloat_type|bit(vorz_bit_t))
234 #endif
235
236 /* Byte (BYTE) : Record with the components size and position:
237 1 longword, indirect:
238 Bits 30..24: type info
239 Bits 23..0: pointer X
240 X^.byte_size = size, a fixnum >=0.
241 X^.byte_position = position, a fixnum >=0.
242 Typetest with bytep and if_bytep, constructor with allocate_byte().
243
244 NUM_STACK is some kind of a number-stack-pointer.
245 Usage:
246 {
247 SAVE_NUM_STACK
248 ...
249 num_stack_need(...);
250 ...
251 num_stack_need(...);
252 RESTORE_NUM_STACK
253 ...
254 }
255 SAVE_NUM_STACK saves the current value of NUM_STACK.
256 Then you may reserve space unlimited times on the numeric stack with
257 num_stack_need().
258 With RESTORE_NUM_STACK NUM_STACK will be reset to the previous value and
259 the allocated stack-space will be freed.
260 In each C function SAVE_NUM_STACK/RESTORE_NUM_STACK should only be
261 called once.
262
263 num_stack_need(need, low_addr = , high_addr = );
264 reserves need digits on the number-stack and puts the lower (the MSDptr)
265 and upper limit (the LSDptr) of the allocated space into low_addr and
266 high_addr. Both are optional.
267
268 num_stack_need_1(need, low_addr = , high_addr = );
269 same as num_stack_need, with additional space for one digit below low_addr. */
270
271 #ifdef LISPARIT
272
273 #ifdef GNU
274 #define SAVE_NUM_STACK
275 #define RESTORE_NUM_STACK ;
276 #define num_stack_need(need,low_assignment,high_assignment) \
277 {var uintL __need = (uintL)(need); \
278 var uintD* __array = (uintD*)__builtin_alloca(__need*sizeof(uintD)); \
279 check_SP_notUNIX(); \
280 unused (low_assignment &__array[0]); \
281 unused (high_assignment &__array[__need]); \
282 }
283 #define num_stack_need_1(need,low_assignment,high_assignment) \
284 {var uintL __need = (uintL)(need)+1; \
285 var uintD* __array = (uintD*)__builtin_alloca(__need*sizeof(uintD)); \
286 check_SP_notUNIX(); \
287 unused (low_assignment &__array[1]); \
288 unused (high_assignment &__array[__need]); \
289 }
290 #elif (defined(UNIX) && !defined(NO_ALLOCA) && !defined(SPARC)) || defined(MICROSOFT)
291 /* reserve space at the machine stack. */
292 #define SAVE_NUM_STACK
293 #define RESTORE_NUM_STACK ;
294 #define num_stack_need(need,low_assignment,high_assignment) \
295 {var uintL __need = (uintL)(need); \
296 var uintD* __array = (uintD*)alloca(__need*sizeof(uintD)); \
297 unused (low_assignment &__array[0]); \
298 unused (high_assignment &__array[__need]); \
299 }
300 #define num_stack_need_1(need,low_assignment,high_assignment) \
301 {var uintL __need = (uintL)(need)+1; \
302 var uintD* __array = (uintD*)alloca(__need*sizeof(uintD)); \
303 unused (low_assignment &__array[1]); \
304 unused (high_assignment &__array[__need]); \
305 }
306 #else
307 /* Use malloca/freea.
308 num_stack is the first stack-allocated block. freea(num_stack) also frees
309 all more recently allocated blocks. */
310 #define SAVE_NUM_STACK var void* num_stack = NULL;
311 #define RESTORE_NUM_STACK if (num_stack) freea(num_stack);
312 #define num_stack_need(need,low_assignment,high_assignment) \
313 {var uintL __need = (uintL)(need); \
314 var uintD* __array = (uintD*)malloca(__need*sizeof(uintD)); \
315 if (!num_stack) { num_stack = __array; } \
316 unused (low_assignment &__array[0]); \
317 unused (high_assignment &__array[__need]); \
318 }
319 #define num_stack_need_1(need,low_assignment,high_assignment) \
320 {var uintL __need = (uintL)(need)+1; \
321 var uintD* __array = (uintD*)malloca(__need*sizeof(uintD)); \
322 if (!num_stack) { num_stack = __array; } \
323 unused (low_assignment &__array[1]); \
324 unused (high_assignment &__array[__need]); \
325 }
326 #endif
327
328 #endif /* LISPARIT */
329
330 /* Returns 2^n, n being a constant expression.
331 Returns the same value as bit(n), is however undefined if n<0 or n>=32. */
332 #define bitc(n) (1UL << (((n) >= 0 && (n) < intLsize) ? (n) : 0))
333
334 #if defined(HAVE_LONG_LONG_INT) || defined(MICROSOFT)
335 /* Returns 2^n, n being a constant expression.
336 Returns the same value as wbit(n), is however undefined if n<0 or n>=64. */
337 #define wbitc(n) (ULL(1) << (((n) >= 0 && (n) < 2*intLsize) ? (n) : 0))
338 #endif
339
340 #ifdef LISPARIT
341
342 /* Error message for division by zero */
divide_0(void)343 local _Noreturn void divide_0 (void) {
344 pushSTACK(TheSubr(subr_self)->name); /* slot :OPERATION */
345 pushSTACK(NIL); /* slot :OPERANDS not available */
346 pushSTACK(TheSubr(subr_self)->name);
347 error(division_by_zero,GETTEXT("~S: division by zero"));
348 }
349
350 /* Error message for floating point overflow
351 error_overflow(); */
error_overflow(void)352 local _Noreturn void error_overflow (void) {
353 pushSTACK(TheSubr(subr_self)->name); /* slot :OPERATION */
354 pushSTACK(NIL); /* slot :OPERANDS not available */
355 pushSTACK(TheSubr(subr_self)->name);
356 error(floating_point_overflow,GETTEXT("~S: floating point overflow"));
357 }
358
359 /* Error message for floating point underflow
360 error_underflow(); */
error_underflow(void)361 local _Noreturn void error_underflow (void) {
362 pushSTACK(TheSubr(subr_self)->name); /* slot :OPERATION */
363 pushSTACK(NIL); /* slot :OPERANDS not available */
364 pushSTACK(TheSubr(subr_self)->name);
365 error(floating_point_underflow,GETTEXT("~S: floating point underflow"));
366 }
367
368 /* Checks if floating point underflow is allowed
369 underflow_allowed() */
370 #define underflow_allowed() (nullpSv(inhibit_floating_point_underflow))
371
372 #endif /* LISPARIT */
373
374