3 * Forth Inspired Command Language - 64 bit math support routines
4 * Authors: Michael A. Gauland (gaulandm@mdhost.cse.tek.com)
5 * Larry Hastings (larry@hastings.org)
6 * John Sadler (john_sadler@alum.mit.edu)
7 * Created: 25 January 1998
8 * Rev 2.03: Support for 128 bit DP math. This file really ouught to
10 * $Id: double.c,v 1.2 2010/09/12 15:18:07 asau Exp $
13 * Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
14 * All rights reserved.
16 * Get the latest Ficl release at http://ficl.sourceforge.net
18 * I am interested in hearing from anyone who uses Ficl. If you have
19 * a problem, a success story, a defect, an enhancement request, or
20 * if you would like to contribute to the Ficl release, please
21 * contact me by email at the address above.
23 * L I C E N S E and D I S C L A I M E R
25 * Redistribution and use in source and binary forms, with or without
26 * modification, are permitted provided that the following conditions
28 * 1. Redistributions of source code must retain the above copyright
29 * notice, this list of conditions and the following disclaimer.
30 * 2. Redistributions in binary form must reproduce the above copyright
31 * notice, this list of conditions and the following disclaimer in the
32 * documentation and/or other materials provided with the distribution.
34 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
35 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
36 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
37 * ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
38 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
39 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
40 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
41 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
42 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
43 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
49 #if FICL_PLATFORM_HAS_2INTEGER
51 ficl2UnsignedDivide(ficl2Unsigned q
, ficlUnsigned y
)
53 ficl2UnsignedQR result
;
55 result
.quotient
= q
/ y
;
57 * Once we have the quotient, it's cheaper to calculate the
58 * remainder this way than with % (mod). --lch
60 result
.remainder
= (ficlInteger
)(q
- (result
.quotient
* y
));
65 #else /* FICL_PLATFORM_HAS_2INTEGER */
67 #define FICL_CELL_HIGH_BIT ((uintmax_t)1 << (FICL_BITS_PER_CELL-1))
68 #define UMOD_SHIFT (FICL_BITS_PER_CELL / 2)
69 #define UMOD_MASK ((1L << (FICL_BITS_PER_CELL / 2)) - 1)
72 * ficl2IntegerIsNegative
73 * Returns TRUE if the specified ficl2Unsigned has its sign bit set.
76 ficl2IntegerIsNegative(ficl2Integer x
)
83 * Negates an ficl2Unsigned by complementing and incrementing.
86 ficl2IntegerNegate(ficl2Integer x
)
98 * ficl2UnsignedMultiplyAccumulate
99 * Mixed precision multiply and accumulate primitive for number building.
100 * Multiplies ficl2Unsigned u by ficlUnsigned mul and adds ficlUnsigned add.
101 * Mul is typically the numeric base, and add represents a digit to be
102 * appended to the growing number.
103 * Returns the result of the operation
106 ficl2UnsignedMultiplyAccumulate(ficl2Unsigned u
, ficlUnsigned mul
,
109 ficl2Unsigned resultLo
= ficl2UnsignedMultiply(u
.low
, mul
);
110 ficl2Unsigned resultHi
= ficl2UnsignedMultiply(u
.high
, mul
);
111 resultLo
.high
+= resultHi
.low
;
112 resultHi
.low
= resultLo
.low
+ add
;
114 if (resultHi
.low
< resultLo
.low
)
117 resultLo
.low
= resultHi
.low
;
123 * ficl2IntegerMultiply
124 * Multiplies a pair of ficlIntegers and returns an ficl2Integer result.
127 ficl2IntegerMultiply(ficlInteger x
, ficlInteger y
)
143 prod
= ficl2UnsignedMultiply(x
, y
);
144 FICL_2INTEGER_SET(FICL_2UNSIGNED_GET_HIGH(prod
),
145 FICL_2UNSIGNED_GET_LOW(prod
), result
);
149 return (ficl2IntegerNegate(result
));
153 ficl2IntegerDecrement(ficl2Integer x
)
155 if (x
.low
== INTMAX_MIN
)
163 ficl2UnsignedAdd(ficl2Unsigned x
, ficl2Unsigned y
)
165 ficl2Unsigned result
;
167 result
.high
= x
.high
+ y
.high
;
168 result
.low
= x
.low
+ y
.low
;
170 if (result
.low
< y
.low
)
177 * ficl2UnsignedMultiply
179 * Michael A. Gauland gaulandm@mdhost.cse.tek.com
182 ficl2UnsignedMultiply(ficlUnsigned x
, ficlUnsigned y
)
184 ficl2Unsigned result
= { 0, 0 };
185 ficl2Unsigned addend
;
188 addend
.high
= 0; /* No sign extension--arguments are unsigned */
192 result
= ficl2UnsignedAdd(result
, addend
);
195 addend
= ficl2UnsignedArithmeticShiftLeft(addend
);
201 * ficl2UnsignedSubtract
204 ficl2UnsignedSubtract(ficl2Unsigned x
, ficl2Unsigned y
)
206 ficl2Unsigned result
;
208 result
.high
= x
.high
- y
.high
;
209 result
.low
= x
.low
- y
.low
;
219 * ficl2UnsignedArithmeticShiftLeft
223 ficl2UnsignedArithmeticShiftLeft(ficl2Unsigned x
)
225 ficl2Unsigned result
;
227 result
.high
= x
.high
<< 1;
228 if (x
.low
& FICL_CELL_HIGH_BIT
) {
232 result
.low
= x
.low
<< 1;
238 * ficl2UnsignedArithmeticShiftRight
239 * 64 bit right shift (unsigned - no sign extend)
242 ficl2UnsignedArithmeticShiftRight(ficl2Unsigned x
)
244 ficl2Unsigned result
;
246 result
.low
= x
.low
>> 1;
248 result
.low
|= FICL_CELL_HIGH_BIT
;
251 result
.high
= x
.high
>> 1;
260 ficl2UnsignedOr(ficl2Unsigned x
, ficl2Unsigned y
)
262 ficl2Unsigned result
;
264 result
.high
= x
.high
| y
.high
;
265 result
.low
= x
.low
| y
.low
;
271 * ficl2UnsignedCompare
272 * Return -1 if x < y; 0 if x==y, and 1 if x > y.
275 ficl2UnsignedCompare(ficl2Unsigned x
, ficl2Unsigned y
)
282 /* High parts are equal */
286 else if (x
.low
< y
.low
)
293 * ficl2UnsignedDivide
294 * Portable versions of ficl2Multiply and ficl2Divide in C
296 * Michael A. Gauland gaulandm@mdhost.cse.tek.com
299 ficl2UnsignedDivide(ficl2Unsigned q
, ficlUnsigned y
)
301 ficl2UnsignedQR result
;
302 ficl2Unsigned quotient
;
303 ficl2Unsigned subtrahend
;
315 while ((ficl2UnsignedCompare(subtrahend
, q
) < 0) &&
316 (subtrahend
.high
& FICL_CELL_HIGH_BIT
) == 0) {
317 mask
= ficl2UnsignedArithmeticShiftLeft(mask
);
318 subtrahend
= ficl2UnsignedArithmeticShiftLeft(subtrahend
);
321 while (mask
.low
!= 0 || mask
.high
!= 0) {
322 if (ficl2UnsignedCompare(subtrahend
, q
) <= 0) {
323 q
= ficl2UnsignedSubtract(q
, subtrahend
);
324 quotient
= ficl2UnsignedOr(quotient
, mask
);
326 mask
= ficl2UnsignedArithmeticShiftRight(mask
);
327 subtrahend
= ficl2UnsignedArithmeticShiftRight(subtrahend
);
330 result
.quotient
= quotient
;
331 result
.remainder
= q
.low
;
334 #endif /* !FICL_PLATFORM_HAS_2INTEGER */
337 * ficl2IntegerDivideFloored
339 * FROM THE FORTH ANS...
340 * Floored division is integer division in which the remainder carries
341 * the sign of the divisor or is zero, and the quotient is rounded to
342 * its arithmetic floor. Symmetric division is integer division in which
343 * the remainder carries the sign of the dividend or is zero and the
344 * quotient is the mathematical quotient rounded towards zero or
345 * truncated. Examples of each are shown in tables 3.3 and 3.4.
347 * Table 3.3 - Floored Division Example
348 * Dividend Divisor Remainder Quotient
349 * -------- ------- --------- --------
356 * Table 3.4 - Symmetric Division Example
357 * Dividend Divisor Remainder Quotient
358 * -------- ------- --------- --------
365 ficl2IntegerDivideFloored(ficl2Integer num
, ficlInteger den
)
373 if (ficl2IntegerIsNegative(num
)) {
374 num
= ficl2IntegerNegate(num
);
375 signQuot
= -signQuot
;
381 signQuot
= -signQuot
;
384 FICL_2UNSIGNED_SET(FICL_2UNSIGNED_GET_HIGH(num
),
385 FICL_2UNSIGNED_GET_LOW(num
), u
);
386 uqr
= ficl2UnsignedDivide(u
, (ficlUnsigned
)den
);
387 qr
= FICL_2UNSIGNEDQR_TO_2INTEGERQR(uqr
);
389 qr
.quotient
= ficl2IntegerNegate(qr
.quotient
);
390 if (qr
.remainder
!= 0) {
391 qr
.quotient
= ficl2IntegerDecrement(qr
.quotient
);
392 qr
.remainder
= den
- qr
.remainder
;
397 qr
.remainder
= -qr
.remainder
;
403 * ficl2IntegerDivideSymmetric
404 * Divide an ficl2Unsigned by a ficlInteger and return a ficlInteger quotient
405 * and a ficlInteger remainder. The absolute values of quotient and remainder
406 * are not affected by the signs of the numerator and denominator
407 * (the operation is symmetric on the number line)
410 ficl2IntegerDivideSymmetric(ficl2Integer num
, ficlInteger den
)
418 if (ficl2IntegerIsNegative(num
)) {
419 num
= ficl2IntegerNegate(num
);
421 signQuot
= -signQuot
;
426 signQuot
= -signQuot
;
429 FICL_2UNSIGNED_SET(FICL_2UNSIGNED_GET_HIGH(num
),
430 FICL_2UNSIGNED_GET_LOW(num
), u
);
431 uqr
= ficl2UnsignedDivide(u
, (ficlUnsigned
)den
);
432 qr
= FICL_2UNSIGNEDQR_TO_2INTEGERQR(uqr
);
434 qr
.remainder
= -qr
.remainder
;
437 qr
.quotient
= ficl2IntegerNegate(qr
.quotient
);