1 1.1 christos /* Decimal number arithmetic module for the decNumber C Library. 2 1.6 christos Copyright (C) 2005-2018 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.6 christos decNumber *inv=invbuff; /* assume 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.6 christos /* iterations by approximately 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.6 christos if (decNumberIsNegative(lhs) && !decNumberIsNegative(rhs)) { 6033 1.1 christos result=-1; 6034 1.1 christos break; 6035 1.1 christos } 6036 1.6 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