decNumber.c revision 1.1 1 1.1 christos /* Decimal number arithmetic module for the decNumber C Library.
2 1.1 christos Copyright (C) 2005-2013 Free Software Foundation, Inc.
3 1.1 christos Contributed by IBM Corporation. Author Mike Cowlishaw.
4 1.1 christos
5 1.1 christos This file is part of GCC.
6 1.1 christos
7 1.1 christos GCC is free software; you can redistribute it and/or modify it under
8 1.1 christos the terms of the GNU General Public License as published by the Free
9 1.1 christos Software Foundation; either version 3, or (at your option) any later
10 1.1 christos version.
11 1.1 christos
12 1.1 christos GCC is distributed in the hope that it will be useful, but WITHOUT ANY
13 1.1 christos WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 1.1 christos FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15 1.1 christos for more details.
16 1.1 christos
17 1.1 christos Under Section 7 of GPL version 3, you are granted additional
18 1.1 christos permissions described in the GCC Runtime Library Exception, version
19 1.1 christos 3.1, as published by the Free Software Foundation.
20 1.1 christos
21 1.1 christos You should have received a copy of the GNU General Public License and
22 1.1 christos a copy of the GCC Runtime Library Exception along with this program;
23 1.1 christos see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
24 1.1 christos <http://www.gnu.org/licenses/>. */
25 1.1 christos
26 1.1 christos /* ------------------------------------------------------------------ */
27 1.1 christos /* Decimal Number arithmetic module */
28 1.1 christos /* ------------------------------------------------------------------ */
29 1.1 christos /* This module comprises the routines for arbitrary-precision General */
30 1.1 christos /* Decimal Arithmetic as defined in the specification which may be */
31 1.1 christos /* found on the General Decimal Arithmetic pages. It implements both */
32 1.1 christos /* the full ('extended') arithmetic and the simpler ('subset') */
33 1.1 christos /* arithmetic. */
34 1.1 christos /* */
35 1.1 christos /* Usage notes: */
36 1.1 christos /* */
37 1.1 christos /* 1. This code is ANSI C89 except: */
38 1.1 christos /* */
39 1.1 christos /* a) C99 line comments (double forward slash) are used. (Most C */
40 1.1 christos /* compilers accept these. If yours does not, a simple script */
41 1.1 christos /* can be used to convert them to ANSI C comments.) */
42 1.1 christos /* */
43 1.1 christos /* b) Types from C99 stdint.h are used. If you do not have this */
44 1.1 christos /* header file, see the User's Guide section of the decNumber */
45 1.1 christos /* documentation; this lists the necessary definitions. */
46 1.1 christos /* */
47 1.1 christos /* c) If DECDPUN>4 or DECUSE64=1, the C99 64-bit int64_t and */
48 1.1 christos /* uint64_t types may be used. To avoid these, set DECUSE64=0 */
49 1.1 christos /* and DECDPUN<=4 (see documentation). */
50 1.1 christos /* */
51 1.1 christos /* The code also conforms to C99 restrictions; in particular, */
52 1.1 christos /* strict aliasing rules are observed. */
53 1.1 christos /* */
54 1.1 christos /* 2. The decNumber format which this library uses is optimized for */
55 1.1 christos /* efficient processing of relatively short numbers; in particular */
56 1.1 christos /* it allows the use of fixed sized structures and minimizes copy */
57 1.1 christos /* and move operations. It does, however, support arbitrary */
58 1.1 christos /* precision (up to 999,999,999 digits) and arbitrary exponent */
59 1.1 christos /* range (Emax in the range 0 through 999,999,999 and Emin in the */
60 1.1 christos /* range -999,999,999 through 0). Mathematical functions (for */
61 1.1 christos /* example decNumberExp) as identified below are restricted more */
62 1.1 christos /* tightly: digits, emax, and -emin in the context must be <= */
63 1.1 christos /* DEC_MAX_MATH (999999), and their operand(s) must be within */
64 1.1 christos /* these bounds. */
65 1.1 christos /* */
66 1.1 christos /* 3. Logical functions are further restricted; their operands must */
67 1.1 christos /* be finite, positive, have an exponent of zero, and all digits */
68 1.1 christos /* must be either 0 or 1. The result will only contain digits */
69 1.1 christos /* which are 0 or 1 (and will have exponent=0 and a sign of 0). */
70 1.1 christos /* */
71 1.1 christos /* 4. Operands to operator functions are never modified unless they */
72 1.1 christos /* are also specified to be the result number (which is always */
73 1.1 christos /* permitted). Other than that case, operands must not overlap. */
74 1.1 christos /* */
75 1.1 christos /* 5. Error handling: the type of the error is ORed into the status */
76 1.1 christos /* flags in the current context (decContext structure). The */
77 1.1 christos /* SIGFPE signal is then raised if the corresponding trap-enabler */
78 1.1 christos /* flag in the decContext is set (is 1). */
79 1.1 christos /* */
80 1.1 christos /* It is the responsibility of the caller to clear the status */
81 1.1 christos /* flags as required. */
82 1.1 christos /* */
83 1.1 christos /* The result of any routine which returns a number will always */
84 1.1 christos /* be a valid number (which may be a special value, such as an */
85 1.1 christos /* Infinity or NaN). */
86 1.1 christos /* */
87 1.1 christos /* 6. The decNumber format is not an exchangeable concrete */
88 1.1 christos /* representation as it comprises fields which may be machine- */
89 1.1 christos /* dependent (packed or unpacked, or special length, for example). */
90 1.1 christos /* Canonical conversions to and from strings are provided; other */
91 1.1 christos /* conversions are available in separate modules. */
92 1.1 christos /* */
93 1.1 christos /* 7. Normally, input operands are assumed to be valid. Set DECCHECK */
94 1.1 christos /* to 1 for extended operand checking (including NULL operands). */
95 1.1 christos /* Results are undefined if a badly-formed structure (or a NULL */
96 1.1 christos /* pointer to a structure) is provided, though with DECCHECK */
97 1.1 christos /* enabled the operator routines are protected against exceptions. */
98 1.1 christos /* (Except if the result pointer is NULL, which is unrecoverable.) */
99 1.1 christos /* */
100 1.1 christos /* However, the routines will never cause exceptions if they are */
101 1.1 christos /* given well-formed operands, even if the value of the operands */
102 1.1 christos /* is inappropriate for the operation and DECCHECK is not set. */
103 1.1 christos /* (Except for SIGFPE, as and where documented.) */
104 1.1 christos /* */
105 1.1 christos /* 8. Subset arithmetic is available only if DECSUBSET is set to 1. */
106 1.1 christos /* ------------------------------------------------------------------ */
107 1.1 christos /* Implementation notes for maintenance of this module: */
108 1.1 christos /* */
109 1.1 christos /* 1. Storage leak protection: Routines which use malloc are not */
110 1.1 christos /* permitted to use return for fastpath or error exits (i.e., */
111 1.1 christos /* they follow strict structured programming conventions). */
112 1.1 christos /* Instead they have a do{}while(0); construct surrounding the */
113 1.1 christos /* code which is protected -- break may be used to exit this. */
114 1.1 christos /* Other routines can safely use the return statement inline. */
115 1.1 christos /* */
116 1.1 christos /* Storage leak accounting can be enabled using DECALLOC. */
117 1.1 christos /* */
118 1.1 christos /* 2. All loops use the for(;;) construct. Any do construct does */
119 1.1 christos /* not loop; it is for allocation protection as just described. */
120 1.1 christos /* */
121 1.1 christos /* 3. Setting status in the context must always be the very last */
122 1.1 christos /* action in a routine, as non-0 status may raise a trap and hence */
123 1.1 christos /* the call to set status may not return (if the handler uses long */
124 1.1 christos /* jump). Therefore all cleanup must be done first. In general, */
125 1.1 christos /* to achieve this status is accumulated and is only applied just */
126 1.1 christos /* before return by calling decContextSetStatus (via decStatus). */
127 1.1 christos /* */
128 1.1 christos /* Routines which allocate storage cannot, in general, use the */
129 1.1 christos /* 'top level' routines which could cause a non-returning */
130 1.1 christos /* transfer of control. The decXxxxOp routines are safe (do not */
131 1.1 christos /* call decStatus even if traps are set in the context) and should */
132 1.1 christos /* be used instead (they are also a little faster). */
133 1.1 christos /* */
134 1.1 christos /* 4. Exponent checking is minimized by allowing the exponent to */
135 1.1 christos /* grow outside its limits during calculations, provided that */
136 1.1 christos /* the decFinalize function is called later. Multiplication and */
137 1.1 christos /* division, and intermediate calculations in exponentiation, */
138 1.1 christos /* require more careful checks because of the risk of 31-bit */
139 1.1 christos /* overflow (the most negative valid exponent is -1999999997, for */
140 1.1 christos /* a 999999999-digit number with adjusted exponent of -999999999). */
141 1.1 christos /* */
142 1.1 christos /* 5. Rounding is deferred until finalization of results, with any */
143 1.1 christos /* 'off to the right' data being represented as a single digit */
144 1.1 christos /* residue (in the range -1 through 9). This avoids any double- */
145 1.1 christos /* rounding when more than one shortening takes place (for */
146 1.1 christos /* example, when a result is subnormal). */
147 1.1 christos /* */
148 1.1 christos /* 6. The digits count is allowed to rise to a multiple of DECDPUN */
149 1.1 christos /* during many operations, so whole Units are handled and exact */
150 1.1 christos /* accounting of digits is not needed. The correct digits value */
151 1.1 christos /* is found by decGetDigits, which accounts for leading zeros. */
152 1.1 christos /* This must be called before any rounding if the number of digits */
153 1.1 christos /* is not known exactly. */
154 1.1 christos /* */
155 1.1 christos /* 7. The multiply-by-reciprocal 'trick' is used for partitioning */
156 1.1 christos /* numbers up to four digits, using appropriate constants. This */
157 1.1 christos /* is not useful for longer numbers because overflow of 32 bits */
158 1.1 christos /* would lead to 4 multiplies, which is almost as expensive as */
159 1.1 christos /* a divide (unless a floating-point or 64-bit multiply is */
160 1.1 christos /* assumed to be available). */
161 1.1 christos /* */
162 1.1 christos /* 8. Unusual abbreviations that may be used in the commentary: */
163 1.1 christos /* lhs -- left hand side (operand, of an operation) */
164 1.1 christos /* lsd -- least significant digit (of coefficient) */
165 1.1 christos /* lsu -- least significant Unit (of coefficient) */
166 1.1 christos /* msd -- most significant digit (of coefficient) */
167 1.1 christos /* msi -- most significant item (in an array) */
168 1.1 christos /* msu -- most significant Unit (of coefficient) */
169 1.1 christos /* rhs -- right hand side (operand, of an operation) */
170 1.1 christos /* +ve -- positive */
171 1.1 christos /* -ve -- negative */
172 1.1 christos /* ** -- raise to the power */
173 1.1 christos /* ------------------------------------------------------------------ */
174 1.1 christos
175 1.1 christos #include <stdlib.h> /* for malloc, free, etc. */
176 1.1 christos #include <stdio.h> /* for printf [if needed] */
177 1.1 christos #include <string.h> /* for strcpy */
178 1.1 christos #include <ctype.h> /* for lower */
179 1.1 christos #include "dconfig.h" /* for GCC definitions */
180 1.1 christos #include "decNumber.h" /* base number library */
181 1.1 christos #include "decNumberLocal.h" /* decNumber local types, etc. */
182 1.1 christos
183 1.1 christos /* Constants */
184 1.1 christos /* Public lookup table used by the D2U macro */
185 1.1 christos const uByte d2utable[DECMAXD2U+1]=D2UTABLE;
186 1.1 christos
187 1.1 christos #define DECVERB 1 /* set to 1 for verbose DECCHECK */
188 1.1 christos #define powers DECPOWERS /* old internal name */
189 1.1 christos
190 1.1 christos /* Local constants */
191 1.1 christos #define DIVIDE 0x80 /* Divide operators */
192 1.1 christos #define REMAINDER 0x40 /* .. */
193 1.1 christos #define DIVIDEINT 0x20 /* .. */
194 1.1 christos #define REMNEAR 0x10 /* .. */
195 1.1 christos #define COMPARE 0x01 /* Compare operators */
196 1.1 christos #define COMPMAX 0x02 /* .. */
197 1.1 christos #define COMPMIN 0x03 /* .. */
198 1.1 christos #define COMPTOTAL 0x04 /* .. */
199 1.1 christos #define COMPNAN 0x05 /* .. [NaN processing] */
200 1.1 christos #define COMPSIG 0x06 /* .. [signaling COMPARE] */
201 1.1 christos #define COMPMAXMAG 0x07 /* .. */
202 1.1 christos #define COMPMINMAG 0x08 /* .. */
203 1.1 christos
204 1.1 christos #define DEC_sNaN 0x40000000 /* local status: sNaN signal */
205 1.1 christos #define BADINT (Int)0x80000000 /* most-negative Int; error indicator */
206 1.1 christos /* Next two indicate an integer >= 10**6, and its parity (bottom bit) */
207 1.1 christos #define BIGEVEN (Int)0x80000002
208 1.1 christos #define BIGODD (Int)0x80000003
209 1.1 christos
210 1.1 christos static Unit uarrone[1]={1}; /* Unit array of 1, used for incrementing */
211 1.1 christos
212 1.1 christos /* Granularity-dependent code */
213 1.1 christos #if DECDPUN<=4
214 1.1 christos #define eInt Int /* extended integer */
215 1.1 christos #define ueInt uInt /* unsigned extended integer */
216 1.1 christos /* Constant multipliers for divide-by-power-of five using reciprocal */
217 1.1 christos /* multiply, after removing powers of 2 by shifting, and final shift */
218 1.1 christos /* of 17 [we only need up to **4] */
219 1.1 christos static const uInt multies[]={131073, 26215, 5243, 1049, 210};
220 1.1 christos /* QUOT10 -- macro to return the quotient of unit u divided by 10**n */
221 1.1 christos #define QUOT10(u, n) ((((uInt)(u)>>(n))*multies[n])>>17)
222 1.1 christos #else
223 1.1 christos /* For DECDPUN>4 non-ANSI-89 64-bit types are needed. */
224 1.1 christos #if !DECUSE64
225 1.1 christos #error decNumber.c: DECUSE64 must be 1 when DECDPUN>4
226 1.1 christos #endif
227 1.1 christos #define eInt Long /* extended integer */
228 1.1 christos #define ueInt uLong /* unsigned extended integer */
229 1.1 christos #endif
230 1.1 christos
231 1.1 christos /* Local routines */
232 1.1 christos static decNumber * decAddOp(decNumber *, const decNumber *, const decNumber *,
233 1.1 christos decContext *, uByte, uInt *);
234 1.1 christos static Flag decBiStr(const char *, const char *, const char *);
235 1.1 christos static uInt decCheckMath(const decNumber *, decContext *, uInt *);
236 1.1 christos static void decApplyRound(decNumber *, decContext *, Int, uInt *);
237 1.1 christos static Int decCompare(const decNumber *lhs, const decNumber *rhs, Flag);
238 1.1 christos static decNumber * decCompareOp(decNumber *, const decNumber *,
239 1.1 christos const decNumber *, decContext *,
240 1.1 christos Flag, uInt *);
241 1.1 christos static void decCopyFit(decNumber *, const decNumber *, decContext *,
242 1.1 christos Int *, uInt *);
243 1.1 christos static decNumber * decDecap(decNumber *, Int);
244 1.1 christos static decNumber * decDivideOp(decNumber *, const decNumber *,
245 1.1 christos const decNumber *, decContext *, Flag, uInt *);
246 1.1 christos static decNumber * decExpOp(decNumber *, const decNumber *,
247 1.1 christos decContext *, uInt *);
248 1.1 christos static void decFinalize(decNumber *, decContext *, Int *, uInt *);
249 1.1 christos static Int decGetDigits(Unit *, Int);
250 1.1 christos static Int decGetInt(const decNumber *);
251 1.1 christos static decNumber * decLnOp(decNumber *, const decNumber *,
252 1.1 christos decContext *, uInt *);
253 1.1 christos static decNumber * decMultiplyOp(decNumber *, const decNumber *,
254 1.1 christos const decNumber *, decContext *,
255 1.1 christos uInt *);
256 1.1 christos static decNumber * decNaNs(decNumber *, const decNumber *,
257 1.1 christos const decNumber *, decContext *, uInt *);
258 1.1 christos static decNumber * decQuantizeOp(decNumber *, const decNumber *,
259 1.1 christos const decNumber *, decContext *, Flag,
260 1.1 christos uInt *);
261 1.1 christos static void decReverse(Unit *, Unit *);
262 1.1 christos static void decSetCoeff(decNumber *, decContext *, const Unit *,
263 1.1 christos Int, Int *, uInt *);
264 1.1 christos static void decSetMaxValue(decNumber *, decContext *);
265 1.1 christos static void decSetOverflow(decNumber *, decContext *, uInt *);
266 1.1 christos static void decSetSubnormal(decNumber *, decContext *, Int *, uInt *);
267 1.1 christos static Int decShiftToLeast(Unit *, Int, Int);
268 1.1 christos static Int decShiftToMost(Unit *, Int, Int);
269 1.1 christos static void decStatus(decNumber *, uInt, decContext *);
270 1.1 christos static void decToString(const decNumber *, char[], Flag);
271 1.1 christos static decNumber * decTrim(decNumber *, decContext *, Flag, Flag, Int *);
272 1.1 christos static Int decUnitAddSub(const Unit *, Int, const Unit *, Int, Int,
273 1.1 christos Unit *, Int);
274 1.1 christos static Int decUnitCompare(const Unit *, Int, const Unit *, Int, Int);
275 1.1 christos
276 1.1 christos #if !DECSUBSET
277 1.1 christos /* decFinish == decFinalize when no subset arithmetic needed */
278 1.1 christos #define decFinish(a,b,c,d) decFinalize(a,b,c,d)
279 1.1 christos #else
280 1.1 christos static void decFinish(decNumber *, decContext *, Int *, uInt *);
281 1.1 christos static decNumber * decRoundOperand(const decNumber *, decContext *, uInt *);
282 1.1 christos #endif
283 1.1 christos
284 1.1 christos /* Local macros */
285 1.1 christos /* masked special-values bits */
286 1.1 christos #define SPECIALARG (rhs->bits & DECSPECIAL)
287 1.1 christos #define SPECIALARGS ((lhs->bits | rhs->bits) & DECSPECIAL)
288 1.1 christos
289 1.1 christos /* Diagnostic macros, etc. */
290 1.1 christos #if DECALLOC
291 1.1 christos /* Handle malloc/free accounting. If enabled, our accountable routines */
292 1.1 christos /* are used; otherwise the code just goes straight to the system malloc */
293 1.1 christos /* and free routines. */
294 1.1 christos #define malloc(a) decMalloc(a)
295 1.1 christos #define free(a) decFree(a)
296 1.1 christos #define DECFENCE 0x5a /* corruption detector */
297 1.1 christos /* 'Our' malloc and free: */
298 1.1 christos static void *decMalloc(size_t);
299 1.1 christos static void decFree(void *);
300 1.1 christos uInt decAllocBytes=0; /* count of bytes allocated */
301 1.1 christos /* Note that DECALLOC code only checks for storage buffer overflow. */
302 1.1 christos /* To check for memory leaks, the decAllocBytes variable must be */
303 1.1 christos /* checked to be 0 at appropriate times (e.g., after the test */
304 1.1 christos /* harness completes a set of tests). This checking may be unreliable */
305 1.1 christos /* if the testing is done in a multi-thread environment. */
306 1.1 christos #endif
307 1.1 christos
308 1.1 christos #if DECCHECK
309 1.1 christos /* Optional checking routines. Enabling these means that decNumber */
310 1.1 christos /* and decContext operands to operator routines are checked for */
311 1.1 christos /* correctness. This roughly doubles the execution time of the */
312 1.1 christos /* fastest routines (and adds 600+ bytes), so should not normally be */
313 1.1 christos /* used in 'production'. */
314 1.1 christos /* decCheckInexact is used to check that inexact results have a full */
315 1.1 christos /* complement of digits (where appropriate -- this is not the case */
316 1.1 christos /* for Quantize, for example) */
317 1.1 christos #define DECUNRESU ((decNumber *)(void *)0xffffffff)
318 1.1 christos #define DECUNUSED ((const decNumber *)(void *)0xffffffff)
319 1.1 christos #define DECUNCONT ((decContext *)(void *)(0xffffffff))
320 1.1 christos static Flag decCheckOperands(decNumber *, const decNumber *,
321 1.1 christos const decNumber *, decContext *);
322 1.1 christos static Flag decCheckNumber(const decNumber *);
323 1.1 christos static void decCheckInexact(const decNumber *, decContext *);
324 1.1 christos #endif
325 1.1 christos
326 1.1 christos #if DECTRACE || DECCHECK
327 1.1 christos /* Optional trace/debugging routines (may or may not be used) */
328 1.1 christos void decNumberShow(const decNumber *); /* displays the components of a number */
329 1.1 christos static void decDumpAr(char, const Unit *, Int);
330 1.1 christos #endif
331 1.1 christos
332 1.1 christos /* ================================================================== */
333 1.1 christos /* Conversions */
334 1.1 christos /* ================================================================== */
335 1.1 christos
336 1.1 christos /* ------------------------------------------------------------------ */
337 1.1 christos /* from-int32 -- conversion from Int or uInt */
338 1.1 christos /* */
339 1.1 christos /* dn is the decNumber to receive the integer */
340 1.1 christos /* in or uin is the integer to be converted */
341 1.1 christos /* returns dn */
342 1.1 christos /* */
343 1.1 christos /* No error is possible. */
344 1.1 christos /* ------------------------------------------------------------------ */
345 1.1 christos decNumber * decNumberFromInt32(decNumber *dn, Int in) {
346 1.1 christos uInt unsig;
347 1.1 christos if (in>=0) unsig=in;
348 1.1 christos else { /* negative (possibly BADINT) */
349 1.1 christos if (in==BADINT) unsig=(uInt)1073741824*2; /* special case */
350 1.1 christos else unsig=-in; /* invert */
351 1.1 christos }
352 1.1 christos /* in is now positive */
353 1.1 christos decNumberFromUInt32(dn, unsig);
354 1.1 christos if (in<0) dn->bits=DECNEG; /* sign needed */
355 1.1 christos return dn;
356 1.1 christos } /* decNumberFromInt32 */
357 1.1 christos
358 1.1 christos decNumber * decNumberFromUInt32(decNumber *dn, uInt uin) {
359 1.1 christos Unit *up; /* work pointer */
360 1.1 christos decNumberZero(dn); /* clean */
361 1.1 christos if (uin==0) return dn; /* [or decGetDigits bad call] */
362 1.1 christos for (up=dn->lsu; uin>0; up++) {
363 1.1 christos *up=(Unit)(uin%(DECDPUNMAX+1));
364 1.1 christos uin=uin/(DECDPUNMAX+1);
365 1.1 christos }
366 1.1 christos dn->digits=decGetDigits(dn->lsu, up-dn->lsu);
367 1.1 christos return dn;
368 1.1 christos } /* decNumberFromUInt32 */
369 1.1 christos
370 1.1 christos /* ------------------------------------------------------------------ */
371 1.1 christos /* to-int32 -- conversion to Int or uInt */
372 1.1 christos /* */
373 1.1 christos /* dn is the decNumber to convert */
374 1.1 christos /* set is the context for reporting errors */
375 1.1 christos /* returns the converted decNumber, or 0 if Invalid is set */
376 1.1 christos /* */
377 1.1 christos /* Invalid is set if the decNumber does not have exponent==0 or if */
378 1.1 christos /* it is a NaN, Infinite, or out-of-range. */
379 1.1 christos /* ------------------------------------------------------------------ */
380 1.1 christos Int decNumberToInt32(const decNumber *dn, decContext *set) {
381 1.1 christos #if DECCHECK
382 1.1 christos if (decCheckOperands(DECUNRESU, DECUNUSED, dn, set)) return 0;
383 1.1 christos #endif
384 1.1 christos
385 1.1 christos /* special or too many digits, or bad exponent */
386 1.1 christos if (dn->bits&DECSPECIAL || dn->digits>10 || dn->exponent!=0) ; /* bad */
387 1.1 christos else { /* is a finite integer with 10 or fewer digits */
388 1.1 christos Int d; /* work */
389 1.1 christos const Unit *up; /* .. */
390 1.1 christos uInt hi=0, lo; /* .. */
391 1.1 christos up=dn->lsu; /* -> lsu */
392 1.1 christos lo=*up; /* get 1 to 9 digits */
393 1.1 christos #if DECDPUN>1 /* split to higher */
394 1.1 christos hi=lo/10;
395 1.1 christos lo=lo%10;
396 1.1 christos #endif
397 1.1 christos up++;
398 1.1 christos /* collect remaining Units, if any, into hi */
399 1.1 christos for (d=DECDPUN; d<dn->digits; up++, d+=DECDPUN) hi+=*up*powers[d-1];
400 1.1 christos /* now low has the lsd, hi the remainder */
401 1.1 christos if (hi>214748364 || (hi==214748364 && lo>7)) { /* out of range? */
402 1.1 christos /* most-negative is a reprieve */
403 1.1 christos if (dn->bits&DECNEG && hi==214748364 && lo==8) return 0x80000000;
404 1.1 christos /* bad -- drop through */
405 1.1 christos }
406 1.1 christos else { /* in-range always */
407 1.1 christos Int i=X10(hi)+lo;
408 1.1 christos if (dn->bits&DECNEG) return -i;
409 1.1 christos return i;
410 1.1 christos }
411 1.1 christos } /* integer */
412 1.1 christos decContextSetStatus(set, DEC_Invalid_operation); /* [may not return] */
413 1.1 christos return 0;
414 1.1 christos } /* decNumberToInt32 */
415 1.1 christos
416 1.1 christos uInt decNumberToUInt32(const decNumber *dn, decContext *set) {
417 1.1 christos #if DECCHECK
418 1.1 christos if (decCheckOperands(DECUNRESU, DECUNUSED, dn, set)) return 0;
419 1.1 christos #endif
420 1.1 christos /* special or too many digits, or bad exponent, or negative (<0) */
421 1.1 christos if (dn->bits&DECSPECIAL || dn->digits>10 || dn->exponent!=0
422 1.1 christos || (dn->bits&DECNEG && !ISZERO(dn))); /* bad */
423 1.1 christos else { /* is a finite integer with 10 or fewer digits */
424 1.1 christos Int d; /* work */
425 1.1 christos const Unit *up; /* .. */
426 1.1 christos uInt hi=0, lo; /* .. */
427 1.1 christos up=dn->lsu; /* -> lsu */
428 1.1 christos lo=*up; /* get 1 to 9 digits */
429 1.1 christos #if DECDPUN>1 /* split to higher */
430 1.1 christos hi=lo/10;
431 1.1 christos lo=lo%10;
432 1.1 christos #endif
433 1.1 christos up++;
434 1.1 christos /* collect remaining Units, if any, into hi */
435 1.1 christos for (d=DECDPUN; d<dn->digits; up++, d+=DECDPUN) hi+=*up*powers[d-1];
436 1.1 christos
437 1.1 christos /* now low has the lsd, hi the remainder */
438 1.1 christos if (hi>429496729 || (hi==429496729 && lo>5)) ; /* no reprieve possible */
439 1.1 christos else return X10(hi)+lo;
440 1.1 christos } /* integer */
441 1.1 christos decContextSetStatus(set, DEC_Invalid_operation); /* [may not return] */
442 1.1 christos return 0;
443 1.1 christos } /* decNumberToUInt32 */
444 1.1 christos
445 1.1 christos /* ------------------------------------------------------------------ */
446 1.1 christos /* to-scientific-string -- conversion to numeric string */
447 1.1 christos /* to-engineering-string -- conversion to numeric string */
448 1.1 christos /* */
449 1.1 christos /* decNumberToString(dn, string); */
450 1.1 christos /* decNumberToEngString(dn, string); */
451 1.1 christos /* */
452 1.1 christos /* dn is the decNumber to convert */
453 1.1 christos /* string is the string where the result will be laid out */
454 1.1 christos /* */
455 1.1 christos /* string must be at least dn->digits+14 characters long */
456 1.1 christos /* */
457 1.1 christos /* No error is possible, and no status can be set. */
458 1.1 christos /* ------------------------------------------------------------------ */
459 1.1 christos char * decNumberToString(const decNumber *dn, char *string){
460 1.1 christos decToString(dn, string, 0);
461 1.1 christos return string;
462 1.1 christos } /* DecNumberToString */
463 1.1 christos
464 1.1 christos char * decNumberToEngString(const decNumber *dn, char *string){
465 1.1 christos decToString(dn, string, 1);
466 1.1 christos return string;
467 1.1 christos } /* DecNumberToEngString */
468 1.1 christos
469 1.1 christos /* ------------------------------------------------------------------ */
470 1.1 christos /* to-number -- conversion from numeric string */
471 1.1 christos /* */
472 1.1 christos /* decNumberFromString -- convert string to decNumber */
473 1.1 christos /* dn -- the number structure to fill */
474 1.1 christos /* chars[] -- the string to convert ('\0' terminated) */
475 1.1 christos /* set -- the context used for processing any error, */
476 1.1 christos /* determining the maximum precision available */
477 1.1 christos /* (set.digits), determining the maximum and minimum */
478 1.1 christos /* exponent (set.emax and set.emin), determining if */
479 1.1 christos /* extended values are allowed, and checking the */
480 1.1 christos /* rounding mode if overflow occurs or rounding is */
481 1.1 christos /* needed. */
482 1.1 christos /* */
483 1.1 christos /* The length of the coefficient and the size of the exponent are */
484 1.1 christos /* checked by this routine, so the correct error (Underflow or */
485 1.1 christos /* Overflow) can be reported or rounding applied, as necessary. */
486 1.1 christos /* */
487 1.1 christos /* If bad syntax is detected, the result will be a quiet NaN. */
488 1.1 christos /* ------------------------------------------------------------------ */
489 1.1 christos decNumber * decNumberFromString(decNumber *dn, const char chars[],
490 1.1 christos decContext *set) {
491 1.1 christos Int exponent=0; /* working exponent [assume 0] */
492 1.1 christos uByte bits=0; /* working flags [assume +ve] */
493 1.1 christos Unit *res; /* where result will be built */
494 1.1 christos Unit resbuff[SD2U(DECBUFFER+9)];/* local buffer in case need temporary */
495 1.1 christos /* [+9 allows for ln() constants] */
496 1.1 christos Unit *allocres=NULL; /* -> allocated result, iff allocated */
497 1.1 christos Int d=0; /* count of digits found in decimal part */
498 1.1 christos const char *dotchar=NULL; /* where dot was found */
499 1.1 christos const char *cfirst=chars; /* -> first character of decimal part */
500 1.1 christos const char *last=NULL; /* -> last digit of decimal part */
501 1.1 christos const char *c; /* work */
502 1.1 christos Unit *up; /* .. */
503 1.1 christos #if DECDPUN>1
504 1.1 christos Int cut, out; /* .. */
505 1.1 christos #endif
506 1.1 christos Int residue; /* rounding residue */
507 1.1 christos uInt status=0; /* error code */
508 1.1 christos
509 1.1 christos #if DECCHECK
510 1.1 christos if (decCheckOperands(DECUNRESU, DECUNUSED, DECUNUSED, set))
511 1.1 christos return decNumberZero(dn);
512 1.1 christos #endif
513 1.1 christos
514 1.1 christos do { /* status & malloc protection */
515 1.1 christos for (c=chars;; c++) { /* -> input character */
516 1.1 christos if (*c>='0' && *c<='9') { /* test for Arabic digit */
517 1.1 christos last=c;
518 1.1 christos d++; /* count of real digits */
519 1.1 christos continue; /* still in decimal part */
520 1.1 christos }
521 1.1 christos if (*c=='.' && dotchar==NULL) { /* first '.' */
522 1.1 christos dotchar=c; /* record offset into decimal part */
523 1.1 christos if (c==cfirst) cfirst++; /* first digit must follow */
524 1.1 christos continue;}
525 1.1 christos if (c==chars) { /* first in string... */
526 1.1 christos if (*c=='-') { /* valid - sign */
527 1.1 christos cfirst++;
528 1.1 christos bits=DECNEG;
529 1.1 christos continue;}
530 1.1 christos if (*c=='+') { /* valid + sign */
531 1.1 christos cfirst++;
532 1.1 christos continue;}
533 1.1 christos }
534 1.1 christos /* *c is not a digit, or a valid +, -, or '.' */
535 1.1 christos break;
536 1.1 christos } /* c */
537 1.1 christos
538 1.1 christos if (last==NULL) { /* no digits yet */
539 1.1 christos status=DEC_Conversion_syntax;/* assume the worst */
540 1.1 christos if (*c=='\0') break; /* and no more to come... */
541 1.1 christos #if DECSUBSET
542 1.1 christos /* if subset then infinities and NaNs are not allowed */
543 1.1 christos if (!set->extended) break; /* hopeless */
544 1.1 christos #endif
545 1.1 christos /* Infinities and NaNs are possible, here */
546 1.1 christos if (dotchar!=NULL) break; /* .. unless had a dot */
547 1.1 christos decNumberZero(dn); /* be optimistic */
548 1.1 christos if (decBiStr(c, "infinity", "INFINITY")
549 1.1 christos || decBiStr(c, "inf", "INF")) {
550 1.1 christos dn->bits=bits | DECINF;
551 1.1 christos status=0; /* is OK */
552 1.1 christos break; /* all done */
553 1.1 christos }
554 1.1 christos /* a NaN expected */
555 1.1 christos /* 2003.09.10 NaNs are now permitted to have a sign */
556 1.1 christos dn->bits=bits | DECNAN; /* assume simple NaN */
557 1.1 christos if (*c=='s' || *c=='S') { /* looks like an sNaN */
558 1.1 christos c++;
559 1.1 christos dn->bits=bits | DECSNAN;
560 1.1 christos }
561 1.1 christos if (*c!='n' && *c!='N') break; /* check caseless "NaN" */
562 1.1 christos c++;
563 1.1 christos if (*c!='a' && *c!='A') break; /* .. */
564 1.1 christos c++;
565 1.1 christos if (*c!='n' && *c!='N') break; /* .. */
566 1.1 christos c++;
567 1.1 christos /* now either nothing, or nnnn payload, expected */
568 1.1 christos /* -> start of integer and skip leading 0s [including plain 0] */
569 1.1 christos for (cfirst=c; *cfirst=='0';) cfirst++;
570 1.1 christos if (*cfirst=='\0') { /* "NaN" or "sNaN", maybe with all 0s */
571 1.1 christos status=0; /* it's good */
572 1.1 christos break; /* .. */
573 1.1 christos }
574 1.1 christos /* something other than 0s; setup last and d as usual [no dots] */
575 1.1 christos for (c=cfirst;; c++, d++) {
576 1.1 christos if (*c<'0' || *c>'9') break; /* test for Arabic digit */
577 1.1 christos last=c;
578 1.1 christos }
579 1.1 christos if (*c!='\0') break; /* not all digits */
580 1.1 christos if (d>set->digits-1) {
581 1.1 christos /* [NB: payload in a decNumber can be full length unless */
582 1.1 christos /* clamped, in which case can only be digits-1] */
583 1.1 christos if (set->clamp) break;
584 1.1 christos if (d>set->digits) break;
585 1.1 christos } /* too many digits? */
586 1.1 christos /* good; drop through to convert the integer to coefficient */
587 1.1 christos status=0; /* syntax is OK */
588 1.1 christos bits=dn->bits; /* for copy-back */
589 1.1 christos } /* last==NULL */
590 1.1 christos
591 1.1 christos else if (*c!='\0') { /* more to process... */
592 1.1 christos /* had some digits; exponent is only valid sequence now */
593 1.1 christos Flag nege; /* 1=negative exponent */
594 1.1 christos const char *firstexp; /* -> first significant exponent digit */
595 1.1 christos status=DEC_Conversion_syntax;/* assume the worst */
596 1.1 christos if (*c!='e' && *c!='E') break;
597 1.1 christos /* Found 'e' or 'E' -- now process explicit exponent */
598 1.1 christos /* 1998.07.11: sign no longer required */
599 1.1 christos nege=0;
600 1.1 christos c++; /* to (possible) sign */
601 1.1 christos if (*c=='-') {nege=1; c++;}
602 1.1 christos else if (*c=='+') c++;
603 1.1 christos if (*c=='\0') break;
604 1.1 christos
605 1.1 christos for (; *c=='0' && *(c+1)!='\0';) c++; /* strip insignificant zeros */
606 1.1 christos firstexp=c; /* save exponent digit place */
607 1.1 christos for (; ;c++) {
608 1.1 christos if (*c<'0' || *c>'9') break; /* not a digit */
609 1.1 christos exponent=X10(exponent)+(Int)*c-(Int)'0';
610 1.1 christos } /* c */
611 1.1 christos /* if not now on a '\0', *c must not be a digit */
612 1.1 christos if (*c!='\0') break;
613 1.1 christos
614 1.1 christos /* (this next test must be after the syntax checks) */
615 1.1 christos /* if it was too long the exponent may have wrapped, so check */
616 1.1 christos /* carefully and set it to a certain overflow if wrap possible */
617 1.1 christos if (c>=firstexp+9+1) {
618 1.1 christos if (c>firstexp+9+1 || *firstexp>'1') exponent=DECNUMMAXE*2;
619 1.1 christos /* [up to 1999999999 is OK, for example 1E-1000000998] */
620 1.1 christos }
621 1.1 christos if (nege) exponent=-exponent; /* was negative */
622 1.1 christos status=0; /* is OK */
623 1.1 christos } /* stuff after digits */
624 1.1 christos
625 1.1 christos /* Here when whole string has been inspected; syntax is good */
626 1.1 christos /* cfirst->first digit (never dot), last->last digit (ditto) */
627 1.1 christos
628 1.1 christos /* strip leading zeros/dot [leave final 0 if all 0's] */
629 1.1 christos if (*cfirst=='0') { /* [cfirst has stepped over .] */
630 1.1 christos for (c=cfirst; c<last; c++, cfirst++) {
631 1.1 christos if (*c=='.') continue; /* ignore dots */
632 1.1 christos if (*c!='0') break; /* non-zero found */
633 1.1 christos d--; /* 0 stripped */
634 1.1 christos } /* c */
635 1.1 christos #if DECSUBSET
636 1.1 christos /* make a rapid exit for easy zeros if !extended */
637 1.1 christos if (*cfirst=='0' && !set->extended) {
638 1.1 christos decNumberZero(dn); /* clean result */
639 1.1 christos break; /* [could be return] */
640 1.1 christos }
641 1.1 christos #endif
642 1.1 christos } /* at least one leading 0 */
643 1.1 christos
644 1.1 christos /* Handle decimal point... */
645 1.1 christos if (dotchar!=NULL && dotchar<last) /* non-trailing '.' found? */
646 1.1 christos exponent-=(last-dotchar); /* adjust exponent */
647 1.1 christos /* [we can now ignore the .] */
648 1.1 christos
649 1.1 christos /* OK, the digits string is good. Assemble in the decNumber, or in */
650 1.1 christos /* a temporary units array if rounding is needed */
651 1.1 christos if (d<=set->digits) res=dn->lsu; /* fits into supplied decNumber */
652 1.1 christos else { /* rounding needed */
653 1.1 christos Int needbytes=D2U(d)*sizeof(Unit);/* bytes needed */
654 1.1 christos res=resbuff; /* assume use local buffer */
655 1.1 christos if (needbytes>(Int)sizeof(resbuff)) { /* too big for local */
656 1.1 christos allocres=(Unit *)malloc(needbytes);
657 1.1 christos if (allocres==NULL) {status|=DEC_Insufficient_storage; break;}
658 1.1 christos res=allocres;
659 1.1 christos }
660 1.1 christos }
661 1.1 christos /* res now -> number lsu, buffer, or allocated storage for Unit array */
662 1.1 christos
663 1.1 christos /* Place the coefficient into the selected Unit array */
664 1.1 christos /* [this is often 70% of the cost of this function when DECDPUN>1] */
665 1.1 christos #if DECDPUN>1
666 1.1 christos out=0; /* accumulator */
667 1.1 christos up=res+D2U(d)-1; /* -> msu */
668 1.1 christos cut=d-(up-res)*DECDPUN; /* digits in top unit */
669 1.1 christos for (c=cfirst;; c++) { /* along the digits */
670 1.1 christos if (*c=='.') continue; /* ignore '.' [don't decrement cut] */
671 1.1 christos out=X10(out)+(Int)*c-(Int)'0';
672 1.1 christos if (c==last) break; /* done [never get to trailing '.'] */
673 1.1 christos cut--;
674 1.1 christos if (cut>0) continue; /* more for this unit */
675 1.1 christos *up=(Unit)out; /* write unit */
676 1.1 christos up--; /* prepare for unit below.. */
677 1.1 christos cut=DECDPUN; /* .. */
678 1.1 christos out=0; /* .. */
679 1.1 christos } /* c */
680 1.1 christos *up=(Unit)out; /* write lsu */
681 1.1 christos
682 1.1 christos #else
683 1.1 christos /* DECDPUN==1 */
684 1.1 christos up=res; /* -> lsu */
685 1.1 christos for (c=last; c>=cfirst; c--) { /* over each character, from least */
686 1.1 christos if (*c=='.') continue; /* ignore . [don't step up] */
687 1.1 christos *up=(Unit)((Int)*c-(Int)'0');
688 1.1 christos up++;
689 1.1 christos } /* c */
690 1.1 christos #endif
691 1.1 christos
692 1.1 christos dn->bits=bits;
693 1.1 christos dn->exponent=exponent;
694 1.1 christos dn->digits=d;
695 1.1 christos
696 1.1 christos /* if not in number (too long) shorten into the number */
697 1.1 christos if (d>set->digits) {
698 1.1 christos residue=0;
699 1.1 christos decSetCoeff(dn, set, res, d, &residue, &status);
700 1.1 christos /* always check for overflow or subnormal and round as needed */
701 1.1 christos decFinalize(dn, set, &residue, &status);
702 1.1 christos }
703 1.1 christos else { /* no rounding, but may still have overflow or subnormal */
704 1.1 christos /* [these tests are just for performance; finalize repeats them] */
705 1.1 christos if ((dn->exponent-1<set->emin-dn->digits)
706 1.1 christos || (dn->exponent-1>set->emax-set->digits)) {
707 1.1 christos residue=0;
708 1.1 christos decFinalize(dn, set, &residue, &status);
709 1.1 christos }
710 1.1 christos }
711 1.1 christos /* decNumberShow(dn); */
712 1.1 christos } while(0); /* [for break] */
713 1.1 christos
714 1.1 christos free(allocres); /* drop any storage used */
715 1.1 christos if (status!=0) decStatus(dn, status, set);
716 1.1 christos return dn;
717 1.1 christos } /* decNumberFromString */
718 1.1 christos
719 1.1 christos /* ================================================================== */
720 1.1 christos /* Operators */
721 1.1 christos /* ================================================================== */
722 1.1 christos
723 1.1 christos /* ------------------------------------------------------------------ */
724 1.1 christos /* decNumberAbs -- absolute value operator */
725 1.1 christos /* */
726 1.1 christos /* This computes C = abs(A) */
727 1.1 christos /* */
728 1.1 christos /* res is C, the result. C may be A */
729 1.1 christos /* rhs is A */
730 1.1 christos /* set is the context */
731 1.1 christos /* */
732 1.1 christos /* See also decNumberCopyAbs for a quiet bitwise version of this. */
733 1.1 christos /* C must have space for set->digits digits. */
734 1.1 christos /* ------------------------------------------------------------------ */
735 1.1 christos /* This has the same effect as decNumberPlus unless A is negative, */
736 1.1 christos /* in which case it has the same effect as decNumberMinus. */
737 1.1 christos /* ------------------------------------------------------------------ */
738 1.1 christos decNumber * decNumberAbs(decNumber *res, const decNumber *rhs,
739 1.1 christos decContext *set) {
740 1.1 christos decNumber dzero; /* for 0 */
741 1.1 christos uInt status=0; /* accumulator */
742 1.1 christos
743 1.1 christos #if DECCHECK
744 1.1 christos if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
745 1.1 christos #endif
746 1.1 christos
747 1.1 christos decNumberZero(&dzero); /* set 0 */
748 1.1 christos dzero.exponent=rhs->exponent; /* [no coefficient expansion] */
749 1.1 christos decAddOp(res, &dzero, rhs, set, (uByte)(rhs->bits & DECNEG), &status);
750 1.1 christos if (status!=0) decStatus(res, status, set);
751 1.1 christos #if DECCHECK
752 1.1 christos decCheckInexact(res, set);
753 1.1 christos #endif
754 1.1 christos return res;
755 1.1 christos } /* decNumberAbs */
756 1.1 christos
757 1.1 christos /* ------------------------------------------------------------------ */
758 1.1 christos /* decNumberAdd -- add two Numbers */
759 1.1 christos /* */
760 1.1 christos /* This computes C = A + B */
761 1.1 christos /* */
762 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=X+X) */
763 1.1 christos /* lhs is A */
764 1.1 christos /* rhs is B */
765 1.1 christos /* set is the context */
766 1.1 christos /* */
767 1.1 christos /* C must have space for set->digits digits. */
768 1.1 christos /* ------------------------------------------------------------------ */
769 1.1 christos /* This just calls the routine shared with Subtract */
770 1.1 christos decNumber * decNumberAdd(decNumber *res, const decNumber *lhs,
771 1.1 christos const decNumber *rhs, decContext *set) {
772 1.1 christos uInt status=0; /* accumulator */
773 1.1 christos decAddOp(res, lhs, rhs, set, 0, &status);
774 1.1 christos if (status!=0) decStatus(res, status, set);
775 1.1 christos #if DECCHECK
776 1.1 christos decCheckInexact(res, set);
777 1.1 christos #endif
778 1.1 christos return res;
779 1.1 christos } /* decNumberAdd */
780 1.1 christos
781 1.1 christos /* ------------------------------------------------------------------ */
782 1.1 christos /* decNumberAnd -- AND two Numbers, digitwise */
783 1.1 christos /* */
784 1.1 christos /* This computes C = A & B */
785 1.1 christos /* */
786 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=X&X) */
787 1.1 christos /* lhs is A */
788 1.1 christos /* rhs is B */
789 1.1 christos /* set is the context (used for result length and error report) */
790 1.1 christos /* */
791 1.1 christos /* C must have space for set->digits digits. */
792 1.1 christos /* */
793 1.1 christos /* Logical function restrictions apply (see above); a NaN is */
794 1.1 christos /* returned with Invalid_operation if a restriction is violated. */
795 1.1 christos /* ------------------------------------------------------------------ */
796 1.1 christos decNumber * decNumberAnd(decNumber *res, const decNumber *lhs,
797 1.1 christos const decNumber *rhs, decContext *set) {
798 1.1 christos const Unit *ua, *ub; /* -> operands */
799 1.1 christos const Unit *msua, *msub; /* -> operand msus */
800 1.1 christos Unit *uc, *msuc; /* -> result and its msu */
801 1.1 christos Int msudigs; /* digits in res msu */
802 1.1 christos #if DECCHECK
803 1.1 christos if (decCheckOperands(res, lhs, rhs, set)) return res;
804 1.1 christos #endif
805 1.1 christos
806 1.1 christos if (lhs->exponent!=0 || decNumberIsSpecial(lhs) || decNumberIsNegative(lhs)
807 1.1 christos || rhs->exponent!=0 || decNumberIsSpecial(rhs) || decNumberIsNegative(rhs)) {
808 1.1 christos decStatus(res, DEC_Invalid_operation, set);
809 1.1 christos return res;
810 1.1 christos }
811 1.1 christos
812 1.1 christos /* operands are valid */
813 1.1 christos ua=lhs->lsu; /* bottom-up */
814 1.1 christos ub=rhs->lsu; /* .. */
815 1.1 christos uc=res->lsu; /* .. */
816 1.1 christos msua=ua+D2U(lhs->digits)-1; /* -> msu of lhs */
817 1.1 christos msub=ub+D2U(rhs->digits)-1; /* -> msu of rhs */
818 1.1 christos msuc=uc+D2U(set->digits)-1; /* -> msu of result */
819 1.1 christos msudigs=MSUDIGITS(set->digits); /* [faster than remainder] */
820 1.1 christos for (; uc<=msuc; ua++, ub++, uc++) { /* Unit loop */
821 1.1 christos Unit a, b; /* extract units */
822 1.1 christos if (ua>msua) a=0;
823 1.1 christos else a=*ua;
824 1.1 christos if (ub>msub) b=0;
825 1.1 christos else b=*ub;
826 1.1 christos *uc=0; /* can now write back */
827 1.1 christos if (a|b) { /* maybe 1 bits to examine */
828 1.1 christos Int i, j;
829 1.1 christos *uc=0; /* can now write back */
830 1.1 christos /* This loop could be unrolled and/or use BIN2BCD tables */
831 1.1 christos for (i=0; i<DECDPUN; i++) {
832 1.1 christos if (a&b&1) *uc=*uc+(Unit)powers[i]; /* effect AND */
833 1.1 christos j=a%10;
834 1.1 christos a=a/10;
835 1.1 christos j|=b%10;
836 1.1 christos b=b/10;
837 1.1 christos if (j>1) {
838 1.1 christos decStatus(res, DEC_Invalid_operation, set);
839 1.1 christos return res;
840 1.1 christos }
841 1.1 christos if (uc==msuc && i==msudigs-1) break; /* just did final digit */
842 1.1 christos } /* each digit */
843 1.1 christos } /* both OK */
844 1.1 christos } /* each unit */
845 1.1 christos /* [here uc-1 is the msu of the result] */
846 1.1 christos res->digits=decGetDigits(res->lsu, uc-res->lsu);
847 1.1 christos res->exponent=0; /* integer */
848 1.1 christos res->bits=0; /* sign=0 */
849 1.1 christos return res; /* [no status to set] */
850 1.1 christos } /* decNumberAnd */
851 1.1 christos
852 1.1 christos /* ------------------------------------------------------------------ */
853 1.1 christos /* decNumberCompare -- compare two Numbers */
854 1.1 christos /* */
855 1.1 christos /* This computes C = A ? B */
856 1.1 christos /* */
857 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=X?X) */
858 1.1 christos /* lhs is A */
859 1.1 christos /* rhs is B */
860 1.1 christos /* set is the context */
861 1.1 christos /* */
862 1.1 christos /* C must have space for one digit (or NaN). */
863 1.1 christos /* ------------------------------------------------------------------ */
864 1.1 christos decNumber * decNumberCompare(decNumber *res, const decNumber *lhs,
865 1.1 christos const decNumber *rhs, decContext *set) {
866 1.1 christos uInt status=0; /* accumulator */
867 1.1 christos decCompareOp(res, lhs, rhs, set, COMPARE, &status);
868 1.1 christos if (status!=0) decStatus(res, status, set);
869 1.1 christos return res;
870 1.1 christos } /* decNumberCompare */
871 1.1 christos
872 1.1 christos /* ------------------------------------------------------------------ */
873 1.1 christos /* decNumberCompareSignal -- compare, signalling on all NaNs */
874 1.1 christos /* */
875 1.1 christos /* This computes C = A ? B */
876 1.1 christos /* */
877 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=X?X) */
878 1.1 christos /* lhs is A */
879 1.1 christos /* rhs is B */
880 1.1 christos /* set is the context */
881 1.1 christos /* */
882 1.1 christos /* C must have space for one digit (or NaN). */
883 1.1 christos /* ------------------------------------------------------------------ */
884 1.1 christos decNumber * decNumberCompareSignal(decNumber *res, const decNumber *lhs,
885 1.1 christos const decNumber *rhs, decContext *set) {
886 1.1 christos uInt status=0; /* accumulator */
887 1.1 christos decCompareOp(res, lhs, rhs, set, COMPSIG, &status);
888 1.1 christos if (status!=0) decStatus(res, status, set);
889 1.1 christos return res;
890 1.1 christos } /* decNumberCompareSignal */
891 1.1 christos
892 1.1 christos /* ------------------------------------------------------------------ */
893 1.1 christos /* decNumberCompareTotal -- compare two Numbers, using total ordering */
894 1.1 christos /* */
895 1.1 christos /* This computes C = A ? B, under total ordering */
896 1.1 christos /* */
897 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=X?X) */
898 1.1 christos /* lhs is A */
899 1.1 christos /* rhs is B */
900 1.1 christos /* set is the context */
901 1.1 christos /* */
902 1.1 christos /* C must have space for one digit; the result will always be one of */
903 1.1 christos /* -1, 0, or 1. */
904 1.1 christos /* ------------------------------------------------------------------ */
905 1.1 christos decNumber * decNumberCompareTotal(decNumber *res, const decNumber *lhs,
906 1.1 christos const decNumber *rhs, decContext *set) {
907 1.1 christos uInt status=0; /* accumulator */
908 1.1 christos decCompareOp(res, lhs, rhs, set, COMPTOTAL, &status);
909 1.1 christos if (status!=0) decStatus(res, status, set);
910 1.1 christos return res;
911 1.1 christos } /* decNumberCompareTotal */
912 1.1 christos
913 1.1 christos /* ------------------------------------------------------------------ */
914 1.1 christos /* decNumberCompareTotalMag -- compare, total ordering of magnitudes */
915 1.1 christos /* */
916 1.1 christos /* This computes C = |A| ? |B|, under total ordering */
917 1.1 christos /* */
918 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=X?X) */
919 1.1 christos /* lhs is A */
920 1.1 christos /* rhs is B */
921 1.1 christos /* set is the context */
922 1.1 christos /* */
923 1.1 christos /* C must have space for one digit; the result will always be one of */
924 1.1 christos /* -1, 0, or 1. */
925 1.1 christos /* ------------------------------------------------------------------ */
926 1.1 christos decNumber * decNumberCompareTotalMag(decNumber *res, const decNumber *lhs,
927 1.1 christos const decNumber *rhs, decContext *set) {
928 1.1 christos uInt status=0; /* accumulator */
929 1.1 christos uInt needbytes; /* for space calculations */
930 1.1 christos decNumber bufa[D2N(DECBUFFER+1)];/* +1 in case DECBUFFER=0 */
931 1.1 christos decNumber *allocbufa=NULL; /* -> allocated bufa, iff allocated */
932 1.1 christos decNumber bufb[D2N(DECBUFFER+1)];
933 1.1 christos decNumber *allocbufb=NULL; /* -> allocated bufb, iff allocated */
934 1.1 christos decNumber *a, *b; /* temporary pointers */
935 1.1 christos
936 1.1 christos #if DECCHECK
937 1.1 christos if (decCheckOperands(res, lhs, rhs, set)) return res;
938 1.1 christos #endif
939 1.1 christos
940 1.1 christos do { /* protect allocated storage */
941 1.1 christos /* if either is negative, take a copy and absolute */
942 1.1 christos if (decNumberIsNegative(lhs)) { /* lhs<0 */
943 1.1 christos a=bufa;
944 1.1 christos needbytes=sizeof(decNumber)+(D2U(lhs->digits)-1)*sizeof(Unit);
945 1.1 christos if (needbytes>sizeof(bufa)) { /* need malloc space */
946 1.1 christos allocbufa=(decNumber *)malloc(needbytes);
947 1.1 christos if (allocbufa==NULL) { /* hopeless -- abandon */
948 1.1 christos status|=DEC_Insufficient_storage;
949 1.1 christos break;}
950 1.1 christos a=allocbufa; /* use the allocated space */
951 1.1 christos }
952 1.1 christos decNumberCopy(a, lhs); /* copy content */
953 1.1 christos a->bits&=~DECNEG; /* .. and clear the sign */
954 1.1 christos lhs=a; /* use copy from here on */
955 1.1 christos }
956 1.1 christos if (decNumberIsNegative(rhs)) { /* rhs<0 */
957 1.1 christos b=bufb;
958 1.1 christos needbytes=sizeof(decNumber)+(D2U(rhs->digits)-1)*sizeof(Unit);
959 1.1 christos if (needbytes>sizeof(bufb)) { /* need malloc space */
960 1.1 christos allocbufb=(decNumber *)malloc(needbytes);
961 1.1 christos if (allocbufb==NULL) { /* hopeless -- abandon */
962 1.1 christos status|=DEC_Insufficient_storage;
963 1.1 christos break;}
964 1.1 christos b=allocbufb; /* use the allocated space */
965 1.1 christos }
966 1.1 christos decNumberCopy(b, rhs); /* copy content */
967 1.1 christos b->bits&=~DECNEG; /* .. and clear the sign */
968 1.1 christos rhs=b; /* use copy from here on */
969 1.1 christos }
970 1.1 christos decCompareOp(res, lhs, rhs, set, COMPTOTAL, &status);
971 1.1 christos } while(0); /* end protected */
972 1.1 christos
973 1.1 christos free(allocbufa); /* drop any storage used */
974 1.1 christos free(allocbufb); /* .. */
975 1.1 christos if (status!=0) decStatus(res, status, set);
976 1.1 christos return res;
977 1.1 christos } /* decNumberCompareTotalMag */
978 1.1 christos
979 1.1 christos /* ------------------------------------------------------------------ */
980 1.1 christos /* decNumberDivide -- divide one number by another */
981 1.1 christos /* */
982 1.1 christos /* This computes C = A / B */
983 1.1 christos /* */
984 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=X/X) */
985 1.1 christos /* lhs is A */
986 1.1 christos /* rhs is B */
987 1.1 christos /* set is the context */
988 1.1 christos /* */
989 1.1 christos /* C must have space for set->digits digits. */
990 1.1 christos /* ------------------------------------------------------------------ */
991 1.1 christos decNumber * decNumberDivide(decNumber *res, const decNumber *lhs,
992 1.1 christos const decNumber *rhs, decContext *set) {
993 1.1 christos uInt status=0; /* accumulator */
994 1.1 christos decDivideOp(res, lhs, rhs, set, DIVIDE, &status);
995 1.1 christos if (status!=0) decStatus(res, status, set);
996 1.1 christos #if DECCHECK
997 1.1 christos decCheckInexact(res, set);
998 1.1 christos #endif
999 1.1 christos return res;
1000 1.1 christos } /* decNumberDivide */
1001 1.1 christos
1002 1.1 christos /* ------------------------------------------------------------------ */
1003 1.1 christos /* decNumberDivideInteger -- divide and return integer quotient */
1004 1.1 christos /* */
1005 1.1 christos /* This computes C = A # B, where # is the integer divide operator */
1006 1.1 christos /* */
1007 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=X#X) */
1008 1.1 christos /* lhs is A */
1009 1.1 christos /* rhs is B */
1010 1.1 christos /* set is the context */
1011 1.1 christos /* */
1012 1.1 christos /* C must have space for set->digits digits. */
1013 1.1 christos /* ------------------------------------------------------------------ */
1014 1.1 christos decNumber * decNumberDivideInteger(decNumber *res, const decNumber *lhs,
1015 1.1 christos const decNumber *rhs, decContext *set) {
1016 1.1 christos uInt status=0; /* accumulator */
1017 1.1 christos decDivideOp(res, lhs, rhs, set, DIVIDEINT, &status);
1018 1.1 christos if (status!=0) decStatus(res, status, set);
1019 1.1 christos return res;
1020 1.1 christos } /* decNumberDivideInteger */
1021 1.1 christos
1022 1.1 christos /* ------------------------------------------------------------------ */
1023 1.1 christos /* decNumberExp -- exponentiation */
1024 1.1 christos /* */
1025 1.1 christos /* This computes C = exp(A) */
1026 1.1 christos /* */
1027 1.1 christos /* res is C, the result. C may be A */
1028 1.1 christos /* rhs is A */
1029 1.1 christos /* set is the context; note that rounding mode has no effect */
1030 1.1 christos /* */
1031 1.1 christos /* C must have space for set->digits digits. */
1032 1.1 christos /* */
1033 1.1 christos /* Mathematical function restrictions apply (see above); a NaN is */
1034 1.1 christos /* returned with Invalid_operation if a restriction is violated. */
1035 1.1 christos /* */
1036 1.1 christos /* Finite results will always be full precision and Inexact, except */
1037 1.1 christos /* when A is a zero or -Infinity (giving 1 or 0 respectively). */
1038 1.1 christos /* */
1039 1.1 christos /* An Inexact result is rounded using DEC_ROUND_HALF_EVEN; it will */
1040 1.1 christos /* almost always be correctly rounded, but may be up to 1 ulp in */
1041 1.1 christos /* error in rare cases. */
1042 1.1 christos /* ------------------------------------------------------------------ */
1043 1.1 christos /* This is a wrapper for decExpOp which can handle the slightly wider */
1044 1.1 christos /* (double) range needed by Ln (which has to be able to calculate */
1045 1.1 christos /* exp(-a) where a can be the tiniest number (Ntiny). */
1046 1.1 christos /* ------------------------------------------------------------------ */
1047 1.1 christos decNumber * decNumberExp(decNumber *res, const decNumber *rhs,
1048 1.1 christos decContext *set) {
1049 1.1 christos uInt status=0; /* accumulator */
1050 1.1 christos #if DECSUBSET
1051 1.1 christos decNumber *allocrhs=NULL; /* non-NULL if rounded rhs allocated */
1052 1.1 christos #endif
1053 1.1 christos
1054 1.1 christos #if DECCHECK
1055 1.1 christos if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
1056 1.1 christos #endif
1057 1.1 christos
1058 1.1 christos /* Check restrictions; these restrictions ensure that if h=8 (see */
1059 1.1 christos /* decExpOp) then the result will either overflow or underflow to 0. */
1060 1.1 christos /* Other math functions restrict the input range, too, for inverses. */
1061 1.1 christos /* If not violated then carry out the operation. */
1062 1.1 christos if (!decCheckMath(rhs, set, &status)) do { /* protect allocation */
1063 1.1 christos #if DECSUBSET
1064 1.1 christos if (!set->extended) {
1065 1.1 christos /* reduce operand and set lostDigits status, as needed */
1066 1.1 christos if (rhs->digits>set->digits) {
1067 1.1 christos allocrhs=decRoundOperand(rhs, set, &status);
1068 1.1 christos if (allocrhs==NULL) break;
1069 1.1 christos rhs=allocrhs;
1070 1.1 christos }
1071 1.1 christos }
1072 1.1 christos #endif
1073 1.1 christos decExpOp(res, rhs, set, &status);
1074 1.1 christos } while(0); /* end protected */
1075 1.1 christos
1076 1.1 christos #if DECSUBSET
1077 1.1 christos free(allocrhs); /* drop any storage used */
1078 1.1 christos #endif
1079 1.1 christos /* apply significant status */
1080 1.1 christos if (status!=0) decStatus(res, status, set);
1081 1.1 christos #if DECCHECK
1082 1.1 christos decCheckInexact(res, set);
1083 1.1 christos #endif
1084 1.1 christos return res;
1085 1.1 christos } /* decNumberExp */
1086 1.1 christos
1087 1.1 christos /* ------------------------------------------------------------------ */
1088 1.1 christos /* decNumberFMA -- fused multiply add */
1089 1.1 christos /* */
1090 1.1 christos /* This computes D = (A * B) + C with only one rounding */
1091 1.1 christos /* */
1092 1.1 christos /* res is D, the result. D may be A or B or C (e.g., X=FMA(X,X,X)) */
1093 1.1 christos /* lhs is A */
1094 1.1 christos /* rhs is B */
1095 1.1 christos /* fhs is C [far hand side] */
1096 1.1 christos /* set is the context */
1097 1.1 christos /* */
1098 1.1 christos /* Mathematical function restrictions apply (see above); a NaN is */
1099 1.1 christos /* returned with Invalid_operation if a restriction is violated. */
1100 1.1 christos /* */
1101 1.1 christos /* C must have space for set->digits digits. */
1102 1.1 christos /* ------------------------------------------------------------------ */
1103 1.1 christos decNumber * decNumberFMA(decNumber *res, const decNumber *lhs,
1104 1.1 christos const decNumber *rhs, const decNumber *fhs,
1105 1.1 christos decContext *set) {
1106 1.1 christos uInt status=0; /* accumulator */
1107 1.1 christos decContext dcmul; /* context for the multiplication */
1108 1.1 christos uInt needbytes; /* for space calculations */
1109 1.1 christos decNumber bufa[D2N(DECBUFFER*2+1)];
1110 1.1 christos decNumber *allocbufa=NULL; /* -> allocated bufa, iff allocated */
1111 1.1 christos decNumber *acc; /* accumulator pointer */
1112 1.1 christos decNumber dzero; /* work */
1113 1.1 christos
1114 1.1 christos #if DECCHECK
1115 1.1 christos if (decCheckOperands(res, lhs, rhs, set)) return res;
1116 1.1 christos if (decCheckOperands(res, fhs, DECUNUSED, set)) return res;
1117 1.1 christos #endif
1118 1.1 christos
1119 1.1 christos do { /* protect allocated storage */
1120 1.1 christos #if DECSUBSET
1121 1.1 christos if (!set->extended) { /* [undefined if subset] */
1122 1.1 christos status|=DEC_Invalid_operation;
1123 1.1 christos break;}
1124 1.1 christos #endif
1125 1.1 christos /* Check math restrictions [these ensure no overflow or underflow] */
1126 1.1 christos if ((!decNumberIsSpecial(lhs) && decCheckMath(lhs, set, &status))
1127 1.1 christos || (!decNumberIsSpecial(rhs) && decCheckMath(rhs, set, &status))
1128 1.1 christos || (!decNumberIsSpecial(fhs) && decCheckMath(fhs, set, &status))) break;
1129 1.1 christos /* set up context for multiply */
1130 1.1 christos dcmul=*set;
1131 1.1 christos dcmul.digits=lhs->digits+rhs->digits; /* just enough */
1132 1.1 christos /* [The above may be an over-estimate for subset arithmetic, but that's OK] */
1133 1.1 christos dcmul.emax=DEC_MAX_EMAX; /* effectively unbounded .. */
1134 1.1 christos dcmul.emin=DEC_MIN_EMIN; /* [thanks to Math restrictions] */
1135 1.1 christos /* set up decNumber space to receive the result of the multiply */
1136 1.1 christos acc=bufa; /* may fit */
1137 1.1 christos needbytes=sizeof(decNumber)+(D2U(dcmul.digits)-1)*sizeof(Unit);
1138 1.1 christos if (needbytes>sizeof(bufa)) { /* need malloc space */
1139 1.1 christos allocbufa=(decNumber *)malloc(needbytes);
1140 1.1 christos if (allocbufa==NULL) { /* hopeless -- abandon */
1141 1.1 christos status|=DEC_Insufficient_storage;
1142 1.1 christos break;}
1143 1.1 christos acc=allocbufa; /* use the allocated space */
1144 1.1 christos }
1145 1.1 christos /* multiply with extended range and necessary precision */
1146 1.1 christos /*printf("emin=%ld\n", dcmul.emin); */
1147 1.1 christos decMultiplyOp(acc, lhs, rhs, &dcmul, &status);
1148 1.1 christos /* Only Invalid operation (from sNaN or Inf * 0) is possible in */
1149 1.1 christos /* status; if either is seen than ignore fhs (in case it is */
1150 1.1 christos /* another sNaN) and set acc to NaN unless we had an sNaN */
1151 1.1 christos /* [decMultiplyOp leaves that to caller] */
1152 1.1 christos /* Note sNaN has to go through addOp to shorten payload if */
1153 1.1 christos /* necessary */
1154 1.1 christos if ((status&DEC_Invalid_operation)!=0) {
1155 1.1 christos if (!(status&DEC_sNaN)) { /* but be true invalid */
1156 1.1 christos decNumberZero(res); /* acc not yet set */
1157 1.1 christos res->bits=DECNAN;
1158 1.1 christos break;
1159 1.1 christos }
1160 1.1 christos decNumberZero(&dzero); /* make 0 (any non-NaN would do) */
1161 1.1 christos fhs=&dzero; /* use that */
1162 1.1 christos }
1163 1.1 christos #if DECCHECK
1164 1.1 christos else { /* multiply was OK */
1165 1.1 christos if (status!=0) printf("Status=%08lx after FMA multiply\n", (LI)status);
1166 1.1 christos }
1167 1.1 christos #endif
1168 1.1 christos /* add the third operand and result -> res, and all is done */
1169 1.1 christos decAddOp(res, acc, fhs, set, 0, &status);
1170 1.1 christos } while(0); /* end protected */
1171 1.1 christos
1172 1.1 christos free(allocbufa); /* drop any storage used */
1173 1.1 christos if (status!=0) decStatus(res, status, set);
1174 1.1 christos #if DECCHECK
1175 1.1 christos decCheckInexact(res, set);
1176 1.1 christos #endif
1177 1.1 christos return res;
1178 1.1 christos } /* decNumberFMA */
1179 1.1 christos
1180 1.1 christos /* ------------------------------------------------------------------ */
1181 1.1 christos /* decNumberInvert -- invert a Number, digitwise */
1182 1.1 christos /* */
1183 1.1 christos /* This computes C = ~A */
1184 1.1 christos /* */
1185 1.1 christos /* res is C, the result. C may be A (e.g., X=~X) */
1186 1.1 christos /* rhs is A */
1187 1.1 christos /* set is the context (used for result length and error report) */
1188 1.1 christos /* */
1189 1.1 christos /* C must have space for set->digits digits. */
1190 1.1 christos /* */
1191 1.1 christos /* Logical function restrictions apply (see above); a NaN is */
1192 1.1 christos /* returned with Invalid_operation if a restriction is violated. */
1193 1.1 christos /* ------------------------------------------------------------------ */
1194 1.1 christos decNumber * decNumberInvert(decNumber *res, const decNumber *rhs,
1195 1.1 christos decContext *set) {
1196 1.1 christos const Unit *ua, *msua; /* -> operand and its msu */
1197 1.1 christos Unit *uc, *msuc; /* -> result and its msu */
1198 1.1 christos Int msudigs; /* digits in res msu */
1199 1.1 christos #if DECCHECK
1200 1.1 christos if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
1201 1.1 christos #endif
1202 1.1 christos
1203 1.1 christos if (rhs->exponent!=0 || decNumberIsSpecial(rhs) || decNumberIsNegative(rhs)) {
1204 1.1 christos decStatus(res, DEC_Invalid_operation, set);
1205 1.1 christos return res;
1206 1.1 christos }
1207 1.1 christos /* operand is valid */
1208 1.1 christos ua=rhs->lsu; /* bottom-up */
1209 1.1 christos uc=res->lsu; /* .. */
1210 1.1 christos msua=ua+D2U(rhs->digits)-1; /* -> msu of rhs */
1211 1.1 christos msuc=uc+D2U(set->digits)-1; /* -> msu of result */
1212 1.1 christos msudigs=MSUDIGITS(set->digits); /* [faster than remainder] */
1213 1.1 christos for (; uc<=msuc; ua++, uc++) { /* Unit loop */
1214 1.1 christos Unit a; /* extract unit */
1215 1.1 christos Int i, j; /* work */
1216 1.1 christos if (ua>msua) a=0;
1217 1.1 christos else a=*ua;
1218 1.1 christos *uc=0; /* can now write back */
1219 1.1 christos /* always need to examine all bits in rhs */
1220 1.1 christos /* This loop could be unrolled and/or use BIN2BCD tables */
1221 1.1 christos for (i=0; i<DECDPUN; i++) {
1222 1.1 christos if ((~a)&1) *uc=*uc+(Unit)powers[i]; /* effect INVERT */
1223 1.1 christos j=a%10;
1224 1.1 christos a=a/10;
1225 1.1 christos if (j>1) {
1226 1.1 christos decStatus(res, DEC_Invalid_operation, set);
1227 1.1 christos return res;
1228 1.1 christos }
1229 1.1 christos if (uc==msuc && i==msudigs-1) break; /* just did final digit */
1230 1.1 christos } /* each digit */
1231 1.1 christos } /* each unit */
1232 1.1 christos /* [here uc-1 is the msu of the result] */
1233 1.1 christos res->digits=decGetDigits(res->lsu, uc-res->lsu);
1234 1.1 christos res->exponent=0; /* integer */
1235 1.1 christos res->bits=0; /* sign=0 */
1236 1.1 christos return res; /* [no status to set] */
1237 1.1 christos } /* decNumberInvert */
1238 1.1 christos
1239 1.1 christos /* ------------------------------------------------------------------ */
1240 1.1 christos /* decNumberLn -- natural logarithm */
1241 1.1 christos /* */
1242 1.1 christos /* This computes C = ln(A) */
1243 1.1 christos /* */
1244 1.1 christos /* res is C, the result. C may be A */
1245 1.1 christos /* rhs is A */
1246 1.1 christos /* set is the context; note that rounding mode has no effect */
1247 1.1 christos /* */
1248 1.1 christos /* C must have space for set->digits digits. */
1249 1.1 christos /* */
1250 1.1 christos /* Notable cases: */
1251 1.1 christos /* A<0 -> Invalid */
1252 1.1 christos /* A=0 -> -Infinity (Exact) */
1253 1.1 christos /* A=+Infinity -> +Infinity (Exact) */
1254 1.1 christos /* A=1 exactly -> 0 (Exact) */
1255 1.1 christos /* */
1256 1.1 christos /* Mathematical function restrictions apply (see above); a NaN is */
1257 1.1 christos /* returned with Invalid_operation if a restriction is violated. */
1258 1.1 christos /* */
1259 1.1 christos /* An Inexact result is rounded using DEC_ROUND_HALF_EVEN; it will */
1260 1.1 christos /* almost always be correctly rounded, but may be up to 1 ulp in */
1261 1.1 christos /* error in rare cases. */
1262 1.1 christos /* ------------------------------------------------------------------ */
1263 1.1 christos /* This is a wrapper for decLnOp which can handle the slightly wider */
1264 1.1 christos /* (+11) range needed by Ln, Log10, etc. (which may have to be able */
1265 1.1 christos /* to calculate at p+e+2). */
1266 1.1 christos /* ------------------------------------------------------------------ */
1267 1.1 christos decNumber * decNumberLn(decNumber *res, const decNumber *rhs,
1268 1.1 christos decContext *set) {
1269 1.1 christos uInt status=0; /* accumulator */
1270 1.1 christos #if DECSUBSET
1271 1.1 christos decNumber *allocrhs=NULL; /* non-NULL if rounded rhs allocated */
1272 1.1 christos #endif
1273 1.1 christos
1274 1.1 christos #if DECCHECK
1275 1.1 christos if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
1276 1.1 christos #endif
1277 1.1 christos
1278 1.1 christos /* Check restrictions; this is a math function; if not violated */
1279 1.1 christos /* then carry out the operation. */
1280 1.1 christos if (!decCheckMath(rhs, set, &status)) do { /* protect allocation */
1281 1.1 christos #if DECSUBSET
1282 1.1 christos if (!set->extended) {
1283 1.1 christos /* reduce operand and set lostDigits status, as needed */
1284 1.1 christos if (rhs->digits>set->digits) {
1285 1.1 christos allocrhs=decRoundOperand(rhs, set, &status);
1286 1.1 christos if (allocrhs==NULL) break;
1287 1.1 christos rhs=allocrhs;
1288 1.1 christos }
1289 1.1 christos /* special check in subset for rhs=0 */
1290 1.1 christos if (ISZERO(rhs)) { /* +/- zeros -> error */
1291 1.1 christos status|=DEC_Invalid_operation;
1292 1.1 christos break;}
1293 1.1 christos } /* extended=0 */
1294 1.1 christos #endif
1295 1.1 christos decLnOp(res, rhs, set, &status);
1296 1.1 christos } while(0); /* end protected */
1297 1.1 christos
1298 1.1 christos #if DECSUBSET
1299 1.1 christos free(allocrhs); /* drop any storage used */
1300 1.1 christos #endif
1301 1.1 christos /* apply significant status */
1302 1.1 christos if (status!=0) decStatus(res, status, set);
1303 1.1 christos #if DECCHECK
1304 1.1 christos decCheckInexact(res, set);
1305 1.1 christos #endif
1306 1.1 christos return res;
1307 1.1 christos } /* decNumberLn */
1308 1.1 christos
1309 1.1 christos /* ------------------------------------------------------------------ */
1310 1.1 christos /* decNumberLogB - get adjusted exponent, by 754 rules */
1311 1.1 christos /* */
1312 1.1 christos /* This computes C = adjustedexponent(A) */
1313 1.1 christos /* */
1314 1.1 christos /* res is C, the result. C may be A */
1315 1.1 christos /* rhs is A */
1316 1.1 christos /* set is the context, used only for digits and status */
1317 1.1 christos /* */
1318 1.1 christos /* C must have space for 10 digits (A might have 10**9 digits and */
1319 1.1 christos /* an exponent of +999999999, or one digit and an exponent of */
1320 1.1 christos /* -1999999999). */
1321 1.1 christos /* */
1322 1.1 christos /* This returns the adjusted exponent of A after (in theory) padding */
1323 1.1 christos /* with zeros on the right to set->digits digits while keeping the */
1324 1.1 christos /* same value. The exponent is not limited by emin/emax. */
1325 1.1 christos /* */
1326 1.1 christos /* Notable cases: */
1327 1.1 christos /* A<0 -> Use |A| */
1328 1.1 christos /* A=0 -> -Infinity (Division by zero) */
1329 1.1 christos /* A=Infinite -> +Infinity (Exact) */
1330 1.1 christos /* A=1 exactly -> 0 (Exact) */
1331 1.1 christos /* NaNs are propagated as usual */
1332 1.1 christos /* ------------------------------------------------------------------ */
1333 1.1 christos decNumber * decNumberLogB(decNumber *res, const decNumber *rhs,
1334 1.1 christos decContext *set) {
1335 1.1 christos uInt status=0; /* accumulator */
1336 1.1 christos
1337 1.1 christos #if DECCHECK
1338 1.1 christos if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
1339 1.1 christos #endif
1340 1.1 christos
1341 1.1 christos /* NaNs as usual; Infinities return +Infinity; 0->oops */
1342 1.1 christos if (decNumberIsNaN(rhs)) decNaNs(res, rhs, NULL, set, &status);
1343 1.1 christos else if (decNumberIsInfinite(rhs)) decNumberCopyAbs(res, rhs);
1344 1.1 christos else if (decNumberIsZero(rhs)) {
1345 1.1 christos decNumberZero(res); /* prepare for Infinity */
1346 1.1 christos res->bits=DECNEG|DECINF; /* -Infinity */
1347 1.1 christos status|=DEC_Division_by_zero; /* as per 754 */
1348 1.1 christos }
1349 1.1 christos else { /* finite non-zero */
1350 1.1 christos Int ae=rhs->exponent+rhs->digits-1; /* adjusted exponent */
1351 1.1 christos decNumberFromInt32(res, ae); /* lay it out */
1352 1.1 christos }
1353 1.1 christos
1354 1.1 christos if (status!=0) decStatus(res, status, set);
1355 1.1 christos return res;
1356 1.1 christos } /* decNumberLogB */
1357 1.1 christos
1358 1.1 christos /* ------------------------------------------------------------------ */
1359 1.1 christos /* decNumberLog10 -- logarithm in base 10 */
1360 1.1 christos /* */
1361 1.1 christos /* This computes C = log10(A) */
1362 1.1 christos /* */
1363 1.1 christos /* res is C, the result. C may be A */
1364 1.1 christos /* rhs is A */
1365 1.1 christos /* set is the context; note that rounding mode has no effect */
1366 1.1 christos /* */
1367 1.1 christos /* C must have space for set->digits digits. */
1368 1.1 christos /* */
1369 1.1 christos /* Notable cases: */
1370 1.1 christos /* A<0 -> Invalid */
1371 1.1 christos /* A=0 -> -Infinity (Exact) */
1372 1.1 christos /* A=+Infinity -> +Infinity (Exact) */
1373 1.1 christos /* A=10**n (if n is an integer) -> n (Exact) */
1374 1.1 christos /* */
1375 1.1 christos /* Mathematical function restrictions apply (see above); a NaN is */
1376 1.1 christos /* returned with Invalid_operation if a restriction is violated. */
1377 1.1 christos /* */
1378 1.1 christos /* An Inexact result is rounded using DEC_ROUND_HALF_EVEN; it will */
1379 1.1 christos /* almost always be correctly rounded, but may be up to 1 ulp in */
1380 1.1 christos /* error in rare cases. */
1381 1.1 christos /* ------------------------------------------------------------------ */
1382 1.1 christos /* This calculates ln(A)/ln(10) using appropriate precision. For */
1383 1.1 christos /* ln(A) this is the max(p, rhs->digits + t) + 3, where p is the */
1384 1.1 christos /* requested digits and t is the number of digits in the exponent */
1385 1.1 christos /* (maximum 6). For ln(10) it is p + 3; this is often handled by the */
1386 1.1 christos /* fastpath in decLnOp. The final division is done to the requested */
1387 1.1 christos /* precision. */
1388 1.1 christos /* ------------------------------------------------------------------ */
1389 1.1 christos decNumber * decNumberLog10(decNumber *res, const decNumber *rhs,
1390 1.1 christos decContext *set) {
1391 1.1 christos uInt status=0, ignore=0; /* status accumulators */
1392 1.1 christos uInt needbytes; /* for space calculations */
1393 1.1 christos Int p; /* working precision */
1394 1.1 christos Int t; /* digits in exponent of A */
1395 1.1 christos
1396 1.1 christos /* buffers for a and b working decimals */
1397 1.1 christos /* (adjustment calculator, same size) */
1398 1.1 christos decNumber bufa[D2N(DECBUFFER+2)];
1399 1.1 christos decNumber *allocbufa=NULL; /* -> allocated bufa, iff allocated */
1400 1.1 christos decNumber *a=bufa; /* temporary a */
1401 1.1 christos decNumber bufb[D2N(DECBUFFER+2)];
1402 1.1 christos decNumber *allocbufb=NULL; /* -> allocated bufb, iff allocated */
1403 1.1 christos decNumber *b=bufb; /* temporary b */
1404 1.1 christos decNumber bufw[D2N(10)]; /* working 2-10 digit number */
1405 1.1 christos decNumber *w=bufw; /* .. */
1406 1.1 christos #if DECSUBSET
1407 1.1 christos decNumber *allocrhs=NULL; /* non-NULL if rounded rhs allocated */
1408 1.1 christos #endif
1409 1.1 christos
1410 1.1 christos decContext aset; /* working context */
1411 1.1 christos
1412 1.1 christos #if DECCHECK
1413 1.1 christos if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
1414 1.1 christos #endif
1415 1.1 christos
1416 1.1 christos /* Check restrictions; this is a math function; if not violated */
1417 1.1 christos /* then carry out the operation. */
1418 1.1 christos if (!decCheckMath(rhs, set, &status)) do { /* protect malloc */
1419 1.1 christos #if DECSUBSET
1420 1.1 christos if (!set->extended) {
1421 1.1 christos /* reduce operand and set lostDigits status, as needed */
1422 1.1 christos if (rhs->digits>set->digits) {
1423 1.1 christos allocrhs=decRoundOperand(rhs, set, &status);
1424 1.1 christos if (allocrhs==NULL) break;
1425 1.1 christos rhs=allocrhs;
1426 1.1 christos }
1427 1.1 christos /* special check in subset for rhs=0 */
1428 1.1 christos if (ISZERO(rhs)) { /* +/- zeros -> error */
1429 1.1 christos status|=DEC_Invalid_operation;
1430 1.1 christos break;}
1431 1.1 christos } /* extended=0 */
1432 1.1 christos #endif
1433 1.1 christos
1434 1.1 christos decContextDefault(&aset, DEC_INIT_DECIMAL64); /* clean context */
1435 1.1 christos
1436 1.1 christos /* handle exact powers of 10; only check if +ve finite */
1437 1.1 christos if (!(rhs->bits&(DECNEG|DECSPECIAL)) && !ISZERO(rhs)) {
1438 1.1 christos Int residue=0; /* (no residue) */
1439 1.1 christos uInt copystat=0; /* clean status */
1440 1.1 christos
1441 1.1 christos /* round to a single digit... */
1442 1.1 christos aset.digits=1;
1443 1.1 christos decCopyFit(w, rhs, &aset, &residue, ©stat); /* copy & shorten */
1444 1.1 christos /* if exact and the digit is 1, rhs is a power of 10 */
1445 1.1 christos if (!(copystat&DEC_Inexact) && w->lsu[0]==1) {
1446 1.1 christos /* the exponent, conveniently, is the power of 10; making */
1447 1.1 christos /* this the result needs a little care as it might not fit, */
1448 1.1 christos /* so first convert it into the working number, and then move */
1449 1.1 christos /* to res */
1450 1.1 christos decNumberFromInt32(w, w->exponent);
1451 1.1 christos residue=0;
1452 1.1 christos decCopyFit(res, w, set, &residue, &status); /* copy & round */
1453 1.1 christos decFinish(res, set, &residue, &status); /* cleanup/set flags */
1454 1.1 christos break;
1455 1.1 christos } /* not a power of 10 */
1456 1.1 christos } /* not a candidate for exact */
1457 1.1 christos
1458 1.1 christos /* simplify the information-content calculation to use 'total */
1459 1.1 christos /* number of digits in a, including exponent' as compared to the */
1460 1.1 christos /* requested digits, as increasing this will only rarely cost an */
1461 1.1 christos /* iteration in ln(a) anyway */
1462 1.1 christos t=6; /* it can never be >6 */
1463 1.1 christos
1464 1.1 christos /* allocate space when needed... */
1465 1.1 christos p=(rhs->digits+t>set->digits?rhs->digits+t:set->digits)+3;
1466 1.1 christos needbytes=sizeof(decNumber)+(D2U(p)-1)*sizeof(Unit);
1467 1.1 christos if (needbytes>sizeof(bufa)) { /* need malloc space */
1468 1.1 christos allocbufa=(decNumber *)malloc(needbytes);
1469 1.1 christos if (allocbufa==NULL) { /* hopeless -- abandon */
1470 1.1 christos status|=DEC_Insufficient_storage;
1471 1.1 christos break;}
1472 1.1 christos a=allocbufa; /* use the allocated space */
1473 1.1 christos }
1474 1.1 christos aset.digits=p; /* as calculated */
1475 1.1 christos aset.emax=DEC_MAX_MATH; /* usual bounds */
1476 1.1 christos aset.emin=-DEC_MAX_MATH; /* .. */
1477 1.1 christos aset.clamp=0; /* and no concrete format */
1478 1.1 christos decLnOp(a, rhs, &aset, &status); /* a=ln(rhs) */
1479 1.1 christos
1480 1.1 christos /* skip the division if the result so far is infinite, NaN, or */
1481 1.1 christos /* zero, or there was an error; note NaN from sNaN needs copy */
1482 1.1 christos if (status&DEC_NaNs && !(status&DEC_sNaN)) break;
1483 1.1 christos if (a->bits&DECSPECIAL || ISZERO(a)) {
1484 1.1 christos decNumberCopy(res, a); /* [will fit] */
1485 1.1 christos break;}
1486 1.1 christos
1487 1.1 christos /* for ln(10) an extra 3 digits of precision are needed */
1488 1.1 christos p=set->digits+3;
1489 1.1 christos needbytes=sizeof(decNumber)+(D2U(p)-1)*sizeof(Unit);
1490 1.1 christos if (needbytes>sizeof(bufb)) { /* need malloc space */
1491 1.1 christos allocbufb=(decNumber *)malloc(needbytes);
1492 1.1 christos if (allocbufb==NULL) { /* hopeless -- abandon */
1493 1.1 christos status|=DEC_Insufficient_storage;
1494 1.1 christos break;}
1495 1.1 christos b=allocbufb; /* use the allocated space */
1496 1.1 christos }
1497 1.1 christos decNumberZero(w); /* set up 10... */
1498 1.1 christos #if DECDPUN==1
1499 1.1 christos w->lsu[1]=1; w->lsu[0]=0; /* .. */
1500 1.1 christos #else
1501 1.1 christos w->lsu[0]=10; /* .. */
1502 1.1 christos #endif
1503 1.1 christos w->digits=2; /* .. */
1504 1.1 christos
1505 1.1 christos aset.digits=p;
1506 1.1 christos decLnOp(b, w, &aset, &ignore); /* b=ln(10) */
1507 1.1 christos
1508 1.1 christos aset.digits=set->digits; /* for final divide */
1509 1.1 christos decDivideOp(res, a, b, &aset, DIVIDE, &status); /* into result */
1510 1.1 christos } while(0); /* [for break] */
1511 1.1 christos
1512 1.1 christos free(allocbufa); /* drop any storage used */
1513 1.1 christos free(allocbufb); /* .. */
1514 1.1 christos #if DECSUBSET
1515 1.1 christos free(allocrhs); /* .. */
1516 1.1 christos #endif
1517 1.1 christos /* apply significant status */
1518 1.1 christos if (status!=0) decStatus(res, status, set);
1519 1.1 christos #if DECCHECK
1520 1.1 christos decCheckInexact(res, set);
1521 1.1 christos #endif
1522 1.1 christos return res;
1523 1.1 christos } /* decNumberLog10 */
1524 1.1 christos
1525 1.1 christos /* ------------------------------------------------------------------ */
1526 1.1 christos /* decNumberMax -- compare two Numbers and return the maximum */
1527 1.1 christos /* */
1528 1.1 christos /* This computes C = A ? B, returning the maximum by 754 rules */
1529 1.1 christos /* */
1530 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=X?X) */
1531 1.1 christos /* lhs is A */
1532 1.1 christos /* rhs is B */
1533 1.1 christos /* set is the context */
1534 1.1 christos /* */
1535 1.1 christos /* C must have space for set->digits digits. */
1536 1.1 christos /* ------------------------------------------------------------------ */
1537 1.1 christos decNumber * decNumberMax(decNumber *res, const decNumber *lhs,
1538 1.1 christos const decNumber *rhs, decContext *set) {
1539 1.1 christos uInt status=0; /* accumulator */
1540 1.1 christos decCompareOp(res, lhs, rhs, set, COMPMAX, &status);
1541 1.1 christos if (status!=0) decStatus(res, status, set);
1542 1.1 christos #if DECCHECK
1543 1.1 christos decCheckInexact(res, set);
1544 1.1 christos #endif
1545 1.1 christos return res;
1546 1.1 christos } /* decNumberMax */
1547 1.1 christos
1548 1.1 christos /* ------------------------------------------------------------------ */
1549 1.1 christos /* decNumberMaxMag -- compare and return the maximum by magnitude */
1550 1.1 christos /* */
1551 1.1 christos /* This computes C = A ? B, returning the maximum by 754 rules */
1552 1.1 christos /* */
1553 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=X?X) */
1554 1.1 christos /* lhs is A */
1555 1.1 christos /* rhs is B */
1556 1.1 christos /* set is the context */
1557 1.1 christos /* */
1558 1.1 christos /* C must have space for set->digits digits. */
1559 1.1 christos /* ------------------------------------------------------------------ */
1560 1.1 christos decNumber * decNumberMaxMag(decNumber *res, const decNumber *lhs,
1561 1.1 christos const decNumber *rhs, decContext *set) {
1562 1.1 christos uInt status=0; /* accumulator */
1563 1.1 christos decCompareOp(res, lhs, rhs, set, COMPMAXMAG, &status);
1564 1.1 christos if (status!=0) decStatus(res, status, set);
1565 1.1 christos #if DECCHECK
1566 1.1 christos decCheckInexact(res, set);
1567 1.1 christos #endif
1568 1.1 christos return res;
1569 1.1 christos } /* decNumberMaxMag */
1570 1.1 christos
1571 1.1 christos /* ------------------------------------------------------------------ */
1572 1.1 christos /* decNumberMin -- compare two Numbers and return the minimum */
1573 1.1 christos /* */
1574 1.1 christos /* This computes C = A ? B, returning the minimum by 754 rules */
1575 1.1 christos /* */
1576 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=X?X) */
1577 1.1 christos /* lhs is A */
1578 1.1 christos /* rhs is B */
1579 1.1 christos /* set is the context */
1580 1.1 christos /* */
1581 1.1 christos /* C must have space for set->digits digits. */
1582 1.1 christos /* ------------------------------------------------------------------ */
1583 1.1 christos decNumber * decNumberMin(decNumber *res, const decNumber *lhs,
1584 1.1 christos const decNumber *rhs, decContext *set) {
1585 1.1 christos uInt status=0; /* accumulator */
1586 1.1 christos decCompareOp(res, lhs, rhs, set, COMPMIN, &status);
1587 1.1 christos if (status!=0) decStatus(res, status, set);
1588 1.1 christos #if DECCHECK
1589 1.1 christos decCheckInexact(res, set);
1590 1.1 christos #endif
1591 1.1 christos return res;
1592 1.1 christos } /* decNumberMin */
1593 1.1 christos
1594 1.1 christos /* ------------------------------------------------------------------ */
1595 1.1 christos /* decNumberMinMag -- compare and return the minimum by magnitude */
1596 1.1 christos /* */
1597 1.1 christos /* This computes C = A ? B, returning the minimum by 754 rules */
1598 1.1 christos /* */
1599 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=X?X) */
1600 1.1 christos /* lhs is A */
1601 1.1 christos /* rhs is B */
1602 1.1 christos /* set is the context */
1603 1.1 christos /* */
1604 1.1 christos /* C must have space for set->digits digits. */
1605 1.1 christos /* ------------------------------------------------------------------ */
1606 1.1 christos decNumber * decNumberMinMag(decNumber *res, const decNumber *lhs,
1607 1.1 christos const decNumber *rhs, decContext *set) {
1608 1.1 christos uInt status=0; /* accumulator */
1609 1.1 christos decCompareOp(res, lhs, rhs, set, COMPMINMAG, &status);
1610 1.1 christos if (status!=0) decStatus(res, status, set);
1611 1.1 christos #if DECCHECK
1612 1.1 christos decCheckInexact(res, set);
1613 1.1 christos #endif
1614 1.1 christos return res;
1615 1.1 christos } /* decNumberMinMag */
1616 1.1 christos
1617 1.1 christos /* ------------------------------------------------------------------ */
1618 1.1 christos /* decNumberMinus -- prefix minus operator */
1619 1.1 christos /* */
1620 1.1 christos /* This computes C = 0 - A */
1621 1.1 christos /* */
1622 1.1 christos /* res is C, the result. C may be A */
1623 1.1 christos /* rhs is A */
1624 1.1 christos /* set is the context */
1625 1.1 christos /* */
1626 1.1 christos /* See also decNumberCopyNegate for a quiet bitwise version of this. */
1627 1.1 christos /* C must have space for set->digits digits. */
1628 1.1 christos /* ------------------------------------------------------------------ */
1629 1.1 christos /* Simply use AddOp for the subtract, which will do the necessary. */
1630 1.1 christos /* ------------------------------------------------------------------ */
1631 1.1 christos decNumber * decNumberMinus(decNumber *res, const decNumber *rhs,
1632 1.1 christos decContext *set) {
1633 1.1 christos decNumber dzero;
1634 1.1 christos uInt status=0; /* accumulator */
1635 1.1 christos
1636 1.1 christos #if DECCHECK
1637 1.1 christos if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
1638 1.1 christos #endif
1639 1.1 christos
1640 1.1 christos decNumberZero(&dzero); /* make 0 */
1641 1.1 christos dzero.exponent=rhs->exponent; /* [no coefficient expansion] */
1642 1.1 christos decAddOp(res, &dzero, rhs, set, DECNEG, &status);
1643 1.1 christos if (status!=0) decStatus(res, status, set);
1644 1.1 christos #if DECCHECK
1645 1.1 christos decCheckInexact(res, set);
1646 1.1 christos #endif
1647 1.1 christos return res;
1648 1.1 christos } /* decNumberMinus */
1649 1.1 christos
1650 1.1 christos /* ------------------------------------------------------------------ */
1651 1.1 christos /* decNumberNextMinus -- next towards -Infinity */
1652 1.1 christos /* */
1653 1.1 christos /* This computes C = A - infinitesimal, rounded towards -Infinity */
1654 1.1 christos /* */
1655 1.1 christos /* res is C, the result. C may be A */
1656 1.1 christos /* rhs is A */
1657 1.1 christos /* set is the context */
1658 1.1 christos /* */
1659 1.1 christos /* This is a generalization of 754 NextDown. */
1660 1.1 christos /* ------------------------------------------------------------------ */
1661 1.1 christos decNumber * decNumberNextMinus(decNumber *res, const decNumber *rhs,
1662 1.1 christos decContext *set) {
1663 1.1 christos decNumber dtiny; /* constant */
1664 1.1 christos decContext workset=*set; /* work */
1665 1.1 christos uInt status=0; /* accumulator */
1666 1.1 christos #if DECCHECK
1667 1.1 christos if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
1668 1.1 christos #endif
1669 1.1 christos
1670 1.1 christos /* +Infinity is the special case */
1671 1.1 christos if ((rhs->bits&(DECINF|DECNEG))==DECINF) {
1672 1.1 christos decSetMaxValue(res, set); /* is +ve */
1673 1.1 christos /* there is no status to set */
1674 1.1 christos return res;
1675 1.1 christos }
1676 1.1 christos decNumberZero(&dtiny); /* start with 0 */
1677 1.1 christos dtiny.lsu[0]=1; /* make number that is .. */
1678 1.1 christos dtiny.exponent=DEC_MIN_EMIN-1; /* .. smaller than tiniest */
1679 1.1 christos workset.round=DEC_ROUND_FLOOR;
1680 1.1 christos decAddOp(res, rhs, &dtiny, &workset, DECNEG, &status);
1681 1.1 christos status&=DEC_Invalid_operation|DEC_sNaN; /* only sNaN Invalid please */
1682 1.1 christos if (status!=0) decStatus(res, status, set);
1683 1.1 christos return res;
1684 1.1 christos } /* decNumberNextMinus */
1685 1.1 christos
1686 1.1 christos /* ------------------------------------------------------------------ */
1687 1.1 christos /* decNumberNextPlus -- next towards +Infinity */
1688 1.1 christos /* */
1689 1.1 christos /* This computes C = A + infinitesimal, rounded towards +Infinity */
1690 1.1 christos /* */
1691 1.1 christos /* res is C, the result. C may be A */
1692 1.1 christos /* rhs is A */
1693 1.1 christos /* set is the context */
1694 1.1 christos /* */
1695 1.1 christos /* This is a generalization of 754 NextUp. */
1696 1.1 christos /* ------------------------------------------------------------------ */
1697 1.1 christos decNumber * decNumberNextPlus(decNumber *res, const decNumber *rhs,
1698 1.1 christos decContext *set) {
1699 1.1 christos decNumber dtiny; /* constant */
1700 1.1 christos decContext workset=*set; /* work */
1701 1.1 christos uInt status=0; /* accumulator */
1702 1.1 christos #if DECCHECK
1703 1.1 christos if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
1704 1.1 christos #endif
1705 1.1 christos
1706 1.1 christos /* -Infinity is the special case */
1707 1.1 christos if ((rhs->bits&(DECINF|DECNEG))==(DECINF|DECNEG)) {
1708 1.1 christos decSetMaxValue(res, set);
1709 1.1 christos res->bits=DECNEG; /* negative */
1710 1.1 christos /* there is no status to set */
1711 1.1 christos return res;
1712 1.1 christos }
1713 1.1 christos decNumberZero(&dtiny); /* start with 0 */
1714 1.1 christos dtiny.lsu[0]=1; /* make number that is .. */
1715 1.1 christos dtiny.exponent=DEC_MIN_EMIN-1; /* .. smaller than tiniest */
1716 1.1 christos workset.round=DEC_ROUND_CEILING;
1717 1.1 christos decAddOp(res, rhs, &dtiny, &workset, 0, &status);
1718 1.1 christos status&=DEC_Invalid_operation|DEC_sNaN; /* only sNaN Invalid please */
1719 1.1 christos if (status!=0) decStatus(res, status, set);
1720 1.1 christos return res;
1721 1.1 christos } /* decNumberNextPlus */
1722 1.1 christos
1723 1.1 christos /* ------------------------------------------------------------------ */
1724 1.1 christos /* decNumberNextToward -- next towards rhs */
1725 1.1 christos /* */
1726 1.1 christos /* This computes C = A +/- infinitesimal, rounded towards */
1727 1.1 christos /* +/-Infinity in the direction of B, as per 754-1985 nextafter */
1728 1.1 christos /* modified during revision but dropped from 754-2008. */
1729 1.1 christos /* */
1730 1.1 christos /* res is C, the result. C may be A or B. */
1731 1.1 christos /* lhs is A */
1732 1.1 christos /* rhs is B */
1733 1.1 christos /* set is the context */
1734 1.1 christos /* */
1735 1.1 christos /* This is a generalization of 754-1985 NextAfter. */
1736 1.1 christos /* ------------------------------------------------------------------ */
1737 1.1 christos decNumber * decNumberNextToward(decNumber *res, const decNumber *lhs,
1738 1.1 christos const decNumber *rhs, decContext *set) {
1739 1.1 christos decNumber dtiny; /* constant */
1740 1.1 christos decContext workset=*set; /* work */
1741 1.1 christos Int result; /* .. */
1742 1.1 christos uInt status=0; /* accumulator */
1743 1.1 christos #if DECCHECK
1744 1.1 christos if (decCheckOperands(res, lhs, rhs, set)) return res;
1745 1.1 christos #endif
1746 1.1 christos
1747 1.1 christos if (decNumberIsNaN(lhs) || decNumberIsNaN(rhs)) {
1748 1.1 christos decNaNs(res, lhs, rhs, set, &status);
1749 1.1 christos }
1750 1.1 christos else { /* Is numeric, so no chance of sNaN Invalid, etc. */
1751 1.1 christos result=decCompare(lhs, rhs, 0); /* sign matters */
1752 1.1 christos if (result==BADINT) status|=DEC_Insufficient_storage; /* rare */
1753 1.1 christos else { /* valid compare */
1754 1.1 christos if (result==0) decNumberCopySign(res, lhs, rhs); /* easy */
1755 1.1 christos else { /* differ: need NextPlus or NextMinus */
1756 1.1 christos uByte sub; /* add or subtract */
1757 1.1 christos if (result<0) { /* lhs<rhs, do nextplus */
1758 1.1 christos /* -Infinity is the special case */
1759 1.1 christos if ((lhs->bits&(DECINF|DECNEG))==(DECINF|DECNEG)) {
1760 1.1 christos decSetMaxValue(res, set);
1761 1.1 christos res->bits=DECNEG; /* negative */
1762 1.1 christos return res; /* there is no status to set */
1763 1.1 christos }
1764 1.1 christos workset.round=DEC_ROUND_CEILING;
1765 1.1 christos sub=0; /* add, please */
1766 1.1 christos } /* plus */
1767 1.1 christos else { /* lhs>rhs, do nextminus */
1768 1.1 christos /* +Infinity is the special case */
1769 1.1 christos if ((lhs->bits&(DECINF|DECNEG))==DECINF) {
1770 1.1 christos decSetMaxValue(res, set);
1771 1.1 christos return res; /* there is no status to set */
1772 1.1 christos }
1773 1.1 christos workset.round=DEC_ROUND_FLOOR;
1774 1.1 christos sub=DECNEG; /* subtract, please */
1775 1.1 christos } /* minus */
1776 1.1 christos decNumberZero(&dtiny); /* start with 0 */
1777 1.1 christos dtiny.lsu[0]=1; /* make number that is .. */
1778 1.1 christos dtiny.exponent=DEC_MIN_EMIN-1; /* .. smaller than tiniest */
1779 1.1 christos decAddOp(res, lhs, &dtiny, &workset, sub, &status); /* + or - */
1780 1.1 christos /* turn off exceptions if the result is a normal number */
1781 1.1 christos /* (including Nmin), otherwise let all status through */
1782 1.1 christos if (decNumberIsNormal(res, set)) status=0;
1783 1.1 christos } /* unequal */
1784 1.1 christos } /* compare OK */
1785 1.1 christos } /* numeric */
1786 1.1 christos if (status!=0) decStatus(res, status, set);
1787 1.1 christos return res;
1788 1.1 christos } /* decNumberNextToward */
1789 1.1 christos
1790 1.1 christos /* ------------------------------------------------------------------ */
1791 1.1 christos /* decNumberOr -- OR two Numbers, digitwise */
1792 1.1 christos /* */
1793 1.1 christos /* This computes C = A | B */
1794 1.1 christos /* */
1795 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=X|X) */
1796 1.1 christos /* lhs is A */
1797 1.1 christos /* rhs is B */
1798 1.1 christos /* set is the context (used for result length and error report) */
1799 1.1 christos /* */
1800 1.1 christos /* C must have space for set->digits digits. */
1801 1.1 christos /* */
1802 1.1 christos /* Logical function restrictions apply (see above); a NaN is */
1803 1.1 christos /* returned with Invalid_operation if a restriction is violated. */
1804 1.1 christos /* ------------------------------------------------------------------ */
1805 1.1 christos decNumber * decNumberOr(decNumber *res, const decNumber *lhs,
1806 1.1 christos const decNumber *rhs, decContext *set) {
1807 1.1 christos const Unit *ua, *ub; /* -> operands */
1808 1.1 christos const Unit *msua, *msub; /* -> operand msus */
1809 1.1 christos Unit *uc, *msuc; /* -> result and its msu */
1810 1.1 christos Int msudigs; /* digits in res msu */
1811 1.1 christos #if DECCHECK
1812 1.1 christos if (decCheckOperands(res, lhs, rhs, set)) return res;
1813 1.1 christos #endif
1814 1.1 christos
1815 1.1 christos if (lhs->exponent!=0 || decNumberIsSpecial(lhs) || decNumberIsNegative(lhs)
1816 1.1 christos || rhs->exponent!=0 || decNumberIsSpecial(rhs) || decNumberIsNegative(rhs)) {
1817 1.1 christos decStatus(res, DEC_Invalid_operation, set);
1818 1.1 christos return res;
1819 1.1 christos }
1820 1.1 christos /* operands are valid */
1821 1.1 christos ua=lhs->lsu; /* bottom-up */
1822 1.1 christos ub=rhs->lsu; /* .. */
1823 1.1 christos uc=res->lsu; /* .. */
1824 1.1 christos msua=ua+D2U(lhs->digits)-1; /* -> msu of lhs */
1825 1.1 christos msub=ub+D2U(rhs->digits)-1; /* -> msu of rhs */
1826 1.1 christos msuc=uc+D2U(set->digits)-1; /* -> msu of result */
1827 1.1 christos msudigs=MSUDIGITS(set->digits); /* [faster than remainder] */
1828 1.1 christos for (; uc<=msuc; ua++, ub++, uc++) { /* Unit loop */
1829 1.1 christos Unit a, b; /* extract units */
1830 1.1 christos if (ua>msua) a=0;
1831 1.1 christos else a=*ua;
1832 1.1 christos if (ub>msub) b=0;
1833 1.1 christos else b=*ub;
1834 1.1 christos *uc=0; /* can now write back */
1835 1.1 christos if (a|b) { /* maybe 1 bits to examine */
1836 1.1 christos Int i, j;
1837 1.1 christos /* This loop could be unrolled and/or use BIN2BCD tables */
1838 1.1 christos for (i=0; i<DECDPUN; i++) {
1839 1.1 christos if ((a|b)&1) *uc=*uc+(Unit)powers[i]; /* effect OR */
1840 1.1 christos j=a%10;
1841 1.1 christos a=a/10;
1842 1.1 christos j|=b%10;
1843 1.1 christos b=b/10;
1844 1.1 christos if (j>1) {
1845 1.1 christos decStatus(res, DEC_Invalid_operation, set);
1846 1.1 christos return res;
1847 1.1 christos }
1848 1.1 christos if (uc==msuc && i==msudigs-1) break; /* just did final digit */
1849 1.1 christos } /* each digit */
1850 1.1 christos } /* non-zero */
1851 1.1 christos } /* each unit */
1852 1.1 christos /* [here uc-1 is the msu of the result] */
1853 1.1 christos res->digits=decGetDigits(res->lsu, uc-res->lsu);
1854 1.1 christos res->exponent=0; /* integer */
1855 1.1 christos res->bits=0; /* sign=0 */
1856 1.1 christos return res; /* [no status to set] */
1857 1.1 christos } /* decNumberOr */
1858 1.1 christos
1859 1.1 christos /* ------------------------------------------------------------------ */
1860 1.1 christos /* decNumberPlus -- prefix plus operator */
1861 1.1 christos /* */
1862 1.1 christos /* This computes C = 0 + A */
1863 1.1 christos /* */
1864 1.1 christos /* res is C, the result. C may be A */
1865 1.1 christos /* rhs is A */
1866 1.1 christos /* set is the context */
1867 1.1 christos /* */
1868 1.1 christos /* See also decNumberCopy for a quiet bitwise version of this. */
1869 1.1 christos /* C must have space for set->digits digits. */
1870 1.1 christos /* ------------------------------------------------------------------ */
1871 1.1 christos /* This simply uses AddOp; Add will take fast path after preparing A. */
1872 1.1 christos /* Performance is a concern here, as this routine is often used to */
1873 1.1 christos /* check operands and apply rounding and overflow/underflow testing. */
1874 1.1 christos /* ------------------------------------------------------------------ */
1875 1.1 christos decNumber * decNumberPlus(decNumber *res, const decNumber *rhs,
1876 1.1 christos decContext *set) {
1877 1.1 christos decNumber dzero;
1878 1.1 christos uInt status=0; /* accumulator */
1879 1.1 christos #if DECCHECK
1880 1.1 christos if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
1881 1.1 christos #endif
1882 1.1 christos
1883 1.1 christos decNumberZero(&dzero); /* make 0 */
1884 1.1 christos dzero.exponent=rhs->exponent; /* [no coefficient expansion] */
1885 1.1 christos decAddOp(res, &dzero, rhs, set, 0, &status);
1886 1.1 christos if (status!=0) decStatus(res, status, set);
1887 1.1 christos #if DECCHECK
1888 1.1 christos decCheckInexact(res, set);
1889 1.1 christos #endif
1890 1.1 christos return res;
1891 1.1 christos } /* decNumberPlus */
1892 1.1 christos
1893 1.1 christos /* ------------------------------------------------------------------ */
1894 1.1 christos /* decNumberMultiply -- multiply two Numbers */
1895 1.1 christos /* */
1896 1.1 christos /* This computes C = A x B */
1897 1.1 christos /* */
1898 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=X+X) */
1899 1.1 christos /* lhs is A */
1900 1.1 christos /* rhs is B */
1901 1.1 christos /* set is the context */
1902 1.1 christos /* */
1903 1.1 christos /* C must have space for set->digits digits. */
1904 1.1 christos /* ------------------------------------------------------------------ */
1905 1.1 christos decNumber * decNumberMultiply(decNumber *res, const decNumber *lhs,
1906 1.1 christos const decNumber *rhs, decContext *set) {
1907 1.1 christos uInt status=0; /* accumulator */
1908 1.1 christos decMultiplyOp(res, lhs, rhs, set, &status);
1909 1.1 christos if (status!=0) decStatus(res, status, set);
1910 1.1 christos #if DECCHECK
1911 1.1 christos decCheckInexact(res, set);
1912 1.1 christos #endif
1913 1.1 christos return res;
1914 1.1 christos } /* decNumberMultiply */
1915 1.1 christos
1916 1.1 christos /* ------------------------------------------------------------------ */
1917 1.1 christos /* decNumberPower -- raise a number to a power */
1918 1.1 christos /* */
1919 1.1 christos /* This computes C = A ** B */
1920 1.1 christos /* */
1921 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=X**X) */
1922 1.1 christos /* lhs is A */
1923 1.1 christos /* rhs is B */
1924 1.1 christos /* set is the context */
1925 1.1 christos /* */
1926 1.1 christos /* C must have space for set->digits digits. */
1927 1.1 christos /* */
1928 1.1 christos /* Mathematical function restrictions apply (see above); a NaN is */
1929 1.1 christos /* returned with Invalid_operation if a restriction is violated. */
1930 1.1 christos /* */
1931 1.1 christos /* However, if 1999999997<=B<=999999999 and B is an integer then the */
1932 1.1 christos /* restrictions on A and the context are relaxed to the usual bounds, */
1933 1.1 christos /* for compatibility with the earlier (integer power only) version */
1934 1.1 christos /* of this function. */
1935 1.1 christos /* */
1936 1.1 christos /* When B is an integer, the result may be exact, even if rounded. */
1937 1.1 christos /* */
1938 1.1 christos /* The final result is rounded according to the context; it will */
1939 1.1 christos /* almost always be correctly rounded, but may be up to 1 ulp in */
1940 1.1 christos /* error in rare cases. */
1941 1.1 christos /* ------------------------------------------------------------------ */
1942 1.1 christos decNumber * decNumberPower(decNumber *res, const decNumber *lhs,
1943 1.1 christos const decNumber *rhs, decContext *set) {
1944 1.1 christos #if DECSUBSET
1945 1.1 christos decNumber *alloclhs=NULL; /* non-NULL if rounded lhs allocated */
1946 1.1 christos decNumber *allocrhs=NULL; /* .., rhs */
1947 1.1 christos #endif
1948 1.1 christos decNumber *allocdac=NULL; /* -> allocated acc buffer, iff used */
1949 1.1 christos decNumber *allocinv=NULL; /* -> allocated 1/x buffer, iff used */
1950 1.1 christos Int reqdigits=set->digits; /* requested DIGITS */
1951 1.1 christos Int n; /* rhs in binary */
1952 1.1 christos Flag rhsint=0; /* 1 if rhs is an integer */
1953 1.1 christos Flag useint=0; /* 1 if can use integer calculation */
1954 1.1 christos Flag isoddint=0; /* 1 if rhs is an integer and odd */
1955 1.1 christos Int i; /* work */
1956 1.1 christos #if DECSUBSET
1957 1.1 christos Int dropped; /* .. */
1958 1.1 christos #endif
1959 1.1 christos uInt needbytes; /* buffer size needed */
1960 1.1 christos Flag seenbit; /* seen a bit while powering */
1961 1.1 christos Int residue=0; /* rounding residue */
1962 1.1 christos uInt status=0; /* accumulators */
1963 1.1 christos uByte bits=0; /* result sign if errors */
1964 1.1 christos decContext aset; /* working context */
1965 1.1 christos decNumber dnOne; /* work value 1... */
1966 1.1 christos /* local accumulator buffer [a decNumber, with digits+elength+1 digits] */
1967 1.1 christos decNumber dacbuff[D2N(DECBUFFER+9)];
1968 1.1 christos decNumber *dac=dacbuff; /* -> result accumulator */
1969 1.1 christos /* same again for possible 1/lhs calculation */
1970 1.1 christos decNumber invbuff[D2N(DECBUFFER+9)];
1971 1.1 christos
1972 1.1 christos #if DECCHECK
1973 1.1 christos if (decCheckOperands(res, lhs, rhs, set)) return res;
1974 1.1 christos #endif
1975 1.1 christos
1976 1.1 christos do { /* protect allocated storage */
1977 1.1 christos #if DECSUBSET
1978 1.1 christos if (!set->extended) { /* reduce operands and set status, as needed */
1979 1.1 christos if (lhs->digits>reqdigits) {
1980 1.1 christos alloclhs=decRoundOperand(lhs, set, &status);
1981 1.1 christos if (alloclhs==NULL) break;
1982 1.1 christos lhs=alloclhs;
1983 1.1 christos }
1984 1.1 christos if (rhs->digits>reqdigits) {
1985 1.1 christos allocrhs=decRoundOperand(rhs, set, &status);
1986 1.1 christos if (allocrhs==NULL) break;
1987 1.1 christos rhs=allocrhs;
1988 1.1 christos }
1989 1.1 christos }
1990 1.1 christos #endif
1991 1.1 christos /* [following code does not require input rounding] */
1992 1.1 christos
1993 1.1 christos /* handle NaNs and rhs Infinity (lhs infinity is harder) */
1994 1.1 christos if (SPECIALARGS) {
1995 1.1 christos if (decNumberIsNaN(lhs) || decNumberIsNaN(rhs)) { /* NaNs */
1996 1.1 christos decNaNs(res, lhs, rhs, set, &status);
1997 1.1 christos break;}
1998 1.1 christos if (decNumberIsInfinite(rhs)) { /* rhs Infinity */
1999 1.1 christos Flag rhsneg=rhs->bits&DECNEG; /* save rhs sign */
2000 1.1 christos if (decNumberIsNegative(lhs) /* lhs<0 */
2001 1.1 christos && !decNumberIsZero(lhs)) /* .. */
2002 1.1 christos status|=DEC_Invalid_operation;
2003 1.1 christos else { /* lhs >=0 */
2004 1.1 christos decNumberZero(&dnOne); /* set up 1 */
2005 1.1 christos dnOne.lsu[0]=1;
2006 1.1 christos decNumberCompare(dac, lhs, &dnOne, set); /* lhs ? 1 */
2007 1.1 christos decNumberZero(res); /* prepare for 0/1/Infinity */
2008 1.1 christos if (decNumberIsNegative(dac)) { /* lhs<1 */
2009 1.1 christos if (rhsneg) res->bits|=DECINF; /* +Infinity [else is +0] */
2010 1.1 christos }
2011 1.1 christos else if (dac->lsu[0]==0) { /* lhs=1 */
2012 1.1 christos /* 1**Infinity is inexact, so return fully-padded 1.0000 */
2013 1.1 christos Int shift=set->digits-1;
2014 1.1 christos *res->lsu=1; /* was 0, make int 1 */
2015 1.1 christos res->digits=decShiftToMost(res->lsu, 1, shift);
2016 1.1 christos res->exponent=-shift; /* make 1.0000... */
2017 1.1 christos status|=DEC_Inexact|DEC_Rounded; /* deemed inexact */
2018 1.1 christos }
2019 1.1 christos else { /* lhs>1 */
2020 1.1 christos if (!rhsneg) res->bits|=DECINF; /* +Infinity [else is +0] */
2021 1.1 christos }
2022 1.1 christos } /* lhs>=0 */
2023 1.1 christos break;}
2024 1.1 christos /* [lhs infinity drops through] */
2025 1.1 christos } /* specials */
2026 1.1 christos
2027 1.1 christos /* Original rhs may be an integer that fits and is in range */
2028 1.1 christos n=decGetInt(rhs);
2029 1.1 christos if (n!=BADINT) { /* it is an integer */
2030 1.1 christos rhsint=1; /* record the fact for 1**n */
2031 1.1 christos isoddint=(Flag)n&1; /* [works even if big] */
2032 1.1 christos if (n!=BIGEVEN && n!=BIGODD) /* can use integer path? */
2033 1.1 christos useint=1; /* looks good */
2034 1.1 christos }
2035 1.1 christos
2036 1.1 christos if (decNumberIsNegative(lhs) /* -x .. */
2037 1.1 christos && isoddint) bits=DECNEG; /* .. to an odd power */
2038 1.1 christos
2039 1.1 christos /* handle LHS infinity */
2040 1.1 christos if (decNumberIsInfinite(lhs)) { /* [NaNs already handled] */
2041 1.1 christos uByte rbits=rhs->bits; /* save */
2042 1.1 christos decNumberZero(res); /* prepare */
2043 1.1 christos if (n==0) *res->lsu=1; /* [-]Inf**0 => 1 */
2044 1.1 christos else {
2045 1.1 christos /* -Inf**nonint -> error */
2046 1.1 christos if (!rhsint && decNumberIsNegative(lhs)) {
2047 1.1 christos status|=DEC_Invalid_operation; /* -Inf**nonint is error */
2048 1.1 christos break;}
2049 1.1 christos if (!(rbits & DECNEG)) bits|=DECINF; /* was not a **-n */
2050 1.1 christos /* [otherwise will be 0 or -0] */
2051 1.1 christos res->bits=bits;
2052 1.1 christos }
2053 1.1 christos break;}
2054 1.1 christos
2055 1.1 christos /* similarly handle LHS zero */
2056 1.1 christos if (decNumberIsZero(lhs)) {
2057 1.1 christos if (n==0) { /* 0**0 => Error */
2058 1.1 christos #if DECSUBSET
2059 1.1 christos if (!set->extended) { /* [unless subset] */
2060 1.1 christos decNumberZero(res);
2061 1.1 christos *res->lsu=1; /* return 1 */
2062 1.1 christos break;}
2063 1.1 christos #endif
2064 1.1 christos status|=DEC_Invalid_operation;
2065 1.1 christos }
2066 1.1 christos else { /* 0**x */
2067 1.1 christos uByte rbits=rhs->bits; /* save */
2068 1.1 christos if (rbits & DECNEG) { /* was a 0**(-n) */
2069 1.1 christos #if DECSUBSET
2070 1.1 christos if (!set->extended) { /* [bad if subset] */
2071 1.1 christos status|=DEC_Invalid_operation;
2072 1.1 christos break;}
2073 1.1 christos #endif
2074 1.1 christos bits|=DECINF;
2075 1.1 christos }
2076 1.1 christos decNumberZero(res); /* prepare */
2077 1.1 christos /* [otherwise will be 0 or -0] */
2078 1.1 christos res->bits=bits;
2079 1.1 christos }
2080 1.1 christos break;}
2081 1.1 christos
2082 1.1 christos /* here both lhs and rhs are finite; rhs==0 is handled in the */
2083 1.1 christos /* integer path. Next handle the non-integer cases */
2084 1.1 christos if (!useint) { /* non-integral rhs */
2085 1.1 christos /* any -ve lhs is bad, as is either operand or context out of */
2086 1.1 christos /* bounds */
2087 1.1 christos if (decNumberIsNegative(lhs)) {
2088 1.1 christos status|=DEC_Invalid_operation;
2089 1.1 christos break;}
2090 1.1 christos if (decCheckMath(lhs, set, &status)
2091 1.1 christos || decCheckMath(rhs, set, &status)) break; /* variable status */
2092 1.1 christos
2093 1.1 christos decContextDefault(&aset, DEC_INIT_DECIMAL64); /* clean context */
2094 1.1 christos aset.emax=DEC_MAX_MATH; /* usual bounds */
2095 1.1 christos aset.emin=-DEC_MAX_MATH; /* .. */
2096 1.1 christos aset.clamp=0; /* and no concrete format */
2097 1.1 christos
2098 1.1 christos /* calculate the result using exp(ln(lhs)*rhs), which can */
2099 1.1 christos /* all be done into the accumulator, dac. The precision needed */
2100 1.1 christos /* is enough to contain the full information in the lhs (which */
2101 1.1 christos /* is the total digits, including exponent), or the requested */
2102 1.1 christos /* precision, if larger, + 4; 6 is used for the exponent */
2103 1.1 christos /* maximum length, and this is also used when it is shorter */
2104 1.1 christos /* than the requested digits as it greatly reduces the >0.5 ulp */
2105 1.1 christos /* cases at little cost (because Ln doubles digits each */
2106 1.1 christos /* iteration so a few extra digits rarely causes an extra */
2107 1.1 christos /* iteration) */
2108 1.1 christos aset.digits=MAXI(lhs->digits, set->digits)+6+4;
2109 1.1 christos } /* non-integer rhs */
2110 1.1 christos
2111 1.1 christos else { /* rhs is in-range integer */
2112 1.1 christos if (n==0) { /* x**0 = 1 */
2113 1.1 christos /* (0**0 was handled above) */
2114 1.1 christos decNumberZero(res); /* result=1 */
2115 1.1 christos *res->lsu=1; /* .. */
2116 1.1 christos break;}
2117 1.1 christos /* rhs is a non-zero integer */
2118 1.1 christos if (n<0) n=-n; /* use abs(n) */
2119 1.1 christos
2120 1.1 christos aset=*set; /* clone the context */
2121 1.1 christos aset.round=DEC_ROUND_HALF_EVEN; /* internally use balanced */
2122 1.1 christos /* calculate the working DIGITS */
2123 1.1 christos aset.digits=reqdigits+(rhs->digits+rhs->exponent)+2;
2124 1.1 christos #if DECSUBSET
2125 1.1 christos if (!set->extended) aset.digits--; /* use classic precision */
2126 1.1 christos #endif
2127 1.1 christos /* it's an error if this is more than can be handled */
2128 1.1 christos if (aset.digits>DECNUMMAXP) {status|=DEC_Invalid_operation; break;}
2129 1.1 christos } /* integer path */
2130 1.1 christos
2131 1.1 christos /* aset.digits is the count of digits for the accumulator needed */
2132 1.1 christos /* if accumulator is too long for local storage, then allocate */
2133 1.1 christos needbytes=sizeof(decNumber)+(D2U(aset.digits)-1)*sizeof(Unit);
2134 1.1 christos /* [needbytes also used below if 1/lhs needed] */
2135 1.1 christos if (needbytes>sizeof(dacbuff)) {
2136 1.1 christos allocdac=(decNumber *)malloc(needbytes);
2137 1.1 christos if (allocdac==NULL) { /* hopeless -- abandon */
2138 1.1 christos status|=DEC_Insufficient_storage;
2139 1.1 christos break;}
2140 1.1 christos dac=allocdac; /* use the allocated space */
2141 1.1 christos }
2142 1.1 christos /* here, aset is set up and accumulator is ready for use */
2143 1.1 christos
2144 1.1 christos if (!useint) { /* non-integral rhs */
2145 1.1 christos /* x ** y; special-case x=1 here as it will otherwise always */
2146 1.1 christos /* reduce to integer 1; decLnOp has a fastpath which detects */
2147 1.1 christos /* the case of x=1 */
2148 1.1 christos decLnOp(dac, lhs, &aset, &status); /* dac=ln(lhs) */
2149 1.1 christos /* [no error possible, as lhs 0 already handled] */
2150 1.1 christos if (ISZERO(dac)) { /* x==1, 1.0, etc. */
2151 1.1 christos /* need to return fully-padded 1.0000 etc., but rhsint->1 */
2152 1.1 christos *dac->lsu=1; /* was 0, make int 1 */
2153 1.1 christos if (!rhsint) { /* add padding */
2154 1.1 christos Int shift=set->digits-1;
2155 1.1 christos dac->digits=decShiftToMost(dac->lsu, 1, shift);
2156 1.1 christos dac->exponent=-shift; /* make 1.0000... */
2157 1.1 christos status|=DEC_Inexact|DEC_Rounded; /* deemed inexact */
2158 1.1 christos }
2159 1.1 christos }
2160 1.1 christos else {
2161 1.1 christos decMultiplyOp(dac, dac, rhs, &aset, &status); /* dac=dac*rhs */
2162 1.1 christos decExpOp(dac, dac, &aset, &status); /* dac=exp(dac) */
2163 1.1 christos }
2164 1.1 christos /* and drop through for final rounding */
2165 1.1 christos } /* non-integer rhs */
2166 1.1 christos
2167 1.1 christos else { /* carry on with integer */
2168 1.1 christos decNumberZero(dac); /* acc=1 */
2169 1.1 christos *dac->lsu=1; /* .. */
2170 1.1 christos
2171 1.1 christos /* if a negative power the constant 1 is needed, and if not subset */
2172 1.1 christos /* invert the lhs now rather than inverting the result later */
2173 1.1 christos if (decNumberIsNegative(rhs)) { /* was a **-n [hence digits>0] */
2174 1.1 christos decNumber *inv=invbuff; /* asssume use fixed buffer */
2175 1.1 christos decNumberCopy(&dnOne, dac); /* dnOne=1; [needed now or later] */
2176 1.1 christos #if DECSUBSET
2177 1.1 christos if (set->extended) { /* need to calculate 1/lhs */
2178 1.1 christos #endif
2179 1.1 christos /* divide lhs into 1, putting result in dac [dac=1/dac] */
2180 1.1 christos decDivideOp(dac, &dnOne, lhs, &aset, DIVIDE, &status);
2181 1.1 christos /* now locate or allocate space for the inverted lhs */
2182 1.1 christos if (needbytes>sizeof(invbuff)) {
2183 1.1 christos allocinv=(decNumber *)malloc(needbytes);
2184 1.1 christos if (allocinv==NULL) { /* hopeless -- abandon */
2185 1.1 christos status|=DEC_Insufficient_storage;
2186 1.1 christos break;}
2187 1.1 christos inv=allocinv; /* use the allocated space */
2188 1.1 christos }
2189 1.1 christos /* [inv now points to big-enough buffer or allocated storage] */
2190 1.1 christos decNumberCopy(inv, dac); /* copy the 1/lhs */
2191 1.1 christos decNumberCopy(dac, &dnOne); /* restore acc=1 */
2192 1.1 christos lhs=inv; /* .. and go forward with new lhs */
2193 1.1 christos #if DECSUBSET
2194 1.1 christos }
2195 1.1 christos #endif
2196 1.1 christos }
2197 1.1 christos
2198 1.1 christos /* Raise-to-the-power loop... */
2199 1.1 christos seenbit=0; /* set once a 1-bit is encountered */
2200 1.1 christos for (i=1;;i++){ /* for each bit [top bit ignored] */
2201 1.1 christos /* abandon if had overflow or terminal underflow */
2202 1.1 christos if (status & (DEC_Overflow|DEC_Underflow)) { /* interesting? */
2203 1.1 christos if (status&DEC_Overflow || ISZERO(dac)) break;
2204 1.1 christos }
2205 1.1 christos /* [the following two lines revealed an optimizer bug in a C++ */
2206 1.1 christos /* compiler, with symptom: 5**3 -> 25, when n=n+n was used] */
2207 1.1 christos n=n<<1; /* move next bit to testable position */
2208 1.1 christos if (n<0) { /* top bit is set */
2209 1.1 christos seenbit=1; /* OK, significant bit seen */
2210 1.1 christos decMultiplyOp(dac, dac, lhs, &aset, &status); /* dac=dac*x */
2211 1.1 christos }
2212 1.1 christos if (i==31) break; /* that was the last bit */
2213 1.1 christos if (!seenbit) continue; /* no need to square 1 */
2214 1.1 christos decMultiplyOp(dac, dac, dac, &aset, &status); /* dac=dac*dac [square] */
2215 1.1 christos } /*i*/ /* 32 bits */
2216 1.1 christos
2217 1.1 christos /* complete internal overflow or underflow processing */
2218 1.1 christos if (status & (DEC_Overflow|DEC_Underflow)) {
2219 1.1 christos #if DECSUBSET
2220 1.1 christos /* If subset, and power was negative, reverse the kind of -erflow */
2221 1.1 christos /* [1/x not yet done] */
2222 1.1 christos if (!set->extended && decNumberIsNegative(rhs)) {
2223 1.1 christos if (status & DEC_Overflow)
2224 1.1 christos status^=DEC_Overflow | DEC_Underflow | DEC_Subnormal;
2225 1.1 christos else { /* trickier -- Underflow may or may not be set */
2226 1.1 christos status&=~(DEC_Underflow | DEC_Subnormal); /* [one or both] */
2227 1.1 christos status|=DEC_Overflow;
2228 1.1 christos }
2229 1.1 christos }
2230 1.1 christos #endif
2231 1.1 christos dac->bits=(dac->bits & ~DECNEG) | bits; /* force correct sign */
2232 1.1 christos /* round subnormals [to set.digits rather than aset.digits] */
2233 1.1 christos /* or set overflow result similarly as required */
2234 1.1 christos decFinalize(dac, set, &residue, &status);
2235 1.1 christos decNumberCopy(res, dac); /* copy to result (is now OK length) */
2236 1.1 christos break;
2237 1.1 christos }
2238 1.1 christos
2239 1.1 christos #if DECSUBSET
2240 1.1 christos if (!set->extended && /* subset math */
2241 1.1 christos decNumberIsNegative(rhs)) { /* was a **-n [hence digits>0] */
2242 1.1 christos /* so divide result into 1 [dac=1/dac] */
2243 1.1 christos decDivideOp(dac, &dnOne, dac, &aset, DIVIDE, &status);
2244 1.1 christos }
2245 1.1 christos #endif
2246 1.1 christos } /* rhs integer path */
2247 1.1 christos
2248 1.1 christos /* reduce result to the requested length and copy to result */
2249 1.1 christos decCopyFit(res, dac, set, &residue, &status);
2250 1.1 christos decFinish(res, set, &residue, &status); /* final cleanup */
2251 1.1 christos #if DECSUBSET
2252 1.1 christos if (!set->extended) decTrim(res, set, 0, 1, &dropped); /* trailing zeros */
2253 1.1 christos #endif
2254 1.1 christos } while(0); /* end protected */
2255 1.1 christos
2256 1.1 christos free(allocdac); /* drop any storage used */
2257 1.1 christos free(allocinv); /* .. */
2258 1.1 christos #if DECSUBSET
2259 1.1 christos free(alloclhs); /* .. */
2260 1.1 christos free(allocrhs); /* .. */
2261 1.1 christos #endif
2262 1.1 christos if (status!=0) decStatus(res, status, set);
2263 1.1 christos #if DECCHECK
2264 1.1 christos decCheckInexact(res, set);
2265 1.1 christos #endif
2266 1.1 christos return res;
2267 1.1 christos } /* decNumberPower */
2268 1.1 christos
2269 1.1 christos /* ------------------------------------------------------------------ */
2270 1.1 christos /* decNumberQuantize -- force exponent to requested value */
2271 1.1 christos /* */
2272 1.1 christos /* This computes C = op(A, B), where op adjusts the coefficient */
2273 1.1 christos /* of C (by rounding or shifting) such that the exponent (-scale) */
2274 1.1 christos /* of C has exponent of B. The numerical value of C will equal A, */
2275 1.1 christos /* except for the effects of any rounding that occurred. */
2276 1.1 christos /* */
2277 1.1 christos /* res is C, the result. C may be A or B */
2278 1.1 christos /* lhs is A, the number to adjust */
2279 1.1 christos /* rhs is B, the number with exponent to match */
2280 1.1 christos /* set is the context */
2281 1.1 christos /* */
2282 1.1 christos /* C must have space for set->digits digits. */
2283 1.1 christos /* */
2284 1.1 christos /* Unless there is an error or the result is infinite, the exponent */
2285 1.1 christos /* after the operation is guaranteed to be equal to that of B. */
2286 1.1 christos /* ------------------------------------------------------------------ */
2287 1.1 christos decNumber * decNumberQuantize(decNumber *res, const decNumber *lhs,
2288 1.1 christos const decNumber *rhs, decContext *set) {
2289 1.1 christos uInt status=0; /* accumulator */
2290 1.1 christos decQuantizeOp(res, lhs, rhs, set, 1, &status);
2291 1.1 christos if (status!=0) decStatus(res, status, set);
2292 1.1 christos return res;
2293 1.1 christos } /* decNumberQuantize */
2294 1.1 christos
2295 1.1 christos /* ------------------------------------------------------------------ */
2296 1.1 christos /* decNumberReduce -- remove trailing zeros */
2297 1.1 christos /* */
2298 1.1 christos /* This computes C = 0 + A, and normalizes the result */
2299 1.1 christos /* */
2300 1.1 christos /* res is C, the result. C may be A */
2301 1.1 christos /* rhs is A */
2302 1.1 christos /* set is the context */
2303 1.1 christos /* */
2304 1.1 christos /* C must have space for set->digits digits. */
2305 1.1 christos /* ------------------------------------------------------------------ */
2306 1.1 christos /* Previously known as Normalize */
2307 1.1 christos decNumber * decNumberNormalize(decNumber *res, const decNumber *rhs,
2308 1.1 christos decContext *set) {
2309 1.1 christos return decNumberReduce(res, rhs, set);
2310 1.1 christos } /* decNumberNormalize */
2311 1.1 christos
2312 1.1 christos decNumber * decNumberReduce(decNumber *res, const decNumber *rhs,
2313 1.1 christos decContext *set) {
2314 1.1 christos #if DECSUBSET
2315 1.1 christos decNumber *allocrhs=NULL; /* non-NULL if rounded rhs allocated */
2316 1.1 christos #endif
2317 1.1 christos uInt status=0; /* as usual */
2318 1.1 christos Int residue=0; /* as usual */
2319 1.1 christos Int dropped; /* work */
2320 1.1 christos
2321 1.1 christos #if DECCHECK
2322 1.1 christos if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
2323 1.1 christos #endif
2324 1.1 christos
2325 1.1 christos do { /* protect allocated storage */
2326 1.1 christos #if DECSUBSET
2327 1.1 christos if (!set->extended) {
2328 1.1 christos /* reduce operand and set lostDigits status, as needed */
2329 1.1 christos if (rhs->digits>set->digits) {
2330 1.1 christos allocrhs=decRoundOperand(rhs, set, &status);
2331 1.1 christos if (allocrhs==NULL) break;
2332 1.1 christos rhs=allocrhs;
2333 1.1 christos }
2334 1.1 christos }
2335 1.1 christos #endif
2336 1.1 christos /* [following code does not require input rounding] */
2337 1.1 christos
2338 1.1 christos /* Infinities copy through; NaNs need usual treatment */
2339 1.1 christos if (decNumberIsNaN(rhs)) {
2340 1.1 christos decNaNs(res, rhs, NULL, set, &status);
2341 1.1 christos break;
2342 1.1 christos }
2343 1.1 christos
2344 1.1 christos /* reduce result to the requested length and copy to result */
2345 1.1 christos decCopyFit(res, rhs, set, &residue, &status); /* copy & round */
2346 1.1 christos decFinish(res, set, &residue, &status); /* cleanup/set flags */
2347 1.1 christos decTrim(res, set, 1, 0, &dropped); /* normalize in place */
2348 1.1 christos /* [may clamp] */
2349 1.1 christos } while(0); /* end protected */
2350 1.1 christos
2351 1.1 christos #if DECSUBSET
2352 1.1 christos free(allocrhs); /* .. */
2353 1.1 christos #endif
2354 1.1 christos if (status!=0) decStatus(res, status, set);/* then report status */
2355 1.1 christos return res;
2356 1.1 christos } /* decNumberReduce */
2357 1.1 christos
2358 1.1 christos /* ------------------------------------------------------------------ */
2359 1.1 christos /* decNumberRescale -- force exponent to requested value */
2360 1.1 christos /* */
2361 1.1 christos /* This computes C = op(A, B), where op adjusts the coefficient */
2362 1.1 christos /* of C (by rounding or shifting) such that the exponent (-scale) */
2363 1.1 christos /* of C has the value B. The numerical value of C will equal A, */
2364 1.1 christos /* except for the effects of any rounding that occurred. */
2365 1.1 christos /* */
2366 1.1 christos /* res is C, the result. C may be A or B */
2367 1.1 christos /* lhs is A, the number to adjust */
2368 1.1 christos /* rhs is B, the requested exponent */
2369 1.1 christos /* set is the context */
2370 1.1 christos /* */
2371 1.1 christos /* C must have space for set->digits digits. */
2372 1.1 christos /* */
2373 1.1 christos /* Unless there is an error or the result is infinite, the exponent */
2374 1.1 christos /* after the operation is guaranteed to be equal to B. */
2375 1.1 christos /* ------------------------------------------------------------------ */
2376 1.1 christos decNumber * decNumberRescale(decNumber *res, const decNumber *lhs,
2377 1.1 christos const decNumber *rhs, decContext *set) {
2378 1.1 christos uInt status=0; /* accumulator */
2379 1.1 christos decQuantizeOp(res, lhs, rhs, set, 0, &status);
2380 1.1 christos if (status!=0) decStatus(res, status, set);
2381 1.1 christos return res;
2382 1.1 christos } /* decNumberRescale */
2383 1.1 christos
2384 1.1 christos /* ------------------------------------------------------------------ */
2385 1.1 christos /* decNumberRemainder -- divide and return remainder */
2386 1.1 christos /* */
2387 1.1 christos /* This computes C = A % B */
2388 1.1 christos /* */
2389 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=X%X) */
2390 1.1 christos /* lhs is A */
2391 1.1 christos /* rhs is B */
2392 1.1 christos /* set is the context */
2393 1.1 christos /* */
2394 1.1 christos /* C must have space for set->digits digits. */
2395 1.1 christos /* ------------------------------------------------------------------ */
2396 1.1 christos decNumber * decNumberRemainder(decNumber *res, const decNumber *lhs,
2397 1.1 christos const decNumber *rhs, decContext *set) {
2398 1.1 christos uInt status=0; /* accumulator */
2399 1.1 christos decDivideOp(res, lhs, rhs, set, REMAINDER, &status);
2400 1.1 christos if (status!=0) decStatus(res, status, set);
2401 1.1 christos #if DECCHECK
2402 1.1 christos decCheckInexact(res, set);
2403 1.1 christos #endif
2404 1.1 christos return res;
2405 1.1 christos } /* decNumberRemainder */
2406 1.1 christos
2407 1.1 christos /* ------------------------------------------------------------------ */
2408 1.1 christos /* decNumberRemainderNear -- divide and return remainder from nearest */
2409 1.1 christos /* */
2410 1.1 christos /* This computes C = A % B, where % is the IEEE remainder operator */
2411 1.1 christos /* */
2412 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=X%X) */
2413 1.1 christos /* lhs is A */
2414 1.1 christos /* rhs is B */
2415 1.1 christos /* set is the context */
2416 1.1 christos /* */
2417 1.1 christos /* C must have space for set->digits digits. */
2418 1.1 christos /* ------------------------------------------------------------------ */
2419 1.1 christos decNumber * decNumberRemainderNear(decNumber *res, const decNumber *lhs,
2420 1.1 christos const decNumber *rhs, decContext *set) {
2421 1.1 christos uInt status=0; /* accumulator */
2422 1.1 christos decDivideOp(res, lhs, rhs, set, REMNEAR, &status);
2423 1.1 christos if (status!=0) decStatus(res, status, set);
2424 1.1 christos #if DECCHECK
2425 1.1 christos decCheckInexact(res, set);
2426 1.1 christos #endif
2427 1.1 christos return res;
2428 1.1 christos } /* decNumberRemainderNear */
2429 1.1 christos
2430 1.1 christos /* ------------------------------------------------------------------ */
2431 1.1 christos /* decNumberRotate -- rotate the coefficient of a Number left/right */
2432 1.1 christos /* */
2433 1.1 christos /* This computes C = A rot B (in base ten and rotating set->digits */
2434 1.1 christos /* digits). */
2435 1.1 christos /* */
2436 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=XrotX) */
2437 1.1 christos /* lhs is A */
2438 1.1 christos /* rhs is B, the number of digits to rotate (-ve to right) */
2439 1.1 christos /* set is the context */
2440 1.1 christos /* */
2441 1.1 christos /* The digits of the coefficient of A are rotated to the left (if B */
2442 1.1 christos /* is positive) or to the right (if B is negative) without adjusting */
2443 1.1 christos /* the exponent or the sign of A. If lhs->digits is less than */
2444 1.1 christos /* set->digits the coefficient is padded with zeros on the left */
2445 1.1 christos /* before the rotate. Any leading zeros in the result are removed */
2446 1.1 christos /* as usual. */
2447 1.1 christos /* */
2448 1.1 christos /* B must be an integer (q=0) and in the range -set->digits through */
2449 1.1 christos /* +set->digits. */
2450 1.1 christos /* C must have space for set->digits digits. */
2451 1.1 christos /* NaNs are propagated as usual. Infinities are unaffected (but */
2452 1.1 christos /* B must be valid). No status is set unless B is invalid or an */
2453 1.1 christos /* operand is an sNaN. */
2454 1.1 christos /* ------------------------------------------------------------------ */
2455 1.1 christos decNumber * decNumberRotate(decNumber *res, const decNumber *lhs,
2456 1.1 christos const decNumber *rhs, decContext *set) {
2457 1.1 christos uInt status=0; /* accumulator */
2458 1.1 christos Int rotate; /* rhs as an Int */
2459 1.1 christos
2460 1.1 christos #if DECCHECK
2461 1.1 christos if (decCheckOperands(res, lhs, rhs, set)) return res;
2462 1.1 christos #endif
2463 1.1 christos
2464 1.1 christos /* NaNs propagate as normal */
2465 1.1 christos if (decNumberIsNaN(lhs) || decNumberIsNaN(rhs))
2466 1.1 christos decNaNs(res, lhs, rhs, set, &status);
2467 1.1 christos /* rhs must be an integer */
2468 1.1 christos else if (decNumberIsInfinite(rhs) || rhs->exponent!=0)
2469 1.1 christos status=DEC_Invalid_operation;
2470 1.1 christos else { /* both numeric, rhs is an integer */
2471 1.1 christos rotate=decGetInt(rhs); /* [cannot fail] */
2472 1.1 christos if (rotate==BADINT /* something bad .. */
2473 1.1 christos || rotate==BIGODD || rotate==BIGEVEN /* .. very big .. */
2474 1.1 christos || abs(rotate)>set->digits) /* .. or out of range */
2475 1.1 christos status=DEC_Invalid_operation;
2476 1.1 christos else { /* rhs is OK */
2477 1.1 christos decNumberCopy(res, lhs);
2478 1.1 christos /* convert -ve rotate to equivalent positive rotation */
2479 1.1 christos if (rotate<0) rotate=set->digits+rotate;
2480 1.1 christos if (rotate!=0 && rotate!=set->digits /* zero or full rotation */
2481 1.1 christos && !decNumberIsInfinite(res)) { /* lhs was infinite */
2482 1.1 christos /* left-rotate to do; 0 < rotate < set->digits */
2483 1.1 christos uInt units, shift; /* work */
2484 1.1 christos uInt msudigits; /* digits in result msu */
2485 1.1 christos Unit *msu=res->lsu+D2U(res->digits)-1; /* current msu */
2486 1.1 christos Unit *msumax=res->lsu+D2U(set->digits)-1; /* rotation msu */
2487 1.1 christos for (msu++; msu<=msumax; msu++) *msu=0; /* ensure high units=0 */
2488 1.1 christos res->digits=set->digits; /* now full-length */
2489 1.1 christos msudigits=MSUDIGITS(res->digits); /* actual digits in msu */
2490 1.1 christos
2491 1.1 christos /* rotation here is done in-place, in three steps */
2492 1.1 christos /* 1. shift all to least up to one unit to unit-align final */
2493 1.1 christos /* lsd [any digits shifted out are rotated to the left, */
2494 1.1 christos /* abutted to the original msd (which may require split)] */
2495 1.1 christos /* */
2496 1.1 christos /* [if there are no whole units left to rotate, the */
2497 1.1 christos /* rotation is now complete] */
2498 1.1 christos /* */
2499 1.1 christos /* 2. shift to least, from below the split point only, so that */
2500 1.1 christos /* the final msd is in the right place in its Unit [any */
2501 1.1 christos /* digits shifted out will fit exactly in the current msu, */
2502 1.1 christos /* left aligned, no split required] */
2503 1.1 christos /* */
2504 1.1 christos /* 3. rotate all the units by reversing left part, right */
2505 1.1 christos /* part, and then whole */
2506 1.1 christos /* */
2507 1.1 christos /* example: rotate right 8 digits (2 units + 2), DECDPUN=3. */
2508 1.1 christos /* */
2509 1.1 christos /* start: 00a bcd efg hij klm npq */
2510 1.1 christos /* */
2511 1.1 christos /* 1a 000 0ab cde fgh|ijk lmn [pq saved] */
2512 1.1 christos /* 1b 00p qab cde fgh|ijk lmn */
2513 1.1 christos /* */
2514 1.1 christos /* 2a 00p qab cde fgh|00i jkl [mn saved] */
2515 1.1 christos /* 2b mnp qab cde fgh|00i jkl */
2516 1.1 christos /* */
2517 1.1 christos /* 3a fgh cde qab mnp|00i jkl */
2518 1.1 christos /* 3b fgh cde qab mnp|jkl 00i */
2519 1.1 christos /* 3c 00i jkl mnp qab cde fgh */
2520 1.1 christos
2521 1.1 christos /* Step 1: amount to shift is the partial right-rotate count */
2522 1.1 christos rotate=set->digits-rotate; /* make it right-rotate */
2523 1.1 christos units=rotate/DECDPUN; /* whole units to rotate */
2524 1.1 christos shift=rotate%DECDPUN; /* left-over digits count */
2525 1.1 christos if (shift>0) { /* not an exact number of units */
2526 1.1 christos uInt save=res->lsu[0]%powers[shift]; /* save low digit(s) */
2527 1.1 christos decShiftToLeast(res->lsu, D2U(res->digits), shift);
2528 1.1 christos if (shift>msudigits) { /* msumax-1 needs >0 digits */
2529 1.1 christos uInt rem=save%powers[shift-msudigits];/* split save */
2530 1.1 christos *msumax=(Unit)(save/powers[shift-msudigits]); /* and insert */
2531 1.1 christos *(msumax-1)=*(msumax-1)
2532 1.1 christos +(Unit)(rem*powers[DECDPUN-(shift-msudigits)]); /* .. */
2533 1.1 christos }
2534 1.1 christos else { /* all fits in msumax */
2535 1.1 christos *msumax=*msumax+(Unit)(save*powers[msudigits-shift]); /* [maybe *1] */
2536 1.1 christos }
2537 1.1 christos } /* digits shift needed */
2538 1.1 christos
2539 1.1 christos /* If whole units to rotate... */
2540 1.1 christos if (units>0) { /* some to do */
2541 1.1 christos /* Step 2: the units to touch are the whole ones in rotate, */
2542 1.1 christos /* if any, and the shift is DECDPUN-msudigits (which may be */
2543 1.1 christos /* 0, again) */
2544 1.1 christos shift=DECDPUN-msudigits;
2545 1.1 christos if (shift>0) { /* not an exact number of units */
2546 1.1 christos uInt save=res->lsu[0]%powers[shift]; /* save low digit(s) */
2547 1.1 christos decShiftToLeast(res->lsu, units, shift);
2548 1.1 christos *msumax=*msumax+(Unit)(save*powers[msudigits]);
2549 1.1 christos } /* partial shift needed */
2550 1.1 christos
2551 1.1 christos /* Step 3: rotate the units array using triple reverse */
2552 1.1 christos /* (reversing is easy and fast) */
2553 1.1 christos decReverse(res->lsu+units, msumax); /* left part */
2554 1.1 christos decReverse(res->lsu, res->lsu+units-1); /* right part */
2555 1.1 christos decReverse(res->lsu, msumax); /* whole */
2556 1.1 christos } /* whole units to rotate */
2557 1.1 christos /* the rotation may have left an undetermined number of zeros */
2558 1.1 christos /* on the left, so true length needs to be calculated */
2559 1.1 christos res->digits=decGetDigits(res->lsu, msumax-res->lsu+1);
2560 1.1 christos } /* rotate needed */
2561 1.1 christos } /* rhs OK */
2562 1.1 christos } /* numerics */
2563 1.1 christos if (status!=0) decStatus(res, status, set);
2564 1.1 christos return res;
2565 1.1 christos } /* decNumberRotate */
2566 1.1 christos
2567 1.1 christos /* ------------------------------------------------------------------ */
2568 1.1 christos /* decNumberSameQuantum -- test for equal exponents */
2569 1.1 christos /* */
2570 1.1 christos /* res is the result number, which will contain either 0 or 1 */
2571 1.1 christos /* lhs is a number to test */
2572 1.1 christos /* rhs is the second (usually a pattern) */
2573 1.1 christos /* */
2574 1.1 christos /* No errors are possible and no context is needed. */
2575 1.1 christos /* ------------------------------------------------------------------ */
2576 1.1 christos decNumber * decNumberSameQuantum(decNumber *res, const decNumber *lhs,
2577 1.1 christos const decNumber *rhs) {
2578 1.1 christos Unit ret=0; /* return value */
2579 1.1 christos
2580 1.1 christos #if DECCHECK
2581 1.1 christos if (decCheckOperands(res, lhs, rhs, DECUNCONT)) return res;
2582 1.1 christos #endif
2583 1.1 christos
2584 1.1 christos if (SPECIALARGS) {
2585 1.1 christos if (decNumberIsNaN(lhs) && decNumberIsNaN(rhs)) ret=1;
2586 1.1 christos else if (decNumberIsInfinite(lhs) && decNumberIsInfinite(rhs)) ret=1;
2587 1.1 christos /* [anything else with a special gives 0] */
2588 1.1 christos }
2589 1.1 christos else if (lhs->exponent==rhs->exponent) ret=1;
2590 1.1 christos
2591 1.1 christos decNumberZero(res); /* OK to overwrite an operand now */
2592 1.1 christos *res->lsu=ret;
2593 1.1 christos return res;
2594 1.1 christos } /* decNumberSameQuantum */
2595 1.1 christos
2596 1.1 christos /* ------------------------------------------------------------------ */
2597 1.1 christos /* decNumberScaleB -- multiply by a power of 10 */
2598 1.1 christos /* */
2599 1.1 christos /* This computes C = A x 10**B where B is an integer (q=0) with */
2600 1.1 christos /* maximum magnitude 2*(emax+digits) */
2601 1.1 christos /* */
2602 1.1 christos /* res is C, the result. C may be A or B */
2603 1.1 christos /* lhs is A, the number to adjust */
2604 1.1 christos /* rhs is B, the requested power of ten to use */
2605 1.1 christos /* set is the context */
2606 1.1 christos /* */
2607 1.1 christos /* C must have space for set->digits digits. */
2608 1.1 christos /* */
2609 1.1 christos /* The result may underflow or overflow. */
2610 1.1 christos /* ------------------------------------------------------------------ */
2611 1.1 christos decNumber * decNumberScaleB(decNumber *res, const decNumber *lhs,
2612 1.1 christos const decNumber *rhs, decContext *set) {
2613 1.1 christos Int reqexp; /* requested exponent change [B] */
2614 1.1 christos uInt status=0; /* accumulator */
2615 1.1 christos Int residue; /* work */
2616 1.1 christos
2617 1.1 christos #if DECCHECK
2618 1.1 christos if (decCheckOperands(res, lhs, rhs, set)) return res;
2619 1.1 christos #endif
2620 1.1 christos
2621 1.1 christos /* Handle special values except lhs infinite */
2622 1.1 christos if (decNumberIsNaN(lhs) || decNumberIsNaN(rhs))
2623 1.1 christos decNaNs(res, lhs, rhs, set, &status);
2624 1.1 christos /* rhs must be an integer */
2625 1.1 christos else if (decNumberIsInfinite(rhs) || rhs->exponent!=0)
2626 1.1 christos status=DEC_Invalid_operation;
2627 1.1 christos else {
2628 1.1 christos /* lhs is a number; rhs is a finite with q==0 */
2629 1.1 christos reqexp=decGetInt(rhs); /* [cannot fail] */
2630 1.1 christos if (reqexp==BADINT /* something bad .. */
2631 1.1 christos || reqexp==BIGODD || reqexp==BIGEVEN /* .. very big .. */
2632 1.1 christos || abs(reqexp)>(2*(set->digits+set->emax))) /* .. or out of range */
2633 1.1 christos status=DEC_Invalid_operation;
2634 1.1 christos else { /* rhs is OK */
2635 1.1 christos decNumberCopy(res, lhs); /* all done if infinite lhs */
2636 1.1 christos if (!decNumberIsInfinite(res)) { /* prepare to scale */
2637 1.1 christos res->exponent+=reqexp; /* adjust the exponent */
2638 1.1 christos residue=0;
2639 1.1 christos decFinalize(res, set, &residue, &status); /* .. and check */
2640 1.1 christos } /* finite LHS */
2641 1.1 christos } /* rhs OK */
2642 1.1 christos } /* rhs finite */
2643 1.1 christos if (status!=0) decStatus(res, status, set);
2644 1.1 christos return res;
2645 1.1 christos } /* decNumberScaleB */
2646 1.1 christos
2647 1.1 christos /* ------------------------------------------------------------------ */
2648 1.1 christos /* decNumberShift -- shift the coefficient of a Number left or right */
2649 1.1 christos /* */
2650 1.1 christos /* This computes C = A << B or C = A >> -B (in base ten). */
2651 1.1 christos /* */
2652 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=X<<X) */
2653 1.1 christos /* lhs is A */
2654 1.1 christos /* rhs is B, the number of digits to shift (-ve to right) */
2655 1.1 christos /* set is the context */
2656 1.1 christos /* */
2657 1.1 christos /* The digits of the coefficient of A are shifted to the left (if B */
2658 1.1 christos /* is positive) or to the right (if B is negative) without adjusting */
2659 1.1 christos /* the exponent or the sign of A. */
2660 1.1 christos /* */
2661 1.1 christos /* B must be an integer (q=0) and in the range -set->digits through */
2662 1.1 christos /* +set->digits. */
2663 1.1 christos /* C must have space for set->digits digits. */
2664 1.1 christos /* NaNs are propagated as usual. Infinities are unaffected (but */
2665 1.1 christos /* B must be valid). No status is set unless B is invalid or an */
2666 1.1 christos /* operand is an sNaN. */
2667 1.1 christos /* ------------------------------------------------------------------ */
2668 1.1 christos decNumber * decNumberShift(decNumber *res, const decNumber *lhs,
2669 1.1 christos const decNumber *rhs, decContext *set) {
2670 1.1 christos uInt status=0; /* accumulator */
2671 1.1 christos Int shift; /* rhs as an Int */
2672 1.1 christos
2673 1.1 christos #if DECCHECK
2674 1.1 christos if (decCheckOperands(res, lhs, rhs, set)) return res;
2675 1.1 christos #endif
2676 1.1 christos
2677 1.1 christos /* NaNs propagate as normal */
2678 1.1 christos if (decNumberIsNaN(lhs) || decNumberIsNaN(rhs))
2679 1.1 christos decNaNs(res, lhs, rhs, set, &status);
2680 1.1 christos /* rhs must be an integer */
2681 1.1 christos else if (decNumberIsInfinite(rhs) || rhs->exponent!=0)
2682 1.1 christos status=DEC_Invalid_operation;
2683 1.1 christos else { /* both numeric, rhs is an integer */
2684 1.1 christos shift=decGetInt(rhs); /* [cannot fail] */
2685 1.1 christos if (shift==BADINT /* something bad .. */
2686 1.1 christos || shift==BIGODD || shift==BIGEVEN /* .. very big .. */
2687 1.1 christos || abs(shift)>set->digits) /* .. or out of range */
2688 1.1 christos status=DEC_Invalid_operation;
2689 1.1 christos else { /* rhs is OK */
2690 1.1 christos decNumberCopy(res, lhs);
2691 1.1 christos if (shift!=0 && !decNumberIsInfinite(res)) { /* something to do */
2692 1.1 christos if (shift>0) { /* to left */
2693 1.1 christos if (shift==set->digits) { /* removing all */
2694 1.1 christos *res->lsu=0; /* so place 0 */
2695 1.1 christos res->digits=1; /* .. */
2696 1.1 christos }
2697 1.1 christos else { /* */
2698 1.1 christos /* first remove leading digits if necessary */
2699 1.1 christos if (res->digits+shift>set->digits) {
2700 1.1 christos decDecap(res, res->digits+shift-set->digits);
2701 1.1 christos /* that updated res->digits; may have gone to 1 (for a */
2702 1.1 christos /* single digit or for zero */
2703 1.1 christos }
2704 1.1 christos if (res->digits>1 || *res->lsu) /* if non-zero.. */
2705 1.1 christos res->digits=decShiftToMost(res->lsu, res->digits, shift);
2706 1.1 christos } /* partial left */
2707 1.1 christos } /* left */
2708 1.1 christos else { /* to right */
2709 1.1 christos if (-shift>=res->digits) { /* discarding all */
2710 1.1 christos *res->lsu=0; /* so place 0 */
2711 1.1 christos res->digits=1; /* .. */
2712 1.1 christos }
2713 1.1 christos else {
2714 1.1 christos decShiftToLeast(res->lsu, D2U(res->digits), -shift);
2715 1.1 christos res->digits-=(-shift);
2716 1.1 christos }
2717 1.1 christos } /* to right */
2718 1.1 christos } /* non-0 non-Inf shift */
2719 1.1 christos } /* rhs OK */
2720 1.1 christos } /* numerics */
2721 1.1 christos if (status!=0) decStatus(res, status, set);
2722 1.1 christos return res;
2723 1.1 christos } /* decNumberShift */
2724 1.1 christos
2725 1.1 christos /* ------------------------------------------------------------------ */
2726 1.1 christos /* decNumberSquareRoot -- square root operator */
2727 1.1 christos /* */
2728 1.1 christos /* This computes C = squareroot(A) */
2729 1.1 christos /* */
2730 1.1 christos /* res is C, the result. C may be A */
2731 1.1 christos /* rhs is A */
2732 1.1 christos /* set is the context; note that rounding mode has no effect */
2733 1.1 christos /* */
2734 1.1 christos /* C must have space for set->digits digits. */
2735 1.1 christos /* ------------------------------------------------------------------ */
2736 1.1 christos /* This uses the following varying-precision algorithm in: */
2737 1.1 christos /* */
2738 1.1 christos /* Properly Rounded Variable Precision Square Root, T. E. Hull and */
2739 1.1 christos /* A. Abrham, ACM Transactions on Mathematical Software, Vol 11 #3, */
2740 1.1 christos /* pp229-237, ACM, September 1985. */
2741 1.1 christos /* */
2742 1.1 christos /* The square-root is calculated using Newton's method, after which */
2743 1.1 christos /* a check is made to ensure the result is correctly rounded. */
2744 1.1 christos /* */
2745 1.1 christos /* % [Reformatted original Numerical Turing source code follows.] */
2746 1.1 christos /* function sqrt(x : real) : real */
2747 1.1 christos /* % sqrt(x) returns the properly rounded approximation to the square */
2748 1.1 christos /* % root of x, in the precision of the calling environment, or it */
2749 1.1 christos /* % fails if x < 0. */
2750 1.1 christos /* % t e hull and a abrham, august, 1984 */
2751 1.1 christos /* if x <= 0 then */
2752 1.1 christos /* if x < 0 then */
2753 1.1 christos /* assert false */
2754 1.1 christos /* else */
2755 1.1 christos /* result 0 */
2756 1.1 christos /* end if */
2757 1.1 christos /* end if */
2758 1.1 christos /* var f := setexp(x, 0) % fraction part of x [0.1 <= x < 1] */
2759 1.1 christos /* var e := getexp(x) % exponent part of x */
2760 1.1 christos /* var approx : real */
2761 1.1 christos /* if e mod 2 = 0 then */
2762 1.1 christos /* approx := .259 + .819 * f % approx to root of f */
2763 1.1 christos /* else */
2764 1.1 christos /* f := f/l0 % adjustments */
2765 1.1 christos /* e := e + 1 % for odd */
2766 1.1 christos /* approx := .0819 + 2.59 * f % exponent */
2767 1.1 christos /* end if */
2768 1.1 christos /* */
2769 1.1 christos /* var p:= 3 */
2770 1.1 christos /* const maxp := currentprecision + 2 */
2771 1.1 christos /* loop */
2772 1.1 christos /* p := min(2*p - 2, maxp) % p = 4,6,10, . . . , maxp */
2773 1.1 christos /* precision p */
2774 1.1 christos /* approx := .5 * (approx + f/approx) */
2775 1.1 christos /* exit when p = maxp */
2776 1.1 christos /* end loop */
2777 1.1 christos /* */
2778 1.1 christos /* % approx is now within 1 ulp of the properly rounded square root */
2779 1.1 christos /* % of f; to ensure proper rounding, compare squares of (approx - */
2780 1.1 christos /* % l/2 ulp) and (approx + l/2 ulp) with f. */
2781 1.1 christos /* p := currentprecision */
2782 1.1 christos /* begin */
2783 1.1 christos /* precision p + 2 */
2784 1.1 christos /* const approxsubhalf := approx - setexp(.5, -p) */
2785 1.1 christos /* if mulru(approxsubhalf, approxsubhalf) > f then */
2786 1.1 christos /* approx := approx - setexp(.l, -p + 1) */
2787 1.1 christos /* else */
2788 1.1 christos /* const approxaddhalf := approx + setexp(.5, -p) */
2789 1.1 christos /* if mulrd(approxaddhalf, approxaddhalf) < f then */
2790 1.1 christos /* approx := approx + setexp(.l, -p + 1) */
2791 1.1 christos /* end if */
2792 1.1 christos /* end if */
2793 1.1 christos /* end */
2794 1.1 christos /* result setexp(approx, e div 2) % fix exponent */
2795 1.1 christos /* end sqrt */
2796 1.1 christos /* ------------------------------------------------------------------ */
2797 1.1 christos decNumber * decNumberSquareRoot(decNumber *res, const decNumber *rhs,
2798 1.1 christos decContext *set) {
2799 1.1 christos decContext workset, approxset; /* work contexts */
2800 1.1 christos decNumber dzero; /* used for constant zero */
2801 1.1 christos Int maxp; /* largest working precision */
2802 1.1 christos Int workp; /* working precision */
2803 1.1 christos Int residue=0; /* rounding residue */
2804 1.1 christos uInt status=0, ignore=0; /* status accumulators */
2805 1.1 christos uInt rstatus; /* .. */
2806 1.1 christos Int exp; /* working exponent */
2807 1.1 christos Int ideal; /* ideal (preferred) exponent */
2808 1.1 christos Int needbytes; /* work */
2809 1.1 christos Int dropped; /* .. */
2810 1.1 christos
2811 1.1 christos #if DECSUBSET
2812 1.1 christos decNumber *allocrhs=NULL; /* non-NULL if rounded rhs allocated */
2813 1.1 christos #endif
2814 1.1 christos /* buffer for f [needs +1 in case DECBUFFER 0] */
2815 1.1 christos decNumber buff[D2N(DECBUFFER+1)];
2816 1.1 christos /* buffer for a [needs +2 to match likely maxp] */
2817 1.1 christos decNumber bufa[D2N(DECBUFFER+2)];
2818 1.1 christos /* buffer for temporary, b [must be same size as a] */
2819 1.1 christos decNumber bufb[D2N(DECBUFFER+2)];
2820 1.1 christos decNumber *allocbuff=NULL; /* -> allocated buff, iff allocated */
2821 1.1 christos decNumber *allocbufa=NULL; /* -> allocated bufa, iff allocated */
2822 1.1 christos decNumber *allocbufb=NULL; /* -> allocated bufb, iff allocated */
2823 1.1 christos decNumber *f=buff; /* reduced fraction */
2824 1.1 christos decNumber *a=bufa; /* approximation to result */
2825 1.1 christos decNumber *b=bufb; /* intermediate result */
2826 1.1 christos /* buffer for temporary variable, up to 3 digits */
2827 1.1 christos decNumber buft[D2N(3)];
2828 1.1 christos decNumber *t=buft; /* up-to-3-digit constant or work */
2829 1.1 christos
2830 1.1 christos #if DECCHECK
2831 1.1 christos if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
2832 1.1 christos #endif
2833 1.1 christos
2834 1.1 christos do { /* protect allocated storage */
2835 1.1 christos #if DECSUBSET
2836 1.1 christos if (!set->extended) {
2837 1.1 christos /* reduce operand and set lostDigits status, as needed */
2838 1.1 christos if (rhs->digits>set->digits) {
2839 1.1 christos allocrhs=decRoundOperand(rhs, set, &status);
2840 1.1 christos if (allocrhs==NULL) break;
2841 1.1 christos /* [Note: 'f' allocation below could reuse this buffer if */
2842 1.1 christos /* used, but as this is rare they are kept separate for clarity.] */
2843 1.1 christos rhs=allocrhs;
2844 1.1 christos }
2845 1.1 christos }
2846 1.1 christos #endif
2847 1.1 christos /* [following code does not require input rounding] */
2848 1.1 christos
2849 1.1 christos /* handle infinities and NaNs */
2850 1.1 christos if (SPECIALARG) {
2851 1.1 christos if (decNumberIsInfinite(rhs)) { /* an infinity */
2852 1.1 christos if (decNumberIsNegative(rhs)) status|=DEC_Invalid_operation;
2853 1.1 christos else decNumberCopy(res, rhs); /* +Infinity */
2854 1.1 christos }
2855 1.1 christos else decNaNs(res, rhs, NULL, set, &status); /* a NaN */
2856 1.1 christos break;
2857 1.1 christos }
2858 1.1 christos
2859 1.1 christos /* calculate the ideal (preferred) exponent [floor(exp/2)] */
2860 1.1 christos /* [It would be nicer to write: ideal=rhs->exponent>>1, but this */
2861 1.1 christos /* generates a compiler warning. Generated code is the same.] */
2862 1.1 christos ideal=(rhs->exponent&~1)/2; /* target */
2863 1.1 christos
2864 1.1 christos /* handle zeros */
2865 1.1 christos if (ISZERO(rhs)) {
2866 1.1 christos decNumberCopy(res, rhs); /* could be 0 or -0 */
2867 1.1 christos res->exponent=ideal; /* use the ideal [safe] */
2868 1.1 christos /* use decFinish to clamp any out-of-range exponent, etc. */
2869 1.1 christos decFinish(res, set, &residue, &status);
2870 1.1 christos break;
2871 1.1 christos }
2872 1.1 christos
2873 1.1 christos /* any other -x is an oops */
2874 1.1 christos if (decNumberIsNegative(rhs)) {
2875 1.1 christos status|=DEC_Invalid_operation;
2876 1.1 christos break;
2877 1.1 christos }
2878 1.1 christos
2879 1.1 christos /* space is needed for three working variables */
2880 1.1 christos /* f -- the same precision as the RHS, reduced to 0.01->0.99... */
2881 1.1 christos /* a -- Hull's approximation -- precision, when assigned, is */
2882 1.1 christos /* currentprecision+1 or the input argument precision, */
2883 1.1 christos /* whichever is larger (+2 for use as temporary) */
2884 1.1 christos /* b -- intermediate temporary result (same size as a) */
2885 1.1 christos /* if any is too long for local storage, then allocate */
2886 1.1 christos workp=MAXI(set->digits+1, rhs->digits); /* actual rounding precision */
2887 1.1 christos workp=MAXI(workp, 7); /* at least 7 for low cases */
2888 1.1 christos maxp=workp+2; /* largest working precision */
2889 1.1 christos
2890 1.1 christos needbytes=sizeof(decNumber)+(D2U(rhs->digits)-1)*sizeof(Unit);
2891 1.1 christos if (needbytes>(Int)sizeof(buff)) {
2892 1.1 christos allocbuff=(decNumber *)malloc(needbytes);
2893 1.1 christos if (allocbuff==NULL) { /* hopeless -- abandon */
2894 1.1 christos status|=DEC_Insufficient_storage;
2895 1.1 christos break;}
2896 1.1 christos f=allocbuff; /* use the allocated space */
2897 1.1 christos }
2898 1.1 christos /* a and b both need to be able to hold a maxp-length number */
2899 1.1 christos needbytes=sizeof(decNumber)+(D2U(maxp)-1)*sizeof(Unit);
2900 1.1 christos if (needbytes>(Int)sizeof(bufa)) { /* [same applies to b] */
2901 1.1 christos allocbufa=(decNumber *)malloc(needbytes);
2902 1.1 christos allocbufb=(decNumber *)malloc(needbytes);
2903 1.1 christos if (allocbufa==NULL || allocbufb==NULL) { /* hopeless */
2904 1.1 christos status|=DEC_Insufficient_storage;
2905 1.1 christos break;}
2906 1.1 christos a=allocbufa; /* use the allocated spaces */
2907 1.1 christos b=allocbufb; /* .. */
2908 1.1 christos }
2909 1.1 christos
2910 1.1 christos /* copy rhs -> f, save exponent, and reduce so 0.1 <= f < 1 */
2911 1.1 christos decNumberCopy(f, rhs);
2912 1.1 christos exp=f->exponent+f->digits; /* adjusted to Hull rules */
2913 1.1 christos f->exponent=-(f->digits); /* to range */
2914 1.1 christos
2915 1.1 christos /* set up working context */
2916 1.1 christos decContextDefault(&workset, DEC_INIT_DECIMAL64);
2917 1.1 christos workset.emax=DEC_MAX_EMAX;
2918 1.1 christos workset.emin=DEC_MIN_EMIN;
2919 1.1 christos
2920 1.1 christos /* [Until further notice, no error is possible and status bits */
2921 1.1 christos /* (Rounded, etc.) should be ignored, not accumulated.] */
2922 1.1 christos
2923 1.1 christos /* Calculate initial approximation, and allow for odd exponent */
2924 1.1 christos workset.digits=workp; /* p for initial calculation */
2925 1.1 christos t->bits=0; t->digits=3;
2926 1.1 christos a->bits=0; a->digits=3;
2927 1.1 christos if ((exp & 1)==0) { /* even exponent */
2928 1.1 christos /* Set t=0.259, a=0.819 */
2929 1.1 christos t->exponent=-3;
2930 1.1 christos a->exponent=-3;
2931 1.1 christos #if DECDPUN>=3
2932 1.1 christos t->lsu[0]=259;
2933 1.1 christos a->lsu[0]=819;
2934 1.1 christos #elif DECDPUN==2
2935 1.1 christos t->lsu[0]=59; t->lsu[1]=2;
2936 1.1 christos a->lsu[0]=19; a->lsu[1]=8;
2937 1.1 christos #else
2938 1.1 christos t->lsu[0]=9; t->lsu[1]=5; t->lsu[2]=2;
2939 1.1 christos a->lsu[0]=9; a->lsu[1]=1; a->lsu[2]=8;
2940 1.1 christos #endif
2941 1.1 christos }
2942 1.1 christos else { /* odd exponent */
2943 1.1 christos /* Set t=0.0819, a=2.59 */
2944 1.1 christos f->exponent--; /* f=f/10 */
2945 1.1 christos exp++; /* e=e+1 */
2946 1.1 christos t->exponent=-4;
2947 1.1 christos a->exponent=-2;
2948 1.1 christos #if DECDPUN>=3
2949 1.1 christos t->lsu[0]=819;
2950 1.1 christos a->lsu[0]=259;
2951 1.1 christos #elif DECDPUN==2
2952 1.1 christos t->lsu[0]=19; t->lsu[1]=8;
2953 1.1 christos a->lsu[0]=59; a->lsu[1]=2;
2954 1.1 christos #else
2955 1.1 christos t->lsu[0]=9; t->lsu[1]=1; t->lsu[2]=8;
2956 1.1 christos a->lsu[0]=9; a->lsu[1]=5; a->lsu[2]=2;
2957 1.1 christos #endif
2958 1.1 christos }
2959 1.1 christos
2960 1.1 christos decMultiplyOp(a, a, f, &workset, &ignore); /* a=a*f */
2961 1.1 christos decAddOp(a, a, t, &workset, 0, &ignore); /* ..+t */
2962 1.1 christos /* [a is now the initial approximation for sqrt(f), calculated with */
2963 1.1 christos /* currentprecision, which is also a's precision.] */
2964 1.1 christos
2965 1.1 christos /* the main calculation loop */
2966 1.1 christos decNumberZero(&dzero); /* make 0 */
2967 1.1 christos decNumberZero(t); /* set t = 0.5 */
2968 1.1 christos t->lsu[0]=5; /* .. */
2969 1.1 christos t->exponent=-1; /* .. */
2970 1.1 christos workset.digits=3; /* initial p */
2971 1.1 christos for (; workset.digits<maxp;) {
2972 1.1 christos /* set p to min(2*p - 2, maxp) [hence 3; or: 4, 6, 10, ... , maxp] */
2973 1.1 christos workset.digits=MINI(workset.digits*2-2, maxp);
2974 1.1 christos /* a = 0.5 * (a + f/a) */
2975 1.1 christos /* [calculated at p then rounded to currentprecision] */
2976 1.1 christos decDivideOp(b, f, a, &workset, DIVIDE, &ignore); /* b=f/a */
2977 1.1 christos decAddOp(b, b, a, &workset, 0, &ignore); /* b=b+a */
2978 1.1 christos decMultiplyOp(a, b, t, &workset, &ignore); /* a=b*0.5 */
2979 1.1 christos } /* loop */
2980 1.1 christos
2981 1.1 christos /* Here, 0.1 <= a < 1 [Hull], and a has maxp digits */
2982 1.1 christos /* now reduce to length, etc.; this needs to be done with a */
2983 1.1 christos /* having the correct exponent so as to handle subnormals */
2984 1.1 christos /* correctly */
2985 1.1 christos approxset=*set; /* get emin, emax, etc. */
2986 1.1 christos approxset.round=DEC_ROUND_HALF_EVEN;
2987 1.1 christos a->exponent+=exp/2; /* set correct exponent */
2988 1.1 christos rstatus=0; /* clear status */
2989 1.1 christos residue=0; /* .. and accumulator */
2990 1.1 christos decCopyFit(a, a, &approxset, &residue, &rstatus); /* reduce (if needed) */
2991 1.1 christos decFinish(a, &approxset, &residue, &rstatus); /* clean and finalize */
2992 1.1 christos
2993 1.1 christos /* Overflow was possible if the input exponent was out-of-range, */
2994 1.1 christos /* in which case quit */
2995 1.1 christos if (rstatus&DEC_Overflow) {
2996 1.1 christos status=rstatus; /* use the status as-is */
2997 1.1 christos decNumberCopy(res, a); /* copy to result */
2998 1.1 christos break;
2999 1.1 christos }
3000 1.1 christos
3001 1.1 christos /* Preserve status except Inexact/Rounded */
3002 1.1 christos status|=(rstatus & ~(DEC_Rounded|DEC_Inexact));
3003 1.1 christos
3004 1.1 christos /* Carry out the Hull correction */
3005 1.1 christos a->exponent-=exp/2; /* back to 0.1->1 */
3006 1.1 christos
3007 1.1 christos /* a is now at final precision and within 1 ulp of the properly */
3008 1.1 christos /* rounded square root of f; to ensure proper rounding, compare */
3009 1.1 christos /* squares of (a - l/2 ulp) and (a + l/2 ulp) with f. */
3010 1.1 christos /* Here workset.digits=maxp and t=0.5, and a->digits determines */
3011 1.1 christos /* the ulp */
3012 1.1 christos workset.digits--; /* maxp-1 is OK now */
3013 1.1 christos t->exponent=-a->digits-1; /* make 0.5 ulp */
3014 1.1 christos decAddOp(b, a, t, &workset, DECNEG, &ignore); /* b = a - 0.5 ulp */
3015 1.1 christos workset.round=DEC_ROUND_UP;
3016 1.1 christos decMultiplyOp(b, b, b, &workset, &ignore); /* b = mulru(b, b) */
3017 1.1 christos decCompareOp(b, f, b, &workset, COMPARE, &ignore); /* b ? f, reversed */
3018 1.1 christos if (decNumberIsNegative(b)) { /* f < b [i.e., b > f] */
3019 1.1 christos /* this is the more common adjustment, though both are rare */
3020 1.1 christos t->exponent++; /* make 1.0 ulp */
3021 1.1 christos t->lsu[0]=1; /* .. */
3022 1.1 christos decAddOp(a, a, t, &workset, DECNEG, &ignore); /* a = a - 1 ulp */
3023 1.1 christos /* assign to approx [round to length] */
3024 1.1 christos approxset.emin-=exp/2; /* adjust to match a */
3025 1.1 christos approxset.emax-=exp/2;
3026 1.1 christos decAddOp(a, &dzero, a, &approxset, 0, &ignore);
3027 1.1 christos }
3028 1.1 christos else {
3029 1.1 christos decAddOp(b, a, t, &workset, 0, &ignore); /* b = a + 0.5 ulp */
3030 1.1 christos workset.round=DEC_ROUND_DOWN;
3031 1.1 christos decMultiplyOp(b, b, b, &workset, &ignore); /* b = mulrd(b, b) */
3032 1.1 christos decCompareOp(b, b, f, &workset, COMPARE, &ignore); /* b ? f */
3033 1.1 christos if (decNumberIsNegative(b)) { /* b < f */
3034 1.1 christos t->exponent++; /* make 1.0 ulp */
3035 1.1 christos t->lsu[0]=1; /* .. */
3036 1.1 christos decAddOp(a, a, t, &workset, 0, &ignore); /* a = a + 1 ulp */
3037 1.1 christos /* assign to approx [round to length] */
3038 1.1 christos approxset.emin-=exp/2; /* adjust to match a */
3039 1.1 christos approxset.emax-=exp/2;
3040 1.1 christos decAddOp(a, &dzero, a, &approxset, 0, &ignore);
3041 1.1 christos }
3042 1.1 christos }
3043 1.1 christos /* [no errors are possible in the above, and rounding/inexact during */
3044 1.1 christos /* estimation are irrelevant, so status was not accumulated] */
3045 1.1 christos
3046 1.1 christos /* Here, 0.1 <= a < 1 (still), so adjust back */
3047 1.1 christos a->exponent+=exp/2; /* set correct exponent */
3048 1.1 christos
3049 1.1 christos /* count droppable zeros [after any subnormal rounding] by */
3050 1.1 christos /* trimming a copy */
3051 1.1 christos decNumberCopy(b, a);
3052 1.1 christos decTrim(b, set, 1, 1, &dropped); /* [drops trailing zeros] */
3053 1.1 christos
3054 1.1 christos /* Set Inexact and Rounded. The answer can only be exact if */
3055 1.1 christos /* it is short enough so that squaring it could fit in workp */
3056 1.1 christos /* digits, so this is the only (relatively rare) condition that */
3057 1.1 christos /* a careful check is needed */
3058 1.1 christos if (b->digits*2-1 > workp) { /* cannot fit */
3059 1.1 christos status|=DEC_Inexact|DEC_Rounded;
3060 1.1 christos }
3061 1.1 christos else { /* could be exact/unrounded */
3062 1.1 christos uInt mstatus=0; /* local status */
3063 1.1 christos decMultiplyOp(b, b, b, &workset, &mstatus); /* try the multiply */
3064 1.1 christos if (mstatus&DEC_Overflow) { /* result just won't fit */
3065 1.1 christos status|=DEC_Inexact|DEC_Rounded;
3066 1.1 christos }
3067 1.1 christos else { /* plausible */
3068 1.1 christos decCompareOp(t, b, rhs, &workset, COMPARE, &mstatus); /* b ? rhs */
3069 1.1 christos if (!ISZERO(t)) status|=DEC_Inexact|DEC_Rounded; /* not equal */
3070 1.1 christos else { /* is Exact */
3071 1.1 christos /* here, dropped is the count of trailing zeros in 'a' */
3072 1.1 christos /* use closest exponent to ideal... */
3073 1.1 christos Int todrop=ideal-a->exponent; /* most that can be dropped */
3074 1.1 christos if (todrop<0) status|=DEC_Rounded; /* ideally would add 0s */
3075 1.1 christos else { /* unrounded */
3076 1.1 christos /* there are some to drop, but emax may not allow all */
3077 1.1 christos Int maxexp=set->emax-set->digits+1;
3078 1.1 christos Int maxdrop=maxexp-a->exponent;
3079 1.1 christos if (todrop>maxdrop && set->clamp) { /* apply clamping */
3080 1.1 christos todrop=maxdrop;
3081 1.1 christos status|=DEC_Clamped;
3082 1.1 christos }
3083 1.1 christos if (dropped<todrop) { /* clamp to those available */
3084 1.1 christos todrop=dropped;
3085 1.1 christos status|=DEC_Clamped;
3086 1.1 christos }
3087 1.1 christos if (todrop>0) { /* have some to drop */
3088 1.1 christos decShiftToLeast(a->lsu, D2U(a->digits), todrop);
3089 1.1 christos a->exponent+=todrop; /* maintain numerical value */
3090 1.1 christos a->digits-=todrop; /* new length */
3091 1.1 christos }
3092 1.1 christos }
3093 1.1 christos }
3094 1.1 christos }
3095 1.1 christos }
3096 1.1 christos
3097 1.1 christos /* double-check Underflow, as perhaps the result could not have */
3098 1.1 christos /* been subnormal (initial argument too big), or it is now Exact */
3099 1.1 christos if (status&DEC_Underflow) {
3100 1.1 christos Int ae=rhs->exponent+rhs->digits-1; /* adjusted exponent */
3101 1.1 christos /* check if truly subnormal */
3102 1.1 christos #if DECEXTFLAG /* DEC_Subnormal too */
3103 1.1 christos if (ae>=set->emin*2) status&=~(DEC_Subnormal|DEC_Underflow);
3104 1.1 christos #else
3105 1.1 christos if (ae>=set->emin*2) status&=~DEC_Underflow;
3106 1.1 christos #endif
3107 1.1 christos /* check if truly inexact */
3108 1.1 christos if (!(status&DEC_Inexact)) status&=~DEC_Underflow;
3109 1.1 christos }
3110 1.1 christos
3111 1.1 christos decNumberCopy(res, a); /* a is now the result */
3112 1.1 christos } while(0); /* end protected */
3113 1.1 christos
3114 1.1 christos free(allocbuff); /* drop any storage used */
3115 1.1 christos free(allocbufa); /* .. */
3116 1.1 christos free(allocbufb); /* .. */
3117 1.1 christos #if DECSUBSET
3118 1.1 christos free(allocrhs); /* .. */
3119 1.1 christos #endif
3120 1.1 christos if (status!=0) decStatus(res, status, set);/* then report status */
3121 1.1 christos #if DECCHECK
3122 1.1 christos decCheckInexact(res, set);
3123 1.1 christos #endif
3124 1.1 christos return res;
3125 1.1 christos } /* decNumberSquareRoot */
3126 1.1 christos
3127 1.1 christos /* ------------------------------------------------------------------ */
3128 1.1 christos /* decNumberSubtract -- subtract two Numbers */
3129 1.1 christos /* */
3130 1.1 christos /* This computes C = A - B */
3131 1.1 christos /* */
3132 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=X-X) */
3133 1.1 christos /* lhs is A */
3134 1.1 christos /* rhs is B */
3135 1.1 christos /* set is the context */
3136 1.1 christos /* */
3137 1.1 christos /* C must have space for set->digits digits. */
3138 1.1 christos /* ------------------------------------------------------------------ */
3139 1.1 christos decNumber * decNumberSubtract(decNumber *res, const decNumber *lhs,
3140 1.1 christos const decNumber *rhs, decContext *set) {
3141 1.1 christos uInt status=0; /* accumulator */
3142 1.1 christos
3143 1.1 christos decAddOp(res, lhs, rhs, set, DECNEG, &status);
3144 1.1 christos if (status!=0) decStatus(res, status, set);
3145 1.1 christos #if DECCHECK
3146 1.1 christos decCheckInexact(res, set);
3147 1.1 christos #endif
3148 1.1 christos return res;
3149 1.1 christos } /* decNumberSubtract */
3150 1.1 christos
3151 1.1 christos /* ------------------------------------------------------------------ */
3152 1.1 christos /* decNumberToIntegralExact -- round-to-integral-value with InExact */
3153 1.1 christos /* decNumberToIntegralValue -- round-to-integral-value */
3154 1.1 christos /* */
3155 1.1 christos /* res is the result */
3156 1.1 christos /* rhs is input number */
3157 1.1 christos /* set is the context */
3158 1.1 christos /* */
3159 1.1 christos /* res must have space for any value of rhs. */
3160 1.1 christos /* */
3161 1.1 christos /* This implements the IEEE special operators and therefore treats */
3162 1.1 christos /* special values as valid. For finite numbers it returns */
3163 1.1 christos /* rescale(rhs, 0) if rhs->exponent is <0. */
3164 1.1 christos /* Otherwise the result is rhs (so no error is possible, except for */
3165 1.1 christos /* sNaN). */
3166 1.1 christos /* */
3167 1.1 christos /* The context is used for rounding mode and status after sNaN, but */
3168 1.1 christos /* the digits setting is ignored. The Exact version will signal */
3169 1.1 christos /* Inexact if the result differs numerically from rhs; the other */
3170 1.1 christos /* never signals Inexact. */
3171 1.1 christos /* ------------------------------------------------------------------ */
3172 1.1 christos decNumber * decNumberToIntegralExact(decNumber *res, const decNumber *rhs,
3173 1.1 christos decContext *set) {
3174 1.1 christos decNumber dn;
3175 1.1 christos decContext workset; /* working context */
3176 1.1 christos uInt status=0; /* accumulator */
3177 1.1 christos
3178 1.1 christos #if DECCHECK
3179 1.1 christos if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
3180 1.1 christos #endif
3181 1.1 christos
3182 1.1 christos /* handle infinities and NaNs */
3183 1.1 christos if (SPECIALARG) {
3184 1.1 christos if (decNumberIsInfinite(rhs)) decNumberCopy(res, rhs); /* an Infinity */
3185 1.1 christos else decNaNs(res, rhs, NULL, set, &status); /* a NaN */
3186 1.1 christos }
3187 1.1 christos else { /* finite */
3188 1.1 christos /* have a finite number; no error possible (res must be big enough) */
3189 1.1 christos if (rhs->exponent>=0) return decNumberCopy(res, rhs);
3190 1.1 christos /* that was easy, but if negative exponent there is work to do... */
3191 1.1 christos workset=*set; /* clone rounding, etc. */
3192 1.1 christos workset.digits=rhs->digits; /* no length rounding */
3193 1.1 christos workset.traps=0; /* no traps */
3194 1.1 christos decNumberZero(&dn); /* make a number with exponent 0 */
3195 1.1 christos decNumberQuantize(res, rhs, &dn, &workset);
3196 1.1 christos status|=workset.status;
3197 1.1 christos }
3198 1.1 christos if (status!=0) decStatus(res, status, set);
3199 1.1 christos return res;
3200 1.1 christos } /* decNumberToIntegralExact */
3201 1.1 christos
3202 1.1 christos decNumber * decNumberToIntegralValue(decNumber *res, const decNumber *rhs,
3203 1.1 christos decContext *set) {
3204 1.1 christos decContext workset=*set; /* working context */
3205 1.1 christos workset.traps=0; /* no traps */
3206 1.1 christos decNumberToIntegralExact(res, rhs, &workset);
3207 1.1 christos /* this never affects set, except for sNaNs; NaN will have been set */
3208 1.1 christos /* or propagated already, so no need to call decStatus */
3209 1.1 christos set->status|=workset.status&DEC_Invalid_operation;
3210 1.1 christos return res;
3211 1.1 christos } /* decNumberToIntegralValue */
3212 1.1 christos
3213 1.1 christos /* ------------------------------------------------------------------ */
3214 1.1 christos /* decNumberXor -- XOR two Numbers, digitwise */
3215 1.1 christos /* */
3216 1.1 christos /* This computes C = A ^ B */
3217 1.1 christos /* */
3218 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=X^X) */
3219 1.1 christos /* lhs is A */
3220 1.1 christos /* rhs is B */
3221 1.1 christos /* set is the context (used for result length and error report) */
3222 1.1 christos /* */
3223 1.1 christos /* C must have space for set->digits digits. */
3224 1.1 christos /* */
3225 1.1 christos /* Logical function restrictions apply (see above); a NaN is */
3226 1.1 christos /* returned with Invalid_operation if a restriction is violated. */
3227 1.1 christos /* ------------------------------------------------------------------ */
3228 1.1 christos decNumber * decNumberXor(decNumber *res, const decNumber *lhs,
3229 1.1 christos const decNumber *rhs, decContext *set) {
3230 1.1 christos const Unit *ua, *ub; /* -> operands */
3231 1.1 christos const Unit *msua, *msub; /* -> operand msus */
3232 1.1 christos Unit *uc, *msuc; /* -> result and its msu */
3233 1.1 christos Int msudigs; /* digits in res msu */
3234 1.1 christos #if DECCHECK
3235 1.1 christos if (decCheckOperands(res, lhs, rhs, set)) return res;
3236 1.1 christos #endif
3237 1.1 christos
3238 1.1 christos if (lhs->exponent!=0 || decNumberIsSpecial(lhs) || decNumberIsNegative(lhs)
3239 1.1 christos || rhs->exponent!=0 || decNumberIsSpecial(rhs) || decNumberIsNegative(rhs)) {
3240 1.1 christos decStatus(res, DEC_Invalid_operation, set);
3241 1.1 christos return res;
3242 1.1 christos }
3243 1.1 christos /* operands are valid */
3244 1.1 christos ua=lhs->lsu; /* bottom-up */
3245 1.1 christos ub=rhs->lsu; /* .. */
3246 1.1 christos uc=res->lsu; /* .. */
3247 1.1 christos msua=ua+D2U(lhs->digits)-1; /* -> msu of lhs */
3248 1.1 christos msub=ub+D2U(rhs->digits)-1; /* -> msu of rhs */
3249 1.1 christos msuc=uc+D2U(set->digits)-1; /* -> msu of result */
3250 1.1 christos msudigs=MSUDIGITS(set->digits); /* [faster than remainder] */
3251 1.1 christos for (; uc<=msuc; ua++, ub++, uc++) { /* Unit loop */
3252 1.1 christos Unit a, b; /* extract units */
3253 1.1 christos if (ua>msua) a=0;
3254 1.1 christos else a=*ua;
3255 1.1 christos if (ub>msub) b=0;
3256 1.1 christos else b=*ub;
3257 1.1 christos *uc=0; /* can now write back */
3258 1.1 christos if (a|b) { /* maybe 1 bits to examine */
3259 1.1 christos Int i, j;
3260 1.1 christos /* This loop could be unrolled and/or use BIN2BCD tables */
3261 1.1 christos for (i=0; i<DECDPUN; i++) {
3262 1.1 christos if ((a^b)&1) *uc=*uc+(Unit)powers[i]; /* effect XOR */
3263 1.1 christos j=a%10;
3264 1.1 christos a=a/10;
3265 1.1 christos j|=b%10;
3266 1.1 christos b=b/10;
3267 1.1 christos if (j>1) {
3268 1.1 christos decStatus(res, DEC_Invalid_operation, set);
3269 1.1 christos return res;
3270 1.1 christos }
3271 1.1 christos if (uc==msuc && i==msudigs-1) break; /* just did final digit */
3272 1.1 christos } /* each digit */
3273 1.1 christos } /* non-zero */
3274 1.1 christos } /* each unit */
3275 1.1 christos /* [here uc-1 is the msu of the result] */
3276 1.1 christos res->digits=decGetDigits(res->lsu, uc-res->lsu);
3277 1.1 christos res->exponent=0; /* integer */
3278 1.1 christos res->bits=0; /* sign=0 */
3279 1.1 christos return res; /* [no status to set] */
3280 1.1 christos } /* decNumberXor */
3281 1.1 christos
3282 1.1 christos
3283 1.1 christos /* ================================================================== */
3284 1.1 christos /* Utility routines */
3285 1.1 christos /* ================================================================== */
3286 1.1 christos
3287 1.1 christos /* ------------------------------------------------------------------ */
3288 1.1 christos /* decNumberClass -- return the decClass of a decNumber */
3289 1.1 christos /* dn -- the decNumber to test */
3290 1.1 christos /* set -- the context to use for Emin */
3291 1.1 christos /* returns the decClass enum */
3292 1.1 christos /* ------------------------------------------------------------------ */
3293 1.1 christos enum decClass decNumberClass(const decNumber *dn, decContext *set) {
3294 1.1 christos if (decNumberIsSpecial(dn)) {
3295 1.1 christos if (decNumberIsQNaN(dn)) return DEC_CLASS_QNAN;
3296 1.1 christos if (decNumberIsSNaN(dn)) return DEC_CLASS_SNAN;
3297 1.1 christos /* must be an infinity */
3298 1.1 christos if (decNumberIsNegative(dn)) return DEC_CLASS_NEG_INF;
3299 1.1 christos return DEC_CLASS_POS_INF;
3300 1.1 christos }
3301 1.1 christos /* is finite */
3302 1.1 christos if (decNumberIsNormal(dn, set)) { /* most common */
3303 1.1 christos if (decNumberIsNegative(dn)) return DEC_CLASS_NEG_NORMAL;
3304 1.1 christos return DEC_CLASS_POS_NORMAL;
3305 1.1 christos }
3306 1.1 christos /* is subnormal or zero */
3307 1.1 christos if (decNumberIsZero(dn)) { /* most common */
3308 1.1 christos if (decNumberIsNegative(dn)) return DEC_CLASS_NEG_ZERO;
3309 1.1 christos return DEC_CLASS_POS_ZERO;
3310 1.1 christos }
3311 1.1 christos if (decNumberIsNegative(dn)) return DEC_CLASS_NEG_SUBNORMAL;
3312 1.1 christos return DEC_CLASS_POS_SUBNORMAL;
3313 1.1 christos } /* decNumberClass */
3314 1.1 christos
3315 1.1 christos /* ------------------------------------------------------------------ */
3316 1.1 christos /* decNumberClassToString -- convert decClass to a string */
3317 1.1 christos /* */
3318 1.1 christos /* eclass is a valid decClass */
3319 1.1 christos /* returns a constant string describing the class (max 13+1 chars) */
3320 1.1 christos /* ------------------------------------------------------------------ */
3321 1.1 christos const char *decNumberClassToString(enum decClass eclass) {
3322 1.1 christos if (eclass==DEC_CLASS_POS_NORMAL) return DEC_ClassString_PN;
3323 1.1 christos if (eclass==DEC_CLASS_NEG_NORMAL) return DEC_ClassString_NN;
3324 1.1 christos if (eclass==DEC_CLASS_POS_ZERO) return DEC_ClassString_PZ;
3325 1.1 christos if (eclass==DEC_CLASS_NEG_ZERO) return DEC_ClassString_NZ;
3326 1.1 christos if (eclass==DEC_CLASS_POS_SUBNORMAL) return DEC_ClassString_PS;
3327 1.1 christos if (eclass==DEC_CLASS_NEG_SUBNORMAL) return DEC_ClassString_NS;
3328 1.1 christos if (eclass==DEC_CLASS_POS_INF) return DEC_ClassString_PI;
3329 1.1 christos if (eclass==DEC_CLASS_NEG_INF) return DEC_ClassString_NI;
3330 1.1 christos if (eclass==DEC_CLASS_QNAN) return DEC_ClassString_QN;
3331 1.1 christos if (eclass==DEC_CLASS_SNAN) return DEC_ClassString_SN;
3332 1.1 christos return DEC_ClassString_UN; /* Unknown */
3333 1.1 christos } /* decNumberClassToString */
3334 1.1 christos
3335 1.1 christos /* ------------------------------------------------------------------ */
3336 1.1 christos /* decNumberCopy -- copy a number */
3337 1.1 christos /* */
3338 1.1 christos /* dest is the target decNumber */
3339 1.1 christos /* src is the source decNumber */
3340 1.1 christos /* returns dest */
3341 1.1 christos /* */
3342 1.1 christos /* (dest==src is allowed and is a no-op) */
3343 1.1 christos /* All fields are updated as required. This is a utility operation, */
3344 1.1 christos /* so special values are unchanged and no error is possible. */
3345 1.1 christos /* ------------------------------------------------------------------ */
3346 1.1 christos decNumber * decNumberCopy(decNumber *dest, const decNumber *src) {
3347 1.1 christos
3348 1.1 christos #if DECCHECK
3349 1.1 christos if (src==NULL) return decNumberZero(dest);
3350 1.1 christos #endif
3351 1.1 christos
3352 1.1 christos if (dest==src) return dest; /* no copy required */
3353 1.1 christos
3354 1.1 christos /* Use explicit assignments here as structure assignment could copy */
3355 1.1 christos /* more than just the lsu (for small DECDPUN). This would not affect */
3356 1.1 christos /* the value of the results, but could disturb test harness spill */
3357 1.1 christos /* checking. */
3358 1.1 christos dest->bits=src->bits;
3359 1.1 christos dest->exponent=src->exponent;
3360 1.1 christos dest->digits=src->digits;
3361 1.1 christos dest->lsu[0]=src->lsu[0];
3362 1.1 christos if (src->digits>DECDPUN) { /* more Units to come */
3363 1.1 christos const Unit *smsup, *s; /* work */
3364 1.1 christos Unit *d; /* .. */
3365 1.1 christos /* memcpy for the remaining Units would be safe as they cannot */
3366 1.1 christos /* overlap. However, this explicit loop is faster in short cases. */
3367 1.1 christos d=dest->lsu+1; /* -> first destination */
3368 1.1 christos smsup=src->lsu+D2U(src->digits); /* -> source msu+1 */
3369 1.1 christos for (s=src->lsu+1; s<smsup; s++, d++) *d=*s;
3370 1.1 christos }
3371 1.1 christos return dest;
3372 1.1 christos } /* decNumberCopy */
3373 1.1 christos
3374 1.1 christos /* ------------------------------------------------------------------ */
3375 1.1 christos /* decNumberCopyAbs -- quiet absolute value operator */
3376 1.1 christos /* */
3377 1.1 christos /* This sets C = abs(A) */
3378 1.1 christos /* */
3379 1.1 christos /* res is C, the result. C may be A */
3380 1.1 christos /* rhs is A */
3381 1.1 christos /* */
3382 1.1 christos /* C must have space for set->digits digits. */
3383 1.1 christos /* No exception or error can occur; this is a quiet bitwise operation.*/
3384 1.1 christos /* See also decNumberAbs for a checking version of this. */
3385 1.1 christos /* ------------------------------------------------------------------ */
3386 1.1 christos decNumber * decNumberCopyAbs(decNumber *res, const decNumber *rhs) {
3387 1.1 christos #if DECCHECK
3388 1.1 christos if (decCheckOperands(res, DECUNUSED, rhs, DECUNCONT)) return res;
3389 1.1 christos #endif
3390 1.1 christos decNumberCopy(res, rhs);
3391 1.1 christos res->bits&=~DECNEG; /* turn off sign */
3392 1.1 christos return res;
3393 1.1 christos } /* decNumberCopyAbs */
3394 1.1 christos
3395 1.1 christos /* ------------------------------------------------------------------ */
3396 1.1 christos /* decNumberCopyNegate -- quiet negate value operator */
3397 1.1 christos /* */
3398 1.1 christos /* This sets C = negate(A) */
3399 1.1 christos /* */
3400 1.1 christos /* res is C, the result. C may be A */
3401 1.1 christos /* rhs is A */
3402 1.1 christos /* */
3403 1.1 christos /* C must have space for set->digits digits. */
3404 1.1 christos /* No exception or error can occur; this is a quiet bitwise operation.*/
3405 1.1 christos /* See also decNumberMinus for a checking version of this. */
3406 1.1 christos /* ------------------------------------------------------------------ */
3407 1.1 christos decNumber * decNumberCopyNegate(decNumber *res, const decNumber *rhs) {
3408 1.1 christos #if DECCHECK
3409 1.1 christos if (decCheckOperands(res, DECUNUSED, rhs, DECUNCONT)) return res;
3410 1.1 christos #endif
3411 1.1 christos decNumberCopy(res, rhs);
3412 1.1 christos res->bits^=DECNEG; /* invert the sign */
3413 1.1 christos return res;
3414 1.1 christos } /* decNumberCopyNegate */
3415 1.1 christos
3416 1.1 christos /* ------------------------------------------------------------------ */
3417 1.1 christos /* decNumberCopySign -- quiet copy and set sign operator */
3418 1.1 christos /* */
3419 1.1 christos /* This sets C = A with the sign of B */
3420 1.1 christos /* */
3421 1.1 christos /* res is C, the result. C may be A */
3422 1.1 christos /* lhs is A */
3423 1.1 christos /* rhs is B */
3424 1.1 christos /* */
3425 1.1 christos /* C must have space for set->digits digits. */
3426 1.1 christos /* No exception or error can occur; this is a quiet bitwise operation.*/
3427 1.1 christos /* ------------------------------------------------------------------ */
3428 1.1 christos decNumber * decNumberCopySign(decNumber *res, const decNumber *lhs,
3429 1.1 christos const decNumber *rhs) {
3430 1.1 christos uByte sign; /* rhs sign */
3431 1.1 christos #if DECCHECK
3432 1.1 christos if (decCheckOperands(res, DECUNUSED, rhs, DECUNCONT)) return res;
3433 1.1 christos #endif
3434 1.1 christos sign=rhs->bits & DECNEG; /* save sign bit */
3435 1.1 christos decNumberCopy(res, lhs);
3436 1.1 christos res->bits&=~DECNEG; /* clear the sign */
3437 1.1 christos res->bits|=sign; /* set from rhs */
3438 1.1 christos return res;
3439 1.1 christos } /* decNumberCopySign */
3440 1.1 christos
3441 1.1 christos /* ------------------------------------------------------------------ */
3442 1.1 christos /* decNumberGetBCD -- get the coefficient in BCD8 */
3443 1.1 christos /* dn is the source decNumber */
3444 1.1 christos /* bcd is the uInt array that will receive dn->digits BCD bytes, */
3445 1.1 christos /* most-significant at offset 0 */
3446 1.1 christos /* returns bcd */
3447 1.1 christos /* */
3448 1.1 christos /* bcd must have at least dn->digits bytes. No error is possible; if */
3449 1.1 christos /* dn is a NaN or Infinite, digits must be 1 and the coefficient 0. */
3450 1.1 christos /* ------------------------------------------------------------------ */
3451 1.1 christos uByte * decNumberGetBCD(const decNumber *dn, uByte *bcd) {
3452 1.1 christos uByte *ub=bcd+dn->digits-1; /* -> lsd */
3453 1.1 christos const Unit *up=dn->lsu; /* Unit pointer, -> lsu */
3454 1.1 christos
3455 1.1 christos #if DECDPUN==1 /* trivial simple copy */
3456 1.1 christos for (; ub>=bcd; ub--, up++) *ub=*up;
3457 1.1 christos #else /* chopping needed */
3458 1.1 christos uInt u=*up; /* work */
3459 1.1 christos uInt cut=DECDPUN; /* downcounter through unit */
3460 1.1 christos for (; ub>=bcd; ub--) {
3461 1.1 christos *ub=(uByte)(u%10); /* [*6554 trick inhibits, here] */
3462 1.1 christos u=u/10;
3463 1.1 christos cut--;
3464 1.1 christos if (cut>0) continue; /* more in this unit */
3465 1.1 christos up++;
3466 1.1 christos u=*up;
3467 1.1 christos cut=DECDPUN;
3468 1.1 christos }
3469 1.1 christos #endif
3470 1.1 christos return bcd;
3471 1.1 christos } /* decNumberGetBCD */
3472 1.1 christos
3473 1.1 christos /* ------------------------------------------------------------------ */
3474 1.1 christos /* decNumberSetBCD -- set (replace) the coefficient from BCD8 */
3475 1.1 christos /* dn is the target decNumber */
3476 1.1 christos /* bcd is the uInt array that will source n BCD bytes, most- */
3477 1.1 christos /* significant at offset 0 */
3478 1.1 christos /* n is the number of digits in the source BCD array (bcd) */
3479 1.1 christos /* returns dn */
3480 1.1 christos /* */
3481 1.1 christos /* dn must have space for at least n digits. No error is possible; */
3482 1.1 christos /* if dn is a NaN, or Infinite, or is to become a zero, n must be 1 */
3483 1.1 christos /* and bcd[0] zero. */
3484 1.1 christos /* ------------------------------------------------------------------ */
3485 1.1 christos decNumber * decNumberSetBCD(decNumber *dn, const uByte *bcd, uInt n) {
3486 1.1 christos Unit *up=dn->lsu+D2U(dn->digits)-1; /* -> msu [target pointer] */
3487 1.1 christos const uByte *ub=bcd; /* -> source msd */
3488 1.1 christos
3489 1.1 christos #if DECDPUN==1 /* trivial simple copy */
3490 1.1 christos for (; ub<bcd+n; ub++, up--) *up=*ub;
3491 1.1 christos #else /* some assembly needed */
3492 1.1 christos /* calculate how many digits in msu, and hence first cut */
3493 1.1 christos Int cut=MSUDIGITS(n); /* [faster than remainder] */
3494 1.1 christos for (;up>=dn->lsu; up--) { /* each Unit from msu */
3495 1.1 christos *up=0; /* will take <=DECDPUN digits */
3496 1.1 christos for (; cut>0; ub++, cut--) *up=X10(*up)+*ub;
3497 1.1 christos cut=DECDPUN; /* next Unit has all digits */
3498 1.1 christos }
3499 1.1 christos #endif
3500 1.1 christos dn->digits=n; /* set digit count */
3501 1.1 christos return dn;
3502 1.1 christos } /* decNumberSetBCD */
3503 1.1 christos
3504 1.1 christos /* ------------------------------------------------------------------ */
3505 1.1 christos /* decNumberIsNormal -- test normality of a decNumber */
3506 1.1 christos /* dn is the decNumber to test */
3507 1.1 christos /* set is the context to use for Emin */
3508 1.1 christos /* returns 1 if |dn| is finite and >=Nmin, 0 otherwise */
3509 1.1 christos /* ------------------------------------------------------------------ */
3510 1.1 christos Int decNumberIsNormal(const decNumber *dn, decContext *set) {
3511 1.1 christos Int ae; /* adjusted exponent */
3512 1.1 christos #if DECCHECK
3513 1.1 christos if (decCheckOperands(DECUNRESU, DECUNUSED, dn, set)) return 0;
3514 1.1 christos #endif
3515 1.1 christos
3516 1.1 christos if (decNumberIsSpecial(dn)) return 0; /* not finite */
3517 1.1 christos if (decNumberIsZero(dn)) return 0; /* not non-zero */
3518 1.1 christos
3519 1.1 christos ae=dn->exponent+dn->digits-1; /* adjusted exponent */
3520 1.1 christos if (ae<set->emin) return 0; /* is subnormal */
3521 1.1 christos return 1;
3522 1.1 christos } /* decNumberIsNormal */
3523 1.1 christos
3524 1.1 christos /* ------------------------------------------------------------------ */
3525 1.1 christos /* decNumberIsSubnormal -- test subnormality of a decNumber */
3526 1.1 christos /* dn is the decNumber to test */
3527 1.1 christos /* set is the context to use for Emin */
3528 1.1 christos /* returns 1 if |dn| is finite, non-zero, and <Nmin, 0 otherwise */
3529 1.1 christos /* ------------------------------------------------------------------ */
3530 1.1 christos Int decNumberIsSubnormal(const decNumber *dn, decContext *set) {
3531 1.1 christos Int ae; /* adjusted exponent */
3532 1.1 christos #if DECCHECK
3533 1.1 christos if (decCheckOperands(DECUNRESU, DECUNUSED, dn, set)) return 0;
3534 1.1 christos #endif
3535 1.1 christos
3536 1.1 christos if (decNumberIsSpecial(dn)) return 0; /* not finite */
3537 1.1 christos if (decNumberIsZero(dn)) return 0; /* not non-zero */
3538 1.1 christos
3539 1.1 christos ae=dn->exponent+dn->digits-1; /* adjusted exponent */
3540 1.1 christos if (ae<set->emin) return 1; /* is subnormal */
3541 1.1 christos return 0;
3542 1.1 christos } /* decNumberIsSubnormal */
3543 1.1 christos
3544 1.1 christos /* ------------------------------------------------------------------ */
3545 1.1 christos /* decNumberTrim -- remove insignificant zeros */
3546 1.1 christos /* */
3547 1.1 christos /* dn is the number to trim */
3548 1.1 christos /* returns dn */
3549 1.1 christos /* */
3550 1.1 christos /* All fields are updated as required. This is a utility operation, */
3551 1.1 christos /* so special values are unchanged and no error is possible. The */
3552 1.1 christos /* zeros are removed unconditionally. */
3553 1.1 christos /* ------------------------------------------------------------------ */
3554 1.1 christos decNumber * decNumberTrim(decNumber *dn) {
3555 1.1 christos Int dropped; /* work */
3556 1.1 christos decContext set; /* .. */
3557 1.1 christos #if DECCHECK
3558 1.1 christos if (decCheckOperands(DECUNRESU, DECUNUSED, dn, DECUNCONT)) return dn;
3559 1.1 christos #endif
3560 1.1 christos decContextDefault(&set, DEC_INIT_BASE); /* clamp=0 */
3561 1.1 christos return decTrim(dn, &set, 0, 1, &dropped);
3562 1.1 christos } /* decNumberTrim */
3563 1.1 christos
3564 1.1 christos /* ------------------------------------------------------------------ */
3565 1.1 christos /* decNumberVersion -- return the name and version of this module */
3566 1.1 christos /* */
3567 1.1 christos /* No error is possible. */
3568 1.1 christos /* ------------------------------------------------------------------ */
3569 1.1 christos const char * decNumberVersion(void) {
3570 1.1 christos return DECVERSION;
3571 1.1 christos } /* decNumberVersion */
3572 1.1 christos
3573 1.1 christos /* ------------------------------------------------------------------ */
3574 1.1 christos /* decNumberZero -- set a number to 0 */
3575 1.1 christos /* */
3576 1.1 christos /* dn is the number to set, with space for one digit */
3577 1.1 christos /* returns dn */
3578 1.1 christos /* */
3579 1.1 christos /* No error is possible. */
3580 1.1 christos /* ------------------------------------------------------------------ */
3581 1.1 christos /* Memset is not used as it is much slower in some environments. */
3582 1.1 christos decNumber * decNumberZero(decNumber *dn) {
3583 1.1 christos
3584 1.1 christos #if DECCHECK
3585 1.1 christos if (decCheckOperands(dn, DECUNUSED, DECUNUSED, DECUNCONT)) return dn;
3586 1.1 christos #endif
3587 1.1 christos
3588 1.1 christos dn->bits=0;
3589 1.1 christos dn->exponent=0;
3590 1.1 christos dn->digits=1;
3591 1.1 christos dn->lsu[0]=0;
3592 1.1 christos return dn;
3593 1.1 christos } /* decNumberZero */
3594 1.1 christos
3595 1.1 christos /* ================================================================== */
3596 1.1 christos /* Local routines */
3597 1.1 christos /* ================================================================== */
3598 1.1 christos
3599 1.1 christos /* ------------------------------------------------------------------ */
3600 1.1 christos /* decToString -- lay out a number into a string */
3601 1.1 christos /* */
3602 1.1 christos /* dn is the number to lay out */
3603 1.1 christos /* string is where to lay out the number */
3604 1.1 christos /* eng is 1 if Engineering, 0 if Scientific */
3605 1.1 christos /* */
3606 1.1 christos /* string must be at least dn->digits+14 characters long */
3607 1.1 christos /* No error is possible. */
3608 1.1 christos /* */
3609 1.1 christos /* Note that this routine can generate a -0 or 0.000. These are */
3610 1.1 christos /* never generated in subset to-number or arithmetic, but can occur */
3611 1.1 christos /* in non-subset arithmetic (e.g., -1*0 or 1.234-1.234). */
3612 1.1 christos /* ------------------------------------------------------------------ */
3613 1.1 christos /* If DECCHECK is enabled the string "?" is returned if a number is */
3614 1.1 christos /* invalid. */
3615 1.1 christos static void decToString(const decNumber *dn, char *string, Flag eng) {
3616 1.1 christos Int exp=dn->exponent; /* local copy */
3617 1.1 christos Int e; /* E-part value */
3618 1.1 christos Int pre; /* digits before the '.' */
3619 1.1 christos Int cut; /* for counting digits in a Unit */
3620 1.1 christos char *c=string; /* work [output pointer] */
3621 1.1 christos const Unit *up=dn->lsu+D2U(dn->digits)-1; /* -> msu [input pointer] */
3622 1.1 christos uInt u, pow; /* work */
3623 1.1 christos
3624 1.1 christos #if DECCHECK
3625 1.1 christos if (decCheckOperands(DECUNRESU, dn, DECUNUSED, DECUNCONT)) {
3626 1.1 christos strcpy(string, "?");
3627 1.1 christos return;}
3628 1.1 christos #endif
3629 1.1 christos
3630 1.1 christos if (decNumberIsNegative(dn)) { /* Negatives get a minus */
3631 1.1 christos *c='-';
3632 1.1 christos c++;
3633 1.1 christos }
3634 1.1 christos if (dn->bits&DECSPECIAL) { /* Is a special value */
3635 1.1 christos if (decNumberIsInfinite(dn)) {
3636 1.1 christos strcpy(c, "Inf");
3637 1.1 christos strcpy(c+3, "inity");
3638 1.1 christos return;}
3639 1.1 christos /* a NaN */
3640 1.1 christos if (dn->bits&DECSNAN) { /* signalling NaN */
3641 1.1 christos *c='s';
3642 1.1 christos c++;
3643 1.1 christos }
3644 1.1 christos strcpy(c, "NaN");
3645 1.1 christos c+=3; /* step past */
3646 1.1 christos /* if not a clean non-zero coefficient, that's all there is in a */
3647 1.1 christos /* NaN string */
3648 1.1 christos if (exp!=0 || (*dn->lsu==0 && dn->digits==1)) return;
3649 1.1 christos /* [drop through to add integer] */
3650 1.1 christos }
3651 1.1 christos
3652 1.1 christos /* calculate how many digits in msu, and hence first cut */
3653 1.1 christos cut=MSUDIGITS(dn->digits); /* [faster than remainder] */
3654 1.1 christos cut--; /* power of ten for digit */
3655 1.1 christos
3656 1.1 christos if (exp==0) { /* simple integer [common fastpath] */
3657 1.1 christos for (;up>=dn->lsu; up--) { /* each Unit from msu */
3658 1.1 christos u=*up; /* contains DECDPUN digits to lay out */
3659 1.1 christos for (; cut>=0; c++, cut--) TODIGIT(u, cut, c, pow);
3660 1.1 christos cut=DECDPUN-1; /* next Unit has all digits */
3661 1.1 christos }
3662 1.1 christos *c='\0'; /* terminate the string */
3663 1.1 christos return;}
3664 1.1 christos
3665 1.1 christos /* non-0 exponent -- assume plain form */
3666 1.1 christos pre=dn->digits+exp; /* digits before '.' */
3667 1.1 christos e=0; /* no E */
3668 1.1 christos if ((exp>0) || (pre<-5)) { /* need exponential form */
3669 1.1 christos e=exp+dn->digits-1; /* calculate E value */
3670 1.1 christos pre=1; /* assume one digit before '.' */
3671 1.1 christos if (eng && (e!=0)) { /* engineering: may need to adjust */
3672 1.1 christos Int adj; /* adjustment */
3673 1.1 christos /* The C remainder operator is undefined for negative numbers, so */
3674 1.1 christos /* a positive remainder calculation must be used here */
3675 1.1 christos if (e<0) {
3676 1.1 christos adj=(-e)%3;
3677 1.1 christos if (adj!=0) adj=3-adj;
3678 1.1 christos }
3679 1.1 christos else { /* e>0 */
3680 1.1 christos adj=e%3;
3681 1.1 christos }
3682 1.1 christos e=e-adj;
3683 1.1 christos /* if dealing with zero still produce an exponent which is a */
3684 1.1 christos /* multiple of three, as expected, but there will only be the */
3685 1.1 christos /* one zero before the E, still. Otherwise note the padding. */
3686 1.1 christos if (!ISZERO(dn)) pre+=adj;
3687 1.1 christos else { /* is zero */
3688 1.1 christos if (adj!=0) { /* 0.00Esnn needed */
3689 1.1 christos e=e+3;
3690 1.1 christos pre=-(2-adj);
3691 1.1 christos }
3692 1.1 christos } /* zero */
3693 1.1 christos } /* eng */
3694 1.1 christos } /* need exponent */
3695 1.1 christos
3696 1.1 christos /* lay out the digits of the coefficient, adding 0s and . as needed */
3697 1.1 christos u=*up;
3698 1.1 christos if (pre>0) { /* xxx.xxx or xx00 (engineering) form */
3699 1.1 christos Int n=pre;
3700 1.1 christos for (; pre>0; pre--, c++, cut--) {
3701 1.1 christos if (cut<0) { /* need new Unit */
3702 1.1 christos if (up==dn->lsu) break; /* out of input digits (pre>digits) */
3703 1.1 christos up--;
3704 1.1 christos cut=DECDPUN-1;
3705 1.1 christos u=*up;
3706 1.1 christos }
3707 1.1 christos TODIGIT(u, cut, c, pow);
3708 1.1 christos }
3709 1.1 christos if (n<dn->digits) { /* more to come, after '.' */
3710 1.1 christos *c='.'; c++;
3711 1.1 christos for (;; c++, cut--) {
3712 1.1 christos if (cut<0) { /* need new Unit */
3713 1.1 christos if (up==dn->lsu) break; /* out of input digits */
3714 1.1 christos up--;
3715 1.1 christos cut=DECDPUN-1;
3716 1.1 christos u=*up;
3717 1.1 christos }
3718 1.1 christos TODIGIT(u, cut, c, pow);
3719 1.1 christos }
3720 1.1 christos }
3721 1.1 christos else for (; pre>0; pre--, c++) *c='0'; /* 0 padding (for engineering) needed */
3722 1.1 christos }
3723 1.1 christos else { /* 0.xxx or 0.000xxx form */
3724 1.1 christos *c='0'; c++;
3725 1.1 christos *c='.'; c++;
3726 1.1 christos for (; pre<0; pre++, c++) *c='0'; /* add any 0's after '.' */
3727 1.1 christos for (; ; c++, cut--) {
3728 1.1 christos if (cut<0) { /* need new Unit */
3729 1.1 christos if (up==dn->lsu) break; /* out of input digits */
3730 1.1 christos up--;
3731 1.1 christos cut=DECDPUN-1;
3732 1.1 christos u=*up;
3733 1.1 christos }
3734 1.1 christos TODIGIT(u, cut, c, pow);
3735 1.1 christos }
3736 1.1 christos }
3737 1.1 christos
3738 1.1 christos /* Finally add the E-part, if needed. It will never be 0, has a
3739 1.1 christos base maximum and minimum of +999999999 through -999999999, but
3740 1.1 christos could range down to -1999999998 for anormal numbers */
3741 1.1 christos if (e!=0) {
3742 1.1 christos Flag had=0; /* 1=had non-zero */
3743 1.1 christos *c='E'; c++;
3744 1.1 christos *c='+'; c++; /* assume positive */
3745 1.1 christos u=e; /* .. */
3746 1.1 christos if (e<0) {
3747 1.1 christos *(c-1)='-'; /* oops, need - */
3748 1.1 christos u=-e; /* uInt, please */
3749 1.1 christos }
3750 1.1 christos /* lay out the exponent [_itoa or equivalent is not ANSI C] */
3751 1.1 christos for (cut=9; cut>=0; cut--) {
3752 1.1 christos TODIGIT(u, cut, c, pow);
3753 1.1 christos if (*c=='0' && !had) continue; /* skip leading zeros */
3754 1.1 christos had=1; /* had non-0 */
3755 1.1 christos c++; /* step for next */
3756 1.1 christos } /* cut */
3757 1.1 christos }
3758 1.1 christos *c='\0'; /* terminate the string (all paths) */
3759 1.1 christos return;
3760 1.1 christos } /* decToString */
3761 1.1 christos
3762 1.1 christos /* ------------------------------------------------------------------ */
3763 1.1 christos /* decAddOp -- add/subtract operation */
3764 1.1 christos /* */
3765 1.1 christos /* This computes C = A + B */
3766 1.1 christos /* */
3767 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=X+X) */
3768 1.1 christos /* lhs is A */
3769 1.1 christos /* rhs is B */
3770 1.1 christos /* set is the context */
3771 1.1 christos /* negate is DECNEG if rhs should be negated, or 0 otherwise */
3772 1.1 christos /* status accumulates status for the caller */
3773 1.1 christos /* */
3774 1.1 christos /* C must have space for set->digits digits. */
3775 1.1 christos /* Inexact in status must be 0 for correct Exact zero sign in result */
3776 1.1 christos /* ------------------------------------------------------------------ */
3777 1.1 christos /* If possible, the coefficient is calculated directly into C. */
3778 1.1 christos /* However, if: */
3779 1.1 christos /* -- a digits+1 calculation is needed because the numbers are */
3780 1.1 christos /* unaligned and span more than set->digits digits */
3781 1.1 christos /* -- a carry to digits+1 digits looks possible */
3782 1.1 christos /* -- C is the same as A or B, and the result would destructively */
3783 1.1 christos /* overlap the A or B coefficient */
3784 1.1 christos /* then the result must be calculated into a temporary buffer. In */
3785 1.1 christos /* this case a local (stack) buffer is used if possible, and only if */
3786 1.1 christos /* too long for that does malloc become the final resort. */
3787 1.1 christos /* */
3788 1.1 christos /* Misalignment is handled as follows: */
3789 1.1 christos /* Apad: (AExp>BExp) Swap operands and proceed as for BExp>AExp. */
3790 1.1 christos /* BPad: Apply the padding by a combination of shifting (whole */
3791 1.1 christos /* units) and multiplication (part units). */
3792 1.1 christos /* */
3793 1.1 christos /* Addition, especially x=x+1, is speed-critical. */
3794 1.1 christos /* The static buffer is larger than might be expected to allow for */
3795 1.1 christos /* calls from higher-level funtions (notable exp). */
3796 1.1 christos /* ------------------------------------------------------------------ */
3797 1.1 christos static decNumber * decAddOp(decNumber *res, const decNumber *lhs,
3798 1.1 christos const decNumber *rhs, decContext *set,
3799 1.1 christos uByte negate, uInt *status) {
3800 1.1 christos #if DECSUBSET
3801 1.1 christos decNumber *alloclhs=NULL; /* non-NULL if rounded lhs allocated */
3802 1.1 christos decNumber *allocrhs=NULL; /* .., rhs */
3803 1.1 christos #endif
3804 1.1 christos Int rhsshift; /* working shift (in Units) */
3805 1.1 christos Int maxdigits; /* longest logical length */
3806 1.1 christos Int mult; /* multiplier */
3807 1.1 christos Int residue; /* rounding accumulator */
3808 1.1 christos uByte bits; /* result bits */
3809 1.1 christos Flag diffsign; /* non-0 if arguments have different sign */
3810 1.1 christos Unit *acc; /* accumulator for result */
3811 1.1 christos Unit accbuff[SD2U(DECBUFFER*2+20)]; /* local buffer [*2+20 reduces many */
3812 1.1 christos /* allocations when called from */
3813 1.1 christos /* other operations, notable exp] */
3814 1.1 christos Unit *allocacc=NULL; /* -> allocated acc buffer, iff allocated */
3815 1.1 christos Int reqdigits=set->digits; /* local copy; requested DIGITS */
3816 1.1 christos Int padding; /* work */
3817 1.1 christos
3818 1.1 christos #if DECCHECK
3819 1.1 christos if (decCheckOperands(res, lhs, rhs, set)) return res;
3820 1.1 christos #endif
3821 1.1 christos
3822 1.1 christos do { /* protect allocated storage */
3823 1.1 christos #if DECSUBSET
3824 1.1 christos if (!set->extended) {
3825 1.1 christos /* reduce operands and set lostDigits status, as needed */
3826 1.1 christos if (lhs->digits>reqdigits) {
3827 1.1 christos alloclhs=decRoundOperand(lhs, set, status);
3828 1.1 christos if (alloclhs==NULL) break;
3829 1.1 christos lhs=alloclhs;
3830 1.1 christos }
3831 1.1 christos if (rhs->digits>reqdigits) {
3832 1.1 christos allocrhs=decRoundOperand(rhs, set, status);
3833 1.1 christos if (allocrhs==NULL) break;
3834 1.1 christos rhs=allocrhs;
3835 1.1 christos }
3836 1.1 christos }
3837 1.1 christos #endif
3838 1.1 christos /* [following code does not require input rounding] */
3839 1.1 christos
3840 1.1 christos /* note whether signs differ [used all paths] */
3841 1.1 christos diffsign=(Flag)((lhs->bits^rhs->bits^negate)&DECNEG);
3842 1.1 christos
3843 1.1 christos /* handle infinities and NaNs */
3844 1.1 christos if (SPECIALARGS) { /* a special bit set */
3845 1.1 christos if (SPECIALARGS & (DECSNAN | DECNAN)) /* a NaN */
3846 1.1 christos decNaNs(res, lhs, rhs, set, status);
3847 1.1 christos else { /* one or two infinities */
3848 1.1 christos if (decNumberIsInfinite(lhs)) { /* LHS is infinity */
3849 1.1 christos /* two infinities with different signs is invalid */
3850 1.1 christos if (decNumberIsInfinite(rhs) && diffsign) {
3851 1.1 christos *status|=DEC_Invalid_operation;
3852 1.1 christos break;
3853 1.1 christos }
3854 1.1 christos bits=lhs->bits & DECNEG; /* get sign from LHS */
3855 1.1 christos }
3856 1.1 christos else bits=(rhs->bits^negate) & DECNEG;/* RHS must be Infinity */
3857 1.1 christos bits|=DECINF;
3858 1.1 christos decNumberZero(res);
3859 1.1 christos res->bits=bits; /* set +/- infinity */
3860 1.1 christos } /* an infinity */
3861 1.1 christos break;
3862 1.1 christos }
3863 1.1 christos
3864 1.1 christos /* Quick exit for add 0s; return the non-0, modified as need be */
3865 1.1 christos if (ISZERO(lhs)) {
3866 1.1 christos Int adjust; /* work */
3867 1.1 christos Int lexp=lhs->exponent; /* save in case LHS==RES */
3868 1.1 christos bits=lhs->bits; /* .. */
3869 1.1 christos residue=0; /* clear accumulator */
3870 1.1 christos decCopyFit(res, rhs, set, &residue, status); /* copy (as needed) */
3871 1.1 christos res->bits^=negate; /* flip if rhs was negated */
3872 1.1 christos #if DECSUBSET
3873 1.1 christos if (set->extended) { /* exponents on zeros count */
3874 1.1 christos #endif
3875 1.1 christos /* exponent will be the lower of the two */
3876 1.1 christos adjust=lexp-res->exponent; /* adjustment needed [if -ve] */
3877 1.1 christos if (ISZERO(res)) { /* both 0: special IEEE 754 rules */
3878 1.1 christos if (adjust<0) res->exponent=lexp; /* set exponent */
3879 1.1 christos /* 0-0 gives +0 unless rounding to -infinity, and -0-0 gives -0 */
3880 1.1 christos if (diffsign) {
3881 1.1 christos if (set->round!=DEC_ROUND_FLOOR) res->bits=0;
3882 1.1 christos else res->bits=DECNEG; /* preserve 0 sign */
3883 1.1 christos }
3884 1.1 christos }
3885 1.1 christos else { /* non-0 res */
3886 1.1 christos if (adjust<0) { /* 0-padding needed */
3887 1.1 christos if ((res->digits-adjust)>set->digits) {
3888 1.1 christos adjust=res->digits-set->digits; /* to fit exactly */
3889 1.1 christos *status|=DEC_Rounded; /* [but exact] */
3890 1.1 christos }
3891 1.1 christos res->digits=decShiftToMost(res->lsu, res->digits, -adjust);
3892 1.1 christos res->exponent+=adjust; /* set the exponent. */
3893 1.1 christos }
3894 1.1 christos } /* non-0 res */
3895 1.1 christos #if DECSUBSET
3896 1.1 christos } /* extended */
3897 1.1 christos #endif
3898 1.1 christos decFinish(res, set, &residue, status); /* clean and finalize */
3899 1.1 christos break;}
3900 1.1 christos
3901 1.1 christos if (ISZERO(rhs)) { /* [lhs is non-zero] */
3902 1.1 christos Int adjust; /* work */
3903 1.1 christos Int rexp=rhs->exponent; /* save in case RHS==RES */
3904 1.1 christos bits=rhs->bits; /* be clean */
3905 1.1 christos residue=0; /* clear accumulator */
3906 1.1 christos decCopyFit(res, lhs, set, &residue, status); /* copy (as needed) */
3907 1.1 christos #if DECSUBSET
3908 1.1 christos if (set->extended) { /* exponents on zeros count */
3909 1.1 christos #endif
3910 1.1 christos /* exponent will be the lower of the two */
3911 1.1 christos /* [0-0 case handled above] */
3912 1.1 christos adjust=rexp-res->exponent; /* adjustment needed [if -ve] */
3913 1.1 christos if (adjust<0) { /* 0-padding needed */
3914 1.1 christos if ((res->digits-adjust)>set->digits) {
3915 1.1 christos adjust=res->digits-set->digits; /* to fit exactly */
3916 1.1 christos *status|=DEC_Rounded; /* [but exact] */
3917 1.1 christos }
3918 1.1 christos res->digits=decShiftToMost(res->lsu, res->digits, -adjust);
3919 1.1 christos res->exponent+=adjust; /* set the exponent. */
3920 1.1 christos }
3921 1.1 christos #if DECSUBSET
3922 1.1 christos } /* extended */
3923 1.1 christos #endif
3924 1.1 christos decFinish(res, set, &residue, status); /* clean and finalize */
3925 1.1 christos break;}
3926 1.1 christos
3927 1.1 christos /* [NB: both fastpath and mainpath code below assume these cases */
3928 1.1 christos /* (notably 0-0) have already been handled] */
3929 1.1 christos
3930 1.1 christos /* calculate the padding needed to align the operands */
3931 1.1 christos padding=rhs->exponent-lhs->exponent;
3932 1.1 christos
3933 1.1 christos /* Fastpath cases where the numbers are aligned and normal, the RHS */
3934 1.1 christos /* is all in one unit, no operand rounding is needed, and no carry, */
3935 1.1 christos /* lengthening, or borrow is needed */
3936 1.1 christos if (padding==0
3937 1.1 christos && rhs->digits<=DECDPUN
3938 1.1 christos && rhs->exponent>=set->emin /* [some normals drop through] */
3939 1.1 christos && rhs->exponent<=set->emax-set->digits+1 /* [could clamp] */
3940 1.1 christos && rhs->digits<=reqdigits
3941 1.1 christos && lhs->digits<=reqdigits) {
3942 1.1 christos Int partial=*lhs->lsu;
3943 1.1 christos if (!diffsign) { /* adding */
3944 1.1 christos partial+=*rhs->lsu;
3945 1.1 christos if ((partial<=DECDPUNMAX) /* result fits in unit */
3946 1.1 christos && (lhs->digits>=DECDPUN || /* .. and no digits-count change */
3947 1.1 christos partial<(Int)powers[lhs->digits])) { /* .. */
3948 1.1 christos if (res!=lhs) decNumberCopy(res, lhs); /* not in place */
3949 1.1 christos *res->lsu=(Unit)partial; /* [copy could have overwritten RHS] */
3950 1.1 christos break;
3951 1.1 christos }
3952 1.1 christos /* else drop out for careful add */
3953 1.1 christos }
3954 1.1 christos else { /* signs differ */
3955 1.1 christos partial-=*rhs->lsu;
3956 1.1 christos if (partial>0) { /* no borrow needed, and non-0 result */
3957 1.1 christos if (res!=lhs) decNumberCopy(res, lhs); /* not in place */
3958 1.1 christos *res->lsu=(Unit)partial;
3959 1.1 christos /* this could have reduced digits [but result>0] */
3960 1.1 christos res->digits=decGetDigits(res->lsu, D2U(res->digits));
3961 1.1 christos break;
3962 1.1 christos }
3963 1.1 christos /* else drop out for careful subtract */
3964 1.1 christos }
3965 1.1 christos }
3966 1.1 christos
3967 1.1 christos /* Now align (pad) the lhs or rhs so they can be added or */
3968 1.1 christos /* subtracted, as necessary. If one number is much larger than */
3969 1.1 christos /* the other (that is, if in plain form there is a least one */
3970 1.1 christos /* digit between the lowest digit of one and the highest of the */
3971 1.1 christos /* other) padding with up to DIGITS-1 trailing zeros may be */
3972 1.1 christos /* needed; then apply rounding (as exotic rounding modes may be */
3973 1.1 christos /* affected by the residue). */
3974 1.1 christos rhsshift=0; /* rhs shift to left (padding) in Units */
3975 1.1 christos bits=lhs->bits; /* assume sign is that of LHS */
3976 1.1 christos mult=1; /* likely multiplier */
3977 1.1 christos
3978 1.1 christos /* [if padding==0 the operands are aligned; no padding is needed] */
3979 1.1 christos if (padding!=0) {
3980 1.1 christos /* some padding needed; always pad the RHS, as any required */
3981 1.1 christos /* padding can then be effected by a simple combination of */
3982 1.1 christos /* shifts and a multiply */
3983 1.1 christos Flag swapped=0;
3984 1.1 christos if (padding<0) { /* LHS needs the padding */
3985 1.1 christos const decNumber *t;
3986 1.1 christos padding=-padding; /* will be +ve */
3987 1.1 christos bits=(uByte)(rhs->bits^negate); /* assumed sign is now that of RHS */
3988 1.1 christos t=lhs; lhs=rhs; rhs=t;
3989 1.1 christos swapped=1;
3990 1.1 christos }
3991 1.1 christos
3992 1.1 christos /* If, after pad, rhs would be longer than lhs by digits+1 or */
3993 1.1 christos /* more then lhs cannot affect the answer, except as a residue, */
3994 1.1 christos /* so only need to pad up to a length of DIGITS+1. */
3995 1.1 christos if (rhs->digits+padding > lhs->digits+reqdigits+1) {
3996 1.1 christos /* The RHS is sufficient */
3997 1.1 christos /* for residue use the relative sign indication... */
3998 1.1 christos Int shift=reqdigits-rhs->digits; /* left shift needed */
3999 1.1 christos residue=1; /* residue for rounding */
4000 1.1 christos if (diffsign) residue=-residue; /* signs differ */
4001 1.1 christos /* copy, shortening if necessary */
4002 1.1 christos decCopyFit(res, rhs, set, &residue, status);
4003 1.1 christos /* if it was already shorter, then need to pad with zeros */
4004 1.1 christos if (shift>0) {
4005 1.1 christos res->digits=decShiftToMost(res->lsu, res->digits, shift);
4006 1.1 christos res->exponent-=shift; /* adjust the exponent. */
4007 1.1 christos }
4008 1.1 christos /* flip the result sign if unswapped and rhs was negated */
4009 1.1 christos if (!swapped) res->bits^=negate;
4010 1.1 christos decFinish(res, set, &residue, status); /* done */
4011 1.1 christos break;}
4012 1.1 christos
4013 1.1 christos /* LHS digits may affect result */
4014 1.1 christos rhsshift=D2U(padding+1)-1; /* this much by Unit shift .. */
4015 1.1 christos mult=powers[padding-(rhsshift*DECDPUN)]; /* .. this by multiplication */
4016 1.1 christos } /* padding needed */
4017 1.1 christos
4018 1.1 christos if (diffsign) mult=-mult; /* signs differ */
4019 1.1 christos
4020 1.1 christos /* determine the longer operand */
4021 1.1 christos maxdigits=rhs->digits+padding; /* virtual length of RHS */
4022 1.1 christos if (lhs->digits>maxdigits) maxdigits=lhs->digits;
4023 1.1 christos
4024 1.1 christos /* Decide on the result buffer to use; if possible place directly */
4025 1.1 christos /* into result. */
4026 1.1 christos acc=res->lsu; /* assume add direct to result */
4027 1.1 christos /* If destructive overlap, or the number is too long, or a carry or */
4028 1.1 christos /* borrow to DIGITS+1 might be possible, a buffer must be used. */
4029 1.1 christos /* [Might be worth more sophisticated tests when maxdigits==reqdigits] */
4030 1.1 christos if ((maxdigits>=reqdigits) /* is, or could be, too large */
4031 1.1 christos || (res==rhs && rhsshift>0)) { /* destructive overlap */
4032 1.1 christos /* buffer needed, choose it; units for maxdigits digits will be */
4033 1.1 christos /* needed, +1 Unit for carry or borrow */
4034 1.1 christos Int need=D2U(maxdigits)+1;
4035 1.1 christos acc=accbuff; /* assume use local buffer */
4036 1.1 christos if (need*sizeof(Unit)>sizeof(accbuff)) {
4037 1.1 christos /* printf("malloc add %ld %ld\n", need, sizeof(accbuff)); */
4038 1.1 christos allocacc=(Unit *)malloc(need*sizeof(Unit));
4039 1.1 christos if (allocacc==NULL) { /* hopeless -- abandon */
4040 1.1 christos *status|=DEC_Insufficient_storage;
4041 1.1 christos break;}
4042 1.1 christos acc=allocacc;
4043 1.1 christos }
4044 1.1 christos }
4045 1.1 christos
4046 1.1 christos res->bits=(uByte)(bits&DECNEG); /* it's now safe to overwrite.. */
4047 1.1 christos res->exponent=lhs->exponent; /* .. operands (even if aliased) */
4048 1.1 christos
4049 1.1 christos #if DECTRACE
4050 1.1 christos decDumpAr('A', lhs->lsu, D2U(lhs->digits));
4051 1.1 christos decDumpAr('B', rhs->lsu, D2U(rhs->digits));
4052 1.1 christos printf(" :h: %ld %ld\n", rhsshift, mult);
4053 1.1 christos #endif
4054 1.1 christos
4055 1.1 christos /* add [A+B*m] or subtract [A+B*(-m)] */
4056 1.1 christos res->digits=decUnitAddSub(lhs->lsu, D2U(lhs->digits),
4057 1.1 christos rhs->lsu, D2U(rhs->digits),
4058 1.1 christos rhsshift, acc, mult)
4059 1.1 christos *DECDPUN; /* [units -> digits] */
4060 1.1 christos if (res->digits<0) { /* borrowed... */
4061 1.1 christos res->digits=-res->digits;
4062 1.1 christos res->bits^=DECNEG; /* flip the sign */
4063 1.1 christos }
4064 1.1 christos #if DECTRACE
4065 1.1 christos decDumpAr('+', acc, D2U(res->digits));
4066 1.1 christos #endif
4067 1.1 christos
4068 1.1 christos /* If a buffer was used the result must be copied back, possibly */
4069 1.1 christos /* shortening. (If no buffer was used then the result must have */
4070 1.1 christos /* fit, so can't need rounding and residue must be 0.) */
4071 1.1 christos residue=0; /* clear accumulator */
4072 1.1 christos if (acc!=res->lsu) {
4073 1.1 christos #if DECSUBSET
4074 1.1 christos if (set->extended) { /* round from first significant digit */
4075 1.1 christos #endif
4076 1.1 christos /* remove leading zeros that were added due to rounding up to */
4077 1.1 christos /* integral Units -- before the test for rounding. */
4078 1.1 christos if (res->digits>reqdigits)
4079 1.1 christos res->digits=decGetDigits(acc, D2U(res->digits));
4080 1.1 christos decSetCoeff(res, set, acc, res->digits, &residue, status);
4081 1.1 christos #if DECSUBSET
4082 1.1 christos }
4083 1.1 christos else { /* subset arithmetic rounds from original significant digit */
4084 1.1 christos /* May have an underestimate. This only occurs when both */
4085 1.1 christos /* numbers fit in DECDPUN digits and are padding with a */
4086 1.1 christos /* negative multiple (-10, -100...) and the top digit(s) become */
4087 1.1 christos /* 0. (This only matters when using X3.274 rules where the */
4088 1.1 christos /* leading zero could be included in the rounding.) */
4089 1.1 christos if (res->digits<maxdigits) {
4090 1.1 christos *(acc+D2U(res->digits))=0; /* ensure leading 0 is there */
4091 1.1 christos res->digits=maxdigits;
4092 1.1 christos }
4093 1.1 christos else {
4094 1.1 christos /* remove leading zeros that added due to rounding up to */
4095 1.1 christos /* integral Units (but only those in excess of the original */
4096 1.1 christos /* maxdigits length, unless extended) before test for rounding. */
4097 1.1 christos if (res->digits>reqdigits) {
4098 1.1 christos res->digits=decGetDigits(acc, D2U(res->digits));
4099 1.1 christos if (res->digits<maxdigits) res->digits=maxdigits;
4100 1.1 christos }
4101 1.1 christos }
4102 1.1 christos decSetCoeff(res, set, acc, res->digits, &residue, status);
4103 1.1 christos /* Now apply rounding if needed before removing leading zeros. */
4104 1.1 christos /* This is safe because subnormals are not a possibility */
4105 1.1 christos if (residue!=0) {
4106 1.1 christos decApplyRound(res, set, residue, status);
4107 1.1 christos residue=0; /* did what needed to be done */
4108 1.1 christos }
4109 1.1 christos } /* subset */
4110 1.1 christos #endif
4111 1.1 christos } /* used buffer */
4112 1.1 christos
4113 1.1 christos /* strip leading zeros [these were left on in case of subset subtract] */
4114 1.1 christos res->digits=decGetDigits(res->lsu, D2U(res->digits));
4115 1.1 christos
4116 1.1 christos /* apply checks and rounding */
4117 1.1 christos decFinish(res, set, &residue, status);
4118 1.1 christos
4119 1.1 christos /* "When the sum of two operands with opposite signs is exactly */
4120 1.1 christos /* zero, the sign of that sum shall be '+' in all rounding modes */
4121 1.1 christos /* except round toward -Infinity, in which mode that sign shall be */
4122 1.1 christos /* '-'." [Subset zeros also never have '-', set by decFinish.] */
4123 1.1 christos if (ISZERO(res) && diffsign
4124 1.1 christos #if DECSUBSET
4125 1.1 christos && set->extended
4126 1.1 christos #endif
4127 1.1 christos && (*status&DEC_Inexact)==0) {
4128 1.1 christos if (set->round==DEC_ROUND_FLOOR) res->bits|=DECNEG; /* sign - */
4129 1.1 christos else res->bits&=~DECNEG; /* sign + */
4130 1.1 christos }
4131 1.1 christos } while(0); /* end protected */
4132 1.1 christos
4133 1.1 christos free(allocacc); /* drop any storage used */
4134 1.1 christos #if DECSUBSET
4135 1.1 christos free(allocrhs); /* .. */
4136 1.1 christos free(alloclhs); /* .. */
4137 1.1 christos #endif
4138 1.1 christos return res;
4139 1.1 christos } /* decAddOp */
4140 1.1 christos
4141 1.1 christos /* ------------------------------------------------------------------ */
4142 1.1 christos /* decDivideOp -- division operation */
4143 1.1 christos /* */
4144 1.1 christos /* This routine performs the calculations for all four division */
4145 1.1 christos /* operators (divide, divideInteger, remainder, remainderNear). */
4146 1.1 christos /* */
4147 1.1 christos /* C=A op B */
4148 1.1 christos /* */
4149 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=X/X) */
4150 1.1 christos /* lhs is A */
4151 1.1 christos /* rhs is B */
4152 1.1 christos /* set is the context */
4153 1.1 christos /* op is DIVIDE, DIVIDEINT, REMAINDER, or REMNEAR respectively. */
4154 1.1 christos /* status is the usual accumulator */
4155 1.1 christos /* */
4156 1.1 christos /* C must have space for set->digits digits. */
4157 1.1 christos /* */
4158 1.1 christos /* ------------------------------------------------------------------ */
4159 1.1 christos /* The underlying algorithm of this routine is the same as in the */
4160 1.1 christos /* 1981 S/370 implementation, that is, non-restoring long division */
4161 1.1 christos /* with bi-unit (rather than bi-digit) estimation for each unit */
4162 1.1 christos /* multiplier. In this pseudocode overview, complications for the */
4163 1.1 christos /* Remainder operators and division residues for exact rounding are */
4164 1.1 christos /* omitted for clarity. */
4165 1.1 christos /* */
4166 1.1 christos /* Prepare operands and handle special values */
4167 1.1 christos /* Test for x/0 and then 0/x */
4168 1.1 christos /* Exp =Exp1 - Exp2 */
4169 1.1 christos /* Exp =Exp +len(var1) -len(var2) */
4170 1.1 christos /* Sign=Sign1 * Sign2 */
4171 1.1 christos /* Pad accumulator (Var1) to double-length with 0's (pad1) */
4172 1.1 christos /* Pad Var2 to same length as Var1 */
4173 1.1 christos /* msu2pair/plus=1st 2 or 1 units of var2, +1 to allow for round */
4174 1.1 christos /* have=0 */
4175 1.1 christos /* Do until (have=digits+1 OR residue=0) */
4176 1.1 christos /* if exp<0 then if integer divide/residue then leave */
4177 1.1 christos /* this_unit=0 */
4178 1.1 christos /* Do forever */
4179 1.1 christos /* compare numbers */
4180 1.1 christos /* if <0 then leave inner_loop */
4181 1.1 christos /* if =0 then (* quick exit without subtract *) do */
4182 1.1 christos /* this_unit=this_unit+1; output this_unit */
4183 1.1 christos /* leave outer_loop; end */
4184 1.1 christos /* Compare lengths of numbers (mantissae): */
4185 1.1 christos /* If same then tops2=msu2pair -- {units 1&2 of var2} */
4186 1.1 christos /* else tops2=msu2plus -- {0, unit 1 of var2} */
4187 1.1 christos /* tops1=first_unit_of_Var1*10**DECDPUN +second_unit_of_var1 */
4188 1.1 christos /* mult=tops1/tops2 -- Good and safe guess at divisor */
4189 1.1 christos /* if mult=0 then mult=1 */
4190 1.1 christos /* this_unit=this_unit+mult */
4191 1.1 christos /* subtract */
4192 1.1 christos /* end inner_loop */
4193 1.1 christos /* if have\=0 | this_unit\=0 then do */
4194 1.1 christos /* output this_unit */
4195 1.1 christos /* have=have+1; end */
4196 1.1 christos /* var2=var2/10 */
4197 1.1 christos /* exp=exp-1 */
4198 1.1 christos /* end outer_loop */
4199 1.1 christos /* exp=exp+1 -- set the proper exponent */
4200 1.1 christos /* if have=0 then generate answer=0 */
4201 1.1 christos /* Return (Result is defined by Var1) */
4202 1.1 christos /* */
4203 1.1 christos /* ------------------------------------------------------------------ */
4204 1.1 christos /* Two working buffers are needed during the division; one (digits+ */
4205 1.1 christos /* 1) to accumulate the result, and the other (up to 2*digits+1) for */
4206 1.1 christos /* long subtractions. These are acc and var1 respectively. */
4207 1.1 christos /* var1 is a copy of the lhs coefficient, var2 is the rhs coefficient.*/
4208 1.1 christos /* The static buffers may be larger than might be expected to allow */
4209 1.1 christos /* for calls from higher-level funtions (notable exp). */
4210 1.1 christos /* ------------------------------------------------------------------ */
4211 1.1 christos static decNumber * decDivideOp(decNumber *res,
4212 1.1 christos const decNumber *lhs, const decNumber *rhs,
4213 1.1 christos decContext *set, Flag op, uInt *status) {
4214 1.1 christos #if DECSUBSET
4215 1.1 christos decNumber *alloclhs=NULL; /* non-NULL if rounded lhs allocated */
4216 1.1 christos decNumber *allocrhs=NULL; /* .., rhs */
4217 1.1 christos #endif
4218 1.1 christos Unit accbuff[SD2U(DECBUFFER+DECDPUN+10)]; /* local buffer */
4219 1.1 christos Unit *acc=accbuff; /* -> accumulator array for result */
4220 1.1 christos Unit *allocacc=NULL; /* -> allocated buffer, iff allocated */
4221 1.1 christos Unit *accnext; /* -> where next digit will go */
4222 1.1 christos Int acclength; /* length of acc needed [Units] */
4223 1.1 christos Int accunits; /* count of units accumulated */
4224 1.1 christos Int accdigits; /* count of digits accumulated */
4225 1.1 christos
4226 1.1 christos Unit varbuff[SD2U(DECBUFFER*2+DECDPUN)]; /* buffer for var1 */
4227 1.1 christos Unit *var1=varbuff; /* -> var1 array for long subtraction */
4228 1.1 christos Unit *varalloc=NULL; /* -> allocated buffer, iff used */
4229 1.1 christos Unit *msu1; /* -> msu of var1 */
4230 1.1 christos
4231 1.1 christos const Unit *var2; /* -> var2 array */
4232 1.1 christos const Unit *msu2; /* -> msu of var2 */
4233 1.1 christos Int msu2plus; /* msu2 plus one [does not vary] */
4234 1.1 christos eInt msu2pair; /* msu2 pair plus one [does not vary] */
4235 1.1 christos
4236 1.1 christos Int var1units, var2units; /* actual lengths */
4237 1.1 christos Int var2ulen; /* logical length (units) */
4238 1.1 christos Int var1initpad=0; /* var1 initial padding (digits) */
4239 1.1 christos Int maxdigits; /* longest LHS or required acc length */
4240 1.1 christos Int mult; /* multiplier for subtraction */
4241 1.1 christos Unit thisunit; /* current unit being accumulated */
4242 1.1 christos Int residue; /* for rounding */
4243 1.1 christos Int reqdigits=set->digits; /* requested DIGITS */
4244 1.1 christos Int exponent; /* working exponent */
4245 1.1 christos Int maxexponent=0; /* DIVIDE maximum exponent if unrounded */
4246 1.1 christos uByte bits; /* working sign */
4247 1.1 christos Unit *target; /* work */
4248 1.1 christos const Unit *source; /* .. */
4249 1.1 christos uInt const *pow; /* .. */
4250 1.1 christos Int shift, cut; /* .. */
4251 1.1 christos #if DECSUBSET
4252 1.1 christos Int dropped; /* work */
4253 1.1 christos #endif
4254 1.1 christos
4255 1.1 christos #if DECCHECK
4256 1.1 christos if (decCheckOperands(res, lhs, rhs, set)) return res;
4257 1.1 christos #endif
4258 1.1 christos
4259 1.1 christos do { /* protect allocated storage */
4260 1.1 christos #if DECSUBSET
4261 1.1 christos if (!set->extended) {
4262 1.1 christos /* reduce operands and set lostDigits status, as needed */
4263 1.1 christos if (lhs->digits>reqdigits) {
4264 1.1 christos alloclhs=decRoundOperand(lhs, set, status);
4265 1.1 christos if (alloclhs==NULL) break;
4266 1.1 christos lhs=alloclhs;
4267 1.1 christos }
4268 1.1 christos if (rhs->digits>reqdigits) {
4269 1.1 christos allocrhs=decRoundOperand(rhs, set, status);
4270 1.1 christos if (allocrhs==NULL) break;
4271 1.1 christos rhs=allocrhs;
4272 1.1 christos }
4273 1.1 christos }
4274 1.1 christos #endif
4275 1.1 christos /* [following code does not require input rounding] */
4276 1.1 christos
4277 1.1 christos bits=(lhs->bits^rhs->bits)&DECNEG; /* assumed sign for divisions */
4278 1.1 christos
4279 1.1 christos /* handle infinities and NaNs */
4280 1.1 christos if (SPECIALARGS) { /* a special bit set */
4281 1.1 christos if (SPECIALARGS & (DECSNAN | DECNAN)) { /* one or two NaNs */
4282 1.1 christos decNaNs(res, lhs, rhs, set, status);
4283 1.1 christos break;
4284 1.1 christos }
4285 1.1 christos /* one or two infinities */
4286 1.1 christos if (decNumberIsInfinite(lhs)) { /* LHS (dividend) is infinite */
4287 1.1 christos if (decNumberIsInfinite(rhs) || /* two infinities are invalid .. */
4288 1.1 christos op & (REMAINDER | REMNEAR)) { /* as is remainder of infinity */
4289 1.1 christos *status|=DEC_Invalid_operation;
4290 1.1 christos break;
4291 1.1 christos }
4292 1.1 christos /* [Note that infinity/0 raises no exceptions] */
4293 1.1 christos decNumberZero(res);
4294 1.1 christos res->bits=bits|DECINF; /* set +/- infinity */
4295 1.1 christos break;
4296 1.1 christos }
4297 1.1 christos else { /* RHS (divisor) is infinite */
4298 1.1 christos residue=0;
4299 1.1 christos if (op&(REMAINDER|REMNEAR)) {
4300 1.1 christos /* result is [finished clone of] lhs */
4301 1.1 christos decCopyFit(res, lhs, set, &residue, status);
4302 1.1 christos }
4303 1.1 christos else { /* a division */
4304 1.1 christos decNumberZero(res);
4305 1.1 christos res->bits=bits; /* set +/- zero */
4306 1.1 christos /* for DIVIDEINT the exponent is always 0. For DIVIDE, result */
4307 1.1 christos /* is a 0 with infinitely negative exponent, clamped to minimum */
4308 1.1 christos if (op&DIVIDE) {
4309 1.1 christos res->exponent=set->emin-set->digits+1;
4310 1.1 christos *status|=DEC_Clamped;
4311 1.1 christos }
4312 1.1 christos }
4313 1.1 christos decFinish(res, set, &residue, status);
4314 1.1 christos break;
4315 1.1 christos }
4316 1.1 christos }
4317 1.1 christos
4318 1.1 christos /* handle 0 rhs (x/0) */
4319 1.1 christos if (ISZERO(rhs)) { /* x/0 is always exceptional */
4320 1.1 christos if (ISZERO(lhs)) {
4321 1.1 christos decNumberZero(res); /* [after lhs test] */
4322 1.1 christos *status|=DEC_Division_undefined;/* 0/0 will become NaN */
4323 1.1 christos }
4324 1.1 christos else {
4325 1.1 christos decNumberZero(res);
4326 1.1 christos if (op&(REMAINDER|REMNEAR)) *status|=DEC_Invalid_operation;
4327 1.1 christos else {
4328 1.1 christos *status|=DEC_Division_by_zero; /* x/0 */
4329 1.1 christos res->bits=bits|DECINF; /* .. is +/- Infinity */
4330 1.1 christos }
4331 1.1 christos }
4332 1.1 christos break;}
4333 1.1 christos
4334 1.1 christos /* handle 0 lhs (0/x) */
4335 1.1 christos if (ISZERO(lhs)) { /* 0/x [x!=0] */
4336 1.1 christos #if DECSUBSET
4337 1.1 christos if (!set->extended) decNumberZero(res);
4338 1.1 christos else {
4339 1.1 christos #endif
4340 1.1 christos if (op&DIVIDE) {
4341 1.1 christos residue=0;
4342 1.1 christos exponent=lhs->exponent-rhs->exponent; /* ideal exponent */
4343 1.1 christos decNumberCopy(res, lhs); /* [zeros always fit] */
4344 1.1 christos res->bits=bits; /* sign as computed */
4345 1.1 christos res->exponent=exponent; /* exponent, too */
4346 1.1 christos decFinalize(res, set, &residue, status); /* check exponent */
4347 1.1 christos }
4348 1.1 christos else if (op&DIVIDEINT) {
4349 1.1 christos decNumberZero(res); /* integer 0 */
4350 1.1 christos res->bits=bits; /* sign as computed */
4351 1.1 christos }
4352 1.1 christos else { /* a remainder */
4353 1.1 christos exponent=rhs->exponent; /* [save in case overwrite] */
4354 1.1 christos decNumberCopy(res, lhs); /* [zeros always fit] */
4355 1.1 christos if (exponent<res->exponent) res->exponent=exponent; /* use lower */
4356 1.1 christos }
4357 1.1 christos #if DECSUBSET
4358 1.1 christos }
4359 1.1 christos #endif
4360 1.1 christos break;}
4361 1.1 christos
4362 1.1 christos /* Precalculate exponent. This starts off adjusted (and hence fits */
4363 1.1 christos /* in 31 bits) and becomes the usual unadjusted exponent as the */
4364 1.1 christos /* division proceeds. The order of evaluation is important, here, */
4365 1.1 christos /* to avoid wrap. */
4366 1.1 christos exponent=(lhs->exponent+lhs->digits)-(rhs->exponent+rhs->digits);
4367 1.1 christos
4368 1.1 christos /* If the working exponent is -ve, then some quick exits are */
4369 1.1 christos /* possible because the quotient is known to be <1 */
4370 1.1 christos /* [for REMNEAR, it needs to be < -1, as -0.5 could need work] */
4371 1.1 christos if (exponent<0 && !(op==DIVIDE)) {
4372 1.1 christos if (op&DIVIDEINT) {
4373 1.1 christos decNumberZero(res); /* integer part is 0 */
4374 1.1 christos #if DECSUBSET
4375 1.1 christos if (set->extended)
4376 1.1 christos #endif
4377 1.1 christos res->bits=bits; /* set +/- zero */
4378 1.1 christos break;}
4379 1.1 christos /* fastpath remainders so long as the lhs has the smaller */
4380 1.1 christos /* (or equal) exponent */
4381 1.1 christos if (lhs->exponent<=rhs->exponent) {
4382 1.1 christos if (op&REMAINDER || exponent<-1) {
4383 1.1 christos /* It is REMAINDER or safe REMNEAR; result is [finished */
4384 1.1 christos /* clone of] lhs (r = x - 0*y) */
4385 1.1 christos residue=0;
4386 1.1 christos decCopyFit(res, lhs, set, &residue, status);
4387 1.1 christos decFinish(res, set, &residue, status);
4388 1.1 christos break;
4389 1.1 christos }
4390 1.1 christos /* [unsafe REMNEAR drops through] */
4391 1.1 christos }
4392 1.1 christos } /* fastpaths */
4393 1.1 christos
4394 1.1 christos /* Long (slow) division is needed; roll up the sleeves... */
4395 1.1 christos
4396 1.1 christos /* The accumulator will hold the quotient of the division. */
4397 1.1 christos /* If it needs to be too long for stack storage, then allocate. */
4398 1.1 christos acclength=D2U(reqdigits+DECDPUN); /* in Units */
4399 1.1 christos if (acclength*sizeof(Unit)>sizeof(accbuff)) {
4400 1.1 christos /* printf("malloc dvacc %ld units\n", acclength); */
4401 1.1 christos allocacc=(Unit *)malloc(acclength*sizeof(Unit));
4402 1.1 christos if (allocacc==NULL) { /* hopeless -- abandon */
4403 1.1 christos *status|=DEC_Insufficient_storage;
4404 1.1 christos break;}
4405 1.1 christos acc=allocacc; /* use the allocated space */
4406 1.1 christos }
4407 1.1 christos
4408 1.1 christos /* var1 is the padded LHS ready for subtractions. */
4409 1.1 christos /* If it needs to be too long for stack storage, then allocate. */
4410 1.1 christos /* The maximum units needed for var1 (long subtraction) is: */
4411 1.1 christos /* Enough for */
4412 1.1 christos /* (rhs->digits+reqdigits-1) -- to allow full slide to right */
4413 1.1 christos /* or (lhs->digits) -- to allow for long lhs */
4414 1.1 christos /* whichever is larger */
4415 1.1 christos /* +1 -- for rounding of slide to right */
4416 1.1 christos /* +1 -- for leading 0s */
4417 1.1 christos /* +1 -- for pre-adjust if a remainder or DIVIDEINT */
4418 1.1 christos /* [Note: unused units do not participate in decUnitAddSub data] */
4419 1.1 christos maxdigits=rhs->digits+reqdigits-1;
4420 1.1 christos if (lhs->digits>maxdigits) maxdigits=lhs->digits;
4421 1.1 christos var1units=D2U(maxdigits)+2;
4422 1.1 christos /* allocate a guard unit above msu1 for REMAINDERNEAR */
4423 1.1 christos if (!(op&DIVIDE)) var1units++;
4424 1.1 christos if ((var1units+1)*sizeof(Unit)>sizeof(varbuff)) {
4425 1.1 christos /* printf("malloc dvvar %ld units\n", var1units+1); */
4426 1.1 christos varalloc=(Unit *)malloc((var1units+1)*sizeof(Unit));
4427 1.1 christos if (varalloc==NULL) { /* hopeless -- abandon */
4428 1.1 christos *status|=DEC_Insufficient_storage;
4429 1.1 christos break;}
4430 1.1 christos var1=varalloc; /* use the allocated space */
4431 1.1 christos }
4432 1.1 christos
4433 1.1 christos /* Extend the lhs and rhs to full long subtraction length. The lhs */
4434 1.1 christos /* is truly extended into the var1 buffer, with 0 padding, so a */
4435 1.1 christos /* subtract in place is always possible. The rhs (var2) has */
4436 1.1 christos /* virtual padding (implemented by decUnitAddSub). */
4437 1.1 christos /* One guard unit was allocated above msu1 for rem=rem+rem in */
4438 1.1 christos /* REMAINDERNEAR. */
4439 1.1 christos msu1=var1+var1units-1; /* msu of var1 */
4440 1.1 christos source=lhs->lsu+D2U(lhs->digits)-1; /* msu of input array */
4441 1.1 christos for (target=msu1; source>=lhs->lsu; source--, target--) *target=*source;
4442 1.1 christos for (; target>=var1; target--) *target=0;
4443 1.1 christos
4444 1.1 christos /* rhs (var2) is left-aligned with var1 at the start */
4445 1.1 christos var2ulen=var1units; /* rhs logical length (units) */
4446 1.1 christos var2units=D2U(rhs->digits); /* rhs actual length (units) */
4447 1.1 christos var2=rhs->lsu; /* -> rhs array */
4448 1.1 christos msu2=var2+var2units-1; /* -> msu of var2 [never changes] */
4449 1.1 christos /* now set up the variables which will be used for estimating the */
4450 1.1 christos /* multiplication factor. If these variables are not exact, add */
4451 1.1 christos /* 1 to make sure that the multiplier is never overestimated. */
4452 1.1 christos msu2plus=*msu2; /* it's value .. */
4453 1.1 christos if (var2units>1) msu2plus++; /* .. +1 if any more */
4454 1.1 christos msu2pair=(eInt)*msu2*(DECDPUNMAX+1);/* top two pair .. */
4455 1.1 christos if (var2units>1) { /* .. [else treat 2nd as 0] */
4456 1.1 christos msu2pair+=*(msu2-1); /* .. */
4457 1.1 christos if (var2units>2) msu2pair++; /* .. +1 if any more */
4458 1.1 christos }
4459 1.1 christos
4460 1.1 christos /* The calculation is working in units, which may have leading zeros, */
4461 1.1 christos /* but the exponent was calculated on the assumption that they are */
4462 1.1 christos /* both left-aligned. Adjust the exponent to compensate: add the */
4463 1.1 christos /* number of leading zeros in var1 msu and subtract those in var2 msu. */
4464 1.1 christos /* [This is actually done by counting the digits and negating, as */
4465 1.1 christos /* lead1=DECDPUN-digits1, and similarly for lead2.] */
4466 1.1 christos for (pow=&powers[1]; *msu1>=*pow; pow++) exponent--;
4467 1.1 christos for (pow=&powers[1]; *msu2>=*pow; pow++) exponent++;
4468 1.1 christos
4469 1.1 christos /* Now, if doing an integer divide or remainder, ensure that */
4470 1.1 christos /* the result will be Unit-aligned. To do this, shift the var1 */
4471 1.1 christos /* accumulator towards least if need be. (It's much easier to */
4472 1.1 christos /* do this now than to reassemble the residue afterwards, if */
4473 1.1 christos /* doing a remainder.) Also ensure the exponent is not negative. */
4474 1.1 christos if (!(op&DIVIDE)) {
4475 1.1 christos Unit *u; /* work */
4476 1.1 christos /* save the initial 'false' padding of var1, in digits */
4477 1.1 christos var1initpad=(var1units-D2U(lhs->digits))*DECDPUN;
4478 1.1 christos /* Determine the shift to do. */
4479 1.1 christos if (exponent<0) cut=-exponent;
4480 1.1 christos else cut=DECDPUN-exponent%DECDPUN;
4481 1.1 christos decShiftToLeast(var1, var1units, cut);
4482 1.1 christos exponent+=cut; /* maintain numerical value */
4483 1.1 christos var1initpad-=cut; /* .. and reduce padding */
4484 1.1 christos /* clean any most-significant units which were just emptied */
4485 1.1 christos for (u=msu1; cut>=DECDPUN; cut-=DECDPUN, u--) *u=0;
4486 1.1 christos } /* align */
4487 1.1 christos else { /* is DIVIDE */
4488 1.1 christos maxexponent=lhs->exponent-rhs->exponent; /* save */
4489 1.1 christos /* optimization: if the first iteration will just produce 0, */
4490 1.1 christos /* preadjust to skip it [valid for DIVIDE only] */
4491 1.1 christos if (*msu1<*msu2) {
4492 1.1 christos var2ulen--; /* shift down */
4493 1.1 christos exponent-=DECDPUN; /* update the exponent */
4494 1.1 christos }
4495 1.1 christos }
4496 1.1 christos
4497 1.1 christos /* ---- start the long-division loops ------------------------------ */
4498 1.1 christos accunits=0; /* no units accumulated yet */
4499 1.1 christos accdigits=0; /* .. or digits */
4500 1.1 christos accnext=acc+acclength-1; /* -> msu of acc [NB: allows digits+1] */
4501 1.1 christos for (;;) { /* outer forever loop */
4502 1.1 christos thisunit=0; /* current unit assumed 0 */
4503 1.1 christos /* find the next unit */
4504 1.1 christos for (;;) { /* inner forever loop */
4505 1.1 christos /* strip leading zero units [from either pre-adjust or from */
4506 1.1 christos /* subtract last time around]. Leave at least one unit. */
4507 1.1 christos for (; *msu1==0 && msu1>var1; msu1--) var1units--;
4508 1.1 christos
4509 1.1 christos if (var1units<var2ulen) break; /* var1 too low for subtract */
4510 1.1 christos if (var1units==var2ulen) { /* unit-by-unit compare needed */
4511 1.1 christos /* compare the two numbers, from msu */
4512 1.1 christos const Unit *pv1, *pv2;
4513 1.1 christos Unit v2; /* units to compare */
4514 1.1 christos pv2=msu2; /* -> msu */
4515 1.1 christos for (pv1=msu1; ; pv1--, pv2--) {
4516 1.1 christos /* v1=*pv1 -- always OK */
4517 1.1 christos v2=0; /* assume in padding */
4518 1.1 christos if (pv2>=var2) v2=*pv2; /* in range */
4519 1.1 christos if (*pv1!=v2) break; /* no longer the same */
4520 1.1 christos if (pv1==var1) break; /* done; leave pv1 as is */
4521 1.1 christos }
4522 1.1 christos /* here when all inspected or a difference seen */
4523 1.1 christos if (*pv1<v2) break; /* var1 too low to subtract */
4524 1.1 christos if (*pv1==v2) { /* var1 == var2 */
4525 1.1 christos /* reach here if var1 and var2 are identical; subtraction */
4526 1.1 christos /* would increase digit by one, and the residue will be 0 so */
4527 1.1 christos /* the calculation is done; leave the loop with residue=0. */
4528 1.1 christos thisunit++; /* as though subtracted */
4529 1.1 christos *var1=0; /* set var1 to 0 */
4530 1.1 christos var1units=1; /* .. */
4531 1.1 christos break; /* from inner */
4532 1.1 christos } /* var1 == var2 */
4533 1.1 christos /* *pv1>v2. Prepare for real subtraction; the lengths are equal */
4534 1.1 christos /* Estimate the multiplier (there's always a msu1-1)... */
4535 1.1 christos /* Bring in two units of var2 to provide a good estimate. */
4536 1.1 christos mult=(Int)(((eInt)*msu1*(DECDPUNMAX+1)+*(msu1-1))/msu2pair);
4537 1.1 christos } /* lengths the same */
4538 1.1 christos else { /* var1units > var2ulen, so subtraction is safe */
4539 1.1 christos /* The var2 msu is one unit towards the lsu of the var1 msu, */
4540 1.1 christos /* so only one unit for var2 can be used. */
4541 1.1 christos mult=(Int)(((eInt)*msu1*(DECDPUNMAX+1)+*(msu1-1))/msu2plus);
4542 1.1 christos }
4543 1.1 christos if (mult==0) mult=1; /* must always be at least 1 */
4544 1.1 christos /* subtraction needed; var1 is > var2 */
4545 1.1 christos thisunit=(Unit)(thisunit+mult); /* accumulate */
4546 1.1 christos /* subtract var1-var2, into var1; only the overlap needs */
4547 1.1 christos /* processing, as this is an in-place calculation */
4548 1.1 christos shift=var2ulen-var2units;
4549 1.1 christos #if DECTRACE
4550 1.1 christos decDumpAr('1', &var1[shift], var1units-shift);
4551 1.1 christos decDumpAr('2', var2, var2units);
4552 1.1 christos printf("m=%ld\n", -mult);
4553 1.1 christos #endif
4554 1.1 christos decUnitAddSub(&var1[shift], var1units-shift,
4555 1.1 christos var2, var2units, 0,
4556 1.1 christos &var1[shift], -mult);
4557 1.1 christos #if DECTRACE
4558 1.1 christos decDumpAr('#', &var1[shift], var1units-shift);
4559 1.1 christos #endif
4560 1.1 christos /* var1 now probably has leading zeros; these are removed at the */
4561 1.1 christos /* top of the inner loop. */
4562 1.1 christos } /* inner loop */
4563 1.1 christos
4564 1.1 christos /* The next unit has been calculated in full; unless it's a */
4565 1.1 christos /* leading zero, add to acc */
4566 1.1 christos if (accunits!=0 || thisunit!=0) { /* is first or non-zero */
4567 1.1 christos *accnext=thisunit; /* store in accumulator */
4568 1.1 christos /* account exactly for the new digits */
4569 1.1 christos if (accunits==0) {
4570 1.1 christos accdigits++; /* at least one */
4571 1.1 christos for (pow=&powers[1]; thisunit>=*pow; pow++) accdigits++;
4572 1.1 christos }
4573 1.1 christos else accdigits+=DECDPUN;
4574 1.1 christos accunits++; /* update count */
4575 1.1 christos accnext--; /* ready for next */
4576 1.1 christos if (accdigits>reqdigits) break; /* have enough digits */
4577 1.1 christos }
4578 1.1 christos
4579 1.1 christos /* if the residue is zero, the operation is done (unless divide */
4580 1.1 christos /* or divideInteger and still not enough digits yet) */
4581 1.1 christos if (*var1==0 && var1units==1) { /* residue is 0 */
4582 1.1 christos if (op&(REMAINDER|REMNEAR)) break;
4583 1.1 christos if ((op&DIVIDE) && (exponent<=maxexponent)) break;
4584 1.1 christos /* [drop through if divideInteger] */
4585 1.1 christos }
4586 1.1 christos /* also done enough if calculating remainder or integer */
4587 1.1 christos /* divide and just did the last ('units') unit */
4588 1.1 christos if (exponent==0 && !(op&DIVIDE)) break;
4589 1.1 christos
4590 1.1 christos /* to get here, var1 is less than var2, so divide var2 by the per- */
4591 1.1 christos /* Unit power of ten and go for the next digit */
4592 1.1 christos var2ulen--; /* shift down */
4593 1.1 christos exponent-=DECDPUN; /* update the exponent */
4594 1.1 christos } /* outer loop */
4595 1.1 christos
4596 1.1 christos /* ---- division is complete --------------------------------------- */
4597 1.1 christos /* here: acc has at least reqdigits+1 of good results (or fewer */
4598 1.1 christos /* if early stop), starting at accnext+1 (its lsu) */
4599 1.1 christos /* var1 has any residue at the stopping point */
4600 1.1 christos /* accunits is the number of digits collected in acc */
4601 1.1 christos if (accunits==0) { /* acc is 0 */
4602 1.1 christos accunits=1; /* show have a unit .. */
4603 1.1 christos accdigits=1; /* .. */
4604 1.1 christos *accnext=0; /* .. whose value is 0 */
4605 1.1 christos }
4606 1.1 christos else accnext++; /* back to last placed */
4607 1.1 christos /* accnext now -> lowest unit of result */
4608 1.1 christos
4609 1.1 christos residue=0; /* assume no residue */
4610 1.1 christos if (op&DIVIDE) {
4611 1.1 christos /* record the presence of any residue, for rounding */
4612 1.1 christos if (*var1!=0 || var1units>1) residue=1;
4613 1.1 christos else { /* no residue */
4614 1.1 christos /* Had an exact division; clean up spurious trailing 0s. */
4615 1.1 christos /* There will be at most DECDPUN-1, from the final multiply, */
4616 1.1 christos /* and then only if the result is non-0 (and even) and the */
4617 1.1 christos /* exponent is 'loose'. */
4618 1.1 christos #if DECDPUN>1
4619 1.1 christos Unit lsu=*accnext;
4620 1.1 christos if (!(lsu&0x01) && (lsu!=0)) {
4621 1.1 christos /* count the trailing zeros */
4622 1.1 christos Int drop=0;
4623 1.1 christos for (;; drop++) { /* [will terminate because lsu!=0] */
4624 1.1 christos if (exponent>=maxexponent) break; /* don't chop real 0s */
4625 1.1 christos #if DECDPUN<=4
4626 1.1 christos if ((lsu-QUOT10(lsu, drop+1)
4627 1.1 christos *powers[drop+1])!=0) break; /* found non-0 digit */
4628 1.1 christos #else
4629 1.1 christos if (lsu%powers[drop+1]!=0) break; /* found non-0 digit */
4630 1.1 christos #endif
4631 1.1 christos exponent++;
4632 1.1 christos }
4633 1.1 christos if (drop>0) {
4634 1.1 christos accunits=decShiftToLeast(accnext, accunits, drop);
4635 1.1 christos accdigits=decGetDigits(accnext, accunits);
4636 1.1 christos accunits=D2U(accdigits);
4637 1.1 christos /* [exponent was adjusted in the loop] */
4638 1.1 christos }
4639 1.1 christos } /* neither odd nor 0 */
4640 1.1 christos #endif
4641 1.1 christos } /* exact divide */
4642 1.1 christos } /* divide */
4643 1.1 christos else /* op!=DIVIDE */ {
4644 1.1 christos /* check for coefficient overflow */
4645 1.1 christos if (accdigits+exponent>reqdigits) {
4646 1.1 christos *status|=DEC_Division_impossible;
4647 1.1 christos break;
4648 1.1 christos }
4649 1.1 christos if (op & (REMAINDER|REMNEAR)) {
4650 1.1 christos /* [Here, the exponent will be 0, because var1 was adjusted */
4651 1.1 christos /* appropriately.] */
4652 1.1 christos Int postshift; /* work */
4653 1.1 christos Flag wasodd=0; /* integer was odd */
4654 1.1 christos Unit *quotlsu; /* for save */
4655 1.1 christos Int quotdigits; /* .. */
4656 1.1 christos
4657 1.1 christos bits=lhs->bits; /* remainder sign is always as lhs */
4658 1.1 christos
4659 1.1 christos /* Fastpath when residue is truly 0 is worthwhile [and */
4660 1.1 christos /* simplifies the code below] */
4661 1.1 christos if (*var1==0 && var1units==1) { /* residue is 0 */
4662 1.1 christos Int exp=lhs->exponent; /* save min(exponents) */
4663 1.1 christos if (rhs->exponent<exp) exp=rhs->exponent;
4664 1.1 christos decNumberZero(res); /* 0 coefficient */
4665 1.1 christos #if DECSUBSET
4666 1.1 christos if (set->extended)
4667 1.1 christos #endif
4668 1.1 christos res->exponent=exp; /* .. with proper exponent */
4669 1.1 christos res->bits=(uByte)(bits&DECNEG); /* [cleaned] */
4670 1.1 christos decFinish(res, set, &residue, status); /* might clamp */
4671 1.1 christos break;
4672 1.1 christos }
4673 1.1 christos /* note if the quotient was odd */
4674 1.1 christos if (*accnext & 0x01) wasodd=1; /* acc is odd */
4675 1.1 christos quotlsu=accnext; /* save in case need to reinspect */
4676 1.1 christos quotdigits=accdigits; /* .. */
4677 1.1 christos
4678 1.1 christos /* treat the residue, in var1, as the value to return, via acc */
4679 1.1 christos /* calculate the unused zero digits. This is the smaller of: */
4680 1.1 christos /* var1 initial padding (saved above) */
4681 1.1 christos /* var2 residual padding, which happens to be given by: */
4682 1.1 christos postshift=var1initpad+exponent-lhs->exponent+rhs->exponent;
4683 1.1 christos /* [the 'exponent' term accounts for the shifts during divide] */
4684 1.1 christos if (var1initpad<postshift) postshift=var1initpad;
4685 1.1 christos
4686 1.1 christos /* shift var1 the requested amount, and adjust its digits */
4687 1.1 christos var1units=decShiftToLeast(var1, var1units, postshift);
4688 1.1 christos accnext=var1;
4689 1.1 christos accdigits=decGetDigits(var1, var1units);
4690 1.1 christos accunits=D2U(accdigits);
4691 1.1 christos
4692 1.1 christos exponent=lhs->exponent; /* exponent is smaller of lhs & rhs */
4693 1.1 christos if (rhs->exponent<exponent) exponent=rhs->exponent;
4694 1.1 christos
4695 1.1 christos /* Now correct the result if doing remainderNear; if it */
4696 1.1 christos /* (looking just at coefficients) is > rhs/2, or == rhs/2 and */
4697 1.1 christos /* the integer was odd then the result should be rem-rhs. */
4698 1.1 christos if (op&REMNEAR) {
4699 1.1 christos Int compare, tarunits; /* work */
4700 1.1 christos Unit *up; /* .. */
4701 1.1 christos /* calculate remainder*2 into the var1 buffer (which has */
4702 1.1 christos /* 'headroom' of an extra unit and hence enough space) */
4703 1.1 christos /* [a dedicated 'double' loop would be faster, here] */
4704 1.1 christos tarunits=decUnitAddSub(accnext, accunits, accnext, accunits,
4705 1.1 christos 0, accnext, 1);
4706 1.1 christos /* decDumpAr('r', accnext, tarunits); */
4707 1.1 christos
4708 1.1 christos /* Here, accnext (var1) holds tarunits Units with twice the */
4709 1.1 christos /* remainder's coefficient, which must now be compared to the */
4710 1.1 christos /* RHS. The remainder's exponent may be smaller than the RHS's. */
4711 1.1 christos compare=decUnitCompare(accnext, tarunits, rhs->lsu, D2U(rhs->digits),
4712 1.1 christos rhs->exponent-exponent);
4713 1.1 christos if (compare==BADINT) { /* deep trouble */
4714 1.1 christos *status|=DEC_Insufficient_storage;
4715 1.1 christos break;}
4716 1.1 christos
4717 1.1 christos /* now restore the remainder by dividing by two; the lsu */
4718 1.1 christos /* is known to be even. */
4719 1.1 christos for (up=accnext; up<accnext+tarunits; up++) {
4720 1.1 christos Int half; /* half to add to lower unit */
4721 1.1 christos half=*up & 0x01;
4722 1.1 christos *up/=2; /* [shift] */
4723 1.1 christos if (!half) continue;
4724 1.1 christos *(up-1)+=(DECDPUNMAX+1)/2;
4725 1.1 christos }
4726 1.1 christos /* [accunits still describes the original remainder length] */
4727 1.1 christos
4728 1.1 christos if (compare>0 || (compare==0 && wasodd)) { /* adjustment needed */
4729 1.1 christos Int exp, expunits, exprem; /* work */
4730 1.1 christos /* This is effectively causing round-up of the quotient, */
4731 1.1 christos /* so if it was the rare case where it was full and all */
4732 1.1 christos /* nines, it would overflow and hence division-impossible */
4733 1.1 christos /* should be raised */
4734 1.1 christos Flag allnines=0; /* 1 if quotient all nines */
4735 1.1 christos if (quotdigits==reqdigits) { /* could be borderline */
4736 1.1 christos for (up=quotlsu; ; up++) {
4737 1.1 christos if (quotdigits>DECDPUN) {
4738 1.1 christos if (*up!=DECDPUNMAX) break;/* non-nines */
4739 1.1 christos }
4740 1.1 christos else { /* this is the last Unit */
4741 1.1 christos if (*up==powers[quotdigits]-1) allnines=1;
4742 1.1 christos break;
4743 1.1 christos }
4744 1.1 christos quotdigits-=DECDPUN; /* checked those digits */
4745 1.1 christos } /* up */
4746 1.1 christos } /* borderline check */
4747 1.1 christos if (allnines) {
4748 1.1 christos *status|=DEC_Division_impossible;
4749 1.1 christos break;}
4750 1.1 christos
4751 1.1 christos /* rem-rhs is needed; the sign will invert. Again, var1 */
4752 1.1 christos /* can safely be used for the working Units array. */
4753 1.1 christos exp=rhs->exponent-exponent; /* RHS padding needed */
4754 1.1 christos /* Calculate units and remainder from exponent. */
4755 1.1 christos expunits=exp/DECDPUN;
4756 1.1 christos exprem=exp%DECDPUN;
4757 1.1 christos /* subtract [A+B*(-m)]; the result will always be negative */
4758 1.1 christos accunits=-decUnitAddSub(accnext, accunits,
4759 1.1 christos rhs->lsu, D2U(rhs->digits),
4760 1.1 christos expunits, accnext, -(Int)powers[exprem]);
4761 1.1 christos accdigits=decGetDigits(accnext, accunits); /* count digits exactly */
4762 1.1 christos accunits=D2U(accdigits); /* and recalculate the units for copy */
4763 1.1 christos /* [exponent is as for original remainder] */
4764 1.1 christos bits^=DECNEG; /* flip the sign */
4765 1.1 christos }
4766 1.1 christos } /* REMNEAR */
4767 1.1 christos } /* REMAINDER or REMNEAR */
4768 1.1 christos } /* not DIVIDE */
4769 1.1 christos
4770 1.1 christos /* Set exponent and bits */
4771 1.1 christos res->exponent=exponent;
4772 1.1 christos res->bits=(uByte)(bits&DECNEG); /* [cleaned] */
4773 1.1 christos
4774 1.1 christos /* Now the coefficient. */
4775 1.1 christos decSetCoeff(res, set, accnext, accdigits, &residue, status);
4776 1.1 christos
4777 1.1 christos decFinish(res, set, &residue, status); /* final cleanup */
4778 1.1 christos
4779 1.1 christos #if DECSUBSET
4780 1.1 christos /* If a divide then strip trailing zeros if subset [after round] */
4781 1.1 christos if (!set->extended && (op==DIVIDE)) decTrim(res, set, 0, 1, &dropped);
4782 1.1 christos #endif
4783 1.1 christos } while(0); /* end protected */
4784 1.1 christos
4785 1.1 christos free(varalloc); /* drop any storage used */
4786 1.1 christos free(allocacc); /* .. */
4787 1.1 christos #if DECSUBSET
4788 1.1 christos free(allocrhs); /* .. */
4789 1.1 christos free(alloclhs); /* .. */
4790 1.1 christos #endif
4791 1.1 christos return res;
4792 1.1 christos } /* decDivideOp */
4793 1.1 christos
4794 1.1 christos /* ------------------------------------------------------------------ */
4795 1.1 christos /* decMultiplyOp -- multiplication operation */
4796 1.1 christos /* */
4797 1.1 christos /* This routine performs the multiplication C=A x B. */
4798 1.1 christos /* */
4799 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=X*X) */
4800 1.1 christos /* lhs is A */
4801 1.1 christos /* rhs is B */
4802 1.1 christos /* set is the context */
4803 1.1 christos /* status is the usual accumulator */
4804 1.1 christos /* */
4805 1.1 christos /* C must have space for set->digits digits. */
4806 1.1 christos /* */
4807 1.1 christos /* ------------------------------------------------------------------ */
4808 1.1 christos /* 'Classic' multiplication is used rather than Karatsuba, as the */
4809 1.1 christos /* latter would give only a minor improvement for the short numbers */
4810 1.1 christos /* expected to be handled most (and uses much more memory). */
4811 1.1 christos /* */
4812 1.1 christos /* There are two major paths here: the general-purpose ('old code') */
4813 1.1 christos /* path which handles all DECDPUN values, and a fastpath version */
4814 1.1 christos /* which is used if 64-bit ints are available, DECDPUN<=4, and more */
4815 1.1 christos /* than two calls to decUnitAddSub would be made. */
4816 1.1 christos /* */
4817 1.1 christos /* The fastpath version lumps units together into 8-digit or 9-digit */
4818 1.1 christos /* chunks, and also uses a lazy carry strategy to minimise expensive */
4819 1.1 christos /* 64-bit divisions. The chunks are then broken apart again into */
4820 1.1 christos /* units for continuing processing. Despite this overhead, the */
4821 1.1 christos /* fastpath can speed up some 16-digit operations by 10x (and much */
4822 1.1 christos /* more for higher-precision calculations). */
4823 1.1 christos /* */
4824 1.1 christos /* A buffer always has to be used for the accumulator; in the */
4825 1.1 christos /* fastpath, buffers are also always needed for the chunked copies of */
4826 1.1 christos /* of the operand coefficients. */
4827 1.1 christos /* Static buffers are larger than needed just for multiply, to allow */
4828 1.1 christos /* for calls from other operations (notably exp). */
4829 1.1 christos /* ------------------------------------------------------------------ */
4830 1.1 christos #define FASTMUL (DECUSE64 && DECDPUN<5)
4831 1.1 christos static decNumber * decMultiplyOp(decNumber *res, const decNumber *lhs,
4832 1.1 christos const decNumber *rhs, decContext *set,
4833 1.1 christos uInt *status) {
4834 1.1 christos Int accunits; /* Units of accumulator in use */
4835 1.1 christos Int exponent; /* work */
4836 1.1 christos Int residue=0; /* rounding residue */
4837 1.1 christos uByte bits; /* result sign */
4838 1.1 christos Unit *acc; /* -> accumulator Unit array */
4839 1.1 christos Int needbytes; /* size calculator */
4840 1.1 christos void *allocacc=NULL; /* -> allocated accumulator, iff allocated */
4841 1.1 christos Unit accbuff[SD2U(DECBUFFER*4+1)]; /* buffer (+1 for DECBUFFER==0, */
4842 1.1 christos /* *4 for calls from other operations) */
4843 1.1 christos const Unit *mer, *mermsup; /* work */
4844 1.1 christos Int madlength; /* Units in multiplicand */
4845 1.1 christos Int shift; /* Units to shift multiplicand by */
4846 1.1 christos
4847 1.1 christos #if FASTMUL
4848 1.1 christos /* if DECDPUN is 1 or 3 work in base 10**9, otherwise */
4849 1.1 christos /* (DECDPUN is 2 or 4) then work in base 10**8 */
4850 1.1 christos #if DECDPUN & 1 /* odd */
4851 1.1 christos #define FASTBASE 1000000000 /* base */
4852 1.1 christos #define FASTDIGS 9 /* digits in base */
4853 1.1 christos #define FASTLAZY 18 /* carry resolution point [1->18] */
4854 1.1 christos #else
4855 1.1 christos #define FASTBASE 100000000
4856 1.1 christos #define FASTDIGS 8
4857 1.1 christos #define FASTLAZY 1844 /* carry resolution point [1->1844] */
4858 1.1 christos #endif
4859 1.1 christos /* three buffers are used, two for chunked copies of the operands */
4860 1.1 christos /* (base 10**8 or base 10**9) and one base 2**64 accumulator with */
4861 1.1 christos /* lazy carry evaluation */
4862 1.1 christos uInt zlhibuff[(DECBUFFER*2+1)/8+1]; /* buffer (+1 for DECBUFFER==0) */
4863 1.1 christos uInt *zlhi=zlhibuff; /* -> lhs array */
4864 1.1 christos uInt *alloclhi=NULL; /* -> allocated buffer, iff allocated */
4865 1.1 christos uInt zrhibuff[(DECBUFFER*2+1)/8+1]; /* buffer (+1 for DECBUFFER==0) */
4866 1.1 christos uInt *zrhi=zrhibuff; /* -> rhs array */
4867 1.1 christos uInt *allocrhi=NULL; /* -> allocated buffer, iff allocated */
4868 1.1 christos uLong zaccbuff[(DECBUFFER*2+1)/4+2]; /* buffer (+1 for DECBUFFER==0) */
4869 1.1 christos /* [allocacc is shared for both paths, as only one will run] */
4870 1.1 christos uLong *zacc=zaccbuff; /* -> accumulator array for exact result */
4871 1.1 christos #if DECDPUN==1
4872 1.1 christos Int zoff; /* accumulator offset */
4873 1.1 christos #endif
4874 1.1 christos uInt *lip, *rip; /* item pointers */
4875 1.1 christos uInt *lmsi, *rmsi; /* most significant items */
4876 1.1 christos Int ilhs, irhs, iacc; /* item counts in the arrays */
4877 1.1 christos Int lazy; /* lazy carry counter */
4878 1.1 christos uLong lcarry; /* uLong carry */
4879 1.1 christos uInt carry; /* carry (NB not uLong) */
4880 1.1 christos Int count; /* work */
4881 1.1 christos const Unit *cup; /* .. */
4882 1.1 christos Unit *up; /* .. */
4883 1.1 christos uLong *lp; /* .. */
4884 1.1 christos Int p; /* .. */
4885 1.1 christos #endif
4886 1.1 christos
4887 1.1 christos #if DECSUBSET
4888 1.1 christos decNumber *alloclhs=NULL; /* -> allocated buffer, iff allocated */
4889 1.1 christos decNumber *allocrhs=NULL; /* -> allocated buffer, iff allocated */
4890 1.1 christos #endif
4891 1.1 christos
4892 1.1 christos #if DECCHECK
4893 1.1 christos if (decCheckOperands(res, lhs, rhs, set)) return res;
4894 1.1 christos #endif
4895 1.1 christos
4896 1.1 christos /* precalculate result sign */
4897 1.1 christos bits=(uByte)((lhs->bits^rhs->bits)&DECNEG);
4898 1.1 christos
4899 1.1 christos /* handle infinities and NaNs */
4900 1.1 christos if (SPECIALARGS) { /* a special bit set */
4901 1.1 christos if (SPECIALARGS & (DECSNAN | DECNAN)) { /* one or two NaNs */
4902 1.1 christos decNaNs(res, lhs, rhs, set, status);
4903 1.1 christos return res;}
4904 1.1 christos /* one or two infinities; Infinity * 0 is invalid */
4905 1.1 christos if (((lhs->bits & DECINF)==0 && ISZERO(lhs))
4906 1.1 christos ||((rhs->bits & DECINF)==0 && ISZERO(rhs))) {
4907 1.1 christos *status|=DEC_Invalid_operation;
4908 1.1 christos return res;}
4909 1.1 christos decNumberZero(res);
4910 1.1 christos res->bits=bits|DECINF; /* infinity */
4911 1.1 christos return res;}
4912 1.1 christos
4913 1.1 christos /* For best speed, as in DMSRCN [the original Rexx numerics */
4914 1.1 christos /* module], use the shorter number as the multiplier (rhs) and */
4915 1.1 christos /* the longer as the multiplicand (lhs) to minimise the number of */
4916 1.1 christos /* adds (partial products) */
4917 1.1 christos if (lhs->digits<rhs->digits) { /* swap... */
4918 1.1 christos const decNumber *hold=lhs;
4919 1.1 christos lhs=rhs;
4920 1.1 christos rhs=hold;
4921 1.1 christos }
4922 1.1 christos
4923 1.1 christos do { /* protect allocated storage */
4924 1.1 christos #if DECSUBSET
4925 1.1 christos if (!set->extended) {
4926 1.1 christos /* reduce operands and set lostDigits status, as needed */
4927 1.1 christos if (lhs->digits>set->digits) {
4928 1.1 christos alloclhs=decRoundOperand(lhs, set, status);
4929 1.1 christos if (alloclhs==NULL) break;
4930 1.1 christos lhs=alloclhs;
4931 1.1 christos }
4932 1.1 christos if (rhs->digits>set->digits) {
4933 1.1 christos allocrhs=decRoundOperand(rhs, set, status);
4934 1.1 christos if (allocrhs==NULL) break;
4935 1.1 christos rhs=allocrhs;
4936 1.1 christos }
4937 1.1 christos }
4938 1.1 christos #endif
4939 1.1 christos /* [following code does not require input rounding] */
4940 1.1 christos
4941 1.1 christos #if FASTMUL /* fastpath can be used */
4942 1.1 christos /* use the fast path if there are enough digits in the shorter */
4943 1.1 christos /* operand to make the setup and takedown worthwhile */
4944 1.1 christos #define NEEDTWO (DECDPUN*2) /* within two decUnitAddSub calls */
4945 1.1 christos if (rhs->digits>NEEDTWO) { /* use fastpath... */
4946 1.1 christos /* calculate the number of elements in each array */
4947 1.1 christos ilhs=(lhs->digits+FASTDIGS-1)/FASTDIGS; /* [ceiling] */
4948 1.1 christos irhs=(rhs->digits+FASTDIGS-1)/FASTDIGS; /* .. */
4949 1.1 christos iacc=ilhs+irhs;
4950 1.1 christos
4951 1.1 christos /* allocate buffers if required, as usual */
4952 1.1 christos needbytes=ilhs*sizeof(uInt);
4953 1.1 christos if (needbytes>(Int)sizeof(zlhibuff)) {
4954 1.1 christos alloclhi=(uInt *)malloc(needbytes);
4955 1.1 christos zlhi=alloclhi;}
4956 1.1 christos needbytes=irhs*sizeof(uInt);
4957 1.1 christos if (needbytes>(Int)sizeof(zrhibuff)) {
4958 1.1 christos allocrhi=(uInt *)malloc(needbytes);
4959 1.1 christos zrhi=allocrhi;}
4960 1.1 christos
4961 1.1 christos /* Allocating the accumulator space needs a special case when */
4962 1.1 christos /* DECDPUN=1 because when converting the accumulator to Units */
4963 1.1 christos /* after the multiplication each 8-byte item becomes 9 1-byte */
4964 1.1 christos /* units. Therefore iacc extra bytes are needed at the front */
4965 1.1 christos /* (rounded up to a multiple of 8 bytes), and the uLong */
4966 1.1 christos /* accumulator starts offset the appropriate number of units */
4967 1.1 christos /* to the right to avoid overwrite during the unchunking. */
4968 1.1 christos needbytes=iacc*sizeof(uLong);
4969 1.1 christos #if DECDPUN==1
4970 1.1 christos zoff=(iacc+7)/8; /* items to offset by */
4971 1.1 christos needbytes+=zoff*8;
4972 1.1 christos #endif
4973 1.1 christos if (needbytes>(Int)sizeof(zaccbuff)) {
4974 1.1 christos allocacc=(uLong *)malloc(needbytes);
4975 1.1 christos zacc=(uLong *)allocacc;}
4976 1.1 christos if (zlhi==NULL||zrhi==NULL||zacc==NULL) {
4977 1.1 christos *status|=DEC_Insufficient_storage;
4978 1.1 christos break;}
4979 1.1 christos
4980 1.1 christos acc=(Unit *)zacc; /* -> target Unit array */
4981 1.1 christos #if DECDPUN==1
4982 1.1 christos zacc+=zoff; /* start uLong accumulator to right */
4983 1.1 christos #endif
4984 1.1 christos
4985 1.1 christos /* assemble the chunked copies of the left and right sides */
4986 1.1 christos for (count=lhs->digits, cup=lhs->lsu, lip=zlhi; count>0; lip++)
4987 1.1 christos for (p=0, *lip=0; p<FASTDIGS && count>0;
4988 1.1 christos p+=DECDPUN, cup++, count-=DECDPUN)
4989 1.1 christos *lip+=*cup*powers[p];
4990 1.1 christos lmsi=lip-1; /* save -> msi */
4991 1.1 christos for (count=rhs->digits, cup=rhs->lsu, rip=zrhi; count>0; rip++)
4992 1.1 christos for (p=0, *rip=0; p<FASTDIGS && count>0;
4993 1.1 christos p+=DECDPUN, cup++, count-=DECDPUN)
4994 1.1 christos *rip+=*cup*powers[p];
4995 1.1 christos rmsi=rip-1; /* save -> msi */
4996 1.1 christos
4997 1.1 christos /* zero the accumulator */
4998 1.1 christos for (lp=zacc; lp<zacc+iacc; lp++) *lp=0;
4999 1.1 christos
5000 1.1 christos /* Start the multiplication */
5001 1.1 christos /* Resolving carries can dominate the cost of accumulating the */
5002 1.1 christos /* partial products, so this is only done when necessary. */
5003 1.1 christos /* Each uLong item in the accumulator can hold values up to */
5004 1.1 christos /* 2**64-1, and each partial product can be as large as */
5005 1.1 christos /* (10**FASTDIGS-1)**2. When FASTDIGS=9, this can be added to */
5006 1.1 christos /* itself 18.4 times in a uLong without overflowing, so during */
5007 1.1 christos /* the main calculation resolution is carried out every 18th */
5008 1.1 christos /* add -- every 162 digits. Similarly, when FASTDIGS=8, the */
5009 1.1 christos /* partial products can be added to themselves 1844.6 times in */
5010 1.1 christos /* a uLong without overflowing, so intermediate carry */
5011 1.1 christos /* resolution occurs only every 14752 digits. Hence for common */
5012 1.1 christos /* short numbers usually only the one final carry resolution */
5013 1.1 christos /* occurs. */
5014 1.1 christos /* (The count is set via FASTLAZY to simplify experiments to */
5015 1.1 christos /* measure the value of this approach: a 35% improvement on a */
5016 1.1 christos /* [34x34] multiply.) */
5017 1.1 christos lazy=FASTLAZY; /* carry delay count */
5018 1.1 christos for (rip=zrhi; rip<=rmsi; rip++) { /* over each item in rhs */
5019 1.1 christos lp=zacc+(rip-zrhi); /* where to add the lhs */
5020 1.1 christos for (lip=zlhi; lip<=lmsi; lip++, lp++) { /* over each item in lhs */
5021 1.1 christos *lp+=(uLong)(*lip)*(*rip); /* [this should in-line] */
5022 1.1 christos } /* lip loop */
5023 1.1 christos lazy--;
5024 1.1 christos if (lazy>0 && rip!=rmsi) continue;
5025 1.1 christos lazy=FASTLAZY; /* reset delay count */
5026 1.1 christos /* spin up the accumulator resolving overflows */
5027 1.1 christos for (lp=zacc; lp<zacc+iacc; lp++) {
5028 1.1 christos if (*lp<FASTBASE) continue; /* it fits */
5029 1.1 christos lcarry=*lp/FASTBASE; /* top part [slow divide] */
5030 1.1 christos /* lcarry can exceed 2**32-1, so check again; this check */
5031 1.1 christos /* and occasional extra divide (slow) is well worth it, as */
5032 1.1 christos /* it allows FASTLAZY to be increased to 18 rather than 4 */
5033 1.1 christos /* in the FASTDIGS=9 case */
5034 1.1 christos if (lcarry<FASTBASE) carry=(uInt)lcarry; /* [usual] */
5035 1.1 christos else { /* two-place carry [fairly rare] */
5036 1.1 christos uInt carry2=(uInt)(lcarry/FASTBASE); /* top top part */
5037 1.1 christos *(lp+2)+=carry2; /* add to item+2 */
5038 1.1 christos *lp-=((uLong)FASTBASE*FASTBASE*carry2); /* [slow] */
5039 1.1 christos carry=(uInt)(lcarry-((uLong)FASTBASE*carry2)); /* [inline] */
5040 1.1 christos }
5041 1.1 christos *(lp+1)+=carry; /* add to item above [inline] */
5042 1.1 christos *lp-=((uLong)FASTBASE*carry); /* [inline] */
5043 1.1 christos } /* carry resolution */
5044 1.1 christos } /* rip loop */
5045 1.1 christos
5046 1.1 christos /* The multiplication is complete; time to convert back into */
5047 1.1 christos /* units. This can be done in-place in the accumulator and in */
5048 1.1 christos /* 32-bit operations, because carries were resolved after the */
5049 1.1 christos /* final add. This needs N-1 divides and multiplies for */
5050 1.1 christos /* each item in the accumulator (which will become up to N */
5051 1.1 christos /* units, where 2<=N<=9). */
5052 1.1 christos for (lp=zacc, up=acc; lp<zacc+iacc; lp++) {
5053 1.1 christos uInt item=(uInt)*lp; /* decapitate to uInt */
5054 1.1 christos for (p=0; p<FASTDIGS-DECDPUN; p+=DECDPUN, up++) {
5055 1.1 christos uInt part=item/(DECDPUNMAX+1);
5056 1.1 christos *up=(Unit)(item-(part*(DECDPUNMAX+1)));
5057 1.1 christos item=part;
5058 1.1 christos } /* p */
5059 1.1 christos *up=(Unit)item; up++; /* [final needs no division] */
5060 1.1 christos } /* lp */
5061 1.1 christos accunits=up-acc; /* count of units */
5062 1.1 christos }
5063 1.1 christos else { /* here to use units directly, without chunking ['old code'] */
5064 1.1 christos #endif
5065 1.1 christos
5066 1.1 christos /* if accumulator will be too long for local storage, then allocate */
5067 1.1 christos acc=accbuff; /* -> assume buffer for accumulator */
5068 1.1 christos needbytes=(D2U(lhs->digits)+D2U(rhs->digits))*sizeof(Unit);
5069 1.1 christos if (needbytes>(Int)sizeof(accbuff)) {
5070 1.1 christos allocacc=(Unit *)malloc(needbytes);
5071 1.1 christos if (allocacc==NULL) {*status|=DEC_Insufficient_storage; break;}
5072 1.1 christos acc=(Unit *)allocacc; /* use the allocated space */
5073 1.1 christos }
5074 1.1 christos
5075 1.1 christos /* Now the main long multiplication loop */
5076 1.1 christos /* Unlike the equivalent in the IBM Java implementation, there */
5077 1.1 christos /* is no advantage in calculating from msu to lsu. So, do it */
5078 1.1 christos /* by the book, as it were. */
5079 1.1 christos /* Each iteration calculates ACC=ACC+MULTAND*MULT */
5080 1.1 christos accunits=1; /* accumulator starts at '0' */
5081 1.1 christos *acc=0; /* .. (lsu=0) */
5082 1.1 christos shift=0; /* no multiplicand shift at first */
5083 1.1 christos madlength=D2U(lhs->digits); /* this won't change */
5084 1.1 christos mermsup=rhs->lsu+D2U(rhs->digits); /* -> msu+1 of multiplier */
5085 1.1 christos
5086 1.1 christos for (mer=rhs->lsu; mer<mermsup; mer++) {
5087 1.1 christos /* Here, *mer is the next Unit in the multiplier to use */
5088 1.1 christos /* If non-zero [optimization] add it... */
5089 1.1 christos if (*mer!=0) accunits=decUnitAddSub(&acc[shift], accunits-shift,
5090 1.1 christos lhs->lsu, madlength, 0,
5091 1.1 christos &acc[shift], *mer)
5092 1.1 christos + shift;
5093 1.1 christos else { /* extend acc with a 0; it will be used shortly */
5094 1.1 christos *(acc+accunits)=0; /* [this avoids length of <=0 later] */
5095 1.1 christos accunits++;
5096 1.1 christos }
5097 1.1 christos /* multiply multiplicand by 10**DECDPUN for next Unit to left */
5098 1.1 christos shift++; /* add this for 'logical length' */
5099 1.1 christos } /* n */
5100 1.1 christos #if FASTMUL
5101 1.1 christos } /* unchunked units */
5102 1.1 christos #endif
5103 1.1 christos /* common end-path */
5104 1.1 christos #if DECTRACE
5105 1.1 christos decDumpAr('*', acc, accunits); /* Show exact result */
5106 1.1 christos #endif
5107 1.1 christos
5108 1.1 christos /* acc now contains the exact result of the multiplication, */
5109 1.1 christos /* possibly with a leading zero unit; build the decNumber from */
5110 1.1 christos /* it, noting if any residue */
5111 1.1 christos res->bits=bits; /* set sign */
5112 1.1 christos res->digits=decGetDigits(acc, accunits); /* count digits exactly */
5113 1.1 christos
5114 1.1 christos /* There can be a 31-bit wrap in calculating the exponent. */
5115 1.1 christos /* This can only happen if both input exponents are negative and */
5116 1.1 christos /* both their magnitudes are large. If there was a wrap, set a */
5117 1.1 christos /* safe very negative exponent, from which decFinalize() will */
5118 1.1 christos /* raise a hard underflow shortly. */
5119 1.1 christos exponent=lhs->exponent+rhs->exponent; /* calculate exponent */
5120 1.1 christos if (lhs->exponent<0 && rhs->exponent<0 && exponent>0)
5121 1.1 christos exponent=-2*DECNUMMAXE; /* force underflow */
5122 1.1 christos res->exponent=exponent; /* OK to overwrite now */
5123 1.1 christos
5124 1.1 christos
5125 1.1 christos /* Set the coefficient. If any rounding, residue records */
5126 1.1 christos decSetCoeff(res, set, acc, res->digits, &residue, status);
5127 1.1 christos decFinish(res, set, &residue, status); /* final cleanup */
5128 1.1 christos } while(0); /* end protected */
5129 1.1 christos
5130 1.1 christos free(allocacc); /* drop any storage used */
5131 1.1 christos #if DECSUBSET
5132 1.1 christos free(allocrhs); /* .. */
5133 1.1 christos free(alloclhs); /* .. */
5134 1.1 christos #endif
5135 1.1 christos #if FASTMUL
5136 1.1 christos free(allocrhi); /* .. */
5137 1.1 christos free(alloclhi); /* .. */
5138 1.1 christos #endif
5139 1.1 christos return res;
5140 1.1 christos } /* decMultiplyOp */
5141 1.1 christos
5142 1.1 christos /* ------------------------------------------------------------------ */
5143 1.1 christos /* decExpOp -- effect exponentiation */
5144 1.1 christos /* */
5145 1.1 christos /* This computes C = exp(A) */
5146 1.1 christos /* */
5147 1.1 christos /* res is C, the result. C may be A */
5148 1.1 christos /* rhs is A */
5149 1.1 christos /* set is the context; note that rounding mode has no effect */
5150 1.1 christos /* */
5151 1.1 christos /* C must have space for set->digits digits. status is updated but */
5152 1.1 christos /* not set. */
5153 1.1 christos /* */
5154 1.1 christos /* Restrictions: */
5155 1.1 christos /* */
5156 1.1 christos /* digits, emax, and -emin in the context must be less than */
5157 1.1 christos /* 2*DEC_MAX_MATH (1999998), and the rhs must be within these */
5158 1.1 christos /* bounds or a zero. This is an internal routine, so these */
5159 1.1 christos /* restrictions are contractual and not enforced. */
5160 1.1 christos /* */
5161 1.1 christos /* A finite result is rounded using DEC_ROUND_HALF_EVEN; it will */
5162 1.1 christos /* almost always be correctly rounded, but may be up to 1 ulp in */
5163 1.1 christos /* error in rare cases. */
5164 1.1 christos /* */
5165 1.1 christos /* Finite results will always be full precision and Inexact, except */
5166 1.1 christos /* when A is a zero or -Infinity (giving 1 or 0 respectively). */
5167 1.1 christos /* ------------------------------------------------------------------ */
5168 1.1 christos /* This approach used here is similar to the algorithm described in */
5169 1.1 christos /* */
5170 1.1 christos /* Variable Precision Exponential Function, T. E. Hull and */
5171 1.1 christos /* A. Abrham, ACM Transactions on Mathematical Software, Vol 12 #2, */
5172 1.1 christos /* pp79-91, ACM, June 1986. */
5173 1.1 christos /* */
5174 1.1 christos /* with the main difference being that the iterations in the series */
5175 1.1 christos /* evaluation are terminated dynamically (which does not require the */
5176 1.1 christos /* extra variable-precision variables which are expensive in this */
5177 1.1 christos /* context). */
5178 1.1 christos /* */
5179 1.1 christos /* The error analysis in Hull & Abrham's paper applies except for the */
5180 1.1 christos /* round-off error accumulation during the series evaluation. This */
5181 1.1 christos /* code does not precalculate the number of iterations and so cannot */
5182 1.1 christos /* use Horner's scheme. Instead, the accumulation is done at double- */
5183 1.1 christos /* precision, which ensures that the additions of the terms are exact */
5184 1.1 christos /* and do not accumulate round-off (and any round-off errors in the */
5185 1.1 christos /* terms themselves move 'to the right' faster than they can */
5186 1.1 christos /* accumulate). This code also extends the calculation by allowing, */
5187 1.1 christos /* in the spirit of other decNumber operators, the input to be more */
5188 1.1 christos /* precise than the result (the precision used is based on the more */
5189 1.1 christos /* precise of the input or requested result). */
5190 1.1 christos /* */
5191 1.1 christos /* Implementation notes: */
5192 1.1 christos /* */
5193 1.1 christos /* 1. This is separated out as decExpOp so it can be called from */
5194 1.1 christos /* other Mathematical functions (notably Ln) with a wider range */
5195 1.1 christos /* than normal. In particular, it can handle the slightly wider */
5196 1.1 christos /* (double) range needed by Ln (which has to be able to calculate */
5197 1.1 christos /* exp(-x) where x can be the tiniest number (Ntiny). */
5198 1.1 christos /* */
5199 1.1 christos /* 2. Normalizing x to be <=0.1 (instead of <=1) reduces loop */
5200 1.1 christos /* iterations by appoximately a third with additional (although */
5201 1.1 christos /* diminishing) returns as the range is reduced to even smaller */
5202 1.1 christos /* fractions. However, h (the power of 10 used to correct the */
5203 1.1 christos /* result at the end, see below) must be kept <=8 as otherwise */
5204 1.1 christos /* the final result cannot be computed. Hence the leverage is a */
5205 1.1 christos /* sliding value (8-h), where potentially the range is reduced */
5206 1.1 christos /* more for smaller values. */
5207 1.1 christos /* */
5208 1.1 christos /* The leverage that can be applied in this way is severely */
5209 1.1 christos /* limited by the cost of the raise-to-the power at the end, */
5210 1.1 christos /* which dominates when the number of iterations is small (less */
5211 1.1 christos /* than ten) or when rhs is short. As an example, the adjustment */
5212 1.1 christos /* x**10,000,000 needs 31 multiplications, all but one full-width. */
5213 1.1 christos /* */
5214 1.1 christos /* 3. The restrictions (especially precision) could be raised with */
5215 1.1 christos /* care, but the full decNumber range seems very hard within the */
5216 1.1 christos /* 32-bit limits. */
5217 1.1 christos /* */
5218 1.1 christos /* 4. The working precisions for the static buffers are twice the */
5219 1.1 christos /* obvious size to allow for calls from decNumberPower. */
5220 1.1 christos /* ------------------------------------------------------------------ */
5221 1.1 christos decNumber * decExpOp(decNumber *res, const decNumber *rhs,
5222 1.1 christos decContext *set, uInt *status) {
5223 1.1 christos uInt ignore=0; /* working status */
5224 1.1 christos Int h; /* adjusted exponent for 0.xxxx */
5225 1.1 christos Int p; /* working precision */
5226 1.1 christos Int residue; /* rounding residue */
5227 1.1 christos uInt needbytes; /* for space calculations */
5228 1.1 christos const decNumber *x=rhs; /* (may point to safe copy later) */
5229 1.1 christos decContext aset, tset, dset; /* working contexts */
5230 1.1 christos Int comp; /* work */
5231 1.1 christos
5232 1.1 christos /* the argument is often copied to normalize it, so (unusually) it */
5233 1.1 christos /* is treated like other buffers, using DECBUFFER, +1 in case */
5234 1.1 christos /* DECBUFFER is 0 */
5235 1.1 christos decNumber bufr[D2N(DECBUFFER*2+1)];
5236 1.1 christos decNumber *allocrhs=NULL; /* non-NULL if rhs buffer allocated */
5237 1.1 christos
5238 1.1 christos /* the working precision will be no more than set->digits+8+1 */
5239 1.1 christos /* so for on-stack buffers DECBUFFER+9 is used, +1 in case DECBUFFER */
5240 1.1 christos /* is 0 (and twice that for the accumulator) */
5241 1.1 christos
5242 1.1 christos /* buffer for t, term (working precision plus) */
5243 1.1 christos decNumber buft[D2N(DECBUFFER*2+9+1)];
5244 1.1 christos decNumber *allocbuft=NULL; /* -> allocated buft, iff allocated */
5245 1.1 christos decNumber *t=buft; /* term */
5246 1.1 christos /* buffer for a, accumulator (working precision * 2), at least 9 */
5247 1.1 christos decNumber bufa[D2N(DECBUFFER*4+18+1)];
5248 1.1 christos decNumber *allocbufa=NULL; /* -> allocated bufa, iff allocated */
5249 1.1 christos decNumber *a=bufa; /* accumulator */
5250 1.1 christos /* decNumber for the divisor term; this needs at most 9 digits */
5251 1.1 christos /* and so can be fixed size [16 so can use standard context] */
5252 1.1 christos decNumber bufd[D2N(16)];
5253 1.1 christos decNumber *d=bufd; /* divisor */
5254 1.1 christos decNumber numone; /* constant 1 */
5255 1.1 christos
5256 1.1 christos #if DECCHECK
5257 1.1 christos Int iterations=0; /* for later sanity check */
5258 1.1 christos if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
5259 1.1 christos #endif
5260 1.1 christos
5261 1.1 christos do { /* protect allocated storage */
5262 1.1 christos if (SPECIALARG) { /* handle infinities and NaNs */
5263 1.1 christos if (decNumberIsInfinite(rhs)) { /* an infinity */
5264 1.1 christos if (decNumberIsNegative(rhs)) /* -Infinity -> +0 */
5265 1.1 christos decNumberZero(res);
5266 1.1 christos else decNumberCopy(res, rhs); /* +Infinity -> self */
5267 1.1 christos }
5268 1.1 christos else decNaNs(res, rhs, NULL, set, status); /* a NaN */
5269 1.1 christos break;}
5270 1.1 christos
5271 1.1 christos if (ISZERO(rhs)) { /* zeros -> exact 1 */
5272 1.1 christos decNumberZero(res); /* make clean 1 */
5273 1.1 christos *res->lsu=1; /* .. */
5274 1.1 christos break;} /* [no status to set] */
5275 1.1 christos
5276 1.1 christos /* e**x when 0 < x < 0.66 is < 1+3x/2, hence can fast-path */
5277 1.1 christos /* positive and negative tiny cases which will result in inexact */
5278 1.1 christos /* 1. This also allows the later add-accumulate to always be */
5279 1.1 christos /* exact (because its length will never be more than twice the */
5280 1.1 christos /* working precision). */
5281 1.1 christos /* The comparator (tiny) needs just one digit, so use the */
5282 1.1 christos /* decNumber d for it (reused as the divisor, etc., below); its */
5283 1.1 christos /* exponent is such that if x is positive it will have */
5284 1.1 christos /* set->digits-1 zeros between the decimal point and the digit, */
5285 1.1 christos /* which is 4, and if x is negative one more zero there as the */
5286 1.1 christos /* more precise result will be of the form 0.9999999 rather than */
5287 1.1 christos /* 1.0000001. Hence, tiny will be 0.0000004 if digits=7 and x>0 */
5288 1.1 christos /* or 0.00000004 if digits=7 and x<0. If RHS not larger than */
5289 1.1 christos /* this then the result will be 1.000000 */
5290 1.1 christos decNumberZero(d); /* clean */
5291 1.1 christos *d->lsu=4; /* set 4 .. */
5292 1.1 christos d->exponent=-set->digits; /* * 10**(-d) */
5293 1.1 christos if (decNumberIsNegative(rhs)) d->exponent--; /* negative case */
5294 1.1 christos comp=decCompare(d, rhs, 1); /* signless compare */
5295 1.1 christos if (comp==BADINT) {
5296 1.1 christos *status|=DEC_Insufficient_storage;
5297 1.1 christos break;}
5298 1.1 christos if (comp>=0) { /* rhs < d */
5299 1.1 christos Int shift=set->digits-1;
5300 1.1 christos decNumberZero(res); /* set 1 */
5301 1.1 christos *res->lsu=1; /* .. */
5302 1.1 christos res->digits=decShiftToMost(res->lsu, 1, shift);
5303 1.1 christos res->exponent=-shift; /* make 1.0000... */
5304 1.1 christos *status|=DEC_Inexact | DEC_Rounded; /* .. inexactly */
5305 1.1 christos break;} /* tiny */
5306 1.1 christos
5307 1.1 christos /* set up the context to be used for calculating a, as this is */
5308 1.1 christos /* used on both paths below */
5309 1.1 christos decContextDefault(&aset, DEC_INIT_DECIMAL64);
5310 1.1 christos /* accumulator bounds are as requested (could underflow) */
5311 1.1 christos aset.emax=set->emax; /* usual bounds */
5312 1.1 christos aset.emin=set->emin; /* .. */
5313 1.1 christos aset.clamp=0; /* and no concrete format */
5314 1.1 christos
5315 1.1 christos /* calculate the adjusted (Hull & Abrham) exponent (where the */
5316 1.1 christos /* decimal point is just to the left of the coefficient msd) */
5317 1.1 christos h=rhs->exponent+rhs->digits;
5318 1.1 christos /* if h>8 then 10**h cannot be calculated safely; however, when */
5319 1.1 christos /* h=8 then exp(|rhs|) will be at least exp(1E+7) which is at */
5320 1.1 christos /* least 6.59E+4342944, so (due to the restriction on Emax/Emin) */
5321 1.1 christos /* overflow (or underflow to 0) is guaranteed -- so this case can */
5322 1.1 christos /* be handled by simply forcing the appropriate excess */
5323 1.1 christos if (h>8) { /* overflow/underflow */
5324 1.1 christos /* set up here so Power call below will over or underflow to */
5325 1.1 christos /* zero; set accumulator to either 2 or 0.02 */
5326 1.1 christos /* [stack buffer for a is always big enough for this] */
5327 1.1 christos decNumberZero(a);
5328 1.1 christos *a->lsu=2; /* not 1 but < exp(1) */
5329 1.1 christos if (decNumberIsNegative(rhs)) a->exponent=-2; /* make 0.02 */
5330 1.1 christos h=8; /* clamp so 10**h computable */
5331 1.1 christos p=9; /* set a working precision */
5332 1.1 christos }
5333 1.1 christos else { /* h<=8 */
5334 1.1 christos Int maxlever=(rhs->digits>8?1:0);
5335 1.1 christos /* [could/should increase this for precisions >40 or so, too] */
5336 1.1 christos
5337 1.1 christos /* if h is 8, cannot normalize to a lower upper limit because */
5338 1.1 christos /* the final result will not be computable (see notes above), */
5339 1.1 christos /* but leverage can be applied whenever h is less than 8. */
5340 1.1 christos /* Apply as much as possible, up to a MAXLEVER digits, which */
5341 1.1 christos /* sets the tradeoff against the cost of the later a**(10**h). */
5342 1.1 christos /* As h is increased, the working precision below also */
5343 1.1 christos /* increases to compensate for the "constant digits at the */
5344 1.1 christos /* front" effect. */
5345 1.1 christos Int lever=MINI(8-h, maxlever); /* leverage attainable */
5346 1.1 christos Int use=-rhs->digits-lever; /* exponent to use for RHS */
5347 1.1 christos h+=lever; /* apply leverage selected */
5348 1.1 christos if (h<0) { /* clamp */
5349 1.1 christos use+=h; /* [may end up subnormal] */
5350 1.1 christos h=0;
5351 1.1 christos }
5352 1.1 christos /* Take a copy of RHS if it needs normalization (true whenever x>=1) */
5353 1.1 christos if (rhs->exponent!=use) {
5354 1.1 christos decNumber *newrhs=bufr; /* assume will fit on stack */
5355 1.1 christos needbytes=sizeof(decNumber)+(D2U(rhs->digits)-1)*sizeof(Unit);
5356 1.1 christos if (needbytes>sizeof(bufr)) { /* need malloc space */
5357 1.1 christos allocrhs=(decNumber *)malloc(needbytes);
5358 1.1 christos if (allocrhs==NULL) { /* hopeless -- abandon */
5359 1.1 christos *status|=DEC_Insufficient_storage;
5360 1.1 christos break;}
5361 1.1 christos newrhs=allocrhs; /* use the allocated space */
5362 1.1 christos }
5363 1.1 christos decNumberCopy(newrhs, rhs); /* copy to safe space */
5364 1.1 christos newrhs->exponent=use; /* normalize; now <1 */
5365 1.1 christos x=newrhs; /* ready for use */
5366 1.1 christos /* decNumberShow(x); */
5367 1.1 christos }
5368 1.1 christos
5369 1.1 christos /* Now use the usual power series to evaluate exp(x). The */
5370 1.1 christos /* series starts as 1 + x + x^2/2 ... so prime ready for the */
5371 1.1 christos /* third term by setting the term variable t=x, the accumulator */
5372 1.1 christos /* a=1, and the divisor d=2. */
5373 1.1 christos
5374 1.1 christos /* First determine the working precision. From Hull & Abrham */
5375 1.1 christos /* this is set->digits+h+2. However, if x is 'over-precise' we */
5376 1.1 christos /* need to allow for all its digits to potentially participate */
5377 1.1 christos /* (consider an x where all the excess digits are 9s) so in */
5378 1.1 christos /* this case use x->digits+h+2 */
5379 1.1 christos p=MAXI(x->digits, set->digits)+h+2; /* [h<=8] */
5380 1.1 christos
5381 1.1 christos /* a and t are variable precision, and depend on p, so space */
5382 1.1 christos /* must be allocated for them if necessary */
5383 1.1 christos
5384 1.1 christos /* the accumulator needs to be able to hold 2p digits so that */
5385 1.1 christos /* the additions on the second and subsequent iterations are */
5386 1.1 christos /* sufficiently exact. */
5387 1.1 christos needbytes=sizeof(decNumber)+(D2U(p*2)-1)*sizeof(Unit);
5388 1.1 christos if (needbytes>sizeof(bufa)) { /* need malloc space */
5389 1.1 christos allocbufa=(decNumber *)malloc(needbytes);
5390 1.1 christos if (allocbufa==NULL) { /* hopeless -- abandon */
5391 1.1 christos *status|=DEC_Insufficient_storage;
5392 1.1 christos break;}
5393 1.1 christos a=allocbufa; /* use the allocated space */
5394 1.1 christos }
5395 1.1 christos /* the term needs to be able to hold p digits (which is */
5396 1.1 christos /* guaranteed to be larger than x->digits, so the initial copy */
5397 1.1 christos /* is safe); it may also be used for the raise-to-power */
5398 1.1 christos /* calculation below, which needs an extra two digits */
5399 1.1 christos needbytes=sizeof(decNumber)+(D2U(p+2)-1)*sizeof(Unit);
5400 1.1 christos if (needbytes>sizeof(buft)) { /* need malloc space */
5401 1.1 christos allocbuft=(decNumber *)malloc(needbytes);
5402 1.1 christos if (allocbuft==NULL) { /* hopeless -- abandon */
5403 1.1 christos *status|=DEC_Insufficient_storage;
5404 1.1 christos break;}
5405 1.1 christos t=allocbuft; /* use the allocated space */
5406 1.1 christos }
5407 1.1 christos
5408 1.1 christos decNumberCopy(t, x); /* term=x */
5409 1.1 christos decNumberZero(a); *a->lsu=1; /* accumulator=1 */
5410 1.1 christos decNumberZero(d); *d->lsu=2; /* divisor=2 */
5411 1.1 christos decNumberZero(&numone); *numone.lsu=1; /* constant 1 for increment */
5412 1.1 christos
5413 1.1 christos /* set up the contexts for calculating a, t, and d */
5414 1.1 christos decContextDefault(&tset, DEC_INIT_DECIMAL64);
5415 1.1 christos dset=tset;
5416 1.1 christos /* accumulator bounds are set above, set precision now */
5417 1.1 christos aset.digits=p*2; /* double */
5418 1.1 christos /* term bounds avoid any underflow or overflow */
5419 1.1 christos tset.digits=p;
5420 1.1 christos tset.emin=DEC_MIN_EMIN; /* [emax is plenty] */
5421 1.1 christos /* [dset.digits=16, etc., are sufficient] */
5422 1.1 christos
5423 1.1 christos /* finally ready to roll */
5424 1.1 christos for (;;) {
5425 1.1 christos #if DECCHECK
5426 1.1 christos iterations++;
5427 1.1 christos #endif
5428 1.1 christos /* only the status from the accumulation is interesting */
5429 1.1 christos /* [but it should remain unchanged after first add] */
5430 1.1 christos decAddOp(a, a, t, &aset, 0, status); /* a=a+t */
5431 1.1 christos decMultiplyOp(t, t, x, &tset, &ignore); /* t=t*x */
5432 1.1 christos decDivideOp(t, t, d, &tset, DIVIDE, &ignore); /* t=t/d */
5433 1.1 christos /* the iteration ends when the term cannot affect the result, */
5434 1.1 christos /* if rounded to p digits, which is when its value is smaller */
5435 1.1 christos /* than the accumulator by p+1 digits. There must also be */
5436 1.1 christos /* full precision in a. */
5437 1.1 christos if (((a->digits+a->exponent)>=(t->digits+t->exponent+p+1))
5438 1.1 christos && (a->digits>=p)) break;
5439 1.1 christos decAddOp(d, d, &numone, &dset, 0, &ignore); /* d=d+1 */
5440 1.1 christos } /* iterate */
5441 1.1 christos
5442 1.1 christos #if DECCHECK
5443 1.1 christos /* just a sanity check; comment out test to show always */
5444 1.1 christos if (iterations>p+3)
5445 1.1 christos printf("Exp iterations=%ld, status=%08lx, p=%ld, d=%ld\n",
5446 1.1 christos (LI)iterations, (LI)*status, (LI)p, (LI)x->digits);
5447 1.1 christos #endif
5448 1.1 christos } /* h<=8 */
5449 1.1 christos
5450 1.1 christos /* apply postconditioning: a=a**(10**h) -- this is calculated */
5451 1.1 christos /* at a slightly higher precision than Hull & Abrham suggest */
5452 1.1 christos if (h>0) {
5453 1.1 christos Int seenbit=0; /* set once a 1-bit is seen */
5454 1.1 christos Int i; /* counter */
5455 1.1 christos Int n=powers[h]; /* always positive */
5456 1.1 christos aset.digits=p+2; /* sufficient precision */
5457 1.1 christos /* avoid the overhead and many extra digits of decNumberPower */
5458 1.1 christos /* as all that is needed is the short 'multipliers' loop; here */
5459 1.1 christos /* accumulate the answer into t */
5460 1.1 christos decNumberZero(t); *t->lsu=1; /* acc=1 */
5461 1.1 christos for (i=1;;i++){ /* for each bit [top bit ignored] */
5462 1.1 christos /* abandon if have had overflow or terminal underflow */
5463 1.1 christos if (*status & (DEC_Overflow|DEC_Underflow)) { /* interesting? */
5464 1.1 christos if (*status&DEC_Overflow || ISZERO(t)) break;}
5465 1.1 christos n=n<<1; /* move next bit to testable position */
5466 1.1 christos if (n<0) { /* top bit is set */
5467 1.1 christos seenbit=1; /* OK, have a significant bit */
5468 1.1 christos decMultiplyOp(t, t, a, &aset, status); /* acc=acc*x */
5469 1.1 christos }
5470 1.1 christos if (i==31) break; /* that was the last bit */
5471 1.1 christos if (!seenbit) continue; /* no need to square 1 */
5472 1.1 christos decMultiplyOp(t, t, t, &aset, status); /* acc=acc*acc [square] */
5473 1.1 christos } /*i*/ /* 32 bits */
5474 1.1 christos /* decNumberShow(t); */
5475 1.1 christos a=t; /* and carry on using t instead of a */
5476 1.1 christos }
5477 1.1 christos
5478 1.1 christos /* Copy and round the result to res */
5479 1.1 christos residue=1; /* indicate dirt to right .. */
5480 1.1 christos if (ISZERO(a)) residue=0; /* .. unless underflowed to 0 */
5481 1.1 christos aset.digits=set->digits; /* [use default rounding] */
5482 1.1 christos decCopyFit(res, a, &aset, &residue, status); /* copy & shorten */
5483 1.1 christos decFinish(res, set, &residue, status); /* cleanup/set flags */
5484 1.1 christos } while(0); /* end protected */
5485 1.1 christos
5486 1.1 christos free(allocrhs); /* drop any storage used */
5487 1.1 christos free(allocbufa); /* .. */
5488 1.1 christos free(allocbuft); /* .. */
5489 1.1 christos /* [status is handled by caller] */
5490 1.1 christos return res;
5491 1.1 christos } /* decExpOp */
5492 1.1 christos
5493 1.1 christos /* ------------------------------------------------------------------ */
5494 1.1 christos /* Initial-estimate natural logarithm table */
5495 1.1 christos /* */
5496 1.1 christos /* LNnn -- 90-entry 16-bit table for values from .10 through .99. */
5497 1.1 christos /* The result is a 4-digit encode of the coefficient (c=the */
5498 1.1 christos /* top 14 bits encoding 0-9999) and a 2-digit encode of the */
5499 1.1 christos /* exponent (e=the bottom 2 bits encoding 0-3) */
5500 1.1 christos /* */
5501 1.1 christos /* The resulting value is given by: */
5502 1.1 christos /* */
5503 1.1 christos /* v = -c * 10**(-e-3) */
5504 1.1 christos /* */
5505 1.1 christos /* where e and c are extracted from entry k = LNnn[x-10] */
5506 1.1 christos /* where x is truncated (NB) into the range 10 through 99, */
5507 1.1 christos /* and then c = k>>2 and e = k&3. */
5508 1.1 christos /* ------------------------------------------------------------------ */
5509 1.1 christos const uShort LNnn[90]={9016, 8652, 8316, 8008, 7724, 7456, 7208,
5510 1.1 christos 6972, 6748, 6540, 6340, 6148, 5968, 5792, 5628, 5464, 5312,
5511 1.1 christos 5164, 5020, 4884, 4748, 4620, 4496, 4376, 4256, 4144, 4032,
5512 1.1 christos 39233, 38181, 37157, 36157, 35181, 34229, 33297, 32389, 31501, 30629,
5513 1.1 christos 29777, 28945, 28129, 27329, 26545, 25777, 25021, 24281, 23553, 22837,
5514 1.1 christos 22137, 21445, 20769, 20101, 19445, 18801, 18165, 17541, 16925, 16321,
5515 1.1 christos 15721, 15133, 14553, 13985, 13421, 12865, 12317, 11777, 11241, 10717,
5516 1.1 christos 10197, 9685, 9177, 8677, 8185, 7697, 7213, 6737, 6269, 5801,
5517 1.1 christos 5341, 4889, 4437, 39930, 35534, 31186, 26886, 22630, 18418, 14254,
5518 1.1 christos 10130, 6046, 20055};
5519 1.1 christos
5520 1.1 christos /* ------------------------------------------------------------------ */
5521 1.1 christos /* decLnOp -- effect natural logarithm */
5522 1.1 christos /* */
5523 1.1 christos /* This computes C = ln(A) */
5524 1.1 christos /* */
5525 1.1 christos /* res is C, the result. C may be A */
5526 1.1 christos /* rhs is A */
5527 1.1 christos /* set is the context; note that rounding mode has no effect */
5528 1.1 christos /* */
5529 1.1 christos /* C must have space for set->digits digits. */
5530 1.1 christos /* */
5531 1.1 christos /* Notable cases: */
5532 1.1 christos /* A<0 -> Invalid */
5533 1.1 christos /* A=0 -> -Infinity (Exact) */
5534 1.1 christos /* A=+Infinity -> +Infinity (Exact) */
5535 1.1 christos /* A=1 exactly -> 0 (Exact) */
5536 1.1 christos /* */
5537 1.1 christos /* Restrictions (as for Exp): */
5538 1.1 christos /* */
5539 1.1 christos /* digits, emax, and -emin in the context must be less than */
5540 1.1 christos /* DEC_MAX_MATH+11 (1000010), and the rhs must be within these */
5541 1.1 christos /* bounds or a zero. This is an internal routine, so these */
5542 1.1 christos /* restrictions are contractual and not enforced. */
5543 1.1 christos /* */
5544 1.1 christos /* A finite result is rounded using DEC_ROUND_HALF_EVEN; it will */
5545 1.1 christos /* almost always be correctly rounded, but may be up to 1 ulp in */
5546 1.1 christos /* error in rare cases. */
5547 1.1 christos /* ------------------------------------------------------------------ */
5548 1.1 christos /* The result is calculated using Newton's method, with each */
5549 1.1 christos /* iteration calculating a' = a + x * exp(-a) - 1. See, for example, */
5550 1.1 christos /* Epperson 1989. */
5551 1.1 christos /* */
5552 1.1 christos /* The iteration ends when the adjustment x*exp(-a)-1 is tiny enough. */
5553 1.1 christos /* This has to be calculated at the sum of the precision of x and the */
5554 1.1 christos /* working precision. */
5555 1.1 christos /* */
5556 1.1 christos /* Implementation notes: */
5557 1.1 christos /* */
5558 1.1 christos /* 1. This is separated out as decLnOp so it can be called from */
5559 1.1 christos /* other Mathematical functions (e.g., Log 10) with a wider range */
5560 1.1 christos /* than normal. In particular, it can handle the slightly wider */
5561 1.1 christos /* (+9+2) range needed by a power function. */
5562 1.1 christos /* */
5563 1.1 christos /* 2. The speed of this function is about 10x slower than exp, as */
5564 1.1 christos /* it typically needs 4-6 iterations for short numbers, and the */
5565 1.1 christos /* extra precision needed adds a squaring effect, twice. */
5566 1.1 christos /* */
5567 1.1 christos /* 3. Fastpaths are included for ln(10) and ln(2), up to length 40, */
5568 1.1 christos /* as these are common requests. ln(10) is used by log10(x). */
5569 1.1 christos /* */
5570 1.1 christos /* 4. An iteration might be saved by widening the LNnn table, and */
5571 1.1 christos /* would certainly save at least one if it were made ten times */
5572 1.1 christos /* bigger, too (for truncated fractions 0.100 through 0.999). */
5573 1.1 christos /* However, for most practical evaluations, at least four or five */
5574 1.1 christos /* iterations will be neede -- so this would only speed up by */
5575 1.1 christos /* 20-25% and that probably does not justify increasing the table */
5576 1.1 christos /* size. */
5577 1.1 christos /* */
5578 1.1 christos /* 5. The static buffers are larger than might be expected to allow */
5579 1.1 christos /* for calls from decNumberPower. */
5580 1.1 christos /* ------------------------------------------------------------------ */
5581 1.1 christos decNumber * decLnOp(decNumber *res, const decNumber *rhs,
5582 1.1 christos decContext *set, uInt *status) {
5583 1.1 christos uInt ignore=0; /* working status accumulator */
5584 1.1 christos uInt needbytes; /* for space calculations */
5585 1.1 christos Int residue; /* rounding residue */
5586 1.1 christos Int r; /* rhs=f*10**r [see below] */
5587 1.1 christos Int p; /* working precision */
5588 1.1 christos Int pp; /* precision for iteration */
5589 1.1 christos Int t; /* work */
5590 1.1 christos
5591 1.1 christos /* buffers for a (accumulator, typically precision+2) and b */
5592 1.1 christos /* (adjustment calculator, same size) */
5593 1.1 christos decNumber bufa[D2N(DECBUFFER+12)];
5594 1.1 christos decNumber *allocbufa=NULL; /* -> allocated bufa, iff allocated */
5595 1.1 christos decNumber *a=bufa; /* accumulator/work */
5596 1.1 christos decNumber bufb[D2N(DECBUFFER*2+2)];
5597 1.1 christos decNumber *allocbufb=NULL; /* -> allocated bufa, iff allocated */
5598 1.1 christos decNumber *b=bufb; /* adjustment/work */
5599 1.1 christos
5600 1.1 christos decNumber numone; /* constant 1 */
5601 1.1 christos decNumber cmp; /* work */
5602 1.1 christos decContext aset, bset; /* working contexts */
5603 1.1 christos
5604 1.1 christos #if DECCHECK
5605 1.1 christos Int iterations=0; /* for later sanity check */
5606 1.1 christos if (decCheckOperands(res, DECUNUSED, rhs, set)) return res;
5607 1.1 christos #endif
5608 1.1 christos
5609 1.1 christos do { /* protect allocated storage */
5610 1.1 christos if (SPECIALARG) { /* handle infinities and NaNs */
5611 1.1 christos if (decNumberIsInfinite(rhs)) { /* an infinity */
5612 1.1 christos if (decNumberIsNegative(rhs)) /* -Infinity -> error */
5613 1.1 christos *status|=DEC_Invalid_operation;
5614 1.1 christos else decNumberCopy(res, rhs); /* +Infinity -> self */
5615 1.1 christos }
5616 1.1 christos else decNaNs(res, rhs, NULL, set, status); /* a NaN */
5617 1.1 christos break;}
5618 1.1 christos
5619 1.1 christos if (ISZERO(rhs)) { /* +/- zeros -> -Infinity */
5620 1.1 christos decNumberZero(res); /* make clean */
5621 1.1 christos res->bits=DECINF|DECNEG; /* set - infinity */
5622 1.1 christos break;} /* [no status to set] */
5623 1.1 christos
5624 1.1 christos /* Non-zero negatives are bad... */
5625 1.1 christos if (decNumberIsNegative(rhs)) { /* -x -> error */
5626 1.1 christos *status|=DEC_Invalid_operation;
5627 1.1 christos break;}
5628 1.1 christos
5629 1.1 christos /* Here, rhs is positive, finite, and in range */
5630 1.1 christos
5631 1.1 christos /* lookaside fastpath code for ln(2) and ln(10) at common lengths */
5632 1.1 christos if (rhs->exponent==0 && set->digits<=40) {
5633 1.1 christos #if DECDPUN==1
5634 1.1 christos if (rhs->lsu[0]==0 && rhs->lsu[1]==1 && rhs->digits==2) { /* ln(10) */
5635 1.1 christos #else
5636 1.1 christos if (rhs->lsu[0]==10 && rhs->digits==2) { /* ln(10) */
5637 1.1 christos #endif
5638 1.1 christos aset=*set; aset.round=DEC_ROUND_HALF_EVEN;
5639 1.1 christos #define LN10 "2.302585092994045684017991454684364207601"
5640 1.1 christos decNumberFromString(res, LN10, &aset);
5641 1.1 christos *status|=(DEC_Inexact | DEC_Rounded); /* is inexact */
5642 1.1 christos break;}
5643 1.1 christos if (rhs->lsu[0]==2 && rhs->digits==1) { /* ln(2) */
5644 1.1 christos aset=*set; aset.round=DEC_ROUND_HALF_EVEN;
5645 1.1 christos #define LN2 "0.6931471805599453094172321214581765680755"
5646 1.1 christos decNumberFromString(res, LN2, &aset);
5647 1.1 christos *status|=(DEC_Inexact | DEC_Rounded);
5648 1.1 christos break;}
5649 1.1 christos } /* integer and short */
5650 1.1 christos
5651 1.1 christos /* Determine the working precision. This is normally the */
5652 1.1 christos /* requested precision + 2, with a minimum of 9. However, if */
5653 1.1 christos /* the rhs is 'over-precise' then allow for all its digits to */
5654 1.1 christos /* potentially participate (consider an rhs where all the excess */
5655 1.1 christos /* digits are 9s) so in this case use rhs->digits+2. */
5656 1.1 christos p=MAXI(rhs->digits, MAXI(set->digits, 7))+2;
5657 1.1 christos
5658 1.1 christos /* Allocate space for the accumulator and the high-precision */
5659 1.1 christos /* adjustment calculator, if necessary. The accumulator must */
5660 1.1 christos /* be able to hold p digits, and the adjustment up to */
5661 1.1 christos /* rhs->digits+p digits. They are also made big enough for 16 */
5662 1.1 christos /* digits so that they can be used for calculating the initial */
5663 1.1 christos /* estimate. */
5664 1.1 christos needbytes=sizeof(decNumber)+(D2U(MAXI(p,16))-1)*sizeof(Unit);
5665 1.1 christos if (needbytes>sizeof(bufa)) { /* need malloc space */
5666 1.1 christos allocbufa=(decNumber *)malloc(needbytes);
5667 1.1 christos if (allocbufa==NULL) { /* hopeless -- abandon */
5668 1.1 christos *status|=DEC_Insufficient_storage;
5669 1.1 christos break;}
5670 1.1 christos a=allocbufa; /* use the allocated space */
5671 1.1 christos }
5672 1.1 christos pp=p+rhs->digits;
5673 1.1 christos needbytes=sizeof(decNumber)+(D2U(MAXI(pp,16))-1)*sizeof(Unit);
5674 1.1 christos if (needbytes>sizeof(bufb)) { /* need malloc space */
5675 1.1 christos allocbufb=(decNumber *)malloc(needbytes);
5676 1.1 christos if (allocbufb==NULL) { /* hopeless -- abandon */
5677 1.1 christos *status|=DEC_Insufficient_storage;
5678 1.1 christos break;}
5679 1.1 christos b=allocbufb; /* use the allocated space */
5680 1.1 christos }
5681 1.1 christos
5682 1.1 christos /* Prepare an initial estimate in acc. Calculate this by */
5683 1.1 christos /* considering the coefficient of x to be a normalized fraction, */
5684 1.1 christos /* f, with the decimal point at far left and multiplied by */
5685 1.1 christos /* 10**r. Then, rhs=f*10**r and 0.1<=f<1, and */
5686 1.1 christos /* ln(x) = ln(f) + ln(10)*r */
5687 1.1 christos /* Get the initial estimate for ln(f) from a small lookup */
5688 1.1 christos /* table (see above) indexed by the first two digits of f, */
5689 1.1 christos /* truncated. */
5690 1.1 christos
5691 1.1 christos decContextDefault(&aset, DEC_INIT_DECIMAL64); /* 16-digit extended */
5692 1.1 christos r=rhs->exponent+rhs->digits; /* 'normalised' exponent */
5693 1.1 christos decNumberFromInt32(a, r); /* a=r */
5694 1.1 christos decNumberFromInt32(b, 2302585); /* b=ln(10) (2.302585) */
5695 1.1 christos b->exponent=-6; /* .. */
5696 1.1 christos decMultiplyOp(a, a, b, &aset, &ignore); /* a=a*b */
5697 1.1 christos /* now get top two digits of rhs into b by simple truncate and */
5698 1.1 christos /* force to integer */
5699 1.1 christos residue=0; /* (no residue) */
5700 1.1 christos aset.digits=2; aset.round=DEC_ROUND_DOWN;
5701 1.1 christos decCopyFit(b, rhs, &aset, &residue, &ignore); /* copy & shorten */
5702 1.1 christos b->exponent=0; /* make integer */
5703 1.1 christos t=decGetInt(b); /* [cannot fail] */
5704 1.1 christos if (t<10) t=X10(t); /* adjust single-digit b */
5705 1.1 christos t=LNnn[t-10]; /* look up ln(b) */
5706 1.1 christos decNumberFromInt32(b, t>>2); /* b=ln(b) coefficient */
5707 1.1 christos b->exponent=-(t&3)-3; /* set exponent */
5708 1.1 christos b->bits=DECNEG; /* ln(0.10)->ln(0.99) always -ve */
5709 1.1 christos aset.digits=16; aset.round=DEC_ROUND_HALF_EVEN; /* restore */
5710 1.1 christos decAddOp(a, a, b, &aset, 0, &ignore); /* acc=a+b */
5711 1.1 christos /* the initial estimate is now in a, with up to 4 digits correct. */
5712 1.1 christos /* When rhs is at or near Nmax the estimate will be low, so we */
5713 1.1 christos /* will approach it from below, avoiding overflow when calling exp. */
5714 1.1 christos
5715 1.1 christos decNumberZero(&numone); *numone.lsu=1; /* constant 1 for adjustment */
5716 1.1 christos
5717 1.1 christos /* accumulator bounds are as requested (could underflow, but */
5718 1.1 christos /* cannot overflow) */
5719 1.1 christos aset.emax=set->emax;
5720 1.1 christos aset.emin=set->emin;
5721 1.1 christos aset.clamp=0; /* no concrete format */
5722 1.1 christos /* set up a context to be used for the multiply and subtract */
5723 1.1 christos bset=aset;
5724 1.1 christos bset.emax=DEC_MAX_MATH*2; /* use double bounds for the */
5725 1.1 christos bset.emin=-DEC_MAX_MATH*2; /* adjustment calculation */
5726 1.1 christos /* [see decExpOp call below] */
5727 1.1 christos /* for each iteration double the number of digits to calculate, */
5728 1.1 christos /* up to a maximum of p */
5729 1.1 christos pp=9; /* initial precision */
5730 1.1 christos /* [initially 9 as then the sequence starts 7+2, 16+2, and */
5731 1.1 christos /* 34+2, which is ideal for standard-sized numbers] */
5732 1.1 christos aset.digits=pp; /* working context */
5733 1.1 christos bset.digits=pp+rhs->digits; /* wider context */
5734 1.1 christos for (;;) { /* iterate */
5735 1.1 christos #if DECCHECK
5736 1.1 christos iterations++;
5737 1.1 christos if (iterations>24) break; /* consider 9 * 2**24 */
5738 1.1 christos #endif
5739 1.1 christos /* calculate the adjustment (exp(-a)*x-1) into b. This is a */
5740 1.1 christos /* catastrophic subtraction but it really is the difference */
5741 1.1 christos /* from 1 that is of interest. */
5742 1.1 christos /* Use the internal entry point to Exp as it allows the double */
5743 1.1 christos /* range for calculating exp(-a) when a is the tiniest subnormal. */
5744 1.1 christos a->bits^=DECNEG; /* make -a */
5745 1.1 christos decExpOp(b, a, &bset, &ignore); /* b=exp(-a) */
5746 1.1 christos a->bits^=DECNEG; /* restore sign of a */
5747 1.1 christos /* now multiply by rhs and subtract 1, at the wider precision */
5748 1.1 christos decMultiplyOp(b, b, rhs, &bset, &ignore); /* b=b*rhs */
5749 1.1 christos decAddOp(b, b, &numone, &bset, DECNEG, &ignore); /* b=b-1 */
5750 1.1 christos
5751 1.1 christos /* the iteration ends when the adjustment cannot affect the */
5752 1.1 christos /* result by >=0.5 ulp (at the requested digits), which */
5753 1.1 christos /* is when its value is smaller than the accumulator by */
5754 1.1 christos /* set->digits+1 digits (or it is zero) -- this is a looser */
5755 1.1 christos /* requirement than for Exp because all that happens to the */
5756 1.1 christos /* accumulator after this is the final rounding (but note that */
5757 1.1 christos /* there must also be full precision in a, or a=0). */
5758 1.1 christos
5759 1.1 christos if (decNumberIsZero(b) ||
5760 1.1 christos (a->digits+a->exponent)>=(b->digits+b->exponent+set->digits+1)) {
5761 1.1 christos if (a->digits==p) break;
5762 1.1 christos if (decNumberIsZero(a)) {
5763 1.1 christos decCompareOp(&cmp, rhs, &numone, &aset, COMPARE, &ignore); /* rhs=1 ? */
5764 1.1 christos if (cmp.lsu[0]==0) a->exponent=0; /* yes, exact 0 */
5765 1.1 christos else *status|=(DEC_Inexact | DEC_Rounded); /* no, inexact */
5766 1.1 christos break;
5767 1.1 christos }
5768 1.1 christos /* force padding if adjustment has gone to 0 before full length */
5769 1.1 christos if (decNumberIsZero(b)) b->exponent=a->exponent-p;
5770 1.1 christos }
5771 1.1 christos
5772 1.1 christos /* not done yet ... */
5773 1.1 christos decAddOp(a, a, b, &aset, 0, &ignore); /* a=a+b for next estimate */
5774 1.1 christos if (pp==p) continue; /* precision is at maximum */
5775 1.1 christos /* lengthen the next calculation */
5776 1.1 christos pp=pp*2; /* double precision */
5777 1.1 christos if (pp>p) pp=p; /* clamp to maximum */
5778 1.1 christos aset.digits=pp; /* working context */
5779 1.1 christos bset.digits=pp+rhs->digits; /* wider context */
5780 1.1 christos } /* Newton's iteration */
5781 1.1 christos
5782 1.1 christos #if DECCHECK
5783 1.1 christos /* just a sanity check; remove the test to show always */
5784 1.1 christos if (iterations>24)
5785 1.1 christos printf("Ln iterations=%ld, status=%08lx, p=%ld, d=%ld\n",
5786 1.1 christos (LI)iterations, (LI)*status, (LI)p, (LI)rhs->digits);
5787 1.1 christos #endif
5788 1.1 christos
5789 1.1 christos /* Copy and round the result to res */
5790 1.1 christos residue=1; /* indicate dirt to right */
5791 1.1 christos if (ISZERO(a)) residue=0; /* .. unless underflowed to 0 */
5792 1.1 christos aset.digits=set->digits; /* [use default rounding] */
5793 1.1 christos decCopyFit(res, a, &aset, &residue, status); /* copy & shorten */
5794 1.1 christos decFinish(res, set, &residue, status); /* cleanup/set flags */
5795 1.1 christos } while(0); /* end protected */
5796 1.1 christos
5797 1.1 christos free(allocbufa); /* drop any storage used */
5798 1.1 christos free(allocbufb); /* .. */
5799 1.1 christos /* [status is handled by caller] */
5800 1.1 christos return res;
5801 1.1 christos } /* decLnOp */
5802 1.1 christos
5803 1.1 christos /* ------------------------------------------------------------------ */
5804 1.1 christos /* decQuantizeOp -- force exponent to requested value */
5805 1.1 christos /* */
5806 1.1 christos /* This computes C = op(A, B), where op adjusts the coefficient */
5807 1.1 christos /* of C (by rounding or shifting) such that the exponent (-scale) */
5808 1.1 christos /* of C has the value B or matches the exponent of B. */
5809 1.1 christos /* The numerical value of C will equal A, except for the effects of */
5810 1.1 christos /* any rounding that occurred. */
5811 1.1 christos /* */
5812 1.1 christos /* res is C, the result. C may be A or B */
5813 1.1 christos /* lhs is A, the number to adjust */
5814 1.1 christos /* rhs is B, the requested exponent */
5815 1.1 christos /* set is the context */
5816 1.1 christos /* quant is 1 for quantize or 0 for rescale */
5817 1.1 christos /* status is the status accumulator (this can be called without */
5818 1.1 christos /* risk of control loss) */
5819 1.1 christos /* */
5820 1.1 christos /* C must have space for set->digits digits. */
5821 1.1 christos /* */
5822 1.1 christos /* Unless there is an error or the result is infinite, the exponent */
5823 1.1 christos /* after the operation is guaranteed to be that requested. */
5824 1.1 christos /* ------------------------------------------------------------------ */
5825 1.1 christos static decNumber * decQuantizeOp(decNumber *res, const decNumber *lhs,
5826 1.1 christos const decNumber *rhs, decContext *set,
5827 1.1 christos Flag quant, uInt *status) {
5828 1.1 christos #if DECSUBSET
5829 1.1 christos decNumber *alloclhs=NULL; /* non-NULL if rounded lhs allocated */
5830 1.1 christos decNumber *allocrhs=NULL; /* .., rhs */
5831 1.1 christos #endif
5832 1.1 christos const decNumber *inrhs=rhs; /* save original rhs */
5833 1.1 christos Int reqdigits=set->digits; /* requested DIGITS */
5834 1.1 christos Int reqexp; /* requested exponent [-scale] */
5835 1.1 christos Int residue=0; /* rounding residue */
5836 1.1 christos Int etiny=set->emin-(reqdigits-1);
5837 1.1 christos
5838 1.1 christos #if DECCHECK
5839 1.1 christos if (decCheckOperands(res, lhs, rhs, set)) return res;
5840 1.1 christos #endif
5841 1.1 christos
5842 1.1 christos do { /* protect allocated storage */
5843 1.1 christos #if DECSUBSET
5844 1.1 christos if (!set->extended) {
5845 1.1 christos /* reduce operands and set lostDigits status, as needed */
5846 1.1 christos if (lhs->digits>reqdigits) {
5847 1.1 christos alloclhs=decRoundOperand(lhs, set, status);
5848 1.1 christos if (alloclhs==NULL) break;
5849 1.1 christos lhs=alloclhs;
5850 1.1 christos }
5851 1.1 christos if (rhs->digits>reqdigits) { /* [this only checks lostDigits] */
5852 1.1 christos allocrhs=decRoundOperand(rhs, set, status);
5853 1.1 christos if (allocrhs==NULL) break;
5854 1.1 christos rhs=allocrhs;
5855 1.1 christos }
5856 1.1 christos }
5857 1.1 christos #endif
5858 1.1 christos /* [following code does not require input rounding] */
5859 1.1 christos
5860 1.1 christos /* Handle special values */
5861 1.1 christos if (SPECIALARGS) {
5862 1.1 christos /* NaNs get usual processing */
5863 1.1 christos if (SPECIALARGS & (DECSNAN | DECNAN))
5864 1.1 christos decNaNs(res, lhs, rhs, set, status);
5865 1.1 christos /* one infinity but not both is bad */
5866 1.1 christos else if ((lhs->bits ^ rhs->bits) & DECINF)
5867 1.1 christos *status|=DEC_Invalid_operation;
5868 1.1 christos /* both infinity: return lhs */
5869 1.1 christos else decNumberCopy(res, lhs); /* [nop if in place] */
5870 1.1 christos break;
5871 1.1 christos }
5872 1.1 christos
5873 1.1 christos /* set requested exponent */
5874 1.1 christos if (quant) reqexp=inrhs->exponent; /* quantize -- match exponents */
5875 1.1 christos else { /* rescale -- use value of rhs */
5876 1.1 christos /* Original rhs must be an integer that fits and is in range, */
5877 1.1 christos /* which could be from -1999999997 to +999999999, thanks to */
5878 1.1 christos /* subnormals */
5879 1.1 christos reqexp=decGetInt(inrhs); /* [cannot fail] */
5880 1.1 christos }
5881 1.1 christos
5882 1.1 christos #if DECSUBSET
5883 1.1 christos if (!set->extended) etiny=set->emin; /* no subnormals */
5884 1.1 christos #endif
5885 1.1 christos
5886 1.1 christos if (reqexp==BADINT /* bad (rescale only) or .. */
5887 1.1 christos || reqexp==BIGODD || reqexp==BIGEVEN /* very big (ditto) or .. */
5888 1.1 christos || (reqexp<etiny) /* < lowest */
5889 1.1 christos || (reqexp>set->emax)) { /* > emax */
5890 1.1 christos *status|=DEC_Invalid_operation;
5891 1.1 christos break;}
5892 1.1 christos
5893 1.1 christos /* the RHS has been processed, so it can be overwritten now if necessary */
5894 1.1 christos if (ISZERO(lhs)) { /* zero coefficient unchanged */
5895 1.1 christos decNumberCopy(res, lhs); /* [nop if in place] */
5896 1.1 christos res->exponent=reqexp; /* .. just set exponent */
5897 1.1 christos #if DECSUBSET
5898 1.1 christos if (!set->extended) res->bits=0; /* subset specification; no -0 */
5899 1.1 christos #endif
5900 1.1 christos }
5901 1.1 christos else { /* non-zero lhs */
5902 1.1 christos Int adjust=reqexp-lhs->exponent; /* digit adjustment needed */
5903 1.1 christos /* if adjusted coefficient will definitely not fit, give up now */
5904 1.1 christos if ((lhs->digits-adjust)>reqdigits) {
5905 1.1 christos *status|=DEC_Invalid_operation;
5906 1.1 christos break;
5907 1.1 christos }
5908 1.1 christos
5909 1.1 christos if (adjust>0) { /* increasing exponent */
5910 1.1 christos /* this will decrease the length of the coefficient by adjust */
5911 1.1 christos /* digits, and must round as it does so */
5912 1.1 christos decContext workset; /* work */
5913 1.1 christos workset=*set; /* clone rounding, etc. */
5914 1.1 christos workset.digits=lhs->digits-adjust; /* set requested length */
5915 1.1 christos /* [note that the latter can be <1, here] */
5916 1.1 christos decCopyFit(res, lhs, &workset, &residue, status); /* fit to result */
5917 1.1 christos decApplyRound(res, &workset, residue, status); /* .. and round */
5918 1.1 christos residue=0; /* [used] */
5919 1.1 christos /* If just rounded a 999s case, exponent will be off by one; */
5920 1.1 christos /* adjust back (after checking space), if so. */
5921 1.1 christos if (res->exponent>reqexp) {
5922 1.1 christos /* re-check needed, e.g., for quantize(0.9999, 0.001) under */
5923 1.1 christos /* set->digits==3 */
5924 1.1 christos if (res->digits==reqdigits) { /* cannot shift by 1 */
5925 1.1 christos *status&=~(DEC_Inexact | DEC_Rounded); /* [clean these] */
5926 1.1 christos *status|=DEC_Invalid_operation;
5927 1.1 christos break;
5928 1.1 christos }
5929 1.1 christos res->digits=decShiftToMost(res->lsu, res->digits, 1); /* shift */
5930 1.1 christos res->exponent--; /* (re)adjust the exponent. */
5931 1.1 christos }
5932 1.1 christos #if DECSUBSET
5933 1.1 christos if (ISZERO(res) && !set->extended) res->bits=0; /* subset; no -0 */
5934 1.1 christos #endif
5935 1.1 christos } /* increase */
5936 1.1 christos else /* adjust<=0 */ { /* decreasing or = exponent */
5937 1.1 christos /* this will increase the length of the coefficient by -adjust */
5938 1.1 christos /* digits, by adding zero or more trailing zeros; this is */
5939 1.1 christos /* already checked for fit, above */
5940 1.1 christos decNumberCopy(res, lhs); /* [it will fit] */
5941 1.1 christos /* if padding needed (adjust<0), add it now... */
5942 1.1 christos if (adjust<0) {
5943 1.1 christos res->digits=decShiftToMost(res->lsu, res->digits, -adjust);
5944 1.1 christos res->exponent+=adjust; /* adjust the exponent */
5945 1.1 christos }
5946 1.1 christos } /* decrease */
5947 1.1 christos } /* non-zero */
5948 1.1 christos
5949 1.1 christos /* Check for overflow [do not use Finalize in this case, as an */
5950 1.1 christos /* overflow here is a "don't fit" situation] */
5951 1.1 christos if (res->exponent>set->emax-res->digits+1) { /* too big */
5952 1.1 christos *status|=DEC_Invalid_operation;
5953 1.1 christos break;
5954 1.1 christos }
5955 1.1 christos else {
5956 1.1 christos decFinalize(res, set, &residue, status); /* set subnormal flags */
5957 1.1 christos *status&=~DEC_Underflow; /* suppress Underflow [as per 754] */
5958 1.1 christos }
5959 1.1 christos } while(0); /* end protected */
5960 1.1 christos
5961 1.1 christos #if DECSUBSET
5962 1.1 christos free(allocrhs); /* drop any storage used */
5963 1.1 christos free(alloclhs); /* .. */
5964 1.1 christos #endif
5965 1.1 christos return res;
5966 1.1 christos } /* decQuantizeOp */
5967 1.1 christos
5968 1.1 christos /* ------------------------------------------------------------------ */
5969 1.1 christos /* decCompareOp -- compare, min, or max two Numbers */
5970 1.1 christos /* */
5971 1.1 christos /* This computes C = A ? B and carries out one of four operations: */
5972 1.1 christos /* COMPARE -- returns the signum (as a number) giving the */
5973 1.1 christos /* result of a comparison unless one or both */
5974 1.1 christos /* operands is a NaN (in which case a NaN results) */
5975 1.1 christos /* COMPSIG -- as COMPARE except that a quiet NaN raises */
5976 1.1 christos /* Invalid operation. */
5977 1.1 christos /* COMPMAX -- returns the larger of the operands, using the */
5978 1.1 christos /* 754 maxnum operation */
5979 1.1 christos /* COMPMAXMAG -- ditto, comparing absolute values */
5980 1.1 christos /* COMPMIN -- the 754 minnum operation */
5981 1.1 christos /* COMPMINMAG -- ditto, comparing absolute values */
5982 1.1 christos /* COMTOTAL -- returns the signum (as a number) giving the */
5983 1.1 christos /* result of a comparison using 754 total ordering */
5984 1.1 christos /* */
5985 1.1 christos /* res is C, the result. C may be A and/or B (e.g., X=X?X) */
5986 1.1 christos /* lhs is A */
5987 1.1 christos /* rhs is B */
5988 1.1 christos /* set is the context */
5989 1.1 christos /* op is the operation flag */
5990 1.1 christos /* status is the usual accumulator */
5991 1.1 christos /* */
5992 1.1 christos /* C must have space for one digit for COMPARE or set->digits for */
5993 1.1 christos /* COMPMAX, COMPMIN, COMPMAXMAG, or COMPMINMAG. */
5994 1.1 christos /* ------------------------------------------------------------------ */
5995 1.1 christos /* The emphasis here is on speed for common cases, and avoiding */
5996 1.1 christos /* coefficient comparison if possible. */
5997 1.1 christos /* ------------------------------------------------------------------ */
5998 1.1 christos decNumber * decCompareOp(decNumber *res, const decNumber *lhs,
5999 1.1 christos const decNumber *rhs, decContext *set,
6000 1.1 christos Flag op, uInt *status) {
6001 1.1 christos #if DECSUBSET
6002 1.1 christos decNumber *alloclhs=NULL; /* non-NULL if rounded lhs allocated */
6003 1.1 christos decNumber *allocrhs=NULL; /* .., rhs */
6004 1.1 christos #endif
6005 1.1 christos Int result=0; /* default result value */
6006 1.1 christos uByte merged; /* work */
6007 1.1 christos
6008 1.1 christos #if DECCHECK
6009 1.1 christos if (decCheckOperands(res, lhs, rhs, set)) return res;
6010 1.1 christos #endif
6011 1.1 christos
6012 1.1 christos do { /* protect allocated storage */
6013 1.1 christos #if DECSUBSET
6014 1.1 christos if (!set->extended) {
6015 1.1 christos /* reduce operands and set lostDigits status, as needed */
6016 1.1 christos if (lhs->digits>set->digits) {
6017 1.1 christos alloclhs=decRoundOperand(lhs, set, status);
6018 1.1 christos if (alloclhs==NULL) {result=BADINT; break;}
6019 1.1 christos lhs=alloclhs;
6020 1.1 christos }
6021 1.1 christos if (rhs->digits>set->digits) {
6022 1.1 christos allocrhs=decRoundOperand(rhs, set, status);
6023 1.1 christos if (allocrhs==NULL) {result=BADINT; break;}
6024 1.1 christos rhs=allocrhs;
6025 1.1 christos }
6026 1.1 christos }
6027 1.1 christos #endif
6028 1.1 christos /* [following code does not require input rounding] */
6029 1.1 christos
6030 1.1 christos /* If total ordering then handle differing signs 'up front' */
6031 1.1 christos if (op==COMPTOTAL) { /* total ordering */
6032 1.1 christos if (decNumberIsNegative(lhs) & !decNumberIsNegative(rhs)) {
6033 1.1 christos result=-1;
6034 1.1 christos break;
6035 1.1 christos }
6036 1.1 christos if (!decNumberIsNegative(lhs) & decNumberIsNegative(rhs)) {
6037 1.1 christos result=+1;
6038 1.1 christos break;
6039 1.1 christos }
6040 1.1 christos }
6041 1.1 christos
6042 1.1 christos /* handle NaNs specially; let infinities drop through */
6043 1.1 christos /* This assumes sNaN (even just one) leads to NaN. */
6044 1.1 christos merged=(lhs->bits | rhs->bits) & (DECSNAN | DECNAN);
6045 1.1 christos if (merged) { /* a NaN bit set */
6046 1.1 christos if (op==COMPARE); /* result will be NaN */
6047 1.1 christos else if (op==COMPSIG) /* treat qNaN as sNaN */
6048 1.1 christos *status|=DEC_Invalid_operation | DEC_sNaN;
6049 1.1 christos else if (op==COMPTOTAL) { /* total ordering, always finite */
6050 1.1 christos /* signs are known to be the same; compute the ordering here */
6051 1.1 christos /* as if the signs are both positive, then invert for negatives */
6052 1.1 christos if (!decNumberIsNaN(lhs)) result=-1;
6053 1.1 christos else if (!decNumberIsNaN(rhs)) result=+1;
6054 1.1 christos /* here if both NaNs */
6055 1.1 christos else if (decNumberIsSNaN(lhs) && decNumberIsQNaN(rhs)) result=-1;
6056 1.1 christos else if (decNumberIsQNaN(lhs) && decNumberIsSNaN(rhs)) result=+1;
6057 1.1 christos else { /* both NaN or both sNaN */
6058 1.1 christos /* now it just depends on the payload */
6059 1.1 christos result=decUnitCompare(lhs->lsu, D2U(lhs->digits),
6060 1.1 christos rhs->lsu, D2U(rhs->digits), 0);
6061 1.1 christos /* [Error not possible, as these are 'aligned'] */
6062 1.1 christos } /* both same NaNs */
6063 1.1 christos if (decNumberIsNegative(lhs)) result=-result;
6064 1.1 christos break;
6065 1.1 christos } /* total order */
6066 1.1 christos
6067 1.1 christos else if (merged & DECSNAN); /* sNaN -> qNaN */
6068 1.1 christos else { /* here if MIN or MAX and one or two quiet NaNs */
6069 1.1 christos /* min or max -- 754 rules ignore single NaN */
6070 1.1 christos if (!decNumberIsNaN(lhs) || !decNumberIsNaN(rhs)) {
6071 1.1 christos /* just one NaN; force choice to be the non-NaN operand */
6072 1.1 christos op=COMPMAX;
6073 1.1 christos if (lhs->bits & DECNAN) result=-1; /* pick rhs */
6074 1.1 christos else result=+1; /* pick lhs */
6075 1.1 christos break;
6076 1.1 christos }
6077 1.1 christos } /* max or min */
6078 1.1 christos op=COMPNAN; /* use special path */
6079 1.1 christos decNaNs(res, lhs, rhs, set, status); /* propagate NaN */
6080 1.1 christos break;
6081 1.1 christos }
6082 1.1 christos /* have numbers */
6083 1.1 christos if (op==COMPMAXMAG || op==COMPMINMAG) result=decCompare(lhs, rhs, 1);
6084 1.1 christos else result=decCompare(lhs, rhs, 0); /* sign matters */
6085 1.1 christos } while(0); /* end protected */
6086 1.1 christos
6087 1.1 christos if (result==BADINT) *status|=DEC_Insufficient_storage; /* rare */
6088 1.1 christos else {
6089 1.1 christos if (op==COMPARE || op==COMPSIG ||op==COMPTOTAL) { /* returning signum */
6090 1.1 christos if (op==COMPTOTAL && result==0) {
6091 1.1 christos /* operands are numerically equal or same NaN (and same sign, */
6092 1.1 christos /* tested first); if identical, leave result 0 */
6093 1.1 christos if (lhs->exponent!=rhs->exponent) {
6094 1.1 christos if (lhs->exponent<rhs->exponent) result=-1;
6095 1.1 christos else result=+1;
6096 1.1 christos if (decNumberIsNegative(lhs)) result=-result;
6097 1.1 christos } /* lexp!=rexp */
6098 1.1 christos } /* total-order by exponent */
6099 1.1 christos decNumberZero(res); /* [always a valid result] */
6100 1.1 christos if (result!=0) { /* must be -1 or +1 */
6101 1.1 christos *res->lsu=1;
6102 1.1 christos if (result<0) res->bits=DECNEG;
6103 1.1 christos }
6104 1.1 christos }
6105 1.1 christos else if (op==COMPNAN); /* special, drop through */
6106 1.1 christos else { /* MAX or MIN, non-NaN result */
6107 1.1 christos Int residue=0; /* rounding accumulator */
6108 1.1 christos /* choose the operand for the result */
6109 1.1 christos const decNumber *choice;
6110 1.1 christos if (result==0) { /* operands are numerically equal */
6111 1.1 christos /* choose according to sign then exponent (see 754) */
6112 1.1 christos uByte slhs=(lhs->bits & DECNEG);
6113 1.1 christos uByte srhs=(rhs->bits & DECNEG);
6114 1.1 christos #if DECSUBSET
6115 1.1 christos if (!set->extended) { /* subset: force left-hand */
6116 1.1 christos op=COMPMAX;
6117 1.1 christos result=+1;
6118 1.1 christos }
6119 1.1 christos else
6120 1.1 christos #endif
6121 1.1 christos if (slhs!=srhs) { /* signs differ */
6122 1.1 christos if (slhs) result=-1; /* rhs is max */
6123 1.1 christos else result=+1; /* lhs is max */
6124 1.1 christos }
6125 1.1 christos else if (slhs && srhs) { /* both negative */
6126 1.1 christos if (lhs->exponent<rhs->exponent) result=+1;
6127 1.1 christos else result=-1;
6128 1.1 christos /* [if equal, use lhs, technically identical] */
6129 1.1 christos }
6130 1.1 christos else { /* both positive */
6131 1.1 christos if (lhs->exponent>rhs->exponent) result=+1;
6132 1.1 christos else result=-1;
6133 1.1 christos /* [ditto] */
6134 1.1 christos }
6135 1.1 christos } /* numerically equal */
6136 1.1 christos /* here result will be non-0; reverse if looking for MIN */
6137 1.1 christos if (op==COMPMIN || op==COMPMINMAG) result=-result;
6138 1.1 christos choice=(result>0 ? lhs : rhs); /* choose */
6139 1.1 christos /* copy chosen to result, rounding if need be */
6140 1.1 christos decCopyFit(res, choice, set, &residue, status);
6141 1.1 christos decFinish(res, set, &residue, status);
6142 1.1 christos }
6143 1.1 christos }
6144 1.1 christos #if DECSUBSET
6145 1.1 christos free(allocrhs); /* free any storage used */
6146 1.1 christos free(alloclhs); /* .. */
6147 1.1 christos #endif
6148 1.1 christos return res;
6149 1.1 christos } /* decCompareOp */
6150 1.1 christos
6151 1.1 christos /* ------------------------------------------------------------------ */
6152 1.1 christos /* decCompare -- compare two decNumbers by numerical value */
6153 1.1 christos /* */
6154 1.1 christos /* This routine compares A ? B without altering them. */
6155 1.1 christos /* */
6156 1.1 christos /* Arg1 is A, a decNumber which is not a NaN */
6157 1.1 christos /* Arg2 is B, a decNumber which is not a NaN */
6158 1.1 christos /* Arg3 is 1 for a sign-independent compare, 0 otherwise */
6159 1.1 christos /* */
6160 1.1 christos /* returns -1, 0, or 1 for A<B, A==B, or A>B, or BADINT if failure */
6161 1.1 christos /* (the only possible failure is an allocation error) */
6162 1.1 christos /* ------------------------------------------------------------------ */
6163 1.1 christos static Int decCompare(const decNumber *lhs, const decNumber *rhs,
6164 1.1 christos Flag abs) {
6165 1.1 christos Int result; /* result value */
6166 1.1 christos Int sigr; /* rhs signum */
6167 1.1 christos Int compare; /* work */
6168 1.1 christos
6169 1.1 christos result=1; /* assume signum(lhs) */
6170 1.1 christos if (ISZERO(lhs)) result=0;
6171 1.1 christos if (abs) {
6172 1.1 christos if (ISZERO(rhs)) return result; /* LHS wins or both 0 */
6173 1.1 christos /* RHS is non-zero */
6174 1.1 christos if (result==0) return -1; /* LHS is 0; RHS wins */
6175 1.1 christos /* [here, both non-zero, result=1] */
6176 1.1 christos }
6177 1.1 christos else { /* signs matter */
6178 1.1 christos if (result && decNumberIsNegative(lhs)) result=-1;
6179 1.1 christos sigr=1; /* compute signum(rhs) */
6180 1.1 christos if (ISZERO(rhs)) sigr=0;
6181 1.1 christos else if (decNumberIsNegative(rhs)) sigr=-1;
6182 1.1 christos if (result > sigr) return +1; /* L > R, return 1 */
6183 1.1 christos if (result < sigr) return -1; /* L < R, return -1 */
6184 1.1 christos if (result==0) return 0; /* both 0 */
6185 1.1 christos }
6186 1.1 christos
6187 1.1 christos /* signums are the same; both are non-zero */
6188 1.1 christos if ((lhs->bits | rhs->bits) & DECINF) { /* one or more infinities */
6189 1.1 christos if (decNumberIsInfinite(rhs)) {
6190 1.1 christos if (decNumberIsInfinite(lhs)) result=0;/* both infinite */
6191 1.1 christos else result=-result; /* only rhs infinite */
6192 1.1 christos }
6193 1.1 christos return result;
6194 1.1 christos }
6195 1.1 christos /* must compare the coefficients, allowing for exponents */
6196 1.1 christos if (lhs->exponent>rhs->exponent) { /* LHS exponent larger */
6197 1.1 christos /* swap sides, and sign */
6198 1.1 christos const decNumber *temp=lhs;
6199 1.1 christos lhs=rhs;
6200 1.1 christos rhs=temp;
6201 1.1 christos result=-result;
6202 1.1 christos }
6203 1.1 christos compare=decUnitCompare(lhs->lsu, D2U(lhs->digits),
6204 1.1 christos rhs->lsu, D2U(rhs->digits),
6205 1.1 christos rhs->exponent-lhs->exponent);
6206 1.1 christos if (compare!=BADINT) compare*=result; /* comparison succeeded */
6207 1.1 christos return compare;
6208 1.1 christos } /* decCompare */
6209 1.1 christos
6210 1.1 christos /* ------------------------------------------------------------------ */
6211 1.1 christos /* decUnitCompare -- compare two >=0 integers in Unit arrays */
6212 1.1 christos /* */
6213 1.1 christos /* This routine compares A ? B*10**E where A and B are unit arrays */
6214 1.1 christos /* A is a plain integer */
6215 1.1 christos /* B has an exponent of E (which must be non-negative) */
6216 1.1 christos /* */
6217 1.1 christos /* Arg1 is A first Unit (lsu) */
6218 1.1 christos /* Arg2 is A length in Units */
6219 1.1 christos /* Arg3 is B first Unit (lsu) */
6220 1.1 christos /* Arg4 is B length in Units */
6221 1.1 christos /* Arg5 is E (0 if the units are aligned) */
6222 1.1 christos /* */
6223 1.1 christos /* returns -1, 0, or 1 for A<B, A==B, or A>B, or BADINT if failure */
6224 1.1 christos /* (the only possible failure is an allocation error, which can */
6225 1.1 christos /* only occur if E!=0) */
6226 1.1 christos /* ------------------------------------------------------------------ */
6227 1.1 christos static Int decUnitCompare(const Unit *a, Int alength,
6228 1.1 christos const Unit *b, Int blength, Int exp) {
6229 1.1 christos Unit *acc; /* accumulator for result */
6230 1.1 christos Unit accbuff[SD2U(DECBUFFER*2+1)]; /* local buffer */
6231 1.1 christos Unit *allocacc=NULL; /* -> allocated acc buffer, iff allocated */
6232 1.1 christos Int accunits, need; /* units in use or needed for acc */
6233 1.1 christos const Unit *l, *r, *u; /* work */
6234 1.1 christos Int expunits, exprem, result; /* .. */
6235 1.1 christos
6236 1.1 christos if (exp==0) { /* aligned; fastpath */
6237 1.1 christos if (alength>blength) return 1;
6238 1.1 christos if (alength<blength) return -1;
6239 1.1 christos /* same number of units in both -- need unit-by-unit compare */
6240 1.1 christos l=a+alength-1;
6241 1.1 christos r=b+alength-1;
6242 1.1 christos for (;l>=a; l--, r--) {
6243 1.1 christos if (*l>*r) return 1;
6244 1.1 christos if (*l<*r) return -1;
6245 1.1 christos }
6246 1.1 christos return 0; /* all units match */
6247 1.1 christos } /* aligned */
6248 1.1 christos
6249 1.1 christos /* Unaligned. If one is >1 unit longer than the other, padded */
6250 1.1 christos /* approximately, then can return easily */
6251 1.1 christos if (alength>blength+(Int)D2U(exp)) return 1;
6252 1.1 christos if (alength+1<blength+(Int)D2U(exp)) return -1;
6253 1.1 christos
6254 1.1 christos /* Need to do a real subtract. For this, a result buffer is needed */
6255 1.1 christos /* even though only the sign is of interest. Its length needs */
6256 1.1 christos /* to be the larger of alength and padded blength, +2 */
6257 1.1 christos need=blength+D2U(exp); /* maximum real length of B */
6258 1.1 christos if (need<alength) need=alength;
6259 1.1 christos need+=2;
6260 1.1 christos acc=accbuff; /* assume use local buffer */
6261 1.1 christos if (need*sizeof(Unit)>sizeof(accbuff)) {
6262 1.1 christos allocacc=(Unit *)malloc(need*sizeof(Unit));
6263 1.1 christos if (allocacc==NULL) return BADINT; /* hopeless -- abandon */
6264 1.1 christos acc=allocacc;
6265 1.1 christos }
6266 1.1 christos /* Calculate units and remainder from exponent. */
6267 1.1 christos expunits=exp/DECDPUN;
6268 1.1 christos exprem=exp%DECDPUN;
6269 1.1 christos /* subtract [A+B*(-m)] */
6270 1.1 christos accunits=decUnitAddSub(a, alength, b, blength, expunits, acc,
6271 1.1 christos -(Int)powers[exprem]);
6272 1.1 christos /* [UnitAddSub result may have leading zeros, even on zero] */
6273 1.1 christos if (accunits<0) result=-1; /* negative result */
6274 1.1 christos else { /* non-negative result */
6275 1.1 christos /* check units of the result before freeing any storage */
6276 1.1 christos for (u=acc; u<acc+accunits-1 && *u==0;) u++;
6277 1.1 christos result=(*u==0 ? 0 : +1);
6278 1.1 christos }
6279 1.1 christos /* clean up and return the result */
6280 1.1 christos free(allocacc); /* drop any storage used */
6281 1.1 christos return result;
6282 1.1 christos } /* decUnitCompare */
6283 1.1 christos
6284 1.1 christos /* ------------------------------------------------------------------ */
6285 1.1 christos /* decUnitAddSub -- add or subtract two >=0 integers in Unit arrays */
6286 1.1 christos /* */
6287 1.1 christos /* This routine performs the calculation: */
6288 1.1 christos /* */
6289 1.1 christos /* C=A+(B*M) */
6290 1.1 christos /* */
6291 1.1 christos /* Where M is in the range -DECDPUNMAX through +DECDPUNMAX. */
6292 1.1 christos /* */
6293 1.1 christos /* A may be shorter or longer than B. */
6294 1.1 christos /* */
6295 1.1 christos /* Leading zeros are not removed after a calculation. The result is */
6296 1.1 christos /* either the same length as the longer of A and B (adding any */
6297 1.1 christos /* shift), or one Unit longer than that (if a Unit carry occurred). */
6298 1.1 christos /* */
6299 1.1 christos /* A and B content are not altered unless C is also A or B. */
6300 1.1 christos /* C may be the same array as A or B, but only if no zero padding is */
6301 1.1 christos /* requested (that is, C may be B only if bshift==0). */
6302 1.1 christos /* C is filled from the lsu; only those units necessary to complete */
6303 1.1 christos /* the calculation are referenced. */
6304 1.1 christos /* */
6305 1.1 christos /* Arg1 is A first Unit (lsu) */
6306 1.1 christos /* Arg2 is A length in Units */
6307 1.1 christos /* Arg3 is B first Unit (lsu) */
6308 1.1 christos /* Arg4 is B length in Units */
6309 1.1 christos /* Arg5 is B shift in Units (>=0; pads with 0 units if positive) */
6310 1.1 christos /* Arg6 is C first Unit (lsu) */
6311 1.1 christos /* Arg7 is M, the multiplier */
6312 1.1 christos /* */
6313 1.1 christos /* returns the count of Units written to C, which will be non-zero */
6314 1.1 christos /* and negated if the result is negative. That is, the sign of the */
6315 1.1 christos /* returned Int is the sign of the result (positive for zero) and */
6316 1.1 christos /* the absolute value of the Int is the count of Units. */
6317 1.1 christos /* */
6318 1.1 christos /* It is the caller's responsibility to make sure that C size is */
6319 1.1 christos /* safe, allowing space if necessary for a one-Unit carry. */
6320 1.1 christos /* */
6321 1.1 christos /* This routine is severely performance-critical; *any* change here */
6322 1.1 christos /* must be measured (timed) to assure no performance degradation. */
6323 1.1 christos /* In particular, trickery here tends to be counter-productive, as */
6324 1.1 christos /* increased complexity of code hurts register optimizations on */
6325 1.1 christos /* register-poor architectures. Avoiding divisions is nearly */
6326 1.1 christos /* always a Good Idea, however. */
6327 1.1 christos /* */
6328 1.1 christos /* Special thanks to Rick McGuire (IBM Cambridge, MA) and Dave Clark */
6329 1.1 christos /* (IBM Warwick, UK) for some of the ideas used in this routine. */
6330 1.1 christos /* ------------------------------------------------------------------ */
6331 1.1 christos static Int decUnitAddSub(const Unit *a, Int alength,
6332 1.1 christos const Unit *b, Int blength, Int bshift,
6333 1.1 christos Unit *c, Int m) {
6334 1.1 christos const Unit *alsu=a; /* A lsu [need to remember it] */
6335 1.1 christos Unit *clsu=c; /* C ditto */
6336 1.1 christos Unit *minC; /* low water mark for C */
6337 1.1 christos Unit *maxC; /* high water mark for C */
6338 1.1 christos eInt carry=0; /* carry integer (could be Long) */
6339 1.1 christos Int add; /* work */
6340 1.1 christos #if DECDPUN<=4 /* myriadal, millenary, etc. */
6341 1.1 christos Int est; /* estimated quotient */
6342 1.1 christos #endif
6343 1.1 christos
6344 1.1 christos #if DECTRACE
6345 1.1 christos if (alength<1 || blength<1)
6346 1.1 christos printf("decUnitAddSub: alen blen m %ld %ld [%ld]\n", alength, blength, m);
6347 1.1 christos #endif
6348 1.1 christos
6349 1.1 christos maxC=c+alength; /* A is usually the longer */
6350 1.1 christos minC=c+blength; /* .. and B the shorter */
6351 1.1 christos if (bshift!=0) { /* B is shifted; low As copy across */
6352 1.1 christos minC+=bshift;
6353 1.1 christos /* if in place [common], skip copy unless there's a gap [rare] */
6354 1.1 christos if (a==c && bshift<=alength) {
6355 1.1 christos c+=bshift;
6356 1.1 christos a+=bshift;
6357 1.1 christos }
6358 1.1 christos else for (; c<clsu+bshift; a++, c++) { /* copy needed */
6359 1.1 christos if (a<alsu+alength) *c=*a;
6360 1.1 christos else *c=0;
6361 1.1 christos }
6362 1.1 christos }
6363 1.1 christos if (minC>maxC) { /* swap */
6364 1.1 christos Unit *hold=minC;
6365 1.1 christos minC=maxC;
6366 1.1 christos maxC=hold;
6367 1.1 christos }
6368 1.1 christos
6369 1.1 christos /* For speed, do the addition as two loops; the first where both A */
6370 1.1 christos /* and B contribute, and the second (if necessary) where only one or */
6371 1.1 christos /* other of the numbers contribute. */
6372 1.1 christos /* Carry handling is the same (i.e., duplicated) in each case. */
6373 1.1 christos for (; c<minC; c++) {
6374 1.1 christos carry+=*a;
6375 1.1 christos a++;
6376 1.1 christos carry+=((eInt)*b)*m; /* [special-casing m=1/-1 */
6377 1.1 christos b++; /* here is not a win] */
6378 1.1 christos /* here carry is new Unit of digits; it could be +ve or -ve */
6379 1.1 christos if ((ueInt)carry<=DECDPUNMAX) { /* fastpath 0-DECDPUNMAX */
6380 1.1 christos *c=(Unit)carry;
6381 1.1 christos carry=0;
6382 1.1 christos continue;
6383 1.1 christos }
6384 1.1 christos #if DECDPUN==4 /* use divide-by-multiply */
6385 1.1 christos if (carry>=0) {
6386 1.1 christos est=(((ueInt)carry>>11)*53687)>>18;
6387 1.1 christos *c=(Unit)(carry-est*(DECDPUNMAX+1)); /* remainder */
6388 1.1 christos carry=est; /* likely quotient [89%] */
6389 1.1 christos if (*c<DECDPUNMAX+1) continue; /* estimate was correct */
6390 1.1 christos carry++;
6391 1.1 christos *c-=DECDPUNMAX+1;
6392 1.1 christos continue;
6393 1.1 christos }
6394 1.1 christos /* negative case */
6395 1.1 christos carry=carry+(eInt)(DECDPUNMAX+1)*(DECDPUNMAX+1); /* make positive */
6396 1.1 christos est=(((ueInt)carry>>11)*53687)>>18;
6397 1.1 christos *c=(Unit)(carry-est*(DECDPUNMAX+1));
6398 1.1 christos carry=est-(DECDPUNMAX+1); /* correctly negative */
6399 1.1 christos if (*c<DECDPUNMAX+1) continue; /* was OK */
6400 1.1 christos carry++;
6401 1.1 christos *c-=DECDPUNMAX+1;
6402 1.1 christos #elif DECDPUN==3
6403 1.1 christos if (carry>=0) {
6404 1.1 christos est=(((ueInt)carry>>3)*16777)>>21;
6405 1.1 christos *c=(Unit)(carry-est*(DECDPUNMAX+1)); /* remainder */
6406 1.1 christos carry=est; /* likely quotient [99%] */
6407 1.1 christos if (*c<DECDPUNMAX+1) continue; /* estimate was correct */
6408 1.1 christos carry++;
6409 1.1 christos *c-=DECDPUNMAX+1;
6410 1.1 christos continue;
6411 1.1 christos }
6412 1.1 christos /* negative case */
6413 1.1 christos carry=carry+(eInt)(DECDPUNMAX+1)*(DECDPUNMAX+1); /* make positive */
6414 1.1 christos est=(((ueInt)carry>>3)*16777)>>21;
6415 1.1 christos *c=(Unit)(carry-est*(DECDPUNMAX+1));
6416 1.1 christos carry=est-(DECDPUNMAX+1); /* correctly negative */
6417 1.1 christos if (*c<DECDPUNMAX+1) continue; /* was OK */
6418 1.1 christos carry++;
6419 1.1 christos *c-=DECDPUNMAX+1;
6420 1.1 christos #elif DECDPUN<=2
6421 1.1 christos /* Can use QUOT10 as carry <= 4 digits */
6422 1.1 christos if (carry>=0) {
6423 1.1 christos est=QUOT10(carry, DECDPUN);
6424 1.1 christos *c=(Unit)(carry-est*(DECDPUNMAX+1)); /* remainder */
6425 1.1 christos carry=est; /* quotient */
6426 1.1 christos continue;
6427 1.1 christos }
6428 1.1 christos /* negative case */
6429 1.1 christos carry=carry+(eInt)(DECDPUNMAX+1)*(DECDPUNMAX+1); /* make positive */
6430 1.1 christos est=QUOT10(carry, DECDPUN);
6431 1.1 christos *c=(Unit)(carry-est*(DECDPUNMAX+1));
6432 1.1 christos carry=est-(DECDPUNMAX+1); /* correctly negative */
6433 1.1 christos #else
6434 1.1 christos /* remainder operator is undefined if negative, so must test */
6435 1.1 christos if ((ueInt)carry<(DECDPUNMAX+1)*2) { /* fastpath carry +1 */
6436 1.1 christos *c=(Unit)(carry-(DECDPUNMAX+1)); /* [helps additions] */
6437 1.1 christos carry=1;
6438 1.1 christos continue;
6439 1.1 christos }
6440 1.1 christos if (carry>=0) {
6441 1.1 christos *c=(Unit)(carry%(DECDPUNMAX+1));
6442 1.1 christos carry=carry/(DECDPUNMAX+1);
6443 1.1 christos continue;
6444 1.1 christos }
6445 1.1 christos /* negative case */
6446 1.1 christos carry=carry+(eInt)(DECDPUNMAX+1)*(DECDPUNMAX+1); /* make positive */
6447 1.1 christos *c=(Unit)(carry%(DECDPUNMAX+1));
6448 1.1 christos carry=carry/(DECDPUNMAX+1)-(DECDPUNMAX+1);
6449 1.1 christos #endif
6450 1.1 christos } /* c */
6451 1.1 christos
6452 1.1 christos /* now may have one or other to complete */
6453 1.1 christos /* [pretest to avoid loop setup/shutdown] */
6454 1.1 christos if (c<maxC) for (; c<maxC; c++) {
6455 1.1 christos if (a<alsu+alength) { /* still in A */
6456 1.1 christos carry+=*a;
6457 1.1 christos a++;
6458 1.1 christos }
6459 1.1 christos else { /* inside B */
6460 1.1 christos carry+=((eInt)*b)*m;
6461 1.1 christos b++;
6462 1.1 christos }
6463 1.1 christos /* here carry is new Unit of digits; it could be +ve or -ve and */
6464 1.1 christos /* magnitude up to DECDPUNMAX squared */
6465 1.1 christos if ((ueInt)carry<=DECDPUNMAX) { /* fastpath 0-DECDPUNMAX */
6466 1.1 christos *c=(Unit)carry;
6467 1.1 christos carry=0;
6468 1.1 christos continue;
6469 1.1 christos }
6470 1.1 christos /* result for this unit is negative or >DECDPUNMAX */
6471 1.1 christos #if DECDPUN==4 /* use divide-by-multiply */
6472 1.1 christos if (carry>=0) {
6473 1.1 christos est=(((ueInt)carry>>11)*53687)>>18;
6474 1.1 christos *c=(Unit)(carry-est*(DECDPUNMAX+1)); /* remainder */
6475 1.1 christos carry=est; /* likely quotient [79.7%] */
6476 1.1 christos if (*c<DECDPUNMAX+1) continue; /* estimate was correct */
6477 1.1 christos carry++;
6478 1.1 christos *c-=DECDPUNMAX+1;
6479 1.1 christos continue;
6480 1.1 christos }
6481 1.1 christos /* negative case */
6482 1.1 christos carry=carry+(eInt)(DECDPUNMAX+1)*(DECDPUNMAX+1); /* make positive */
6483 1.1 christos est=(((ueInt)carry>>11)*53687)>>18;
6484 1.1 christos *c=(Unit)(carry-est*(DECDPUNMAX+1));
6485 1.1 christos carry=est-(DECDPUNMAX+1); /* correctly negative */
6486 1.1 christos if (*c<DECDPUNMAX+1) continue; /* was OK */
6487 1.1 christos carry++;
6488 1.1 christos *c-=DECDPUNMAX+1;
6489 1.1 christos #elif DECDPUN==3
6490 1.1 christos if (carry>=0) {
6491 1.1 christos est=(((ueInt)carry>>3)*16777)>>21;
6492 1.1 christos *c=(Unit)(carry-est*(DECDPUNMAX+1)); /* remainder */
6493 1.1 christos carry=est; /* likely quotient [99%] */
6494 1.1 christos if (*c<DECDPUNMAX+1) continue; /* estimate was correct */
6495 1.1 christos carry++;
6496 1.1 christos *c-=DECDPUNMAX+1;
6497 1.1 christos continue;
6498 1.1 christos }
6499 1.1 christos /* negative case */
6500 1.1 christos carry=carry+(eInt)(DECDPUNMAX+1)*(DECDPUNMAX+1); /* make positive */
6501 1.1 christos est=(((ueInt)carry>>3)*16777)>>21;
6502 1.1 christos *c=(Unit)(carry-est*(DECDPUNMAX+1));
6503 1.1 christos carry=est-(DECDPUNMAX+1); /* correctly negative */
6504 1.1 christos if (*c<DECDPUNMAX+1) continue; /* was OK */
6505 1.1 christos carry++;
6506 1.1 christos *c-=DECDPUNMAX+1;
6507 1.1 christos #elif DECDPUN<=2
6508 1.1 christos if (carry>=0) {
6509 1.1 christos est=QUOT10(carry, DECDPUN);
6510 1.1 christos *c=(Unit)(carry-est*(DECDPUNMAX+1)); /* remainder */
6511 1.1 christos carry=est; /* quotient */
6512 1.1 christos continue;
6513 1.1 christos }
6514 1.1 christos /* negative case */
6515 1.1 christos carry=carry+(eInt)(DECDPUNMAX+1)*(DECDPUNMAX+1); /* make positive */
6516 1.1 christos est=QUOT10(carry, DECDPUN);
6517 1.1 christos *c=(Unit)(carry-est*(DECDPUNMAX+1));
6518 1.1 christos carry=est-(DECDPUNMAX+1); /* correctly negative */
6519 1.1 christos #else
6520 1.1 christos if ((ueInt)carry<(DECDPUNMAX+1)*2){ /* fastpath carry 1 */
6521 1.1 christos *c=(Unit)(carry-(DECDPUNMAX+1));
6522 1.1 christos carry=1;
6523 1.1 christos continue;
6524 1.1 christos }
6525 1.1 christos /* remainder operator is undefined if negative, so must test */
6526 1.1 christos if (carry>=0) {
6527 1.1 christos *c=(Unit)(carry%(DECDPUNMAX+1));
6528 1.1 christos carry=carry/(DECDPUNMAX+1);
6529 1.1 christos continue;
6530 1.1 christos }
6531 1.1 christos /* negative case */
6532 1.1 christos carry=carry+(eInt)(DECDPUNMAX+1)*(DECDPUNMAX+1); /* make positive */
6533 1.1 christos *c=(Unit)(carry%(DECDPUNMAX+1));
6534 1.1 christos carry=carry/(DECDPUNMAX+1)-(DECDPUNMAX+1);
6535 1.1 christos #endif
6536 1.1 christos } /* c */
6537 1.1 christos
6538 1.1 christos /* OK, all A and B processed; might still have carry or borrow */
6539 1.1 christos /* return number of Units in the result, negated if a borrow */
6540 1.1 christos if (carry==0) return c-clsu; /* no carry, so no more to do */
6541 1.1 christos if (carry>0) { /* positive carry */
6542 1.1 christos *c=(Unit)carry; /* place as new unit */
6543 1.1 christos c++; /* .. */
6544 1.1 christos return c-clsu;
6545 1.1 christos }
6546 1.1 christos /* -ve carry: it's a borrow; complement needed */
6547 1.1 christos add=1; /* temporary carry... */
6548 1.1 christos for (c=clsu; c<maxC; c++) {
6549 1.1 christos add=DECDPUNMAX+add-*c;
6550 1.1 christos if (add<=DECDPUNMAX) {
6551 1.1 christos *c=(Unit)add;
6552 1.1 christos add=0;
6553 1.1 christos }
6554 1.1 christos else {
6555 1.1 christos *c=0;
6556 1.1 christos add=1;
6557 1.1 christos }
6558 1.1 christos }
6559 1.1 christos /* add an extra unit iff it would be non-zero */
6560 1.1 christos #if DECTRACE
6561 1.1 christos printf("UAS borrow: add %ld, carry %ld\n", add, carry);
6562 1.1 christos #endif
6563 1.1 christos if ((add-carry-1)!=0) {
6564 1.1 christos *c=(Unit)(add-carry-1);
6565 1.1 christos c++; /* interesting, include it */
6566 1.1 christos }
6567 1.1 christos return clsu-c; /* -ve result indicates borrowed */
6568 1.1 christos } /* decUnitAddSub */
6569 1.1 christos
6570 1.1 christos /* ------------------------------------------------------------------ */
6571 1.1 christos /* decTrim -- trim trailing zeros or normalize */
6572 1.1 christos /* */
6573 1.1 christos /* dn is the number to trim or normalize */
6574 1.1 christos /* set is the context to use to check for clamp */
6575 1.1 christos /* all is 1 to remove all trailing zeros, 0 for just fraction ones */
6576 1.1 christos /* noclamp is 1 to unconditional (unclamped) trim */
6577 1.1 christos /* dropped returns the number of discarded trailing zeros */
6578 1.1 christos /* returns dn */
6579 1.1 christos /* */
6580 1.1 christos /* If clamp is set in the context then the number of zeros trimmed */
6581 1.1 christos /* may be limited if the exponent is high. */
6582 1.1 christos /* All fields are updated as required. This is a utility operation, */
6583 1.1 christos /* so special values are unchanged and no error is possible. */
6584 1.1 christos /* ------------------------------------------------------------------ */
6585 1.1 christos static decNumber * decTrim(decNumber *dn, decContext *set, Flag all,
6586 1.1 christos Flag noclamp, Int *dropped) {
6587 1.1 christos Int d, exp; /* work */
6588 1.1 christos uInt cut; /* .. */
6589 1.1 christos Unit *up; /* -> current Unit */
6590 1.1 christos
6591 1.1 christos #if DECCHECK
6592 1.1 christos if (decCheckOperands(dn, DECUNUSED, DECUNUSED, DECUNCONT)) return dn;
6593 1.1 christos #endif
6594 1.1 christos
6595 1.1 christos *dropped=0; /* assume no zeros dropped */
6596 1.1 christos if ((dn->bits & DECSPECIAL) /* fast exit if special .. */
6597 1.1 christos || (*dn->lsu & 0x01)) return dn; /* .. or odd */
6598 1.1 christos if (ISZERO(dn)) { /* .. or 0 */
6599 1.1 christos dn->exponent=0; /* (sign is preserved) */
6600 1.1 christos return dn;
6601 1.1 christos }
6602 1.1 christos
6603 1.1 christos /* have a finite number which is even */
6604 1.1 christos exp=dn->exponent;
6605 1.1 christos cut=1; /* digit (1-DECDPUN) in Unit */
6606 1.1 christos up=dn->lsu; /* -> current Unit */
6607 1.1 christos for (d=0; d<dn->digits-1; d++) { /* [don't strip the final digit] */
6608 1.1 christos /* slice by powers */
6609 1.1 christos #if DECDPUN<=4
6610 1.1 christos uInt quot=QUOT10(*up, cut);
6611 1.1 christos if ((*up-quot*powers[cut])!=0) break; /* found non-0 digit */
6612 1.1 christos #else
6613 1.1 christos if (*up%powers[cut]!=0) break; /* found non-0 digit */
6614 1.1 christos #endif
6615 1.1 christos /* have a trailing 0 */
6616 1.1 christos if (!all) { /* trimming */
6617 1.1 christos /* [if exp>0 then all trailing 0s are significant for trim] */
6618 1.1 christos if (exp<=0) { /* if digit might be significant */
6619 1.1 christos if (exp==0) break; /* then quit */
6620 1.1 christos exp++; /* next digit might be significant */
6621 1.1 christos }
6622 1.1 christos }
6623 1.1 christos cut++; /* next power */
6624 1.1 christos if (cut>DECDPUN) { /* need new Unit */
6625 1.1 christos up++;
6626 1.1 christos cut=1;
6627 1.1 christos }
6628 1.1 christos } /* d */
6629 1.1 christos if (d==0) return dn; /* none to drop */
6630 1.1 christos
6631 1.1 christos /* may need to limit drop if clamping */
6632 1.1 christos if (set->clamp && !noclamp) {
6633 1.1 christos Int maxd=set->emax-set->digits+1-dn->exponent;
6634 1.1 christos if (maxd<=0) return dn; /* nothing possible */
6635 1.1 christos if (d>maxd) d=maxd;
6636 1.1 christos }
6637 1.1 christos
6638 1.1 christos /* effect the drop */
6639 1.1 christos decShiftToLeast(dn->lsu, D2U(dn->digits), d);
6640 1.1 christos dn->exponent+=d; /* maintain numerical value */
6641 1.1 christos dn->digits-=d; /* new length */
6642 1.1 christos *dropped=d; /* report the count */
6643 1.1 christos return dn;
6644 1.1 christos } /* decTrim */
6645 1.1 christos
6646 1.1 christos /* ------------------------------------------------------------------ */
6647 1.1 christos /* decReverse -- reverse a Unit array in place */
6648 1.1 christos /* */
6649 1.1 christos /* ulo is the start of the array */
6650 1.1 christos /* uhi is the end of the array (highest Unit to include) */
6651 1.1 christos /* */
6652 1.1 christos /* The units ulo through uhi are reversed in place (if the number */
6653 1.1 christos /* of units is odd, the middle one is untouched). Note that the */
6654 1.1 christos /* digit(s) in each unit are unaffected. */
6655 1.1 christos /* ------------------------------------------------------------------ */
6656 1.1 christos static void decReverse(Unit *ulo, Unit *uhi) {
6657 1.1 christos Unit temp;
6658 1.1 christos for (; ulo<uhi; ulo++, uhi--) {
6659 1.1 christos temp=*ulo;
6660 1.1 christos *ulo=*uhi;
6661 1.1 christos *uhi=temp;
6662 1.1 christos }
6663 1.1 christos return;
6664 1.1 christos } /* decReverse */
6665 1.1 christos
6666 1.1 christos /* ------------------------------------------------------------------ */
6667 1.1 christos /* decShiftToMost -- shift digits in array towards most significant */
6668 1.1 christos /* */
6669 1.1 christos /* uar is the array */
6670 1.1 christos /* digits is the count of digits in use in the array */
6671 1.1 christos /* shift is the number of zeros to pad with (least significant); */
6672 1.1 christos /* it must be zero or positive */
6673 1.1 christos /* */
6674 1.1 christos /* returns the new length of the integer in the array, in digits */
6675 1.1 christos /* */
6676 1.1 christos /* No overflow is permitted (that is, the uar array must be known to */
6677 1.1 christos /* be large enough to hold the result, after shifting). */
6678 1.1 christos /* ------------------------------------------------------------------ */
6679 1.1 christos static Int decShiftToMost(Unit *uar, Int digits, Int shift) {
6680 1.1 christos Unit *target, *source, *first; /* work */
6681 1.1 christos Int cut; /* odd 0's to add */
6682 1.1 christos uInt next; /* work */
6683 1.1 christos
6684 1.1 christos if (shift==0) return digits; /* [fastpath] nothing to do */
6685 1.1 christos if ((digits+shift)<=DECDPUN) { /* [fastpath] single-unit case */
6686 1.1 christos *uar=(Unit)(*uar*powers[shift]);
6687 1.1 christos return digits+shift;
6688 1.1 christos }
6689 1.1 christos
6690 1.1 christos next=0; /* all paths */
6691 1.1 christos source=uar+D2U(digits)-1; /* where msu comes from */
6692 1.1 christos target=source+D2U(shift); /* where upper part of first cut goes */
6693 1.1 christos cut=DECDPUN-MSUDIGITS(shift); /* where to slice */
6694 1.1 christos if (cut==0) { /* unit-boundary case */
6695 1.1 christos for (; source>=uar; source--, target--) *target=*source;
6696 1.1 christos }
6697 1.1 christos else {
6698 1.1 christos first=uar+D2U(digits+shift)-1; /* where msu of source will end up */
6699 1.1 christos for (; source>=uar; source--, target--) {
6700 1.1 christos /* split the source Unit and accumulate remainder for next */
6701 1.1 christos #if DECDPUN<=4
6702 1.1 christos uInt quot=QUOT10(*source, cut);
6703 1.1 christos uInt rem=*source-quot*powers[cut];
6704 1.1 christos next+=quot;
6705 1.1 christos #else
6706 1.1 christos uInt rem=*source%powers[cut];
6707 1.1 christos next+=*source/powers[cut];
6708 1.1 christos #endif
6709 1.1 christos if (target<=first) *target=(Unit)next; /* write to target iff valid */
6710 1.1 christos next=rem*powers[DECDPUN-cut]; /* save remainder for next Unit */
6711 1.1 christos }
6712 1.1 christos } /* shift-move */
6713 1.1 christos
6714 1.1 christos /* propagate any partial unit to one below and clear the rest */
6715 1.1 christos for (; target>=uar; target--) {
6716 1.1 christos *target=(Unit)next;
6717 1.1 christos next=0;
6718 1.1 christos }
6719 1.1 christos return digits+shift;
6720 1.1 christos } /* decShiftToMost */
6721 1.1 christos
6722 1.1 christos /* ------------------------------------------------------------------ */
6723 1.1 christos /* decShiftToLeast -- shift digits in array towards least significant */
6724 1.1 christos /* */
6725 1.1 christos /* uar is the array */
6726 1.1 christos /* units is length of the array, in units */
6727 1.1 christos /* shift is the number of digits to remove from the lsu end; it */
6728 1.1 christos /* must be zero or positive and <= than units*DECDPUN. */
6729 1.1 christos /* */
6730 1.1 christos /* returns the new length of the integer in the array, in units */
6731 1.1 christos /* */
6732 1.1 christos /* Removed digits are discarded (lost). Units not required to hold */
6733 1.1 christos /* the final result are unchanged. */
6734 1.1 christos /* ------------------------------------------------------------------ */
6735 1.1 christos static Int decShiftToLeast(Unit *uar, Int units, Int shift) {
6736 1.1 christos Unit *target, *up; /* work */
6737 1.1 christos Int cut, count; /* work */
6738 1.1 christos Int quot, rem; /* for division */
6739 1.1 christos
6740 1.1 christos if (shift==0) return units; /* [fastpath] nothing to do */
6741 1.1 christos if (shift==units*DECDPUN) { /* [fastpath] little to do */
6742 1.1 christos *uar=0; /* all digits cleared gives zero */
6743 1.1 christos return 1; /* leaves just the one */
6744 1.1 christos }
6745 1.1 christos
6746 1.1 christos target=uar; /* both paths */
6747 1.1 christos cut=MSUDIGITS(shift);
6748 1.1 christos if (cut==DECDPUN) { /* unit-boundary case; easy */
6749 1.1 christos up=uar+D2U(shift);
6750 1.1 christos for (; up<uar+units; target++, up++) *target=*up;
6751 1.1 christos return target-uar;
6752 1.1 christos }
6753 1.1 christos
6754 1.1 christos /* messier */
6755 1.1 christos up=uar+D2U(shift-cut); /* source; correct to whole Units */
6756 1.1 christos count=units*DECDPUN-shift; /* the maximum new length */
6757 1.1 christos #if DECDPUN<=4
6758 1.1 christos quot=QUOT10(*up, cut);
6759 1.1 christos #else
6760 1.1 christos quot=*up/powers[cut];
6761 1.1 christos #endif
6762 1.1 christos for (; ; target++) {
6763 1.1 christos *target=(Unit)quot;
6764 1.1 christos count-=(DECDPUN-cut);
6765 1.1 christos if (count<=0) break;
6766 1.1 christos up++;
6767 1.1 christos quot=*up;
6768 1.1 christos #if DECDPUN<=4
6769 1.1 christos quot=QUOT10(quot, cut);
6770 1.1 christos rem=*up-quot*powers[cut];
6771 1.1 christos #else
6772 1.1 christos rem=quot%powers[cut];
6773 1.1 christos quot=quot/powers[cut];
6774 1.1 christos #endif
6775 1.1 christos *target=(Unit)(*target+rem*powers[DECDPUN-cut]);
6776 1.1 christos count-=cut;
6777 1.1 christos if (count<=0) break;
6778 1.1 christos }
6779 1.1 christos return target-uar+1;
6780 1.1 christos } /* decShiftToLeast */
6781 1.1 christos
6782 1.1 christos #if DECSUBSET
6783 1.1 christos /* ------------------------------------------------------------------ */
6784 1.1 christos /* decRoundOperand -- round an operand [used for subset only] */
6785 1.1 christos /* */
6786 1.1 christos /* dn is the number to round (dn->digits is > set->digits) */
6787 1.1 christos /* set is the relevant context */
6788 1.1 christos /* status is the status accumulator */
6789 1.1 christos /* */
6790 1.1 christos /* returns an allocated decNumber with the rounded result. */
6791 1.1 christos /* */
6792 1.1 christos /* lostDigits and other status may be set by this. */
6793 1.1 christos /* */
6794 1.1 christos /* Since the input is an operand, it must not be modified. */
6795 1.1 christos /* Instead, return an allocated decNumber, rounded as required. */
6796 1.1 christos /* It is the caller's responsibility to free the allocated storage. */
6797 1.1 christos /* */
6798 1.1 christos /* If no storage is available then the result cannot be used, so NULL */
6799 1.1 christos /* is returned. */
6800 1.1 christos /* ------------------------------------------------------------------ */
6801 1.1 christos static decNumber *decRoundOperand(const decNumber *dn, decContext *set,
6802 1.1 christos uInt *status) {
6803 1.1 christos decNumber *res; /* result structure */
6804 1.1 christos uInt newstatus=0; /* status from round */
6805 1.1 christos Int residue=0; /* rounding accumulator */
6806 1.1 christos
6807 1.1 christos /* Allocate storage for the returned decNumber, big enough for the */
6808 1.1 christos /* length specified by the context */
6809 1.1 christos res=(decNumber *)malloc(sizeof(decNumber)
6810 1.1 christos +(D2U(set->digits)-1)*sizeof(Unit));
6811 1.1 christos if (res==NULL) {
6812 1.1 christos *status|=DEC_Insufficient_storage;
6813 1.1 christos return NULL;
6814 1.1 christos }
6815 1.1 christos decCopyFit(res, dn, set, &residue, &newstatus);
6816 1.1 christos decApplyRound(res, set, residue, &newstatus);
6817 1.1 christos
6818 1.1 christos /* If that set Inexact then "lost digits" is raised... */
6819 1.1 christos if (newstatus & DEC_Inexact) newstatus|=DEC_Lost_digits;
6820 1.1 christos *status|=newstatus;
6821 1.1 christos return res;
6822 1.1 christos } /* decRoundOperand */
6823 1.1 christos #endif
6824 1.1 christos
6825 1.1 christos /* ------------------------------------------------------------------ */
6826 1.1 christos /* decCopyFit -- copy a number, truncating the coefficient if needed */
6827 1.1 christos /* */
6828 1.1 christos /* dest is the target decNumber */
6829 1.1 christos /* src is the source decNumber */
6830 1.1 christos /* set is the context [used for length (digits) and rounding mode] */
6831 1.1 christos /* residue is the residue accumulator */
6832 1.1 christos /* status contains the current status to be updated */
6833 1.1 christos /* */
6834 1.1 christos /* (dest==src is allowed and will be a no-op if fits) */
6835 1.1 christos /* All fields are updated as required. */
6836 1.1 christos /* ------------------------------------------------------------------ */
6837 1.1 christos static void decCopyFit(decNumber *dest, const decNumber *src,
6838 1.1 christos decContext *set, Int *residue, uInt *status) {
6839 1.1 christos dest->bits=src->bits;
6840 1.1 christos dest->exponent=src->exponent;
6841 1.1 christos decSetCoeff(dest, set, src->lsu, src->digits, residue, status);
6842 1.1 christos } /* decCopyFit */
6843 1.1 christos
6844 1.1 christos /* ------------------------------------------------------------------ */
6845 1.1 christos /* decSetCoeff -- set the coefficient of a number */
6846 1.1 christos /* */
6847 1.1 christos /* dn is the number whose coefficient array is to be set. */
6848 1.1 christos /* It must have space for set->digits digits */
6849 1.1 christos /* set is the context [for size] */
6850 1.1 christos /* lsu -> lsu of the source coefficient [may be dn->lsu] */
6851 1.1 christos /* len is digits in the source coefficient [may be dn->digits] */
6852 1.1 christos /* residue is the residue accumulator. This has values as in */
6853 1.1 christos /* decApplyRound, and will be unchanged unless the */
6854 1.1 christos /* target size is less than len. In this case, the */
6855 1.1 christos /* coefficient is truncated and the residue is updated to */
6856 1.1 christos /* reflect the previous residue and the dropped digits. */
6857 1.1 christos /* status is the status accumulator, as usual */
6858 1.1 christos /* */
6859 1.1 christos /* The coefficient may already be in the number, or it can be an */
6860 1.1 christos /* external intermediate array. If it is in the number, lsu must == */
6861 1.1 christos /* dn->lsu and len must == dn->digits. */
6862 1.1 christos /* */
6863 1.1 christos /* Note that the coefficient length (len) may be < set->digits, and */
6864 1.1 christos /* in this case this merely copies the coefficient (or is a no-op */
6865 1.1 christos /* if dn->lsu==lsu). */
6866 1.1 christos /* */
6867 1.1 christos /* Note also that (only internally, from decQuantizeOp and */
6868 1.1 christos /* decSetSubnormal) the value of set->digits may be less than one, */
6869 1.1 christos /* indicating a round to left. This routine handles that case */
6870 1.1 christos /* correctly; caller ensures space. */
6871 1.1 christos /* */
6872 1.1 christos /* dn->digits, dn->lsu (and as required), and dn->exponent are */
6873 1.1 christos /* updated as necessary. dn->bits (sign) is unchanged. */
6874 1.1 christos /* */
6875 1.1 christos /* DEC_Rounded status is set if any digits are discarded. */
6876 1.1 christos /* DEC_Inexact status is set if any non-zero digits are discarded, or */
6877 1.1 christos /* incoming residue was non-0 (implies rounded) */
6878 1.1 christos /* ------------------------------------------------------------------ */
6879 1.1 christos /* mapping array: maps 0-9 to canonical residues, so that a residue */
6880 1.1 christos /* can be adjusted in the range [-1, +1] and achieve correct rounding */
6881 1.1 christos /* 0 1 2 3 4 5 6 7 8 9 */
6882 1.1 christos static const uByte resmap[10]={0, 3, 3, 3, 3, 5, 7, 7, 7, 7};
6883 1.1 christos static void decSetCoeff(decNumber *dn, decContext *set, const Unit *lsu,
6884 1.1 christos Int len, Int *residue, uInt *status) {
6885 1.1 christos Int discard; /* number of digits to discard */
6886 1.1 christos uInt cut; /* cut point in Unit */
6887 1.1 christos const Unit *up; /* work */
6888 1.1 christos Unit *target; /* .. */
6889 1.1 christos Int count; /* .. */
6890 1.1 christos #if DECDPUN<=4
6891 1.1 christos uInt temp; /* .. */
6892 1.1 christos #endif
6893 1.1 christos
6894 1.1 christos discard=len-set->digits; /* digits to discard */
6895 1.1 christos if (discard<=0) { /* no digits are being discarded */
6896 1.1 christos if (dn->lsu!=lsu) { /* copy needed */
6897 1.1 christos /* copy the coefficient array to the result number; no shift needed */
6898 1.1 christos count=len; /* avoids D2U */
6899 1.1 christos up=lsu;
6900 1.1 christos for (target=dn->lsu; count>0; target++, up++, count-=DECDPUN)
6901 1.1 christos *target=*up;
6902 1.1 christos dn->digits=len; /* set the new length */
6903 1.1 christos }
6904 1.1 christos /* dn->exponent and residue are unchanged, record any inexactitude */
6905 1.1 christos if (*residue!=0) *status|=(DEC_Inexact | DEC_Rounded);
6906 1.1 christos return;
6907 1.1 christos }
6908 1.1 christos
6909 1.1 christos /* some digits must be discarded ... */
6910 1.1 christos dn->exponent+=discard; /* maintain numerical value */
6911 1.1 christos *status|=DEC_Rounded; /* accumulate Rounded status */
6912 1.1 christos if (*residue>1) *residue=1; /* previous residue now to right, so reduce */
6913 1.1 christos
6914 1.1 christos if (discard>len) { /* everything, +1, is being discarded */
6915 1.1 christos /* guard digit is 0 */
6916 1.1 christos /* residue is all the number [NB could be all 0s] */
6917 1.1 christos if (*residue<=0) { /* not already positive */
6918 1.1 christos count=len; /* avoids D2U */
6919 1.1 christos for (up=lsu; count>0; up++, count-=DECDPUN) if (*up!=0) { /* found non-0 */
6920 1.1 christos *residue=1;
6921 1.1 christos break; /* no need to check any others */
6922 1.1 christos }
6923 1.1 christos }
6924 1.1 christos if (*residue!=0) *status|=DEC_Inexact; /* record inexactitude */
6925 1.1 christos *dn->lsu=0; /* coefficient will now be 0 */
6926 1.1 christos dn->digits=1; /* .. */
6927 1.1 christos return;
6928 1.1 christos } /* total discard */
6929 1.1 christos
6930 1.1 christos /* partial discard [most common case] */
6931 1.1 christos /* here, at least the first (most significant) discarded digit exists */
6932 1.1 christos
6933 1.1 christos /* spin up the number, noting residue during the spin, until get to */
6934 1.1 christos /* the Unit with the first discarded digit. When reach it, extract */
6935 1.1 christos /* it and remember its position */
6936 1.1 christos count=0;
6937 1.1 christos for (up=lsu;; up++) {
6938 1.1 christos count+=DECDPUN;
6939 1.1 christos if (count>=discard) break; /* full ones all checked */
6940 1.1 christos if (*up!=0) *residue=1;
6941 1.1 christos } /* up */
6942 1.1 christos
6943 1.1 christos /* here up -> Unit with first discarded digit */
6944 1.1 christos cut=discard-(count-DECDPUN)-1;
6945 1.1 christos if (cut==DECDPUN-1) { /* unit-boundary case (fast) */
6946 1.1 christos Unit half=(Unit)powers[DECDPUN]>>1;
6947 1.1 christos /* set residue directly */
6948 1.1 christos if (*up>=half) {
6949 1.1 christos if (*up>half) *residue=7;
6950 1.1 christos else *residue+=5; /* add sticky bit */
6951 1.1 christos }
6952 1.1 christos else { /* <half */
6953 1.1 christos if (*up!=0) *residue=3; /* [else is 0, leave as sticky bit] */
6954 1.1 christos }
6955 1.1 christos if (set->digits<=0) { /* special for Quantize/Subnormal :-( */
6956 1.1 christos *dn->lsu=0; /* .. result is 0 */
6957 1.1 christos dn->digits=1; /* .. */
6958 1.1 christos }
6959 1.1 christos else { /* shift to least */
6960 1.1 christos count=set->digits; /* now digits to end up with */
6961 1.1 christos dn->digits=count; /* set the new length */
6962 1.1 christos up++; /* move to next */
6963 1.1 christos /* on unit boundary, so shift-down copy loop is simple */
6964 1.1 christos for (target=dn->lsu; count>0; target++, up++, count-=DECDPUN)
6965 1.1 christos *target=*up;
6966 1.1 christos }
6967 1.1 christos } /* unit-boundary case */
6968 1.1 christos
6969 1.1 christos else { /* discard digit is in low digit(s), and not top digit */
6970 1.1 christos uInt discard1; /* first discarded digit */
6971 1.1 christos uInt quot, rem; /* for divisions */
6972 1.1 christos if (cut==0) quot=*up; /* is at bottom of unit */
6973 1.1 christos else /* cut>0 */ { /* it's not at bottom of unit */
6974 1.1 christos #if DECDPUN<=4
6975 1.1 christos quot=QUOT10(*up, cut);
6976 1.1 christos rem=*up-quot*powers[cut];
6977 1.1 christos #else
6978 1.1 christos rem=*up%powers[cut];
6979 1.1 christos quot=*up/powers[cut];
6980 1.1 christos #endif
6981 1.1 christos if (rem!=0) *residue=1;
6982 1.1 christos }
6983 1.1 christos /* discard digit is now at bottom of quot */
6984 1.1 christos #if DECDPUN<=4
6985 1.1 christos temp=(quot*6554)>>16; /* fast /10 */
6986 1.1 christos /* Vowels algorithm here not a win (9 instructions) */
6987 1.1 christos discard1=quot-X10(temp);
6988 1.1 christos quot=temp;
6989 1.1 christos #else
6990 1.1 christos discard1=quot%10;
6991 1.1 christos quot=quot/10;
6992 1.1 christos #endif
6993 1.1 christos /* here, discard1 is the guard digit, and residue is everything */
6994 1.1 christos /* else [use mapping array to accumulate residue safely] */
6995 1.1 christos *residue+=resmap[discard1];
6996 1.1 christos cut++; /* update cut */
6997 1.1 christos /* here: up -> Unit of the array with bottom digit */
6998 1.1 christos /* cut is the division point for each Unit */
6999 1.1 christos /* quot holds the uncut high-order digits for the current unit */
7000 1.1 christos if (set->digits<=0) { /* special for Quantize/Subnormal :-( */
7001 1.1 christos *dn->lsu=0; /* .. result is 0 */
7002 1.1 christos dn->digits=1; /* .. */
7003 1.1 christos }
7004 1.1 christos else { /* shift to least needed */
7005 1.1 christos count=set->digits; /* now digits to end up with */
7006 1.1 christos dn->digits=count; /* set the new length */
7007 1.1 christos /* shift-copy the coefficient array to the result number */
7008 1.1 christos for (target=dn->lsu; ; target++) {
7009 1.1 christos *target=(Unit)quot;
7010 1.1 christos count-=(DECDPUN-cut);
7011 1.1 christos if (count<=0) break;
7012 1.1 christos up++;
7013 1.1 christos quot=*up;
7014 1.1 christos #if DECDPUN<=4
7015 1.1 christos quot=QUOT10(quot, cut);
7016 1.1 christos rem=*up-quot*powers[cut];
7017 1.1 christos #else
7018 1.1 christos rem=quot%powers[cut];
7019 1.1 christos quot=quot/powers[cut];
7020 1.1 christos #endif
7021 1.1 christos *target=(Unit)(*target+rem*powers[DECDPUN-cut]);
7022 1.1 christos count-=cut;
7023 1.1 christos if (count<=0) break;
7024 1.1 christos } /* shift-copy loop */
7025 1.1 christos } /* shift to least */
7026 1.1 christos } /* not unit boundary */
7027 1.1 christos
7028 1.1 christos if (*residue!=0) *status|=DEC_Inexact; /* record inexactitude */
7029 1.1 christos return;
7030 1.1 christos } /* decSetCoeff */
7031 1.1 christos
7032 1.1 christos /* ------------------------------------------------------------------ */
7033 1.1 christos /* decApplyRound -- apply pending rounding to a number */
7034 1.1 christos /* */
7035 1.1 christos /* dn is the number, with space for set->digits digits */
7036 1.1 christos /* set is the context [for size and rounding mode] */
7037 1.1 christos /* residue indicates pending rounding, being any accumulated */
7038 1.1 christos /* guard and sticky information. It may be: */
7039 1.1 christos /* 6-9: rounding digit is >5 */
7040 1.1 christos /* 5: rounding digit is exactly half-way */
7041 1.1 christos /* 1-4: rounding digit is <5 and >0 */
7042 1.1 christos /* 0: the coefficient is exact */
7043 1.1 christos /* -1: as 1, but the hidden digits are subtractive, that */
7044 1.1 christos /* is, of the opposite sign to dn. In this case the */
7045 1.1 christos /* coefficient must be non-0. This case occurs when */
7046 1.1 christos /* subtracting a small number (which can be reduced to */
7047 1.1 christos /* a sticky bit); see decAddOp. */
7048 1.1 christos /* status is the status accumulator, as usual */
7049 1.1 christos /* */
7050 1.1 christos /* This routine applies rounding while keeping the length of the */
7051 1.1 christos /* coefficient constant. The exponent and status are unchanged */
7052 1.1 christos /* except if: */
7053 1.1 christos /* */
7054 1.1 christos /* -- the coefficient was increased and is all nines (in which */
7055 1.1 christos /* case Overflow could occur, and is handled directly here so */
7056 1.1 christos /* the caller does not need to re-test for overflow) */
7057 1.1 christos /* */
7058 1.1 christos /* -- the coefficient was decreased and becomes all nines (in which */
7059 1.1 christos /* case Underflow could occur, and is also handled directly). */
7060 1.1 christos /* */
7061 1.1 christos /* All fields in dn are updated as required. */
7062 1.1 christos /* */
7063 1.1 christos /* ------------------------------------------------------------------ */
7064 1.1 christos static void decApplyRound(decNumber *dn, decContext *set, Int residue,
7065 1.1 christos uInt *status) {
7066 1.1 christos Int bump; /* 1 if coefficient needs to be incremented */
7067 1.1 christos /* -1 if coefficient needs to be decremented */
7068 1.1 christos
7069 1.1 christos if (residue==0) return; /* nothing to apply */
7070 1.1 christos
7071 1.1 christos bump=0; /* assume a smooth ride */
7072 1.1 christos
7073 1.1 christos /* now decide whether, and how, to round, depending on mode */
7074 1.1 christos switch (set->round) {
7075 1.1 christos case DEC_ROUND_05UP: { /* round zero or five up (for reround) */
7076 1.1 christos /* This is the same as DEC_ROUND_DOWN unless there is a */
7077 1.1 christos /* positive residue and the lsd of dn is 0 or 5, in which case */
7078 1.1 christos /* it is bumped; when residue is <0, the number is therefore */
7079 1.1 christos /* bumped down unless the final digit was 1 or 6 (in which */
7080 1.1 christos /* case it is bumped down and then up -- a no-op) */
7081 1.1 christos Int lsd5=*dn->lsu%5; /* get lsd and quintate */
7082 1.1 christos if (residue<0 && lsd5!=1) bump=-1;
7083 1.1 christos else if (residue>0 && lsd5==0) bump=1;
7084 1.1 christos /* [bump==1 could be applied directly; use common path for clarity] */
7085 1.1 christos break;} /* r-05 */
7086 1.1 christos
7087 1.1 christos case DEC_ROUND_DOWN: {
7088 1.1 christos /* no change, except if negative residue */
7089 1.1 christos if (residue<0) bump=-1;
7090 1.1 christos break;} /* r-d */
7091 1.1 christos
7092 1.1 christos case DEC_ROUND_HALF_DOWN: {
7093 1.1 christos if (residue>5) bump=1;
7094 1.1 christos break;} /* r-h-d */
7095 1.1 christos
7096 1.1 christos case DEC_ROUND_HALF_EVEN: {
7097 1.1 christos if (residue>5) bump=1; /* >0.5 goes up */
7098 1.1 christos else if (residue==5) { /* exactly 0.5000... */
7099 1.1 christos /* 0.5 goes up iff [new] lsd is odd */
7100 1.1 christos if (*dn->lsu & 0x01) bump=1;
7101 1.1 christos }
7102 1.1 christos break;} /* r-h-e */
7103 1.1 christos
7104 1.1 christos case DEC_ROUND_HALF_UP: {
7105 1.1 christos if (residue>=5) bump=1;
7106 1.1 christos break;} /* r-h-u */
7107 1.1 christos
7108 1.1 christos case DEC_ROUND_UP: {
7109 1.1 christos if (residue>0) bump=1;
7110 1.1 christos break;} /* r-u */
7111 1.1 christos
7112 1.1 christos case DEC_ROUND_CEILING: {
7113 1.1 christos /* same as _UP for positive numbers, and as _DOWN for negatives */
7114 1.1 christos /* [negative residue cannot occur on 0] */
7115 1.1 christos if (decNumberIsNegative(dn)) {
7116 1.1 christos if (residue<0) bump=-1;
7117 1.1 christos }
7118 1.1 christos else {
7119 1.1 christos if (residue>0) bump=1;
7120 1.1 christos }
7121 1.1 christos break;} /* r-c */
7122 1.1 christos
7123 1.1 christos case DEC_ROUND_FLOOR: {
7124 1.1 christos /* same as _UP for negative numbers, and as _DOWN for positive */
7125 1.1 christos /* [negative residue cannot occur on 0] */
7126 1.1 christos if (!decNumberIsNegative(dn)) {
7127 1.1 christos if (residue<0) bump=-1;
7128 1.1 christos }
7129 1.1 christos else {
7130 1.1 christos if (residue>0) bump=1;
7131 1.1 christos }
7132 1.1 christos break;} /* r-f */
7133 1.1 christos
7134 1.1 christos default: { /* e.g., DEC_ROUND_MAX */
7135 1.1 christos *status|=DEC_Invalid_context;
7136 1.1 christos #if DECTRACE || (DECCHECK && DECVERB)
7137 1.1 christos printf("Unknown rounding mode: %d\n", set->round);
7138 1.1 christos #endif
7139 1.1 christos break;}
7140 1.1 christos } /* switch */
7141 1.1 christos
7142 1.1 christos /* now bump the number, up or down, if need be */
7143 1.1 christos if (bump==0) return; /* no action required */
7144 1.1 christos
7145 1.1 christos /* Simply use decUnitAddSub unless bumping up and the number is */
7146 1.1 christos /* all nines. In this special case set to 100... explicitly */
7147 1.1 christos /* and adjust the exponent by one (as otherwise could overflow */
7148 1.1 christos /* the array) */
7149 1.1 christos /* Similarly handle all-nines result if bumping down. */
7150 1.1 christos if (bump>0) {
7151 1.1 christos Unit *up; /* work */
7152 1.1 christos uInt count=dn->digits; /* digits to be checked */
7153 1.1 christos for (up=dn->lsu; ; up++) {
7154 1.1 christos if (count<=DECDPUN) {
7155 1.1 christos /* this is the last Unit (the msu) */
7156 1.1 christos if (*up!=powers[count]-1) break; /* not still 9s */
7157 1.1 christos /* here if it, too, is all nines */
7158 1.1 christos *up=(Unit)powers[count-1]; /* here 999 -> 100 etc. */
7159 1.1 christos for (up=up-1; up>=dn->lsu; up--) *up=0; /* others all to 0 */
7160 1.1 christos dn->exponent++; /* and bump exponent */
7161 1.1 christos /* [which, very rarely, could cause Overflow...] */
7162 1.1 christos if ((dn->exponent+dn->digits)>set->emax+1) {
7163 1.1 christos decSetOverflow(dn, set, status);
7164 1.1 christos }
7165 1.1 christos return; /* done */
7166 1.1 christos }
7167 1.1 christos /* a full unit to check, with more to come */
7168 1.1 christos if (*up!=DECDPUNMAX) break; /* not still 9s */
7169 1.1 christos count-=DECDPUN;
7170 1.1 christos } /* up */
7171 1.1 christos } /* bump>0 */
7172 1.1 christos else { /* -1 */
7173 1.1 christos /* here checking for a pre-bump of 1000... (leading 1, all */
7174 1.1 christos /* other digits zero) */
7175 1.1 christos Unit *up, *sup; /* work */
7176 1.1 christos uInt count=dn->digits; /* digits to be checked */
7177 1.1 christos for (up=dn->lsu; ; up++) {
7178 1.1 christos if (count<=DECDPUN) {
7179 1.1 christos /* this is the last Unit (the msu) */
7180 1.1 christos if (*up!=powers[count-1]) break; /* not 100.. */
7181 1.1 christos /* here if have the 1000... case */
7182 1.1 christos sup=up; /* save msu pointer */
7183 1.1 christos *up=(Unit)powers[count]-1; /* here 100 in msu -> 999 */
7184 1.1 christos /* others all to all-nines, too */
7185 1.1 christos for (up=up-1; up>=dn->lsu; up--) *up=(Unit)powers[DECDPUN]-1;
7186 1.1 christos dn->exponent--; /* and bump exponent */
7187 1.1 christos
7188 1.1 christos /* iff the number was at the subnormal boundary (exponent=etiny) */
7189 1.1 christos /* then the exponent is now out of range, so it will in fact get */
7190 1.1 christos /* clamped to etiny and the final 9 dropped. */
7191 1.1 christos /* printf(">> emin=%d exp=%d sdig=%d\n", set->emin, */
7192 1.1 christos /* dn->exponent, set->digits); */
7193 1.1 christos if (dn->exponent+1==set->emin-set->digits+1) {
7194 1.1 christos if (count==1 && dn->digits==1) *sup=0; /* here 9 -> 0[.9] */
7195 1.1 christos else {
7196 1.1 christos *sup=(Unit)powers[count-1]-1; /* here 999.. in msu -> 99.. */
7197 1.1 christos dn->digits--;
7198 1.1 christos }
7199 1.1 christos dn->exponent++;
7200 1.1 christos *status|=DEC_Underflow | DEC_Subnormal | DEC_Inexact | DEC_Rounded;
7201 1.1 christos }
7202 1.1 christos return; /* done */
7203 1.1 christos }
7204 1.1 christos
7205 1.1 christos /* a full unit to check, with more to come */
7206 1.1 christos if (*up!=0) break; /* not still 0s */
7207 1.1 christos count-=DECDPUN;
7208 1.1 christos } /* up */
7209 1.1 christos
7210 1.1 christos } /* bump<0 */
7211 1.1 christos
7212 1.1 christos /* Actual bump needed. Do it. */
7213 1.1 christos decUnitAddSub(dn->lsu, D2U(dn->digits), uarrone, 1, 0, dn->lsu, bump);
7214 1.1 christos } /* decApplyRound */
7215 1.1 christos
7216 1.1 christos #if DECSUBSET
7217 1.1 christos /* ------------------------------------------------------------------ */
7218 1.1 christos /* decFinish -- finish processing a number */
7219 1.1 christos /* */
7220 1.1 christos /* dn is the number */
7221 1.1 christos /* set is the context */
7222 1.1 christos /* residue is the rounding accumulator (as in decApplyRound) */
7223 1.1 christos /* status is the accumulator */
7224 1.1 christos /* */
7225 1.1 christos /* This finishes off the current number by: */
7226 1.1 christos /* 1. If not extended: */
7227 1.1 christos /* a. Converting a zero result to clean '0' */
7228 1.1 christos /* b. Reducing positive exponents to 0, if would fit in digits */
7229 1.1 christos /* 2. Checking for overflow and subnormals (always) */
7230 1.1 christos /* Note this is just Finalize when no subset arithmetic. */
7231 1.1 christos /* All fields are updated as required. */
7232 1.1 christos /* ------------------------------------------------------------------ */
7233 1.1 christos static void decFinish(decNumber *dn, decContext *set, Int *residue,
7234 1.1 christos uInt *status) {
7235 1.1 christos if (!set->extended) {
7236 1.1 christos if ISZERO(dn) { /* value is zero */
7237 1.1 christos dn->exponent=0; /* clean exponent .. */
7238 1.1 christos dn->bits=0; /* .. and sign */
7239 1.1 christos return; /* no error possible */
7240 1.1 christos }
7241 1.1 christos if (dn->exponent>=0) { /* non-negative exponent */
7242 1.1 christos /* >0; reduce to integer if possible */
7243 1.1 christos if (set->digits >= (dn->exponent+dn->digits)) {
7244 1.1 christos dn->digits=decShiftToMost(dn->lsu, dn->digits, dn->exponent);
7245 1.1 christos dn->exponent=0;
7246 1.1 christos }
7247 1.1 christos }
7248 1.1 christos } /* !extended */
7249 1.1 christos
7250 1.1 christos decFinalize(dn, set, residue, status);
7251 1.1 christos } /* decFinish */
7252 1.1 christos #endif
7253 1.1 christos
7254 1.1 christos /* ------------------------------------------------------------------ */
7255 1.1 christos /* decFinalize -- final check, clamp, and round of a number */
7256 1.1 christos /* */
7257 1.1 christos /* dn is the number */
7258 1.1 christos /* set is the context */
7259 1.1 christos /* residue is the rounding accumulator (as in decApplyRound) */
7260 1.1 christos /* status is the status accumulator */
7261 1.1 christos /* */
7262 1.1 christos /* This finishes off the current number by checking for subnormal */
7263 1.1 christos /* results, applying any pending rounding, checking for overflow, */
7264 1.1 christos /* and applying any clamping. */
7265 1.1 christos /* Underflow and overflow conditions are raised as appropriate. */
7266 1.1 christos /* All fields are updated as required. */
7267 1.1 christos /* ------------------------------------------------------------------ */
7268 1.1 christos static void decFinalize(decNumber *dn, decContext *set, Int *residue,
7269 1.1 christos uInt *status) {
7270 1.1 christos Int shift; /* shift needed if clamping */
7271 1.1 christos Int tinyexp=set->emin-dn->digits+1; /* precalculate subnormal boundary */
7272 1.1 christos
7273 1.1 christos /* Must be careful, here, when checking the exponent as the */
7274 1.1 christos /* adjusted exponent could overflow 31 bits [because it may already */
7275 1.1 christos /* be up to twice the expected]. */
7276 1.1 christos
7277 1.1 christos /* First test for subnormal. This must be done before any final */
7278 1.1 christos /* round as the result could be rounded to Nmin or 0. */
7279 1.1 christos if (dn->exponent<=tinyexp) { /* prefilter */
7280 1.1 christos Int comp;
7281 1.1 christos decNumber nmin;
7282 1.1 christos /* A very nasty case here is dn == Nmin and residue<0 */
7283 1.1 christos if (dn->exponent<tinyexp) {
7284 1.1 christos /* Go handle subnormals; this will apply round if needed. */
7285 1.1 christos decSetSubnormal(dn, set, residue, status);
7286 1.1 christos return;
7287 1.1 christos }
7288 1.1 christos /* Equals case: only subnormal if dn=Nmin and negative residue */
7289 1.1 christos decNumberZero(&nmin);
7290 1.1 christos nmin.lsu[0]=1;
7291 1.1 christos nmin.exponent=set->emin;
7292 1.1 christos comp=decCompare(dn, &nmin, 1); /* (signless compare) */
7293 1.1 christos if (comp==BADINT) { /* oops */
7294 1.1 christos *status|=DEC_Insufficient_storage; /* abandon... */
7295 1.1 christos return;
7296 1.1 christos }
7297 1.1 christos if (*residue<0 && comp==0) { /* neg residue and dn==Nmin */
7298 1.1 christos decApplyRound(dn, set, *residue, status); /* might force down */
7299 1.1 christos decSetSubnormal(dn, set, residue, status);
7300 1.1 christos return;
7301 1.1 christos }
7302 1.1 christos }
7303 1.1 christos
7304 1.1 christos /* now apply any pending round (this could raise overflow). */
7305 1.1 christos if (*residue!=0) decApplyRound(dn, set, *residue, status);
7306 1.1 christos
7307 1.1 christos /* Check for overflow [redundant in the 'rare' case] or clamp */
7308 1.1 christos if (dn->exponent<=set->emax-set->digits+1) return; /* neither needed */
7309 1.1 christos
7310 1.1 christos
7311 1.1 christos /* here when might have an overflow or clamp to do */
7312 1.1 christos if (dn->exponent>set->emax-dn->digits+1) { /* too big */
7313 1.1 christos decSetOverflow(dn, set, status);
7314 1.1 christos return;
7315 1.1 christos }
7316 1.1 christos /* here when the result is normal but in clamp range */
7317 1.1 christos if (!set->clamp) return;
7318 1.1 christos
7319 1.1 christos /* here when need to apply the IEEE exponent clamp (fold-down) */
7320 1.1 christos shift=dn->exponent-(set->emax-set->digits+1);
7321 1.1 christos
7322 1.1 christos /* shift coefficient (if non-zero) */
7323 1.1 christos if (!ISZERO(dn)) {
7324 1.1 christos dn->digits=decShiftToMost(dn->lsu, dn->digits, shift);
7325 1.1 christos }
7326 1.1 christos dn->exponent-=shift; /* adjust the exponent to match */
7327 1.1 christos *status|=DEC_Clamped; /* and record the dirty deed */
7328 1.1 christos return;
7329 1.1 christos } /* decFinalize */
7330 1.1 christos
7331 1.1 christos /* ------------------------------------------------------------------ */
7332 1.1 christos /* decSetOverflow -- set number to proper overflow value */
7333 1.1 christos /* */
7334 1.1 christos /* dn is the number (used for sign [only] and result) */
7335 1.1 christos /* set is the context [used for the rounding mode, etc.] */
7336 1.1 christos /* status contains the current status to be updated */
7337 1.1 christos /* */
7338 1.1 christos /* This sets the sign of a number and sets its value to either */
7339 1.1 christos /* Infinity or the maximum finite value, depending on the sign of */
7340 1.1 christos /* dn and the rounding mode, following IEEE 754 rules. */
7341 1.1 christos /* ------------------------------------------------------------------ */
7342 1.1 christos static void decSetOverflow(decNumber *dn, decContext *set, uInt *status) {
7343 1.1 christos Flag needmax=0; /* result is maximum finite value */
7344 1.1 christos uByte sign=dn->bits&DECNEG; /* clean and save sign bit */
7345 1.1 christos
7346 1.1 christos if (ISZERO(dn)) { /* zero does not overflow magnitude */
7347 1.1 christos Int emax=set->emax; /* limit value */
7348 1.1 christos if (set->clamp) emax-=set->digits-1; /* lower if clamping */
7349 1.1 christos if (dn->exponent>emax) { /* clamp required */
7350 1.1 christos dn->exponent=emax;
7351 1.1 christos *status|=DEC_Clamped;
7352 1.1 christos }
7353 1.1 christos return;
7354 1.1 christos }
7355 1.1 christos
7356 1.1 christos decNumberZero(dn);
7357 1.1 christos switch (set->round) {
7358 1.1 christos case DEC_ROUND_DOWN: {
7359 1.1 christos needmax=1; /* never Infinity */
7360 1.1 christos break;} /* r-d */
7361 1.1 christos case DEC_ROUND_05UP: {
7362 1.1 christos needmax=1; /* never Infinity */
7363 1.1 christos break;} /* r-05 */
7364 1.1 christos case DEC_ROUND_CEILING: {
7365 1.1 christos if (sign) needmax=1; /* Infinity if non-negative */
7366 1.1 christos break;} /* r-c */
7367 1.1 christos case DEC_ROUND_FLOOR: {
7368 1.1 christos if (!sign) needmax=1; /* Infinity if negative */
7369 1.1 christos break;} /* r-f */
7370 1.1 christos default: break; /* Infinity in all other cases */
7371 1.1 christos }
7372 1.1 christos if (needmax) {
7373 1.1 christos decSetMaxValue(dn, set);
7374 1.1 christos dn->bits=sign; /* set sign */
7375 1.1 christos }
7376 1.1 christos else dn->bits=sign|DECINF; /* Value is +/-Infinity */
7377 1.1 christos *status|=DEC_Overflow | DEC_Inexact | DEC_Rounded;
7378 1.1 christos } /* decSetOverflow */
7379 1.1 christos
7380 1.1 christos /* ------------------------------------------------------------------ */
7381 1.1 christos /* decSetMaxValue -- set number to +Nmax (maximum normal value) */
7382 1.1 christos /* */
7383 1.1 christos /* dn is the number to set */
7384 1.1 christos /* set is the context [used for digits and emax] */
7385 1.1 christos /* */
7386 1.1 christos /* This sets the number to the maximum positive value. */
7387 1.1 christos /* ------------------------------------------------------------------ */
7388 1.1 christos static void decSetMaxValue(decNumber *dn, decContext *set) {
7389 1.1 christos Unit *up; /* work */
7390 1.1 christos Int count=set->digits; /* nines to add */
7391 1.1 christos dn->digits=count;
7392 1.1 christos /* fill in all nines to set maximum value */
7393 1.1 christos for (up=dn->lsu; ; up++) {
7394 1.1 christos if (count>DECDPUN) *up=DECDPUNMAX; /* unit full o'nines */
7395 1.1 christos else { /* this is the msu */
7396 1.1 christos *up=(Unit)(powers[count]-1);
7397 1.1 christos break;
7398 1.1 christos }
7399 1.1 christos count-=DECDPUN; /* filled those digits */
7400 1.1 christos } /* up */
7401 1.1 christos dn->bits=0; /* + sign */
7402 1.1 christos dn->exponent=set->emax-set->digits+1;
7403 1.1 christos } /* decSetMaxValue */
7404 1.1 christos
7405 1.1 christos /* ------------------------------------------------------------------ */
7406 1.1 christos /* decSetSubnormal -- process value whose exponent is <Emin */
7407 1.1 christos /* */
7408 1.1 christos /* dn is the number (used as input as well as output; it may have */
7409 1.1 christos /* an allowed subnormal value, which may need to be rounded) */
7410 1.1 christos /* set is the context [used for the rounding mode] */
7411 1.1 christos /* residue is any pending residue */
7412 1.1 christos /* status contains the current status to be updated */
7413 1.1 christos /* */
7414 1.1 christos /* If subset mode, set result to zero and set Underflow flags. */
7415 1.1 christos /* */
7416 1.1 christos /* Value may be zero with a low exponent; this does not set Subnormal */
7417 1.1 christos /* but the exponent will be clamped to Etiny. */
7418 1.1 christos /* */
7419 1.1 christos /* Otherwise ensure exponent is not out of range, and round as */
7420 1.1 christos /* necessary. Underflow is set if the result is Inexact. */
7421 1.1 christos /* ------------------------------------------------------------------ */
7422 1.1 christos static void decSetSubnormal(decNumber *dn, decContext *set, Int *residue,
7423 1.1 christos uInt *status) {
7424 1.1 christos decContext workset; /* work */
7425 1.1 christos Int etiny, adjust; /* .. */
7426 1.1 christos
7427 1.1 christos #if DECSUBSET
7428 1.1 christos /* simple set to zero and 'hard underflow' for subset */
7429 1.1 christos if (!set->extended) {
7430 1.1 christos decNumberZero(dn);
7431 1.1 christos /* always full overflow */
7432 1.1 christos *status|=DEC_Underflow | DEC_Subnormal | DEC_Inexact | DEC_Rounded;
7433 1.1 christos return;
7434 1.1 christos }
7435 1.1 christos #endif
7436 1.1 christos
7437 1.1 christos /* Full arithmetic -- allow subnormals, rounded to minimum exponent */
7438 1.1 christos /* (Etiny) if needed */
7439 1.1 christos etiny=set->emin-(set->digits-1); /* smallest allowed exponent */
7440 1.1 christos
7441 1.1 christos if ISZERO(dn) { /* value is zero */
7442 1.1 christos /* residue can never be non-zero here */
7443 1.1 christos #if DECCHECK
7444 1.1 christos if (*residue!=0) {
7445 1.1 christos printf("++ Subnormal 0 residue %ld\n", (LI)*residue);
7446 1.1 christos *status|=DEC_Invalid_operation;
7447 1.1 christos }
7448 1.1 christos #endif
7449 1.1 christos if (dn->exponent<etiny) { /* clamp required */
7450 1.1 christos dn->exponent=etiny;
7451 1.1 christos *status|=DEC_Clamped;
7452 1.1 christos }
7453 1.1 christos return;
7454 1.1 christos }
7455 1.1 christos
7456 1.1 christos *status|=DEC_Subnormal; /* have a non-zero subnormal */
7457 1.1 christos adjust=etiny-dn->exponent; /* calculate digits to remove */
7458 1.1 christos if (adjust<=0) { /* not out of range; unrounded */
7459 1.1 christos /* residue can never be non-zero here, except in the Nmin-residue */
7460 1.1 christos /* case (which is a subnormal result), so can take fast-path here */
7461 1.1 christos /* it may already be inexact (from setting the coefficient) */
7462 1.1 christos if (*status&DEC_Inexact) *status|=DEC_Underflow;
7463 1.1 christos return;
7464 1.1 christos }
7465 1.1 christos
7466 1.1 christos /* adjust>0, so need to rescale the result so exponent becomes Etiny */
7467 1.1 christos /* [this code is similar to that in rescale] */
7468 1.1 christos workset=*set; /* clone rounding, etc. */
7469 1.1 christos workset.digits=dn->digits-adjust; /* set requested length */
7470 1.1 christos workset.emin-=adjust; /* and adjust emin to match */
7471 1.1 christos /* [note that the latter can be <1, here, similar to Rescale case] */
7472 1.1 christos decSetCoeff(dn, &workset, dn->lsu, dn->digits, residue, status);
7473 1.1 christos decApplyRound(dn, &workset, *residue, status);
7474 1.1 christos
7475 1.1 christos /* Use 754 default rule: Underflow is set iff Inexact */
7476 1.1 christos /* [independent of whether trapped] */
7477 1.1 christos if (*status&DEC_Inexact) *status|=DEC_Underflow;
7478 1.1 christos
7479 1.1 christos /* if rounded up a 999s case, exponent will be off by one; adjust */
7480 1.1 christos /* back if so [it will fit, because it was shortened earlier] */
7481 1.1 christos if (dn->exponent>etiny) {
7482 1.1 christos dn->digits=decShiftToMost(dn->lsu, dn->digits, 1);
7483 1.1 christos dn->exponent--; /* (re)adjust the exponent. */
7484 1.1 christos }
7485 1.1 christos
7486 1.1 christos /* if rounded to zero, it is by definition clamped... */
7487 1.1 christos if (ISZERO(dn)) *status|=DEC_Clamped;
7488 1.1 christos } /* decSetSubnormal */
7489 1.1 christos
7490 1.1 christos /* ------------------------------------------------------------------ */
7491 1.1 christos /* decCheckMath - check entry conditions for a math function */
7492 1.1 christos /* */
7493 1.1 christos /* This checks the context and the operand */
7494 1.1 christos /* */
7495 1.1 christos /* rhs is the operand to check */
7496 1.1 christos /* set is the context to check */
7497 1.1 christos /* status is unchanged if both are good */
7498 1.1 christos /* */
7499 1.1 christos /* returns non-zero if status is changed, 0 otherwise */
7500 1.1 christos /* */
7501 1.1 christos /* Restrictions enforced: */
7502 1.1 christos /* */
7503 1.1 christos /* digits, emax, and -emin in the context must be less than */
7504 1.1 christos /* DEC_MAX_MATH (999999), and A must be within these bounds if */
7505 1.1 christos /* non-zero. Invalid_operation is set in the status if a */
7506 1.1 christos /* restriction is violated. */
7507 1.1 christos /* ------------------------------------------------------------------ */
7508 1.1 christos static uInt decCheckMath(const decNumber *rhs, decContext *set,
7509 1.1 christos uInt *status) {
7510 1.1 christos uInt save=*status; /* record */
7511 1.1 christos if (set->digits>DEC_MAX_MATH
7512 1.1 christos || set->emax>DEC_MAX_MATH
7513 1.1 christos || -set->emin>DEC_MAX_MATH) *status|=DEC_Invalid_context;
7514 1.1 christos else if ((rhs->digits>DEC_MAX_MATH
7515 1.1 christos || rhs->exponent+rhs->digits>DEC_MAX_MATH+1
7516 1.1 christos || rhs->exponent+rhs->digits<2*(1-DEC_MAX_MATH))
7517 1.1 christos && !ISZERO(rhs)) *status|=DEC_Invalid_operation;
7518 1.1 christos return (*status!=save);
7519 1.1 christos } /* decCheckMath */
7520 1.1 christos
7521 1.1 christos /* ------------------------------------------------------------------ */
7522 1.1 christos /* decGetInt -- get integer from a number */
7523 1.1 christos /* */
7524 1.1 christos /* dn is the number [which will not be altered] */
7525 1.1 christos /* */
7526 1.1 christos /* returns one of: */
7527 1.1 christos /* BADINT if there is a non-zero fraction */
7528 1.1 christos /* the converted integer */
7529 1.1 christos /* BIGEVEN if the integer is even and magnitude > 2*10**9 */
7530 1.1 christos /* BIGODD if the integer is odd and magnitude > 2*10**9 */
7531 1.1 christos /* */
7532 1.1 christos /* This checks and gets a whole number from the input decNumber. */
7533 1.1 christos /* The sign can be determined from dn by the caller when BIGEVEN or */
7534 1.1 christos /* BIGODD is returned. */
7535 1.1 christos /* ------------------------------------------------------------------ */
7536 1.1 christos static Int decGetInt(const decNumber *dn) {
7537 1.1 christos Int theInt; /* result accumulator */
7538 1.1 christos const Unit *up; /* work */
7539 1.1 christos Int got; /* digits (real or not) processed */
7540 1.1 christos Int ilength=dn->digits+dn->exponent; /* integral length */
7541 1.1 christos Flag neg=decNumberIsNegative(dn); /* 1 if -ve */
7542 1.1 christos
7543 1.1 christos /* The number must be an integer that fits in 10 digits */
7544 1.1 christos /* Assert, here, that 10 is enough for any rescale Etiny */
7545 1.1 christos #if DEC_MAX_EMAX > 999999999
7546 1.1 christos #error GetInt may need updating [for Emax]
7547 1.1 christos #endif
7548 1.1 christos #if DEC_MIN_EMIN < -999999999
7549 1.1 christos #error GetInt may need updating [for Emin]
7550 1.1 christos #endif
7551 1.1 christos if (ISZERO(dn)) return 0; /* zeros are OK, with any exponent */
7552 1.1 christos
7553 1.1 christos up=dn->lsu; /* ready for lsu */
7554 1.1 christos theInt=0; /* ready to accumulate */
7555 1.1 christos if (dn->exponent>=0) { /* relatively easy */
7556 1.1 christos /* no fractional part [usual]; allow for positive exponent */
7557 1.1 christos got=dn->exponent;
7558 1.1 christos }
7559 1.1 christos else { /* -ve exponent; some fractional part to check and discard */
7560 1.1 christos Int count=-dn->exponent; /* digits to discard */
7561 1.1 christos /* spin up whole units until reach the Unit with the unit digit */
7562 1.1 christos for (; count>=DECDPUN; up++) {
7563 1.1 christos if (*up!=0) return BADINT; /* non-zero Unit to discard */
7564 1.1 christos count-=DECDPUN;
7565 1.1 christos }
7566 1.1 christos if (count==0) got=0; /* [a multiple of DECDPUN] */
7567 1.1 christos else { /* [not multiple of DECDPUN] */
7568 1.1 christos Int rem; /* work */
7569 1.1 christos /* slice off fraction digits and check for non-zero */
7570 1.1 christos #if DECDPUN<=4
7571 1.1 christos theInt=QUOT10(*up, count);
7572 1.1 christos rem=*up-theInt*powers[count];
7573 1.1 christos #else
7574 1.1 christos rem=*up%powers[count]; /* slice off discards */
7575 1.1 christos theInt=*up/powers[count];
7576 1.1 christos #endif
7577 1.1 christos if (rem!=0) return BADINT; /* non-zero fraction */
7578 1.1 christos /* it looks good */
7579 1.1 christos got=DECDPUN-count; /* number of digits so far */
7580 1.1 christos up++; /* ready for next */
7581 1.1 christos }
7582 1.1 christos }
7583 1.1 christos /* now it's known there's no fractional part */
7584 1.1 christos
7585 1.1 christos /* tricky code now, to accumulate up to 9.3 digits */
7586 1.1 christos if (got==0) {theInt=*up; got+=DECDPUN; up++;} /* ensure lsu is there */
7587 1.1 christos
7588 1.1 christos if (ilength<11) {
7589 1.1 christos Int save=theInt;
7590 1.1 christos /* collect any remaining unit(s) */
7591 1.1 christos for (; got<ilength; up++) {
7592 1.1 christos theInt+=*up*powers[got];
7593 1.1 christos got+=DECDPUN;
7594 1.1 christos }
7595 1.1 christos if (ilength==10) { /* need to check for wrap */
7596 1.1 christos if (theInt/(Int)powers[got-DECDPUN]!=(Int)*(up-1)) ilength=11;
7597 1.1 christos /* [that test also disallows the BADINT result case] */
7598 1.1 christos else if (neg && theInt>1999999997) ilength=11;
7599 1.1 christos else if (!neg && theInt>999999999) ilength=11;
7600 1.1 christos if (ilength==11) theInt=save; /* restore correct low bit */
7601 1.1 christos }
7602 1.1 christos }
7603 1.1 christos
7604 1.1 christos if (ilength>10) { /* too big */
7605 1.1 christos if (theInt&1) return BIGODD; /* bottom bit 1 */
7606 1.1 christos return BIGEVEN; /* bottom bit 0 */
7607 1.1 christos }
7608 1.1 christos
7609 1.1 christos if (neg) theInt=-theInt; /* apply sign */
7610 1.1 christos return theInt;
7611 1.1 christos } /* decGetInt */
7612 1.1 christos
7613 1.1 christos /* ------------------------------------------------------------------ */
7614 1.1 christos /* decDecap -- decapitate the coefficient of a number */
7615 1.1 christos /* */
7616 1.1 christos /* dn is the number to be decapitated */
7617 1.1 christos /* drop is the number of digits to be removed from the left of dn; */
7618 1.1 christos /* this must be <= dn->digits (if equal, the coefficient is */
7619 1.1 christos /* set to 0) */
7620 1.1 christos /* */
7621 1.1 christos /* Returns dn; dn->digits will be <= the initial digits less drop */
7622 1.1 christos /* (after removing drop digits there may be leading zero digits */
7623 1.1 christos /* which will also be removed). Only dn->lsu and dn->digits change. */
7624 1.1 christos /* ------------------------------------------------------------------ */
7625 1.1 christos static decNumber *decDecap(decNumber *dn, Int drop) {
7626 1.1 christos Unit *msu; /* -> target cut point */
7627 1.1 christos Int cut; /* work */
7628 1.1 christos if (drop>=dn->digits) { /* losing the whole thing */
7629 1.1 christos #if DECCHECK
7630 1.1 christos if (drop>dn->digits)
7631 1.1 christos printf("decDecap called with drop>digits [%ld>%ld]\n",
7632 1.1 christos (LI)drop, (LI)dn->digits);
7633 1.1 christos #endif
7634 1.1 christos dn->lsu[0]=0;
7635 1.1 christos dn->digits=1;
7636 1.1 christos return dn;
7637 1.1 christos }
7638 1.1 christos msu=dn->lsu+D2U(dn->digits-drop)-1; /* -> likely msu */
7639 1.1 christos cut=MSUDIGITS(dn->digits-drop); /* digits to be in use in msu */
7640 1.1 christos if (cut!=DECDPUN) *msu%=powers[cut]; /* clear left digits */
7641 1.1 christos /* that may have left leading zero digits, so do a proper count... */
7642 1.1 christos dn->digits=decGetDigits(dn->lsu, msu-dn->lsu+1);
7643 1.1 christos return dn;
7644 1.1 christos } /* decDecap */
7645 1.1 christos
7646 1.1 christos /* ------------------------------------------------------------------ */
7647 1.1 christos /* decBiStr -- compare string with pairwise options */
7648 1.1 christos /* */
7649 1.1 christos /* targ is the string to compare */
7650 1.1 christos /* str1 is one of the strings to compare against (length may be 0) */
7651 1.1 christos /* str2 is the other; it must be the same length as str1 */
7652 1.1 christos /* */
7653 1.1 christos /* returns 1 if strings compare equal, (that is, it is the same */
7654 1.1 christos /* length as str1 and str2, and each character of targ is in either */
7655 1.1 christos /* str1 or str2 in the corresponding position), or 0 otherwise */
7656 1.1 christos /* */
7657 1.1 christos /* This is used for generic caseless compare, including the awkward */
7658 1.1 christos /* case of the Turkish dotted and dotless Is. Use as (for example): */
7659 1.1 christos /* if (decBiStr(test, "mike", "MIKE")) ... */
7660 1.1 christos /* ------------------------------------------------------------------ */
7661 1.1 christos static Flag decBiStr(const char *targ, const char *str1, const char *str2) {
7662 1.1 christos for (;;targ++, str1++, str2++) {
7663 1.1 christos if (*targ!=*str1 && *targ!=*str2) return 0;
7664 1.1 christos /* *targ has a match in one (or both, if terminator) */
7665 1.1 christos if (*targ=='\0') break;
7666 1.1 christos } /* forever */
7667 1.1 christos return 1;
7668 1.1 christos } /* decBiStr */
7669 1.1 christos
7670 1.1 christos /* ------------------------------------------------------------------ */
7671 1.1 christos /* decNaNs -- handle NaN operand or operands */
7672 1.1 christos /* */
7673 1.1 christos /* res is the result number */
7674 1.1 christos /* lhs is the first operand */
7675 1.1 christos /* rhs is the second operand, or NULL if none */
7676 1.1 christos /* context is used to limit payload length */
7677 1.1 christos /* status contains the current status */
7678 1.1 christos /* returns res in case convenient */
7679 1.1 christos /* */
7680 1.1 christos /* Called when one or both operands is a NaN, and propagates the */
7681 1.1 christos /* appropriate result to res. When an sNaN is found, it is changed */
7682 1.1 christos /* to a qNaN and Invalid operation is set. */
7683 1.1 christos /* ------------------------------------------------------------------ */
7684 1.1 christos static decNumber * decNaNs(decNumber *res, const decNumber *lhs,
7685 1.1 christos const decNumber *rhs, decContext *set,
7686 1.1 christos uInt *status) {
7687 1.1 christos /* This decision tree ends up with LHS being the source pointer, */
7688 1.1 christos /* and status updated if need be */
7689 1.1 christos if (lhs->bits & DECSNAN)
7690 1.1 christos *status|=DEC_Invalid_operation | DEC_sNaN;
7691 1.1 christos else if (rhs==NULL);
7692 1.1 christos else if (rhs->bits & DECSNAN) {
7693 1.1 christos lhs=rhs;
7694 1.1 christos *status|=DEC_Invalid_operation | DEC_sNaN;
7695 1.1 christos }
7696 1.1 christos else if (lhs->bits & DECNAN);
7697 1.1 christos else lhs=rhs;
7698 1.1 christos
7699 1.1 christos /* propagate the payload */
7700 1.1 christos if (lhs->digits<=set->digits) decNumberCopy(res, lhs); /* easy */
7701 1.1 christos else { /* too long */
7702 1.1 christos const Unit *ul;
7703 1.1 christos Unit *ur, *uresp1;
7704 1.1 christos /* copy safe number of units, then decapitate */
7705 1.1 christos res->bits=lhs->bits; /* need sign etc. */
7706 1.1 christos uresp1=res->lsu+D2U(set->digits);
7707 1.1 christos for (ur=res->lsu, ul=lhs->lsu; ur<uresp1; ur++, ul++) *ur=*ul;
7708 1.1 christos res->digits=D2U(set->digits)*DECDPUN;
7709 1.1 christos /* maybe still too long */
7710 1.1 christos if (res->digits>set->digits) decDecap(res, res->digits-set->digits);
7711 1.1 christos }
7712 1.1 christos
7713 1.1 christos res->bits&=~DECSNAN; /* convert any sNaN to NaN, while */
7714 1.1 christos res->bits|=DECNAN; /* .. preserving sign */
7715 1.1 christos res->exponent=0; /* clean exponent */
7716 1.1 christos /* [coefficient was copied/decapitated] */
7717 1.1 christos return res;
7718 1.1 christos } /* decNaNs */
7719 1.1 christos
7720 1.1 christos /* ------------------------------------------------------------------ */
7721 1.1 christos /* decStatus -- apply non-zero status */
7722 1.1 christos /* */
7723 1.1 christos /* dn is the number to set if error */
7724 1.1 christos /* status contains the current status (not yet in context) */
7725 1.1 christos /* set is the context */
7726 1.1 christos /* */
7727 1.1 christos /* If the status is an error status, the number is set to a NaN, */
7728 1.1 christos /* unless the error was an overflow, divide-by-zero, or underflow, */
7729 1.1 christos /* in which case the number will have already been set. */
7730 1.1 christos /* */
7731 1.1 christos /* The context status is then updated with the new status. Note that */
7732 1.1 christos /* this may raise a signal, so control may never return from this */
7733 1.1 christos /* routine (hence resources must be recovered before it is called). */
7734 1.1 christos /* ------------------------------------------------------------------ */
7735 1.1 christos static void decStatus(decNumber *dn, uInt status, decContext *set) {
7736 1.1 christos if (status & DEC_NaNs) { /* error status -> NaN */
7737 1.1 christos /* if cause was an sNaN, clear and propagate [NaN is already set up] */
7738 1.1 christos if (status & DEC_sNaN) status&=~DEC_sNaN;
7739 1.1 christos else {
7740 1.1 christos decNumberZero(dn); /* other error: clean throughout */
7741 1.1 christos dn->bits=DECNAN; /* and make a quiet NaN */
7742 1.1 christos }
7743 1.1 christos }
7744 1.1 christos decContextSetStatus(set, status); /* [may not return] */
7745 1.1 christos return;
7746 1.1 christos } /* decStatus */
7747 1.1 christos
7748 1.1 christos /* ------------------------------------------------------------------ */
7749 1.1 christos /* decGetDigits -- count digits in a Units array */
7750 1.1 christos /* */
7751 1.1 christos /* uar is the Unit array holding the number (this is often an */
7752 1.1 christos /* accumulator of some sort) */
7753 1.1 christos /* len is the length of the array in units [>=1] */
7754 1.1 christos /* */
7755 1.1 christos /* returns the number of (significant) digits in the array */
7756 1.1 christos /* */
7757 1.1 christos /* All leading zeros are excluded, except the last if the array has */
7758 1.1 christos /* only zero Units. */
7759 1.1 christos /* ------------------------------------------------------------------ */
7760 1.1 christos /* This may be called twice during some operations. */
7761 1.1 christos static Int decGetDigits(Unit *uar, Int len) {
7762 1.1 christos Unit *up=uar+(len-1); /* -> msu */
7763 1.1 christos Int digits=(len-1)*DECDPUN+1; /* possible digits excluding msu */
7764 1.1 christos #if DECDPUN>4
7765 1.1 christos uInt const *pow; /* work */
7766 1.1 christos #endif
7767 1.1 christos /* (at least 1 in final msu) */
7768 1.1 christos #if DECCHECK
7769 1.1 christos if (len<1) printf("decGetDigits called with len<1 [%ld]\n", (LI)len);
7770 1.1 christos #endif
7771 1.1 christos
7772 1.1 christos for (; up>=uar; up--) {
7773 1.1 christos if (*up==0) { /* unit is all 0s */
7774 1.1 christos if (digits==1) break; /* a zero has one digit */
7775 1.1 christos digits-=DECDPUN; /* adjust for 0 unit */
7776 1.1 christos continue;}
7777 1.1 christos /* found the first (most significant) non-zero Unit */
7778 1.1 christos #if DECDPUN>1 /* not done yet */
7779 1.1 christos if (*up<10) break; /* is 1-9 */
7780 1.1 christos digits++;
7781 1.1 christos #if DECDPUN>2 /* not done yet */
7782 1.1 christos if (*up<100) break; /* is 10-99 */
7783 1.1 christos digits++;
7784 1.1 christos #if DECDPUN>3 /* not done yet */
7785 1.1 christos if (*up<1000) break; /* is 100-999 */
7786 1.1 christos digits++;
7787 1.1 christos #if DECDPUN>4 /* count the rest ... */
7788 1.1 christos for (pow=&powers[4]; *up>=*pow; pow++) digits++;
7789 1.1 christos #endif
7790 1.1 christos #endif
7791 1.1 christos #endif
7792 1.1 christos #endif
7793 1.1 christos break;
7794 1.1 christos } /* up */
7795 1.1 christos return digits;
7796 1.1 christos } /* decGetDigits */
7797 1.1 christos
7798 1.1 christos #if DECTRACE | DECCHECK
7799 1.1 christos /* ------------------------------------------------------------------ */
7800 1.1 christos /* decNumberShow -- display a number [debug aid] */
7801 1.1 christos /* dn is the number to show */
7802 1.1 christos /* */
7803 1.1 christos /* Shows: sign, exponent, coefficient (msu first), digits */
7804 1.1 christos /* or: sign, special-value */
7805 1.1 christos /* ------------------------------------------------------------------ */
7806 1.1 christos /* this is public so other modules can use it */
7807 1.1 christos void decNumberShow(const decNumber *dn) {
7808 1.1 christos const Unit *up; /* work */
7809 1.1 christos uInt u, d; /* .. */
7810 1.1 christos Int cut; /* .. */
7811 1.1 christos char isign='+'; /* main sign */
7812 1.1 christos if (dn==NULL) {
7813 1.1 christos printf("NULL\n");
7814 1.1 christos return;}
7815 1.1 christos if (decNumberIsNegative(dn)) isign='-';
7816 1.1 christos printf(" >> %c ", isign);
7817 1.1 christos if (dn->bits&DECSPECIAL) { /* Is a special value */
7818 1.1 christos if (decNumberIsInfinite(dn)) printf("Infinity");
7819 1.1 christos else { /* a NaN */
7820 1.1 christos if (dn->bits&DECSNAN) printf("sNaN"); /* signalling NaN */
7821 1.1 christos else printf("NaN");
7822 1.1 christos }
7823 1.1 christos /* if coefficient and exponent are 0, no more to do */
7824 1.1 christos if (dn->exponent==0 && dn->digits==1 && *dn->lsu==0) {
7825 1.1 christos printf("\n");
7826 1.1 christos return;}
7827 1.1 christos /* drop through to report other information */
7828 1.1 christos printf(" ");
7829 1.1 christos }
7830 1.1 christos
7831 1.1 christos /* now carefully display the coefficient */
7832 1.1 christos up=dn->lsu+D2U(dn->digits)-1; /* msu */
7833 1.1 christos printf("%ld", (LI)*up);
7834 1.1 christos for (up=up-1; up>=dn->lsu; up--) {
7835 1.1 christos u=*up;
7836 1.1 christos printf(":");
7837 1.1 christos for (cut=DECDPUN-1; cut>=0; cut--) {
7838 1.1 christos d=u/powers[cut];
7839 1.1 christos u-=d*powers[cut];
7840 1.1 christos printf("%ld", (LI)d);
7841 1.1 christos } /* cut */
7842 1.1 christos } /* up */
7843 1.1 christos if (dn->exponent!=0) {
7844 1.1 christos char esign='+';
7845 1.1 christos if (dn->exponent<0) esign='-';
7846 1.1 christos printf(" E%c%ld", esign, (LI)abs(dn->exponent));
7847 1.1 christos }
7848 1.1 christos printf(" [%ld]\n", (LI)dn->digits);
7849 1.1 christos } /* decNumberShow */
7850 1.1 christos #endif
7851 1.1 christos
7852 1.1 christos #if DECTRACE || DECCHECK
7853 1.1 christos /* ------------------------------------------------------------------ */
7854 1.1 christos /* decDumpAr -- display a unit array [debug/check aid] */
7855 1.1 christos /* name is a single-character tag name */
7856 1.1 christos /* ar is the array to display */
7857 1.1 christos /* len is the length of the array in Units */
7858 1.1 christos /* ------------------------------------------------------------------ */
7859 1.1 christos static void decDumpAr(char name, const Unit *ar, Int len) {
7860 1.1 christos Int i;
7861 1.1 christos const char *spec;
7862 1.1 christos #if DECDPUN==9
7863 1.1 christos spec="%09d ";
7864 1.1 christos #elif DECDPUN==8
7865 1.1 christos spec="%08d ";
7866 1.1 christos #elif DECDPUN==7
7867 1.1 christos spec="%07d ";
7868 1.1 christos #elif DECDPUN==6
7869 1.1 christos spec="%06d ";
7870 1.1 christos #elif DECDPUN==5
7871 1.1 christos spec="%05d ";
7872 1.1 christos #elif DECDPUN==4
7873 1.1 christos spec="%04d ";
7874 1.1 christos #elif DECDPUN==3
7875 1.1 christos spec="%03d ";
7876 1.1 christos #elif DECDPUN==2
7877 1.1 christos spec="%02d ";
7878 1.1 christos #else
7879 1.1 christos spec="%d ";
7880 1.1 christos #endif
7881 1.1 christos printf(" :%c: ", name);
7882 1.1 christos for (i=len-1; i>=0; i--) {
7883 1.1 christos if (i==len-1) printf("%ld ", (LI)ar[i]);
7884 1.1 christos else printf(spec, ar[i]);
7885 1.1 christos }
7886 1.1 christos printf("\n");
7887 1.1 christos return;}
7888 1.1 christos #endif
7889 1.1 christos
7890 1.1 christos #if DECCHECK
7891 1.1 christos /* ------------------------------------------------------------------ */
7892 1.1 christos /* decCheckOperands -- check operand(s) to a routine */
7893 1.1 christos /* res is the result structure (not checked; it will be set to */
7894 1.1 christos /* quiet NaN if error found (and it is not NULL)) */
7895 1.1 christos /* lhs is the first operand (may be DECUNRESU) */
7896 1.1 christos /* rhs is the second (may be DECUNUSED) */
7897 1.1 christos /* set is the context (may be DECUNCONT) */
7898 1.1 christos /* returns 0 if both operands, and the context are clean, or 1 */
7899 1.1 christos /* otherwise (in which case the context will show an error, */
7900 1.1 christos /* unless NULL). Note that res is not cleaned; caller should */
7901 1.1 christos /* handle this so res=NULL case is safe. */
7902 1.1 christos /* The caller is expected to abandon immediately if 1 is returned. */
7903 1.1 christos /* ------------------------------------------------------------------ */
7904 1.1 christos static Flag decCheckOperands(decNumber *res, const decNumber *lhs,
7905 1.1 christos const decNumber *rhs, decContext *set) {
7906 1.1 christos Flag bad=0;
7907 1.1 christos if (set==NULL) { /* oops; hopeless */
7908 1.1 christos #if DECTRACE || DECVERB
7909 1.1 christos printf("Reference to context is NULL.\n");
7910 1.1 christos #endif
7911 1.1 christos bad=1;
7912 1.1 christos return 1;}
7913 1.1 christos else if (set!=DECUNCONT
7914 1.1 christos && (set->digits<1 || set->round>=DEC_ROUND_MAX)) {
7915 1.1 christos bad=1;
7916 1.1 christos #if DECTRACE || DECVERB
7917 1.1 christos printf("Bad context [digits=%ld round=%ld].\n",
7918 1.1 christos (LI)set->digits, (LI)set->round);
7919 1.1 christos #endif
7920 1.1 christos }
7921 1.1 christos else {
7922 1.1 christos if (res==NULL) {
7923 1.1 christos bad=1;
7924 1.1 christos #if DECTRACE
7925 1.1 christos /* this one not DECVERB as standard tests include NULL */
7926 1.1 christos printf("Reference to result is NULL.\n");
7927 1.1 christos #endif
7928 1.1 christos }
7929 1.1 christos if (!bad && lhs!=DECUNUSED) bad=(decCheckNumber(lhs));
7930 1.1 christos if (!bad && rhs!=DECUNUSED) bad=(decCheckNumber(rhs));
7931 1.1 christos }
7932 1.1 christos if (bad) {
7933 1.1 christos if (set!=DECUNCONT) decContextSetStatus(set, DEC_Invalid_operation);
7934 1.1 christos if (res!=DECUNRESU && res!=NULL) {
7935 1.1 christos decNumberZero(res);
7936 1.1 christos res->bits=DECNAN; /* qNaN */
7937 1.1 christos }
7938 1.1 christos }
7939 1.1 christos return bad;
7940 1.1 christos } /* decCheckOperands */
7941 1.1 christos
7942 1.1 christos /* ------------------------------------------------------------------ */
7943 1.1 christos /* decCheckNumber -- check a number */
7944 1.1 christos /* dn is the number to check */
7945 1.1 christos /* returns 0 if the number is clean, or 1 otherwise */
7946 1.1 christos /* */
7947 1.1 christos /* The number is considered valid if it could be a result from some */
7948 1.1 christos /* operation in some valid context. */
7949 1.1 christos /* ------------------------------------------------------------------ */
7950 1.1 christos static Flag decCheckNumber(const decNumber *dn) {
7951 1.1 christos const Unit *up; /* work */
7952 1.1 christos uInt maxuint; /* .. */
7953 1.1 christos Int ae, d, digits; /* .. */
7954 1.1 christos Int emin, emax; /* .. */
7955 1.1 christos
7956 1.1 christos if (dn==NULL) { /* hopeless */
7957 1.1 christos #if DECTRACE
7958 1.1 christos /* this one not DECVERB as standard tests include NULL */
7959 1.1 christos printf("Reference to decNumber is NULL.\n");
7960 1.1 christos #endif
7961 1.1 christos return 1;}
7962 1.1 christos
7963 1.1 christos /* check special values */
7964 1.1 christos if (dn->bits & DECSPECIAL) {
7965 1.1 christos if (dn->exponent!=0) {
7966 1.1 christos #if DECTRACE || DECVERB
7967 1.1 christos printf("Exponent %ld (not 0) for a special value [%02x].\n",
7968 1.1 christos (LI)dn->exponent, dn->bits);
7969 1.1 christos #endif
7970 1.1 christos return 1;}
7971 1.1 christos
7972 1.1 christos /* 2003.09.08: NaNs may now have coefficients, so next tests Inf only */
7973 1.1 christos if (decNumberIsInfinite(dn)) {
7974 1.1 christos if (dn->digits!=1) {
7975 1.1 christos #if DECTRACE || DECVERB
7976 1.1 christos printf("Digits %ld (not 1) for an infinity.\n", (LI)dn->digits);
7977 1.1 christos #endif
7978 1.1 christos return 1;}
7979 1.1 christos if (*dn->lsu!=0) {
7980 1.1 christos #if DECTRACE || DECVERB
7981 1.1 christos printf("LSU %ld (not 0) for an infinity.\n", (LI)*dn->lsu);
7982 1.1 christos #endif
7983 1.1 christos decDumpAr('I', dn->lsu, D2U(dn->digits));
7984 1.1 christos return 1;}
7985 1.1 christos } /* Inf */
7986 1.1 christos /* 2002.12.26: negative NaNs can now appear through proposed IEEE */
7987 1.1 christos /* concrete formats (decimal64, etc.). */
7988 1.1 christos return 0;
7989 1.1 christos }
7990 1.1 christos
7991 1.1 christos /* check the coefficient */
7992 1.1 christos if (dn->digits<1 || dn->digits>DECNUMMAXP) {
7993 1.1 christos #if DECTRACE || DECVERB
7994 1.1 christos printf("Digits %ld in number.\n", (LI)dn->digits);
7995 1.1 christos #endif
7996 1.1 christos return 1;}
7997 1.1 christos
7998 1.1 christos d=dn->digits;
7999 1.1 christos
8000 1.1 christos for (up=dn->lsu; d>0; up++) {
8001 1.1 christos if (d>DECDPUN) maxuint=DECDPUNMAX;
8002 1.1 christos else { /* reached the msu */
8003 1.1 christos maxuint=powers[d]-1;
8004 1.1 christos if (dn->digits>1 && *up<powers[d-1]) {
8005 1.1 christos #if DECTRACE || DECVERB
8006 1.1 christos printf("Leading 0 in number.\n");
8007 1.1 christos decNumberShow(dn);
8008 1.1 christos #endif
8009 1.1 christos return 1;}
8010 1.1 christos }
8011 1.1 christos if (*up>maxuint) {
8012 1.1 christos #if DECTRACE || DECVERB
8013 1.1 christos printf("Bad Unit [%08lx] in %ld-digit number at offset %ld [maxuint %ld].\n",
8014 1.1 christos (LI)*up, (LI)dn->digits, (LI)(up-dn->lsu), (LI)maxuint);
8015 1.1 christos #endif
8016 1.1 christos return 1;}
8017 1.1 christos d-=DECDPUN;
8018 1.1 christos }
8019 1.1 christos
8020 1.1 christos /* check the exponent. Note that input operands can have exponents */
8021 1.1 christos /* which are out of the set->emin/set->emax and set->digits range */
8022 1.1 christos /* (just as they can have more digits than set->digits). */
8023 1.1 christos ae=dn->exponent+dn->digits-1; /* adjusted exponent */
8024 1.1 christos emax=DECNUMMAXE;
8025 1.1 christos emin=DECNUMMINE;
8026 1.1 christos digits=DECNUMMAXP;
8027 1.1 christos if (ae<emin-(digits-1)) {
8028 1.1 christos #if DECTRACE || DECVERB
8029 1.1 christos printf("Adjusted exponent underflow [%ld].\n", (LI)ae);
8030 1.1 christos decNumberShow(dn);
8031 1.1 christos #endif
8032 1.1 christos return 1;}
8033 1.1 christos if (ae>+emax) {
8034 1.1 christos #if DECTRACE || DECVERB
8035 1.1 christos printf("Adjusted exponent overflow [%ld].\n", (LI)ae);
8036 1.1 christos decNumberShow(dn);
8037 1.1 christos #endif
8038 1.1 christos return 1;}
8039 1.1 christos
8040 1.1 christos return 0; /* it's OK */
8041 1.1 christos } /* decCheckNumber */
8042 1.1 christos
8043 1.1 christos /* ------------------------------------------------------------------ */
8044 1.1 christos /* decCheckInexact -- check a normal finite inexact result has digits */
8045 1.1 christos /* dn is the number to check */
8046 1.1 christos /* set is the context (for status and precision) */
8047 1.1 christos /* sets Invalid operation, etc., if some digits are missing */
8048 1.1 christos /* [this check is not made for DECSUBSET compilation or when */
8049 1.1 christos /* subnormal is not set] */
8050 1.1 christos /* ------------------------------------------------------------------ */
8051 1.1 christos static void decCheckInexact(const decNumber *dn, decContext *set) {
8052 1.1 christos #if !DECSUBSET && DECEXTFLAG
8053 1.1 christos if ((set->status & (DEC_Inexact|DEC_Subnormal))==DEC_Inexact
8054 1.1 christos && (set->digits!=dn->digits) && !(dn->bits & DECSPECIAL)) {
8055 1.1 christos #if DECTRACE || DECVERB
8056 1.1 christos printf("Insufficient digits [%ld] on normal Inexact result.\n",
8057 1.1 christos (LI)dn->digits);
8058 1.1 christos decNumberShow(dn);
8059 1.1 christos #endif
8060 1.1 christos decContextSetStatus(set, DEC_Invalid_operation);
8061 1.1 christos }
8062 1.1 christos #else
8063 1.1 christos /* next is a noop for quiet compiler */
8064 1.1 christos if (dn!=NULL && dn->digits==0) set->status|=DEC_Invalid_operation;
8065 1.1 christos #endif
8066 1.1 christos return;
8067 1.1 christos } /* decCheckInexact */
8068 1.1 christos #endif
8069 1.1 christos
8070 1.1 christos #if DECALLOC
8071 1.1 christos #undef malloc
8072 1.1 christos #undef free
8073 1.1 christos /* ------------------------------------------------------------------ */
8074 1.1 christos /* decMalloc -- accountable allocation routine */
8075 1.1 christos /* n is the number of bytes to allocate */
8076 1.1 christos /* */
8077 1.1 christos /* Semantics is the same as the stdlib malloc routine, but bytes */
8078 1.1 christos /* allocated are accounted for globally, and corruption fences are */
8079 1.1 christos /* added before and after the 'actual' storage. */
8080 1.1 christos /* ------------------------------------------------------------------ */
8081 1.1 christos /* This routine allocates storage with an extra twelve bytes; 8 are */
8082 1.1 christos /* at the start and hold: */
8083 1.1 christos /* 0-3 the original length requested */
8084 1.1 christos /* 4-7 buffer corruption detection fence (DECFENCE, x4) */
8085 1.1 christos /* The 4 bytes at the end also hold a corruption fence (DECFENCE, x4) */
8086 1.1 christos /* ------------------------------------------------------------------ */
8087 1.1 christos static void *decMalloc(size_t n) {
8088 1.1 christos uInt size=n+12; /* true size */
8089 1.1 christos void *alloc; /* -> allocated storage */
8090 1.1 christos uByte *b, *b0; /* work */
8091 1.1 christos uInt uiwork; /* for macros */
8092 1.1 christos
8093 1.1 christos alloc=malloc(size); /* -> allocated storage */
8094 1.1 christos if (alloc==NULL) return NULL; /* out of strorage */
8095 1.1 christos b0=(uByte *)alloc; /* as bytes */
8096 1.1 christos decAllocBytes+=n; /* account for storage */
8097 1.1 christos UBFROMUI(alloc, n); /* save n */
8098 1.1 christos /* printf(" alloc ++ dAB: %ld (%ld)\n", (LI)decAllocBytes, (LI)n); */
8099 1.1 christos for (b=b0+4; b<b0+8; b++) *b=DECFENCE;
8100 1.1 christos for (b=b0+n+8; b<b0+n+12; b++) *b=DECFENCE;
8101 1.1 christos return b0+8; /* -> play area */
8102 1.1 christos } /* decMalloc */
8103 1.1 christos
8104 1.1 christos /* ------------------------------------------------------------------ */
8105 1.1 christos /* decFree -- accountable free routine */
8106 1.1 christos /* alloc is the storage to free */
8107 1.1 christos /* */
8108 1.1 christos /* Semantics is the same as the stdlib malloc routine, except that */
8109 1.1 christos /* the global storage accounting is updated and the fences are */
8110 1.1 christos /* checked to ensure that no routine has written 'out of bounds'. */
8111 1.1 christos /* ------------------------------------------------------------------ */
8112 1.1 christos /* This routine first checks that the fences have not been corrupted. */
8113 1.1 christos /* It then frees the storage using the 'truw' storage address (that */
8114 1.1 christos /* is, offset by 8). */
8115 1.1 christos /* ------------------------------------------------------------------ */
8116 1.1 christos static void decFree(void *alloc) {
8117 1.1 christos uInt n; /* original length */
8118 1.1 christos uByte *b, *b0; /* work */
8119 1.1 christos uInt uiwork; /* for macros */
8120 1.1 christos
8121 1.1 christos if (alloc==NULL) return; /* allowed; it's a nop */
8122 1.1 christos b0=(uByte *)alloc; /* as bytes */
8123 1.1 christos b0-=8; /* -> true start of storage */
8124 1.1 christos n=UBTOUI(b0); /* lift length */
8125 1.1 christos for (b=b0+4; b<b0+8; b++) if (*b!=DECFENCE)
8126 1.1 christos printf("=== Corrupt byte [%02x] at offset %d from %ld ===\n", *b,
8127 1.1 christos b-b0-8, (LI)b0);
8128 1.1 christos for (b=b0+n+8; b<b0+n+12; b++) if (*b!=DECFENCE)
8129 1.1 christos printf("=== Corrupt byte [%02x] at offset +%d from %ld, n=%ld ===\n", *b,
8130 1.1 christos b-b0-8, (LI)b0, (LI)n);
8131 1.1 christos free(b0); /* drop the storage */
8132 1.1 christos decAllocBytes-=n; /* account for storage */
8133 1.1 christos /* printf(" free -- dAB: %d (%d)\n", decAllocBytes, -n); */
8134 1.1 christos } /* decFree */
8135 1.1 christos #define malloc(a) decMalloc(a)
8136 1.1 christos #define free(a) decFree(a)
8137 1.1 christos #endif
8138