1169695Skan/* Decimal Number module for the decNumber C Library
2169695Skan   Copyright (C) 2005 Free Software Foundation, Inc.
3169695Skan   Contributed by IBM Corporation.  Author Mike Cowlishaw.
4169695Skan
5169695Skan   This file is part of GCC.
6169695Skan
7169695Skan   GCC is free software; you can redistribute it and/or modify it under
8169695Skan   the terms of the GNU General Public License as published by the Free
9169695Skan   Software Foundation; either version 2, or (at your option) any later
10169695Skan   version.
11169695Skan
12169695Skan   In addition to the permissions in the GNU General Public License,
13169695Skan   the Free Software Foundation gives you unlimited permission to link
14169695Skan   the compiled version of this file into combinations with other
15169695Skan   programs, and to distribute those combinations without any
16169695Skan   restriction coming from the use of this file.  (The General Public
17169695Skan   License restrictions do apply in other respects; for example, they
18169695Skan   cover modification of the file, and distribution when not linked
19169695Skan   into a combine executable.)
20169695Skan
21169695Skan   GCC is distributed in the hope that it will be useful, but WITHOUT ANY
22169695Skan   WARRANTY; without even the implied warranty of MERCHANTABILITY or
23169695Skan   FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
24169695Skan   for more details.
25169695Skan
26169695Skan   You should have received a copy of the GNU General Public License
27169695Skan   along with GCC; see the file COPYING.  If not, write to the Free
28169695Skan   Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
29169695Skan   02110-1301, USA.  */
30169695Skan
31169695Skan/* ------------------------------------------------------------------ */
32169695Skan/* This module comprises the routines for Standard Decimal Arithmetic */
33169695Skan/* as defined in the specification which may be found on the          */
34169695Skan/* http://www2.hursley.ibm.com/decimal web pages.  It implements both */
35169695Skan/* the full ('extended') arithmetic and the simpler ('subset')        */
36169695Skan/* arithmetic.                                                        */
37169695Skan/*                                                                    */
38169695Skan/* Usage notes:                                                       */
39169695Skan/*                                                                    */
40169695Skan/* 1. This code is ANSI C89 except:                                   */
41169695Skan/*                                                                    */
42169695Skan/*    a) Line comments (double forward slash) are used.  (Most C      */
43169695Skan/*       compilers accept these.  If yours does not, a simple script  */
44169695Skan/*       can be used to convert them to ANSI C comments.)             */
45169695Skan/*                                                                    */
46169695Skan/*    b) Types from C99 stdint.h are used.  If you do not have this   */
47169695Skan/*       header file, see the User's Guide section of the decNumber   */
48169695Skan/*       documentation; this lists the necessary definitions.         */
49169695Skan/*                                                                    */
50169695Skan/*    c) If DECDPUN>4, non-ANSI 64-bit 'long long' types are used.    */
51169695Skan/*       To avoid these, set DECDPUN <= 4 (see documentation).        */
52169695Skan/*                                                                    */
53169695Skan/* 2. The decNumber format which this library uses is optimized for   */
54169695Skan/*    efficient processing of relatively short numbers; in particular */
55169695Skan/*    it allows the use of fixed sized structures and minimizes copy  */
56169695Skan/*    and move operations.  It does, however, support arbitrary       */
57169695Skan/*    precision (up to 999,999,999 digits) and arbitrary exponent     */
58169695Skan/*    range (Emax in the range 0 through 999,999,999 and Emin in the  */
59169695Skan/*    range -999,999,999 through 0).                                  */
60169695Skan/*                                                                    */
61169695Skan/* 3. Operands to operator functions are never modified unless they   */
62169695Skan/*    are also specified to be the result number (which is always     */
63169695Skan/*    permitted).  Other than that case, operands may not overlap.    */
64169695Skan/*                                                                    */
65169695Skan/* 4. Error handling: the type of the error is ORed into the status   */
66169695Skan/*    flags in the current context (decContext structure).  The       */
67169695Skan/*    SIGFPE signal is then raised if the corresponding trap-enabler  */
68169695Skan/*    flag in the decContext is set (is 1).                           */
69169695Skan/*                                                                    */
70169695Skan/*    It is the responsibility of the caller to clear the status      */
71169695Skan/*    flags as required.                                              */
72169695Skan/*                                                                    */
73169695Skan/*    The result of any routine which returns a number will always    */
74169695Skan/*    be a valid number (which may be a special value, such as an     */
75169695Skan/*    Infinity or NaN).                                               */
76169695Skan/*                                                                    */
77169695Skan/* 5. The decNumber format is not an exchangeable concrete            */
78169695Skan/*    representation as it comprises fields which may be machine-     */
79169695Skan/*    dependent (big-endian or little-endian, for example).           */
80169695Skan/*    Canonical conversions to and from strings are provided; other   */
81169695Skan/*    conversions are available in separate modules.                  */
82169695Skan/*                                                                    */
83169695Skan/* 6. Normally, input operands are assumed to be valid.  Set DECCHECK */
84169695Skan/*    to 1 for extended operand checking (including NULL operands).   */
85169695Skan/*    Results are undefined if a badly-formed structure (or a NULL    */
86169695Skan/*    NULL pointer to a structure) is provided, though with DECCHECK  */
87169695Skan/*    enabled the operator routines are protected against exceptions. */
88169695Skan/*    (Except if the result pointer is NULL, which is unrecoverable.) */
89169695Skan/*                                                                    */
90169695Skan/*    However, the routines will never cause exceptions if they are   */
91169695Skan/*    given well-formed operands, even if the value of the operands   */
92169695Skan/*    is inappropriate for the operation and DECCHECK is not set.     */
93169695Skan/*                                                                    */
94169695Skan/* 7. Subset arithmetic is available only if DECSUBSET is set to 1.   */
95169695Skan/* ------------------------------------------------------------------ */
96169695Skan/* Implementation notes for maintenance of this module:               */
97169695Skan/*                                                                    */
98169695Skan/* 1. Storage leak protection:  Routines which use malloc are not     */
99169695Skan/*    permitted to use return for fastpath or error exits (i.e.,      */
100169695Skan/*    they follow strict structured programming conventions).         */
101169695Skan/*    Instead they have a do{}while(0); construct surrounding the     */
102169695Skan/*    code which is protected -- break may be used from this.         */
103169695Skan/*    Other routines are allowed to use the return statement inline.  */
104169695Skan/*                                                                    */
105169695Skan/*    Storage leak accounting can be enabled using DECALLOC.          */
106169695Skan/*                                                                    */
107169695Skan/* 2. All loops use the for(;;) construct.  Any do construct is for   */
108169695Skan/*    protection as just described.                                   */
109169695Skan/*                                                                    */
110169695Skan/* 3. Setting status in the context must always be the very last      */
111169695Skan/*    action in a routine, as non-0 status may raise a trap and hence */
112169695Skan/*    the call to set status may not return (if the handler uses long */
113169695Skan/*    jump).  Therefore all cleanup must be done first.  In general,  */
114169695Skan/*    to achieve this we accumulate status and only finally apply it  */
115169695Skan/*    by calling decContextSetStatus (via decStatus).                 */
116169695Skan/*                                                                    */
117169695Skan/*    Routines which allocate storage cannot, therefore, use the      */
118169695Skan/*    'top level' routines which could cause a non-returning          */
119169695Skan/*    transfer of control.  The decXxxxOp routines are safe (do not   */
120169695Skan/*    call decStatus even if traps are set in the context) and should */
121169695Skan/*    be used instead (they are also a little faster).                */
122169695Skan/*                                                                    */
123169695Skan/* 4. Exponent checking is minimized by allowing the exponent to      */
124169695Skan/*    grow outside its limits during calculations, provided that      */
125169695Skan/*    the decFinalize function is called later.  Multiplication and   */
126169695Skan/*    division, and intermediate calculations in exponentiation,      */
127169695Skan/*    require more careful checks because of the risk of 31-bit       */
128169695Skan/*    overflow (the most negative valid exponent is -1999999997, for  */
129169695Skan/*    a 999999999-digit number with adjusted exponent of -999999999). */
130169695Skan/*                                                                    */
131169695Skan/* 5. Rounding is deferred until finalization of results, with any    */
132169695Skan/*    'off to the right' data being represented as a single digit     */
133169695Skan/*    residue (in the range -1 through 9).  This avoids any double-   */
134169695Skan/*    rounding when more than one shortening takes place (for         */
135169695Skan/*    example, when a result is subnormal).                           */
136169695Skan/*                                                                    */
137169695Skan/* 6. The digits count is allowed to rise to a multiple of DECDPUN    */
138169695Skan/*    during many operations, so whole Units are handled and exact    */
139169695Skan/*    accounting of digits is not needed.  The correct digits value   */
140169695Skan/*    is found by decGetDigits, which accounts for leading zeros.     */
141169695Skan/*    This must be called before any rounding if the number of digits */
142169695Skan/*    is not known exactly.                                           */
143169695Skan/*                                                                    */
144169695Skan/* 7. We use the multiply-by-reciprocal 'trick' for partitioning      */
145169695Skan/*    numbers up to four digits, using appropriate constants.  This   */
146169695Skan/*    is not useful for longer numbers because overflow of 32 bits    */
147169695Skan/*    would lead to 4 multiplies, which is almost as expensive as     */
148169695Skan/*    a divide (unless we assumed floating-point multiply available). */
149169695Skan/*                                                                    */
150169695Skan/* 8. Unusual abbreviations possibly used in the commentary:          */
151169695Skan/*      lhs -- left hand side (operand, of an operation)              */
152169695Skan/*      lsd -- least significant digit (of coefficient)               */
153169695Skan/*      lsu -- least significant Unit (of coefficient)                */
154169695Skan/*      msd -- most significant digit (of coefficient)                */
155169695Skan/*      msu -- most significant Unit (of coefficient)                 */
156169695Skan/*      rhs -- right hand side (operand, of an operation)             */
157169695Skan/*      +ve -- positive                                               */
158169695Skan/*      -ve -- negative                                               */
159169695Skan/* ------------------------------------------------------------------ */
160169695Skan
161169695Skan/* Some of glibc's string inlines cause warnings.  Plus we'd rather
162169695Skan   rely on (and therefore test) GCC's string builtins.  */
163169695Skan#define __NO_STRING_INLINES
164169695Skan
165169695Skan#include <stdlib.h>		/* for malloc, free, etc. */
166169695Skan#include <stdio.h>		/* for printf [if needed] */
167169695Skan#include <string.h>		/* for strcpy */
168169695Skan#include <ctype.h>		/* for lower */
169169695Skan#include "config.h"
170169695Skan#include "decNumber.h"		/* base number library */
171169695Skan#include "decNumberLocal.h"	/* decNumber local types, etc. */
172169695Skan
173169695Skan/* Constants */
174169695Skan/* Public constant array: powers of ten (powers[n]==10**n) */
175169695Skanconst uInt powers[] = { 1, 10, 100, 1000, 10000, 100000, 1000000,
176169695Skan  10000000, 100000000, 1000000000
177169695Skan};
178169695Skan
179169695Skan/* Local constants */
180169695Skan#define DIVIDE    0x80		/* Divide operators */
181169695Skan#define REMAINDER 0x40		/* .. */
182169695Skan#define DIVIDEINT 0x20		/* .. */
183169695Skan#define REMNEAR   0x10		/* .. */
184169695Skan#define COMPARE   0x01		/* Compare operators */
185169695Skan#define COMPMAX   0x02		/* .. */
186169695Skan#define COMPMIN   0x03		/* .. */
187169695Skan#define COMPNAN   0x04		/* .. [NaN processing] */
188169695Skan
189169695Skan#define DEC_sNaN 0x40000000	/* local status: sNaN signal */
190169695Skan#define BADINT (Int)0x80000000	/* most-negative Int; error indicator */
191169695Skan
192169695Skanstatic Unit one[] = { 1 };	/* Unit array of 1, used for incrementing */
193169695Skan
194169695Skan/* Granularity-dependent code */
195169695Skan#if DECDPUN<=4
196169695Skan#define eInt  Int		/* extended integer */
197169695Skan#define ueInt uInt		/* unsigned extended integer */
198169695Skan  /* Constant multipliers for divide-by-power-of five using reciprocal */
199169695Skan  /* multiply, after removing powers of 2 by shifting, and final shift */
200169695Skan  /* of 17 [we only need up to **4] */
201169695Skanstatic const uInt multies[] = { 131073, 26215, 5243, 1049, 210 };
202169695Skan
203169695Skan  /* QUOT10 -- macro to return the quotient of unit u divided by 10**n */
204169695Skan#define QUOT10(u, n) ((((uInt)(u)>>(n))*multies[n])>>17)
205169695Skan#else
206169695Skan  /* For DECDPUN>4 we currently use non-ANSI 64-bit types.  These could */
207169695Skan  /* be replaced by subroutine calls later. */
208169695Skan#ifdef long
209169695Skan#undef long
210169695Skan#endif
211169695Skantypedef signed long long Long;
212169695Skantypedef unsigned long long uLong;
213169695Skan#define eInt  Long		/* extended integer */
214169695Skan#define ueInt uLong		/* unsigned extended integer */
215169695Skan#endif
216169695Skan
217169695Skan/* Local routines */
218169695Skanstatic decNumber *decAddOp (decNumber *, const decNumber *,
219169695Skan			    const decNumber *, decContext *,
220169695Skan			    uByte, uInt *);
221169695Skanstatic void decApplyRound (decNumber *, decContext *, Int, uInt *);
222169695Skanstatic Int decCompare (const decNumber * lhs, const decNumber * rhs);
223169695Skanstatic decNumber *decCompareOp (decNumber *, const decNumber *, const decNumber *,
224169695Skan				decContext *, Flag, uInt *);
225169695Skanstatic void decCopyFit (decNumber *, const decNumber *, decContext *,
226169695Skan			Int *, uInt *);
227169695Skanstatic decNumber *decDivideOp (decNumber *, const decNumber *, const decNumber *,
228169695Skan			       decContext *, Flag, uInt *);
229169695Skanstatic void decFinalize (decNumber *, decContext *, Int *, uInt *);
230169695Skanstatic Int decGetDigits (const Unit *, Int);
231169695Skan#if DECSUBSET
232169695Skanstatic Int decGetInt (const decNumber *, decContext *);
233169695Skan#else
234169695Skanstatic Int decGetInt (const decNumber *);
235169695Skan#endif
236169695Skanstatic decNumber *decMultiplyOp (decNumber *, const decNumber *,
237169695Skan				 const decNumber *, decContext *, uInt *);
238169695Skanstatic decNumber *decNaNs (decNumber *, const decNumber *, const decNumber *, uInt *);
239169695Skanstatic decNumber *decQuantizeOp (decNumber *, const decNumber *,
240169695Skan				 const decNumber *, decContext *, Flag, uInt *);
241169695Skanstatic void decSetCoeff (decNumber *, decContext *, const Unit *,
242169695Skan			 Int, Int *, uInt *);
243169695Skanstatic void decSetOverflow (decNumber *, decContext *, uInt *);
244169695Skanstatic void decSetSubnormal (decNumber *, decContext *, Int *, uInt *);
245169695Skanstatic Int decShiftToLeast (Unit *, Int, Int);
246169695Skanstatic Int decShiftToMost (Unit *, Int, Int);
247169695Skanstatic void decStatus (decNumber *, uInt, decContext *);
248169695Skanstatic Flag decStrEq (const char *, const char *);
249169695Skanstatic void decToString (const decNumber *, char[], Flag);
250169695Skanstatic decNumber *decTrim (decNumber *, Flag, Int *);
251169695Skanstatic Int decUnitAddSub (const Unit *, Int, const Unit *, Int, Int, Unit *, Int);
252169695Skanstatic Int decUnitCompare (const Unit *, Int, const Unit *, Int, Int);
253169695Skan
254169695Skan#if !DECSUBSET
255169695Skan/* decFinish == decFinalize when no subset arithmetic needed */
256169695Skan#define decFinish(a,b,c,d) decFinalize(a,b,c,d)
257169695Skan#else
258169695Skanstatic void decFinish (decNumber *, decContext *, Int *, uInt *);
259169695Skanstatic decNumber *decRoundOperand (const decNumber *, decContext *, uInt *);
260169695Skan#endif
261169695Skan
262169695Skan/* Diagnostic macros, etc. */
263169695Skan#if DECALLOC
264169695Skan/* Handle malloc/free accounting.  If enabled, our accountable routines */
265169695Skan/* are used; otherwise the code just goes straight to the system malloc */
266169695Skan/* and free routines. */
267169695Skan#define malloc(a) decMalloc(a)
268169695Skan#define free(a) decFree(a)
269169695Skan#define DECFENCE 0x5a		/* corruption detector */
270169695Skan/* 'Our' malloc and free: */
271169695Skanstatic void *decMalloc (size_t);
272169695Skanstatic void decFree (void *);
273169695SkanuInt decAllocBytes = 0;		/* count of bytes allocated */
274169695Skan/* Note that DECALLOC code only checks for storage buffer overflow. */
275169695Skan/* To check for memory leaks, the decAllocBytes variable should be */
276169695Skan/* checked to be 0 at appropriate times (e.g., after the test */
277169695Skan/* harness completes a set of tests).  This checking may be unreliable */
278169695Skan/* if the testing is done in a multi-thread environment. */
279169695Skan#endif
280169695Skan
281169695Skan#if DECCHECK
282169695Skan/* Optional operand checking routines.  Enabling these means that */
283169695Skan/* decNumber and decContext operands to operator routines are checked */
284169695Skan/* for correctness.  This roughly doubles the execution time of the */
285169695Skan/* fastest routines (and adds 600+ bytes), so should not normally be */
286169695Skan/* used in 'production'. */
287169695Skan#define DECUNUSED (void *)(0xffffffff)
288169695Skanstatic Flag decCheckOperands (decNumber *, const decNumber *,
289169695Skan			      const decNumber *, decContext *);
290169695Skanstatic Flag decCheckNumber (const decNumber *, decContext *);
291169695Skan#endif
292169695Skan
293169695Skan#if DECTRACE || DECCHECK
294169695Skan/* Optional trace/debugging routines. */
295169695Skanvoid decNumberShow (const decNumber *);	/* displays the components of a number */
296169695Skanstatic void decDumpAr (char, const Unit *, Int);
297169695Skan#endif
298169695Skan
299169695Skan/* ================================================================== */
300169695Skan/* Conversions                                                        */
301169695Skan/* ================================================================== */
302169695Skan
303169695Skan/* ------------------------------------------------------------------ */
304169695Skan/* to-scientific-string -- conversion to numeric string               */
305169695Skan/* to-engineering-string -- conversion to numeric string              */
306169695Skan/*                                                                    */
307169695Skan/*   decNumberToString(dn, string);                                   */
308169695Skan/*   decNumberToEngString(dn, string);                                */
309169695Skan/*                                                                    */
310169695Skan/*  dn is the decNumber to convert                                    */
311169695Skan/*  string is the string where the result will be laid out            */
312169695Skan/*                                                                    */
313169695Skan/*  string must be at least dn->digits+14 characters long             */
314169695Skan/*                                                                    */
315169695Skan/*  No error is possible, and no status can be set.                   */
316169695Skan/* ------------------------------------------------------------------ */
317169695Skanchar *
318169695SkandecNumberToString (const decNumber * dn, char *string)
319169695Skan{
320169695Skan  decToString (dn, string, 0);
321169695Skan  return string;
322169695Skan}
323169695Skan
324169695Skanchar *
325169695SkandecNumberToEngString (const decNumber * dn, char *string)
326169695Skan{
327169695Skan  decToString (dn, string, 1);
328169695Skan  return string;
329169695Skan}
330169695Skan
331169695Skan/* ------------------------------------------------------------------ */
332169695Skan/* to-number -- conversion from numeric string                        */
333169695Skan/*                                                                    */
334169695Skan/* decNumberFromString -- convert string to decNumber                 */
335169695Skan/*   dn        -- the number structure to fill                        */
336169695Skan/*   chars[]   -- the string to convert ('\0' terminated)             */
337169695Skan/*   set       -- the context used for processing any error,          */
338169695Skan/*                determining the maximum precision available         */
339169695Skan/*                (set.digits), determining the maximum and minimum   */
340169695Skan/*                exponent (set.emax and set.emin), determining if    */
341169695Skan/*                extended values are allowed, and checking the       */
342169695Skan/*                rounding mode if overflow occurs or rounding is     */
343169695Skan/*                needed.                                             */
344169695Skan/*                                                                    */
345169695Skan/* The length of the coefficient and the size of the exponent are     */
346169695Skan/* checked by this routine, so the correct error (Underflow or        */
347169695Skan/* Overflow) can be reported or rounding applied, as necessary.       */
348169695Skan/*                                                                    */
349169695Skan/* If bad syntax is detected, the result will be a quiet NaN.         */
350169695Skan/* ------------------------------------------------------------------ */
351169695SkandecNumber *
352169695SkandecNumberFromString (decNumber * dn, const char chars[], decContext * set)
353169695Skan{
354169695Skan  Int exponent = 0;		/* working exponent [assume 0] */
355169695Skan  uByte bits = 0;		/* working flags [assume +ve] */
356169695Skan  Unit *res;			/* where result will be built */
357169695Skan  Unit resbuff[D2U (DECBUFFER + 1)];	/* local buffer in case need temporary */
358169695Skan  Unit *allocres = NULL;	/* -> allocated result, iff allocated */
359169695Skan  Int need;			/* units needed for result */
360169695Skan  Int d = 0;			/* count of digits found in decimal part */
361169695Skan  const char *dotchar = NULL;	/* where dot was found */
362169695Skan  const char *cfirst;		/* -> first character of decimal part */
363169695Skan  const char *last = NULL;	/* -> last digit of decimal part */
364169695Skan  const char *firstexp;		/* -> first significant exponent digit */
365169695Skan  const char *c;		/* work */
366169695Skan  Unit *up;			/* .. */
367169695Skan#if DECDPUN>1
368169695Skan  Int i;			/* .. */
369169695Skan#endif
370169695Skan  Int residue = 0;		/* rounding residue */
371169695Skan  uInt status = 0;		/* error code */
372169695Skan
373169695Skan#if DECCHECK
374169695Skan  if (decCheckOperands (DECUNUSED, DECUNUSED, DECUNUSED, set))
375169695Skan    return decNumberZero (dn);
376169695Skan#endif
377169695Skan
378169695Skan  do
379169695Skan    {				/* status & malloc protection */
380169695Skan      c = chars;		/* -> input character */
381169695Skan      if (*c == '-')
382169695Skan	{			/* handle leading '-' */
383169695Skan	  bits = DECNEG;
384169695Skan	  c++;
385169695Skan	}
386169695Skan      else if (*c == '+')
387169695Skan	c++;			/* step over leading '+' */
388169695Skan      /* We're at the start of the number [we think] */
389169695Skan      cfirst = c;		/* save */
390169695Skan      for (;; c++)
391169695Skan	{
392169695Skan	  if (*c >= '0' && *c <= '9')
393169695Skan	    {			/* test for Arabic digit */
394169695Skan	      last = c;
395169695Skan	      d++;		/* count of real digits */
396169695Skan	      continue;		/* still in decimal part */
397169695Skan	    }
398169695Skan	  if (*c != '.')
399169695Skan	    break;		/* done with decimal part */
400169695Skan	  /* dot: record, check, and ignore */
401169695Skan	  if (dotchar != NULL)
402169695Skan	    {			/* two dots */
403169695Skan	      last = NULL;	/* indicate bad */
404169695Skan	      break;
405169695Skan	    }			/* .. and go report */
406169695Skan	  dotchar = c;		/* offset into decimal part */
407169695Skan	}			/* c */
408169695Skan
409169695Skan      if (last == NULL)
410169695Skan	{			/* no decimal digits, or >1 . */
411169695Skan#if DECSUBSET
412169695Skan	  /* If subset then infinities and NaNs are not allowed */
413169695Skan	  if (!set->extended)
414169695Skan	    {
415169695Skan	      status = DEC_Conversion_syntax;
416169695Skan	      break;		/* all done */
417169695Skan	    }
418169695Skan	  else
419169695Skan	    {
420169695Skan#endif
421169695Skan	      /* Infinities and NaNs are possible, here */
422169695Skan	      decNumberZero (dn);	/* be optimistic */
423169695Skan	      if (decStrEq (c, "Infinity") || decStrEq (c, "Inf"))
424169695Skan		{
425169695Skan		  dn->bits = bits | DECINF;
426169695Skan		  break;	/* all done */
427169695Skan		}
428169695Skan	      else
429169695Skan		{		/* a NaN expected */
430169695Skan		  /* 2003.09.10 NaNs are now permitted to have a sign */
431169695Skan		  status = DEC_Conversion_syntax;	/* assume the worst */
432169695Skan		  dn->bits = bits | DECNAN;	/* assume simple NaN */
433169695Skan		  if (*c == 's' || *c == 'S')
434169695Skan		    {		/* looks like an` sNaN */
435169695Skan		      c++;
436169695Skan		      dn->bits = bits | DECSNAN;
437169695Skan		    }
438169695Skan		  if (*c != 'n' && *c != 'N')
439169695Skan		    break;	/* check caseless "NaN" */
440169695Skan		  c++;
441169695Skan		  if (*c != 'a' && *c != 'A')
442169695Skan		    break;	/* .. */
443169695Skan		  c++;
444169695Skan		  if (*c != 'n' && *c != 'N')
445169695Skan		    break;	/* .. */
446169695Skan		  c++;
447169695Skan		  /* now nothing, or nnnn, expected */
448169695Skan		  /* -> start of integer and skip leading 0s [including plain 0] */
449169695Skan		  for (cfirst = c; *cfirst == '0';)
450169695Skan		    cfirst++;
451169695Skan		  if (*cfirst == '\0')
452169695Skan		    {		/* "NaN" or "sNaN", maybe with all 0s */
453169695Skan		      status = 0;	/* it's good */
454169695Skan		      break;	/* .. */
455169695Skan		    }
456169695Skan		  /* something other than 0s; setup last and d as usual [no dots] */
457169695Skan		  for (c = cfirst;; c++, d++)
458169695Skan		    {
459169695Skan		      if (*c < '0' || *c > '9')
460169695Skan			break;	/* test for Arabic digit */
461169695Skan		      last = c;
462169695Skan		    }
463169695Skan		  if (*c != '\0')
464169695Skan		    break;	/* not all digits */
465169695Skan		  if (d > set->digits)
466169695Skan		    break;	/* too many digits */
467169695Skan		  /* good; drop through and convert the integer */
468169695Skan		  status = 0;
469169695Skan		  bits = dn->bits;	/* for copy-back */
470169695Skan		}		/* NaN expected */
471169695Skan#if DECSUBSET
472169695Skan	    }
473169695Skan#endif
474169695Skan	}			/* last==NULL */
475169695Skan
476169695Skan      if (*c != '\0')
477169695Skan	{			/* more there; exponent expected... */
478169695Skan	  Flag nege = 0;	/* 1=negative exponent */
479169695Skan	  if (*c != 'e' && *c != 'E')
480169695Skan	    {
481169695Skan	      status = DEC_Conversion_syntax;
482169695Skan	      break;
483169695Skan	    }
484169695Skan
485169695Skan	  /* Found 'e' or 'E' -- now process explicit exponent */
486169695Skan	  /* 1998.07.11: sign no longer required */
487169695Skan	  c++;			/* to (expected) sign */
488169695Skan	  if (*c == '-')
489169695Skan	    {
490169695Skan	      nege = 1;
491169695Skan	      c++;
492169695Skan	    }
493169695Skan	  else if (*c == '+')
494169695Skan	    c++;
495169695Skan	  if (*c == '\0')
496169695Skan	    {
497169695Skan	      status = DEC_Conversion_syntax;
498169695Skan	      break;
499169695Skan	    }
500169695Skan
501169695Skan	  for (; *c == '0' && *(c + 1) != '\0';)
502169695Skan	    c++;		/* strip insignificant zeros */
503169695Skan	  firstexp = c;		/* save exponent digit place */
504169695Skan	  for (;; c++)
505169695Skan	    {
506169695Skan	      if (*c < '0' || *c > '9')
507169695Skan		break;		/* not a digit */
508169695Skan	      exponent = X10 (exponent) + (Int) * c - (Int) '0';
509169695Skan	    }			/* c */
510169695Skan	  /* if we didn't end on '\0' must not be a digit */
511169695Skan	  if (*c != '\0')
512169695Skan	    {
513169695Skan	      status = DEC_Conversion_syntax;
514169695Skan	      break;
515169695Skan	    }
516169695Skan
517169695Skan	  /* (this next test must be after the syntax check) */
518169695Skan	  /* if it was too long the exponent may have wrapped, so check */
519169695Skan	  /* carefully and set it to a certain overflow if wrap possible */
520169695Skan	  if (c >= firstexp + 9 + 1)
521169695Skan	    {
522169695Skan	      if (c > firstexp + 9 + 1 || *firstexp > '1')
523169695Skan		exponent = DECNUMMAXE * 2;
524169695Skan	      /* [up to 1999999999 is OK, for example 1E-1000000998] */
525169695Skan	    }
526169695Skan	  if (nege)
527169695Skan	    exponent = -exponent;	/* was negative */
528169695Skan	}			/* had exponent */
529169695Skan      /* Here when all inspected; syntax is good */
530169695Skan
531169695Skan      /* Handle decimal point... */
532169695Skan      if (dotchar != NULL && dotchar < last)	/* embedded . found, so */
533169695Skan	exponent = exponent - (last - dotchar);	/* .. adjust exponent */
534169695Skan      /* [we can now ignore the .] */
535169695Skan
536169695Skan      /* strip leading zeros/dot (leave final if all 0's) */
537169695Skan      for (c = cfirst; c < last; c++)
538169695Skan	{
539169695Skan	  if (*c == '0')
540169695Skan	    d--;		/* 0 stripped */
541169695Skan	  else if (*c != '.')
542169695Skan	    break;
543169695Skan	  cfirst++;		/* step past leader */
544169695Skan	}			/* c */
545169695Skan
546169695Skan#if DECSUBSET
547169695Skan      /* We can now make a rapid exit for zeros if !extended */
548169695Skan      if (*cfirst == '0' && !set->extended)
549169695Skan	{
550169695Skan	  decNumberZero (dn);	/* clean result */
551169695Skan	  break;		/* [could be return] */
552169695Skan	}
553169695Skan#endif
554169695Skan
555169695Skan      /* OK, the digits string is good.  Copy to the decNumber, or to
556169695Skan         a temporary decNumber if rounding is needed */
557169695Skan      if (d <= set->digits)
558169695Skan	res = dn->lsu;		/* fits into given decNumber */
559169695Skan      else
560169695Skan	{			/* rounding needed */
561169695Skan	  need = D2U (d);	/* units needed */
562169695Skan	  res = resbuff;	/* assume use local buffer */
563169695Skan	  if (need * sizeof (Unit) > sizeof (resbuff))
564169695Skan	    {			/* too big for local */
565169695Skan	      allocres = (Unit *) malloc (need * sizeof (Unit));
566169695Skan	      if (allocres == NULL)
567169695Skan		{
568169695Skan		  status |= DEC_Insufficient_storage;
569169695Skan		  break;
570169695Skan		}
571169695Skan	      res = allocres;
572169695Skan	    }
573169695Skan	}
574169695Skan      /* res now -> number lsu, buffer, or allocated storage for Unit array */
575169695Skan
576169695Skan      /* Place the coefficient into the selected Unit array */
577169695Skan#if DECDPUN>1
578169695Skan      i = d % DECDPUN;		/* digits in top unit */
579169695Skan      if (i == 0)
580169695Skan	i = DECDPUN;
581169695Skan      up = res + D2U (d) - 1;	/* -> msu */
582169695Skan      *up = 0;
583169695Skan      for (c = cfirst;; c++)
584169695Skan	{			/* along the digits */
585169695Skan	  if (*c == '.')
586169695Skan	    {			/* ignore . [don't decrement i] */
587169695Skan	      if (c != last)
588169695Skan		continue;
589169695Skan	      break;
590169695Skan	    }
591169695Skan	  *up = (Unit) (X10 (*up) + (Int) * c - (Int) '0');
592169695Skan	  i--;
593169695Skan	  if (i > 0)
594169695Skan	    continue;		/* more for this unit */
595169695Skan	  if (up == res)
596169695Skan	    break;		/* just filled the last unit */
597169695Skan	  i = DECDPUN;
598169695Skan	  up--;
599169695Skan	  *up = 0;
600169695Skan	}			/* c */
601169695Skan#else
602169695Skan      /* DECDPUN==1 */
603169695Skan      up = res;			/* -> lsu */
604169695Skan      for (c = last; c >= cfirst; c--)
605169695Skan	{			/* over each character, from least */
606169695Skan	  if (*c == '.')
607169695Skan	    continue;		/* ignore . [don't step b] */
608169695Skan	  *up = (Unit) ((Int) * c - (Int) '0');
609169695Skan	  up++;
610169695Skan	}			/* c */
611169695Skan#endif
612169695Skan
613169695Skan      dn->bits = bits;
614169695Skan      dn->exponent = exponent;
615169695Skan      dn->digits = d;
616169695Skan
617169695Skan      /* if not in number (too long) shorten into the number */
618169695Skan      if (d > set->digits)
619169695Skan	decSetCoeff (dn, set, res, d, &residue, &status);
620169695Skan
621169695Skan      /* Finally check for overflow or subnormal and round as needed */
622169695Skan      decFinalize (dn, set, &residue, &status);
623169695Skan      /* decNumberShow(dn); */
624169695Skan    }
625169695Skan  while (0);			/* [for break] */
626169695Skan
627169695Skan  if (allocres != NULL)
628169695Skan    free (allocres);		/* drop any storage we used */
629169695Skan  if (status != 0)
630169695Skan    decStatus (dn, status, set);
631169695Skan  return dn;
632169695Skan}
633169695Skan
634169695Skan/* ================================================================== */
635169695Skan/* Operators                                                          */
636169695Skan/* ================================================================== */
637169695Skan
638169695Skan/* ------------------------------------------------------------------ */
639169695Skan/* decNumberAbs -- absolute value operator                            */
640169695Skan/*                                                                    */
641169695Skan/*   This computes C = abs(A)                                         */
642169695Skan/*                                                                    */
643169695Skan/*   res is C, the result.  C may be A                                */
644169695Skan/*   rhs is A                                                         */
645169695Skan/*   set is the context                                               */
646169695Skan/*                                                                    */
647169695Skan/* C must have space for set->digits digits.                          */
648169695Skan/* ------------------------------------------------------------------ */
649169695Skan/* This has the same effect as decNumberPlus unless A is negative,    */
650169695Skan/* in which case it has the same effect as decNumberMinus.            */
651169695Skan/* ------------------------------------------------------------------ */
652169695SkandecNumber *
653169695SkandecNumberAbs (decNumber * res, const decNumber * rhs, decContext * set)
654169695Skan{
655169695Skan  decNumber dzero;		/* for 0 */
656169695Skan  uInt status = 0;		/* accumulator */
657169695Skan
658169695Skan#if DECCHECK
659169695Skan  if (decCheckOperands (res, DECUNUSED, rhs, set))
660169695Skan    return res;
661169695Skan#endif
662169695Skan
663169695Skan  decNumberZero (&dzero);	/* set 0 */
664169695Skan  dzero.exponent = rhs->exponent;	/* [no coefficient expansion] */
665169695Skan  decAddOp (res, &dzero, rhs, set, (uByte) (rhs->bits & DECNEG), &status);
666169695Skan  if (status != 0)
667169695Skan    decStatus (res, status, set);
668169695Skan  return res;
669169695Skan}
670169695Skan
671169695Skan/* ------------------------------------------------------------------ */
672169695Skan/* decNumberAdd -- add two Numbers                                    */
673169695Skan/*                                                                    */
674169695Skan/*   This computes C = A + B                                          */
675169695Skan/*                                                                    */
676169695Skan/*   res is C, the result.  C may be A and/or B (e.g., X=X+X)         */
677169695Skan/*   lhs is A                                                         */
678169695Skan/*   rhs is B                                                         */
679169695Skan/*   set is the context                                               */
680169695Skan/*                                                                    */
681169695Skan/* C must have space for set->digits digits.                          */
682169695Skan/* ------------------------------------------------------------------ */
683169695Skan/* This just calls the routine shared with Subtract                   */
684169695SkandecNumber *
685169695SkandecNumberAdd (decNumber * res, const decNumber * lhs,
686169695Skan	      const decNumber * rhs, decContext * set)
687169695Skan{
688169695Skan  uInt status = 0;		/* accumulator */
689169695Skan  decAddOp (res, lhs, rhs, set, 0, &status);
690169695Skan  if (status != 0)
691169695Skan    decStatus (res, status, set);
692169695Skan  return res;
693169695Skan}
694169695Skan
695169695Skan/* ------------------------------------------------------------------ */
696169695Skan/* decNumberCompare -- compare two Numbers                            */
697169695Skan/*                                                                    */
698169695Skan/*   This computes C = A ? B                                          */
699169695Skan/*                                                                    */
700169695Skan/*   res is C, the result.  C may be A and/or B (e.g., X=X?X)         */
701169695Skan/*   lhs is A                                                         */
702169695Skan/*   rhs is B                                                         */
703169695Skan/*   set is the context                                               */
704169695Skan/*                                                                    */
705169695Skan/* C must have space for one digit.                                   */
706169695Skan/* ------------------------------------------------------------------ */
707169695SkandecNumber *
708169695SkandecNumberCompare (decNumber * res, const decNumber * lhs,
709169695Skan		  const decNumber * rhs, decContext * set)
710169695Skan{
711169695Skan  uInt status = 0;		/* accumulator */
712169695Skan  decCompareOp (res, lhs, rhs, set, COMPARE, &status);
713169695Skan  if (status != 0)
714169695Skan    decStatus (res, status, set);
715169695Skan  return res;
716169695Skan}
717169695Skan
718169695Skan/* ------------------------------------------------------------------ */
719169695Skan/* decNumberDivide -- divide one number by another                    */
720169695Skan/*                                                                    */
721169695Skan/*   This computes C = A / B                                          */
722169695Skan/*                                                                    */
723169695Skan/*   res is C, the result.  C may be A and/or B (e.g., X=X/X)         */
724169695Skan/*   lhs is A                                                         */
725169695Skan/*   rhs is B                                                         */
726169695Skan/*   set is the context                                               */
727169695Skan/*                                                                    */
728169695Skan/* C must have space for set->digits digits.                          */
729169695Skan/* ------------------------------------------------------------------ */
730169695SkandecNumber *
731169695SkandecNumberDivide (decNumber * res, const decNumber * lhs,
732169695Skan		 const decNumber * rhs, decContext * set)
733169695Skan{
734169695Skan  uInt status = 0;		/* accumulator */
735169695Skan  decDivideOp (res, lhs, rhs, set, DIVIDE, &status);
736169695Skan  if (status != 0)
737169695Skan    decStatus (res, status, set);
738169695Skan  return res;
739169695Skan}
740169695Skan
741169695Skan/* ------------------------------------------------------------------ */
742169695Skan/* decNumberDivideInteger -- divide and return integer quotient       */
743169695Skan/*                                                                    */
744169695Skan/*   This computes C = A # B, where # is the integer divide operator  */
745169695Skan/*                                                                    */
746169695Skan/*   res is C, the result.  C may be A and/or B (e.g., X=X#X)         */
747169695Skan/*   lhs is A                                                         */
748169695Skan/*   rhs is B                                                         */
749169695Skan/*   set is the context                                               */
750169695Skan/*                                                                    */
751169695Skan/* C must have space for set->digits digits.                          */
752169695Skan/* ------------------------------------------------------------------ */
753169695SkandecNumber *
754169695SkandecNumberDivideInteger (decNumber * res, const decNumber * lhs,
755169695Skan			const decNumber * rhs, decContext * set)
756169695Skan{
757169695Skan  uInt status = 0;		/* accumulator */
758169695Skan  decDivideOp (res, lhs, rhs, set, DIVIDEINT, &status);
759169695Skan  if (status != 0)
760169695Skan    decStatus (res, status, set);
761169695Skan  return res;
762169695Skan}
763169695Skan
764169695Skan/* ------------------------------------------------------------------ */
765169695Skan/* decNumberMax -- compare two Numbers and return the maximum         */
766169695Skan/*                                                                    */
767169695Skan/*   This computes C = A ? B, returning the maximum or A if equal     */
768169695Skan/*                                                                    */
769169695Skan/*   res is C, the result.  C may be A and/or B (e.g., X=X?X)         */
770169695Skan/*   lhs is A                                                         */
771169695Skan/*   rhs is B                                                         */
772169695Skan/*   set is the context                                               */
773169695Skan/*                                                                    */
774169695Skan/* C must have space for set->digits digits.                          */
775169695Skan/* ------------------------------------------------------------------ */
776169695SkandecNumber *
777169695SkandecNumberMax (decNumber * res, const decNumber * lhs,
778169695Skan	      const decNumber * rhs, decContext * set)
779169695Skan{
780169695Skan  uInt status = 0;		/* accumulator */
781169695Skan  decCompareOp (res, lhs, rhs, set, COMPMAX, &status);
782169695Skan  if (status != 0)
783169695Skan    decStatus (res, status, set);
784169695Skan  return res;
785169695Skan}
786169695Skan
787169695Skan/* ------------------------------------------------------------------ */
788169695Skan/* decNumberMin -- compare two Numbers and return the minimum         */
789169695Skan/*                                                                    */
790169695Skan/*   This computes C = A ? B, returning the minimum or A if equal     */
791169695Skan/*                                                                    */
792169695Skan/*   res is C, the result.  C may be A and/or B (e.g., X=X?X)         */
793169695Skan/*   lhs is A                                                         */
794169695Skan/*   rhs is B                                                         */
795169695Skan/*   set is the context                                               */
796169695Skan/*                                                                    */
797169695Skan/* C must have space for set->digits digits.                          */
798169695Skan/* ------------------------------------------------------------------ */
799169695SkandecNumber *
800169695SkandecNumberMin (decNumber * res, const decNumber * lhs,
801169695Skan	      const decNumber * rhs, decContext * set)
802169695Skan{
803169695Skan  uInt status = 0;		/* accumulator */
804169695Skan  decCompareOp (res, lhs, rhs, set, COMPMIN, &status);
805169695Skan  if (status != 0)
806169695Skan    decStatus (res, status, set);
807169695Skan  return res;
808169695Skan}
809169695Skan
810169695Skan/* ------------------------------------------------------------------ */
811169695Skan/* decNumberMinus -- prefix minus operator                            */
812169695Skan/*                                                                    */
813169695Skan/*   This computes C = 0 - A                                          */
814169695Skan/*                                                                    */
815169695Skan/*   res is C, the result.  C may be A                                */
816169695Skan/*   rhs is A                                                         */
817169695Skan/*   set is the context                                               */
818169695Skan/*                                                                    */
819169695Skan/* C must have space for set->digits digits.                          */
820169695Skan/* ------------------------------------------------------------------ */
821169695Skan/* We simply use AddOp for the subtract, which will do the necessary. */
822169695Skan/* ------------------------------------------------------------------ */
823169695SkandecNumber *
824169695SkandecNumberMinus (decNumber * res, const decNumber * rhs, decContext * set)
825169695Skan{
826169695Skan  decNumber dzero;
827169695Skan  uInt status = 0;		/* accumulator */
828169695Skan
829169695Skan#if DECCHECK
830169695Skan  if (decCheckOperands (res, DECUNUSED, rhs, set))
831169695Skan    return res;
832169695Skan#endif
833169695Skan
834169695Skan  decNumberZero (&dzero);	/* make 0 */
835169695Skan  dzero.exponent = rhs->exponent;	/* [no coefficient expansion] */
836169695Skan  decAddOp (res, &dzero, rhs, set, DECNEG, &status);
837169695Skan  if (status != 0)
838169695Skan    decStatus (res, status, set);
839169695Skan  return res;
840169695Skan}
841169695Skan
842169695Skan/* ------------------------------------------------------------------ */
843169695Skan/* decNumberPlus -- prefix plus operator                              */
844169695Skan/*                                                                    */
845169695Skan/*   This computes C = 0 + A                                          */
846169695Skan/*                                                                    */
847169695Skan/*   res is C, the result.  C may be A                                */
848169695Skan/*   rhs is A                                                         */
849169695Skan/*   set is the context                                               */
850169695Skan/*                                                                    */
851169695Skan/* C must have space for set->digits digits.                          */
852169695Skan/* ------------------------------------------------------------------ */
853169695Skan/* We simply use AddOp; Add will take fast path after preparing A.    */
854169695Skan/* Performance is a concern here, as this routine is often used to    */
855169695Skan/* check operands and apply rounding and overflow/underflow testing.  */
856169695Skan/* ------------------------------------------------------------------ */
857169695SkandecNumber *
858169695SkandecNumberPlus (decNumber * res, const decNumber * rhs, decContext * set)
859169695Skan{
860169695Skan  decNumber dzero;
861169695Skan  uInt status = 0;		/* accumulator */
862169695Skan
863169695Skan#if DECCHECK
864169695Skan  if (decCheckOperands (res, DECUNUSED, rhs, set))
865169695Skan    return res;
866169695Skan#endif
867169695Skan
868169695Skan  decNumberZero (&dzero);	/* make 0 */
869169695Skan  dzero.exponent = rhs->exponent;	/* [no coefficient expansion] */
870169695Skan  decAddOp (res, &dzero, rhs, set, 0, &status);
871169695Skan  if (status != 0)
872169695Skan    decStatus (res, status, set);
873169695Skan  return res;
874169695Skan}
875169695Skan
876169695Skan/* ------------------------------------------------------------------ */
877169695Skan/* decNumberMultiply -- multiply two Numbers                          */
878169695Skan/*                                                                    */
879169695Skan/*   This computes C = A x B                                          */
880169695Skan/*                                                                    */
881169695Skan/*   res is C, the result.  C may be A and/or B (e.g., X=X+X)         */
882169695Skan/*   lhs is A                                                         */
883169695Skan/*   rhs is B                                                         */
884169695Skan/*   set is the context                                               */
885169695Skan/*                                                                    */
886169695Skan/* C must have space for set->digits digits.                          */
887169695Skan/* ------------------------------------------------------------------ */
888169695SkandecNumber *
889169695SkandecNumberMultiply (decNumber * res, const decNumber * lhs,
890169695Skan		   const decNumber * rhs, decContext * set)
891169695Skan{
892169695Skan  uInt status = 0;		/* accumulator */
893169695Skan  decMultiplyOp (res, lhs, rhs, set, &status);
894169695Skan  if (status != 0)
895169695Skan    decStatus (res, status, set);
896169695Skan  return res;
897169695Skan}
898169695Skan
899169695Skan/* ------------------------------------------------------------------ */
900169695Skan/* decNumberNormalize -- remove trailing zeros                        */
901169695Skan/*                                                                    */
902169695Skan/*   This computes C = 0 + A, and normalizes the result               */
903169695Skan/*                                                                    */
904169695Skan/*   res is C, the result.  C may be A                                */
905169695Skan/*   rhs is A                                                         */
906169695Skan/*   set is the context                                               */
907169695Skan/*                                                                    */
908169695Skan/* C must have space for set->digits digits.                          */
909169695Skan/* ------------------------------------------------------------------ */
910169695SkandecNumber *
911169695SkandecNumberNormalize (decNumber * res, const decNumber * rhs, decContext * set)
912169695Skan{
913169695Skan  decNumber *allocrhs = NULL;	/* non-NULL if rounded rhs allocated */
914169695Skan  uInt status = 0;		/* as usual */
915169695Skan  Int residue = 0;		/* as usual */
916169695Skan  Int dropped;			/* work */
917169695Skan
918169695Skan#if DECCHECK
919169695Skan  if (decCheckOperands (res, DECUNUSED, rhs, set))
920169695Skan    return res;
921169695Skan#endif
922169695Skan
923169695Skan  do
924169695Skan    {				/* protect allocated storage */
925169695Skan#if DECSUBSET
926169695Skan      if (!set->extended)
927169695Skan	{
928169695Skan	  /* reduce operand and set lostDigits status, as needed */
929169695Skan	  if (rhs->digits > set->digits)
930169695Skan	    {
931169695Skan	      allocrhs = decRoundOperand (rhs, set, &status);
932169695Skan	      if (allocrhs == NULL)
933169695Skan		break;
934169695Skan	      rhs = allocrhs;
935169695Skan	    }
936169695Skan	}
937169695Skan#endif
938169695Skan      /* [following code does not require input rounding] */
939169695Skan
940169695Skan      /* specials copy through, except NaNs need care */
941169695Skan      if (decNumberIsNaN (rhs))
942169695Skan	{
943169695Skan	  decNaNs (res, rhs, NULL, &status);
944169695Skan	  break;
945169695Skan	}
946169695Skan
947169695Skan      /* reduce result to the requested length and copy to result */
948169695Skan      decCopyFit (res, rhs, set, &residue, &status);	/* copy & round */
949169695Skan      decFinish (res, set, &residue, &status);	/* cleanup/set flags */
950169695Skan      decTrim (res, 1, &dropped);	/* normalize in place */
951169695Skan    }
952169695Skan  while (0);			/* end protected */
953169695Skan
954169695Skan  if (allocrhs != NULL)
955169695Skan    free (allocrhs);		/* .. */
956169695Skan  if (status != 0)
957169695Skan    decStatus (res, status, set);	/* then report status */
958169695Skan  return res;
959169695Skan}
960169695Skan
961169695Skan/* ------------------------------------------------------------------ */
962169695Skan/* decNumberPower -- raise a number to an integer power               */
963169695Skan/*                                                                    */
964169695Skan/*   This computes C = A ** B                                         */
965169695Skan/*                                                                    */
966169695Skan/*   res is C, the result.  C may be A and/or B (e.g., X=X**X)        */
967169695Skan/*   lhs is A                                                         */
968169695Skan/*   rhs is B                                                         */
969169695Skan/*   set is the context                                               */
970169695Skan/*                                                                    */
971169695Skan/* C must have space for set->digits digits.                          */
972169695Skan/*                                                                    */
973169695Skan/* Specification restriction: abs(n) must be <=999999999              */
974169695Skan/* ------------------------------------------------------------------ */
975169695SkandecNumber *
976169695SkandecNumberPower (decNumber * res, const decNumber * lhs,
977169695Skan		const decNumber * rhs, decContext * set)
978169695Skan{
979169695Skan  decNumber *alloclhs = NULL;	/* non-NULL if rounded lhs allocated */
980169695Skan  decNumber *allocrhs = NULL;	/* .., rhs */
981169695Skan  decNumber *allocdac = NULL;	/* -> allocated acc buffer, iff used */
982169695Skan  const decNumber *inrhs = rhs;	/* save original rhs */
983169695Skan  Int reqdigits = set->digits;	/* requested DIGITS */
984169695Skan  Int n;			/* RHS in binary */
985169695Skan  Int i;			/* work */
986169695Skan#if DECSUBSET
987169695Skan  Int dropped;			/* .. */
988169695Skan#endif
989169695Skan  uInt needbytes;		/* buffer size needed */
990169695Skan  Flag seenbit;			/* seen a bit while powering */
991169695Skan  Int residue = 0;		/* rounding residue */
992169695Skan  uInt status = 0;		/* accumulator */
993169695Skan  uByte bits = 0;		/* result sign if errors */
994169695Skan  decContext workset;		/* working context */
995169695Skan  decNumber dnOne;		/* work value 1... */
996169695Skan  /* local accumulator buffer [a decNumber, with digits+elength+1 digits] */
997169695Skan  uByte dacbuff[sizeof (decNumber) + D2U (DECBUFFER + 9) * sizeof (Unit)];
998169695Skan  /* same again for possible 1/lhs calculation */
999169695Skan  uByte lhsbuff[sizeof (decNumber) + D2U (DECBUFFER + 9) * sizeof (Unit)];
1000169695Skan  decNumber *dac = (decNumber *) dacbuff;	/* -> result accumulator */
1001169695Skan
1002169695Skan#if DECCHECK
1003169695Skan  if (decCheckOperands (res, lhs, rhs, set))
1004169695Skan    return res;
1005169695Skan#endif
1006169695Skan
1007169695Skan  do
1008169695Skan    {				/* protect allocated storage */
1009169695Skan#if DECSUBSET
1010169695Skan      if (!set->extended)
1011169695Skan	{
1012169695Skan	  /* reduce operands and set lostDigits status, as needed */
1013169695Skan	  if (lhs->digits > reqdigits)
1014169695Skan	    {
1015169695Skan	      alloclhs = decRoundOperand (lhs, set, &status);
1016169695Skan	      if (alloclhs == NULL)
1017169695Skan		break;
1018169695Skan	      lhs = alloclhs;
1019169695Skan	    }
1020169695Skan	  /* rounding won't affect the result, but we might signal lostDigits */
1021169695Skan	  /* as well as the error for non-integer [x**y would need this too] */
1022169695Skan	  if (rhs->digits > reqdigits)
1023169695Skan	    {
1024169695Skan	      allocrhs = decRoundOperand (rhs, set, &status);
1025169695Skan	      if (allocrhs == NULL)
1026169695Skan		break;
1027169695Skan	      rhs = allocrhs;
1028169695Skan	    }
1029169695Skan	}
1030169695Skan#endif
1031169695Skan      /* [following code does not require input rounding] */
1032169695Skan
1033169695Skan      /* handle rhs Infinity */
1034169695Skan      if (decNumberIsInfinite (rhs))
1035169695Skan	{
1036169695Skan	  status |= DEC_Invalid_operation;	/* bad */
1037169695Skan	  break;
1038169695Skan	}
1039169695Skan      /* handle NaNs */
1040169695Skan      if ((lhs->bits | rhs->bits) & (DECNAN | DECSNAN))
1041169695Skan	{
1042169695Skan	  decNaNs (res, lhs, rhs, &status);
1043169695Skan	  break;
1044169695Skan	}
1045169695Skan
1046169695Skan      /* Original rhs must be an integer that fits and is in range */
1047169695Skan#if DECSUBSET
1048169695Skan      n = decGetInt (inrhs, set);
1049169695Skan#else
1050169695Skan      n = decGetInt (inrhs);
1051169695Skan#endif
1052169695Skan      if (n == BADINT || n > 999999999 || n < -999999999)
1053169695Skan	{
1054169695Skan	  status |= DEC_Invalid_operation;
1055169695Skan	  break;
1056169695Skan	}
1057169695Skan      if (n < 0)
1058169695Skan	{			/* negative */
1059169695Skan	  n = -n;		/* use the absolute value */
1060169695Skan	}
1061169695Skan      if (decNumberIsNegative (lhs)	/* -x .. */
1062169695Skan	  && (n & 0x00000001))
1063169695Skan	bits = DECNEG;		/* .. to an odd power */
1064169695Skan
1065169695Skan      /* handle LHS infinity */
1066169695Skan      if (decNumberIsInfinite (lhs))
1067169695Skan	{			/* [NaNs already handled] */
1068169695Skan	  uByte rbits = rhs->bits;	/* save */
1069169695Skan	  decNumberZero (res);
1070169695Skan	  if (n == 0)
1071169695Skan	    *res->lsu = 1;	/* [-]Inf**0 => 1 */
1072169695Skan	  else
1073169695Skan	    {
1074169695Skan	      if (!(rbits & DECNEG))
1075169695Skan		bits |= DECINF;	/* was not a **-n */
1076169695Skan	      /* [otherwise will be 0 or -0] */
1077169695Skan	      res->bits = bits;
1078169695Skan	    }
1079169695Skan	  break;
1080169695Skan	}
1081169695Skan
1082169695Skan      /* clone the context */
1083169695Skan      workset = *set;		/* copy all fields */
1084169695Skan      /* calculate the working DIGITS */
1085169695Skan      workset.digits = reqdigits + (inrhs->digits + inrhs->exponent) + 1;
1086169695Skan      /* it's an error if this is more than we can handle */
1087169695Skan      if (workset.digits > DECNUMMAXP)
1088169695Skan	{
1089169695Skan	  status |= DEC_Invalid_operation;
1090169695Skan	  break;
1091169695Skan	}
1092169695Skan
1093169695Skan      /* workset.digits is the count of digits for the accumulator we need */
1094169695Skan      /* if accumulator is too long for local storage, then allocate */
1095169695Skan      needbytes =
1096169695Skan	sizeof (decNumber) + (D2U (workset.digits) - 1) * sizeof (Unit);
1097169695Skan      /* [needbytes also used below if 1/lhs needed] */
1098169695Skan      if (needbytes > sizeof (dacbuff))
1099169695Skan	{
1100169695Skan	  allocdac = (decNumber *) malloc (needbytes);
1101169695Skan	  if (allocdac == NULL)
1102169695Skan	    {			/* hopeless -- abandon */
1103169695Skan	      status |= DEC_Insufficient_storage;
1104169695Skan	      break;
1105169695Skan	    }
1106169695Skan	  dac = allocdac;	/* use the allocated space */
1107169695Skan	}
1108169695Skan      decNumberZero (dac);	/* acc=1 */
1109169695Skan      *dac->lsu = 1;		/* .. */
1110169695Skan
1111169695Skan      if (n == 0)
1112169695Skan	{			/* x**0 is usually 1 */
1113169695Skan	  /* 0**0 is bad unless subset, when it becomes 1 */
1114169695Skan	  if (ISZERO (lhs)
1115169695Skan#if DECSUBSET
1116169695Skan	      && set->extended
1117169695Skan#endif
1118169695Skan	    )
1119169695Skan	    status |= DEC_Invalid_operation;
1120169695Skan	  else
1121169695Skan	    decNumberCopy (res, dac);	/* copy the 1 */
1122169695Skan	  break;
1123169695Skan	}
1124169695Skan
1125169695Skan      /* if a negative power we'll need the constant 1, and if not subset */
1126169695Skan      /* we'll invert the lhs now rather than inverting the result later */
1127169695Skan      if (decNumberIsNegative (rhs))
1128169695Skan	{			/* was a **-n [hence digits>0] */
1129169695Skan	  decNumber * newlhs;
1130169695Skan	  decNumberCopy (&dnOne, dac);	/* dnOne=1;  [needed now or later] */
1131169695Skan#if DECSUBSET
1132169695Skan	  if (set->extended)
1133169695Skan	    {			/* need to calculate 1/lhs */
1134169695Skan#endif
1135169695Skan	      /* divide lhs into 1, putting result in dac [dac=1/dac] */
1136169695Skan	      decDivideOp (dac, &dnOne, lhs, &workset, DIVIDE, &status);
1137169695Skan	      if (alloclhs != NULL)
1138169695Skan		{
1139169695Skan		  free (alloclhs);	/* done with intermediate */
1140169695Skan		  alloclhs = NULL;	/* indicate freed */
1141169695Skan		}
1142169695Skan	      /* now locate or allocate space for the inverted lhs */
1143169695Skan	      if (needbytes > sizeof (lhsbuff))
1144169695Skan		{
1145169695Skan		  alloclhs = (decNumber *) malloc (needbytes);
1146169695Skan		  if (alloclhs == NULL)
1147169695Skan		    {		/* hopeless -- abandon */
1148169695Skan		      status |= DEC_Insufficient_storage;
1149169695Skan		      break;
1150169695Skan		    }
1151169695Skan		  newlhs = alloclhs;	/* use the allocated space */
1152169695Skan		}
1153169695Skan	      else
1154169695Skan		newlhs = (decNumber *) lhsbuff;	/* use stack storage */
1155169695Skan	      /* [lhs now points to buffer or allocated storage] */
1156169695Skan	      decNumberCopy (newlhs, dac);	/* copy the 1/lhs */
1157169695Skan	      decNumberCopy (dac, &dnOne);	/* restore acc=1 */
1158169695Skan	      lhs = newlhs;
1159169695Skan#if DECSUBSET
1160169695Skan	    }
1161169695Skan#endif
1162169695Skan	}
1163169695Skan
1164169695Skan      /* Raise-to-the-power loop... */
1165169695Skan      seenbit = 0;		/* set once we've seen a 1-bit */
1166169695Skan      for (i = 1;; i++)
1167169695Skan	{			/* for each bit [top bit ignored] */
1168169695Skan	  /* abandon if we have had overflow or terminal underflow */
1169169695Skan	  if (status & (DEC_Overflow | DEC_Underflow))
1170169695Skan	    {			/* interesting? */
1171169695Skan	      if (status & DEC_Overflow || ISZERO (dac))
1172169695Skan		break;
1173169695Skan	    }
1174169695Skan	  /* [the following two lines revealed an optimizer bug in a C++ */
1175169695Skan	  /* compiler, with symptom: 5**3 -> 25, when n=n+n was used] */
1176169695Skan	  n = n << 1;		/* move next bit to testable position */
1177169695Skan	  if (n < 0)
1178169695Skan	    {			/* top bit is set */
1179169695Skan	      seenbit = 1;	/* OK, we're off */
1180169695Skan	      decMultiplyOp (dac, dac, lhs, &workset, &status);	/* dac=dac*x */
1181169695Skan	    }
1182169695Skan	  if (i == 31)
1183169695Skan	    break;		/* that was the last bit */
1184169695Skan	  if (!seenbit)
1185169695Skan	    continue;		/* we don't have to square 1 */
1186169695Skan	  decMultiplyOp (dac, dac, dac, &workset, &status);	/* dac=dac*dac [square] */
1187169695Skan	}			/*i *//* 32 bits */
1188169695Skan
1189169695Skan      /* complete internal overflow or underflow processing */
1190169695Skan      if (status & (DEC_Overflow | DEC_Subnormal))
1191169695Skan	{
1192169695Skan#if DECSUBSET
1193169695Skan	  /* If subset, and power was negative, reverse the kind of -erflow */
1194169695Skan	  /* [1/x not yet done] */
1195169695Skan	  if (!set->extended && decNumberIsNegative (rhs))
1196169695Skan	    {
1197169695Skan	      if (status & DEC_Overflow)
1198169695Skan		status ^= DEC_Overflow | DEC_Underflow | DEC_Subnormal;
1199169695Skan	      else
1200169695Skan		{		/* trickier -- Underflow may or may not be set */
1201169695Skan		  status &= ~(DEC_Underflow | DEC_Subnormal);	/* [one or both] */
1202169695Skan		  status |= DEC_Overflow;
1203169695Skan		}
1204169695Skan	    }
1205169695Skan#endif
1206169695Skan	  dac->bits = (dac->bits & ~DECNEG) | bits;	/* force correct sign */
1207169695Skan	  /* round subnormals [to set.digits rather than workset.digits] */
1208169695Skan	  /* or set overflow result similarly as required */
1209169695Skan	  decFinalize (dac, set, &residue, &status);
1210169695Skan	  decNumberCopy (res, dac);	/* copy to result (is now OK length) */
1211169695Skan	  break;
1212169695Skan	}
1213169695Skan
1214169695Skan#if DECSUBSET
1215169695Skan      if (!set->extended &&	/* subset math */
1216169695Skan	  decNumberIsNegative (rhs))
1217169695Skan	{			/* was a **-n [hence digits>0] */
1218169695Skan	  /* so divide result into 1 [dac=1/dac] */
1219169695Skan	  decDivideOp (dac, &dnOne, dac, &workset, DIVIDE, &status);
1220169695Skan	}
1221169695Skan#endif
1222169695Skan
1223169695Skan      /* reduce result to the requested length and copy to result */
1224169695Skan      decCopyFit (res, dac, set, &residue, &status);
1225169695Skan      decFinish (res, set, &residue, &status);	/* final cleanup */
1226169695Skan#if DECSUBSET
1227169695Skan      if (!set->extended)
1228169695Skan	decTrim (res, 0, &dropped);	/* trailing zeros */
1229169695Skan#endif
1230169695Skan    }
1231169695Skan  while (0);			/* end protected */
1232169695Skan
1233169695Skan  if (allocdac != NULL)
1234169695Skan    free (allocdac);		/* drop any storage we used */
1235169695Skan  if (allocrhs != NULL)
1236169695Skan    free (allocrhs);		/* .. */
1237169695Skan  if (alloclhs != NULL)
1238169695Skan    free (alloclhs);		/* .. */
1239169695Skan  if (status != 0)
1240169695Skan    decStatus (res, status, set);
1241169695Skan  return res;
1242169695Skan}
1243169695Skan
1244169695Skan/* ------------------------------------------------------------------ */
1245169695Skan/* decNumberQuantize -- force exponent to requested value             */
1246169695Skan/*                                                                    */
1247169695Skan/*   This computes C = op(A, B), where op adjusts the coefficient     */
1248169695Skan/*   of C (by rounding or shifting) such that the exponent (-scale)   */
1249169695Skan/*   of C has exponent of B.  The numerical value of C will equal A,  */
1250169695Skan/*   except for the effects of any rounding that occurred.            */
1251169695Skan/*                                                                    */
1252169695Skan/*   res is C, the result.  C may be A or B                           */
1253169695Skan/*   lhs is A, the number to adjust                                   */
1254169695Skan/*   rhs is B, the number with exponent to match                      */
1255169695Skan/*   set is the context                                               */
1256169695Skan/*                                                                    */
1257169695Skan/* C must have space for set->digits digits.                          */
1258169695Skan/*                                                                    */
1259169695Skan/* Unless there is an error or the result is infinite, the exponent   */
1260169695Skan/* after the operation is guaranteed to be equal to that of B.        */
1261169695Skan/* ------------------------------------------------------------------ */
1262169695SkandecNumber *
1263169695SkandecNumberQuantize (decNumber * res, const decNumber * lhs,
1264169695Skan		   const decNumber * rhs, decContext * set)
1265169695Skan{
1266169695Skan  uInt status = 0;		/* accumulator */
1267169695Skan  decQuantizeOp (res, lhs, rhs, set, 1, &status);
1268169695Skan  if (status != 0)
1269169695Skan    decStatus (res, status, set);
1270169695Skan  return res;
1271169695Skan}
1272169695Skan
1273169695Skan/* ------------------------------------------------------------------ */
1274169695Skan/* decNumberRescale -- force exponent to requested value              */
1275169695Skan/*                                                                    */
1276169695Skan/*   This computes C = op(A, B), where op adjusts the coefficient     */
1277169695Skan/*   of C (by rounding or shifting) such that the exponent (-scale)   */
1278169695Skan/*   of C has the value B.  The numerical value of C will equal A,    */
1279169695Skan/*   except for the effects of any rounding that occurred.            */
1280169695Skan/*                                                                    */
1281169695Skan/*   res is C, the result.  C may be A or B                           */
1282169695Skan/*   lhs is A, the number to adjust                                   */
1283169695Skan/*   rhs is B, the requested exponent                                 */
1284169695Skan/*   set is the context                                               */
1285169695Skan/*                                                                    */
1286169695Skan/* C must have space for set->digits digits.                          */
1287169695Skan/*                                                                    */
1288169695Skan/* Unless there is an error or the result is infinite, the exponent   */
1289169695Skan/* after the operation is guaranteed to be equal to B.                */
1290169695Skan/* ------------------------------------------------------------------ */
1291169695SkandecNumber *
1292169695SkandecNumberRescale (decNumber * res, const decNumber * lhs,
1293169695Skan		  const decNumber * rhs, decContext * set)
1294169695Skan{
1295169695Skan  uInt status = 0;		/* accumulator */
1296169695Skan  decQuantizeOp (res, lhs, rhs, set, 0, &status);
1297169695Skan  if (status != 0)
1298169695Skan    decStatus (res, status, set);
1299169695Skan  return res;
1300169695Skan}
1301169695Skan
1302169695Skan/* ------------------------------------------------------------------ */
1303169695Skan/* decNumberRemainder -- divide and return remainder                  */
1304169695Skan/*                                                                    */
1305169695Skan/*   This computes C = A % B                                          */
1306169695Skan/*                                                                    */
1307169695Skan/*   res is C, the result.  C may be A and/or B (e.g., X=X%X)         */
1308169695Skan/*   lhs is A                                                         */
1309169695Skan/*   rhs is B                                                         */
1310169695Skan/*   set is the context                                               */
1311169695Skan/*                                                                    */
1312169695Skan/* C must have space for set->digits digits.                          */
1313169695Skan/* ------------------------------------------------------------------ */
1314169695SkandecNumber *
1315169695SkandecNumberRemainder (decNumber * res, const decNumber * lhs,
1316169695Skan		    const decNumber * rhs, decContext * set)
1317169695Skan{
1318169695Skan  uInt status = 0;		/* accumulator */
1319169695Skan  decDivideOp (res, lhs, rhs, set, REMAINDER, &status);
1320169695Skan  if (status != 0)
1321169695Skan    decStatus (res, status, set);
1322169695Skan  return res;
1323169695Skan}
1324169695Skan
1325169695Skan/* ------------------------------------------------------------------ */
1326169695Skan/* decNumberRemainderNear -- divide and return remainder from nearest */
1327169695Skan/*                                                                    */
1328169695Skan/*   This computes C = A % B, where % is the IEEE remainder operator  */
1329169695Skan/*                                                                    */
1330169695Skan/*   res is C, the result.  C may be A and/or B (e.g., X=X%X)         */
1331169695Skan/*   lhs is A                                                         */
1332169695Skan/*   rhs is B                                                         */
1333169695Skan/*   set is the context                                               */
1334169695Skan/*                                                                    */
1335169695Skan/* C must have space for set->digits digits.                          */
1336169695Skan/* ------------------------------------------------------------------ */
1337169695SkandecNumber *
1338169695SkandecNumberRemainderNear (decNumber * res, const decNumber * lhs,
1339169695Skan			const decNumber * rhs, decContext * set)
1340169695Skan{
1341169695Skan  uInt status = 0;		/* accumulator */
1342169695Skan  decDivideOp (res, lhs, rhs, set, REMNEAR, &status);
1343169695Skan  if (status != 0)
1344169695Skan    decStatus (res, status, set);
1345169695Skan  return res;
1346169695Skan}
1347169695Skan
1348169695Skan/* ------------------------------------------------------------------ */
1349169695Skan/* decNumberSameQuantum -- test for equal exponents                   */
1350169695Skan/*                                                                    */
1351169695Skan/*   res is the result number, which will contain either 0 or 1       */
1352169695Skan/*   lhs is a number to test                                          */
1353169695Skan/*   rhs is the second (usually a pattern)                            */
1354169695Skan/*                                                                    */
1355169695Skan/* No errors are possible and no context is needed.                   */
1356169695Skan/* ------------------------------------------------------------------ */
1357169695SkandecNumber *
1358169695SkandecNumberSameQuantum (decNumber * res, const decNumber * lhs, const decNumber * rhs)
1359169695Skan{
1360169695Skan  uByte merged;			/* merged flags */
1361169695Skan  Unit ret = 0;			/* return value */
1362169695Skan
1363169695Skan#if DECCHECK
1364169695Skan  if (decCheckOperands (res, lhs, rhs, DECUNUSED))
1365169695Skan    return res;
1366169695Skan#endif
1367169695Skan
1368169695Skan  merged = (lhs->bits | rhs->bits) & DECSPECIAL;
1369169695Skan  if (merged)
1370169695Skan    {
1371169695Skan      if (decNumberIsNaN (lhs) && decNumberIsNaN (rhs))
1372169695Skan	ret = 1;
1373169695Skan      else if (decNumberIsInfinite (lhs) && decNumberIsInfinite (rhs))
1374169695Skan	ret = 1;
1375169695Skan      /* [anything else with a special gives 0] */
1376169695Skan    }
1377169695Skan  else if (lhs->exponent == rhs->exponent)
1378169695Skan    ret = 1;
1379169695Skan
1380169695Skan  decNumberZero (res);		/* OK to overwrite an operand */
1381169695Skan  *res->lsu = ret;
1382169695Skan  return res;
1383169695Skan}
1384169695Skan
1385169695Skan/* ------------------------------------------------------------------ */
1386169695Skan/* decNumberSquareRoot -- square root operator                        */
1387169695Skan/*                                                                    */
1388169695Skan/*   This computes C = squareroot(A)                                  */
1389169695Skan/*                                                                    */
1390169695Skan/*   res is C, the result.  C may be A                                */
1391169695Skan/*   rhs is A                                                         */
1392169695Skan/*   set is the context; note that rounding mode has no effect        */
1393169695Skan/*                                                                    */
1394169695Skan/* C must have space for set->digits digits.                          */
1395169695Skan/* ------------------------------------------------------------------ */
1396169695Skan/* This uses the following varying-precision algorithm in:            */
1397169695Skan/*                                                                    */
1398169695Skan/*   Properly Rounded Variable Precision Square Root, T. E. Hull and  */
1399169695Skan/*   A. Abrham, ACM Transactions on Mathematical Software, Vol 11 #3, */
1400169695Skan/*   pp229-237, ACM, September 1985.                                  */
1401169695Skan/*                                                                    */
1402169695Skan/* % [Reformatted original Numerical Turing source code follows.]     */
1403169695Skan/* function sqrt(x : real) : real                                     */
1404169695Skan/* % sqrt(x) returns the properly rounded approximation to the square */
1405169695Skan/* % root of x, in the precision of the calling environment, or it    */
1406169695Skan/* % fails if x < 0.                                                  */
1407169695Skan/* % t e hull and a abrham, august, 1984                              */
1408169695Skan/* if x <= 0 then                                                     */
1409169695Skan/*   if x < 0 then                                                    */
1410169695Skan/*     assert false                                                   */
1411169695Skan/*   else                                                             */
1412169695Skan/*     result 0                                                       */
1413169695Skan/*   end if                                                           */
1414169695Skan/* end if                                                             */
1415169695Skan/* var f := setexp(x, 0)  % fraction part of x   [0.1 <= x < 1]       */
1416169695Skan/* var e := getexp(x)     % exponent part of x                        */
1417169695Skan/* var approx : real                                                  */
1418169695Skan/* if e mod 2 = 0  then                                               */
1419169695Skan/*   approx := .259 + .819 * f   % approx to root of f                */
1420169695Skan/* else                                                               */
1421169695Skan/*   f := f/l0                   % adjustments                        */
1422169695Skan/*   e := e + 1                  %   for odd                          */
1423169695Skan/*   approx := .0819 + 2.59 * f  %   exponent                         */
1424169695Skan/* end if                                                             */
1425169695Skan/*                                                                    */
1426169695Skan/* var p:= 3                                                          */
1427169695Skan/* const maxp := currentprecision + 2                                 */
1428169695Skan/* loop                                                               */
1429169695Skan/*   p := min(2*p - 2, maxp)     % p = 4,6,10, . . . , maxp           */
1430169695Skan/*   precision p                                                      */
1431169695Skan/*   approx := .5 * (approx + f/approx)                               */
1432169695Skan/*   exit when p = maxp                                               */
1433169695Skan/* end loop                                                           */
1434169695Skan/*                                                                    */
1435169695Skan/* % approx is now within 1 ulp of the properly rounded square root   */
1436169695Skan/* % of f; to ensure proper rounding, compare squares of (approx -    */
1437169695Skan/* % l/2 ulp) and (approx + l/2 ulp) with f.                          */
1438169695Skan/* p := currentprecision                                              */
1439169695Skan/* begin                                                              */
1440169695Skan/*   precision p + 2                                                  */
1441169695Skan/*   const approxsubhalf := approx - setexp(.5, -p)                   */
1442169695Skan/*   if mulru(approxsubhalf, approxsubhalf) > f then                  */
1443169695Skan/*     approx := approx - setexp(.l, -p + 1)                          */
1444169695Skan/*   else                                                             */
1445169695Skan/*     const approxaddhalf := approx + setexp(.5, -p)                 */
1446169695Skan/*     if mulrd(approxaddhalf, approxaddhalf) < f then                */
1447169695Skan/*       approx := approx + setexp(.l, -p + 1)                        */
1448169695Skan/*     end if                                                         */
1449169695Skan/*   end if                                                           */
1450169695Skan/* end                                                                */
1451169695Skan/* result setexp(approx, e div 2)  % fix exponent                     */
1452169695Skan/* end sqrt                                                           */
1453169695Skan/* ------------------------------------------------------------------ */
1454169695SkandecNumber *
1455169695SkandecNumberSquareRoot (decNumber * res, const decNumber * rhs, decContext * set)
1456169695Skan{
1457169695Skan  decContext workset, approxset;	/* work contexts */
1458169695Skan  decNumber dzero;		/* used for constant zero */
1459169695Skan  Int maxp = set->digits + 2;	/* largest working precision */
1460169695Skan  Int residue = 0;		/* rounding residue */
1461169695Skan  uInt status = 0, ignore = 0;	/* status accumulators */
1462169695Skan  Int exp;			/* working exponent */
1463169695Skan  Int ideal;			/* ideal (preferred) exponent */
1464169695Skan  uInt needbytes;		/* work */
1465169695Skan  Int dropped;			/* .. */
1466169695Skan
1467169695Skan  decNumber *allocrhs = NULL;	/* non-NULL if rounded rhs allocated */
1468169695Skan  /* buffer for f [needs +1 in case DECBUFFER 0] */
1469169695Skan  uByte buff[sizeof (decNumber) + (D2U (DECBUFFER + 1) - 1) * sizeof (Unit)];
1470169695Skan  /* buffer for a [needs +2 to match maxp] */
1471169695Skan  uByte bufa[sizeof (decNumber) + (D2U (DECBUFFER + 2) - 1) * sizeof (Unit)];
1472169695Skan  /* buffer for temporary, b [must be same size as a] */
1473169695Skan  uByte bufb[sizeof (decNumber) + (D2U (DECBUFFER + 2) - 1) * sizeof (Unit)];
1474169695Skan  decNumber *allocbuff = NULL;	/* -> allocated buff, iff allocated */
1475169695Skan  decNumber *allocbufa = NULL;	/* -> allocated bufa, iff allocated */
1476169695Skan  decNumber *allocbufb = NULL;	/* -> allocated bufb, iff allocated */
1477169695Skan  decNumber *f = (decNumber *) buff;	/* reduced fraction */
1478169695Skan  decNumber *a = (decNumber *) bufa;	/* approximation to result */
1479169695Skan  decNumber *b = (decNumber *) bufb;	/* intermediate result */
1480169695Skan  /* buffer for temporary variable, up to 3 digits */
1481169695Skan  uByte buft[sizeof (decNumber) + (D2U (3) - 1) * sizeof (Unit)];
1482169695Skan  decNumber *t = (decNumber *) buft;	/* up-to-3-digit constant or work */
1483169695Skan
1484169695Skan#if DECCHECK
1485169695Skan  if (decCheckOperands (res, DECUNUSED, rhs, set))
1486169695Skan    return res;
1487169695Skan#endif
1488169695Skan
1489169695Skan  do
1490169695Skan    {				/* protect allocated storage */
1491169695Skan#if DECSUBSET
1492169695Skan      if (!set->extended)
1493169695Skan	{
1494169695Skan	  /* reduce operand and set lostDigits status, as needed */
1495169695Skan	  if (rhs->digits > set->digits)
1496169695Skan	    {
1497169695Skan	      allocrhs = decRoundOperand (rhs, set, &status);
1498169695Skan	      if (allocrhs == NULL)
1499169695Skan		break;
1500169695Skan	      /* [Note: 'f' allocation below could reuse this buffer if */
1501169695Skan	      /* used, but as this is rare we keep them separate for clarity.] */
1502169695Skan	      rhs = allocrhs;
1503169695Skan	    }
1504169695Skan	}
1505169695Skan#endif
1506169695Skan      /* [following code does not require input rounding] */
1507169695Skan
1508169695Skan      /* handle infinities and NaNs */
1509169695Skan      if (rhs->bits & DECSPECIAL)
1510169695Skan	{
1511169695Skan	  if (decNumberIsInfinite (rhs))
1512169695Skan	    {			/* an infinity */
1513169695Skan	      if (decNumberIsNegative (rhs))
1514169695Skan		status |= DEC_Invalid_operation;
1515169695Skan	      else
1516169695Skan		decNumberCopy (res, rhs);	/* +Infinity */
1517169695Skan	    }
1518169695Skan	  else
1519169695Skan	    decNaNs (res, rhs, NULL, &status);	/* a NaN */
1520169695Skan	  break;
1521169695Skan	}
1522169695Skan
1523169695Skan      /* calculate the ideal (preferred) exponent [floor(exp/2)] */
1524169695Skan      /* [We would like to write: ideal=rhs->exponent>>1, but this */
1525169695Skan      /* generates a compiler warning.  Generated code is the same.] */
1526169695Skan      ideal = (rhs->exponent & ~1) / 2;	/* target */
1527169695Skan
1528169695Skan      /* handle zeros */
1529169695Skan      if (ISZERO (rhs))
1530169695Skan	{
1531169695Skan	  decNumberCopy (res, rhs);	/* could be 0 or -0 */
1532169695Skan	  res->exponent = ideal;	/* use the ideal [safe] */
1533169695Skan	  break;
1534169695Skan	}
1535169695Skan
1536169695Skan      /* any other -x is an oops */
1537169695Skan      if (decNumberIsNegative (rhs))
1538169695Skan	{
1539169695Skan	  status |= DEC_Invalid_operation;
1540169695Skan	  break;
1541169695Skan	}
1542169695Skan
1543169695Skan      /* we need space for three working variables */
1544169695Skan      /*   f -- the same precision as the RHS, reduced to 0.01->0.99... */
1545169695Skan      /*   a -- Hull's approx -- precision, when assigned, is */
1546169695Skan      /*        currentprecision (we allow +2 for use as temporary) */
1547169695Skan      /*   b -- intermediate temporary result */
1548169695Skan      /* if any is too long for local storage, then allocate */
1549169695Skan      needbytes =
1550169695Skan	sizeof (decNumber) + (D2U (rhs->digits) - 1) * sizeof (Unit);
1551169695Skan      if (needbytes > sizeof (buff))
1552169695Skan	{
1553169695Skan	  allocbuff = (decNumber *) malloc (needbytes);
1554169695Skan	  if (allocbuff == NULL)
1555169695Skan	    {			/* hopeless -- abandon */
1556169695Skan	      status |= DEC_Insufficient_storage;
1557169695Skan	      break;
1558169695Skan	    }
1559169695Skan	  f = allocbuff;	/* use the allocated space */
1560169695Skan	}
1561169695Skan      /* a and b both need to be able to hold a maxp-length number */
1562169695Skan      needbytes = sizeof (decNumber) + (D2U (maxp) - 1) * sizeof (Unit);
1563169695Skan      if (needbytes > sizeof (bufa))
1564169695Skan	{			/* [same applies to b] */
1565169695Skan	  allocbufa = (decNumber *) malloc (needbytes);
1566169695Skan	  allocbufb = (decNumber *) malloc (needbytes);
1567169695Skan	  if (allocbufa == NULL || allocbufb == NULL)
1568169695Skan	    {			/* hopeless */
1569169695Skan	      status |= DEC_Insufficient_storage;
1570169695Skan	      break;
1571169695Skan	    }
1572169695Skan	  a = allocbufa;	/* use the allocated space */
1573169695Skan	  b = allocbufb;	/* .. */
1574169695Skan	}
1575169695Skan
1576169695Skan      /* copy rhs -> f, save exponent, and reduce so 0.1 <= f < 1 */
1577169695Skan      decNumberCopy (f, rhs);
1578169695Skan      exp = f->exponent + f->digits;	/* adjusted to Hull rules */
1579169695Skan      f->exponent = -(f->digits);	/* to range */
1580169695Skan
1581169695Skan      /* set up working contexts (the second is used for Numerical */
1582169695Skan      /* Turing assignment) */
1583169695Skan      decContextDefault (&workset, DEC_INIT_DECIMAL64);
1584169695Skan      decContextDefault (&approxset, DEC_INIT_DECIMAL64);
1585169695Skan      approxset.digits = set->digits;	/* approx's length */
1586169695Skan
1587169695Skan      /* [Until further notice, no error is possible and status bits */
1588169695Skan      /* (Rounded, etc.) should be ignored, not accumulated.] */
1589169695Skan
1590169695Skan      /* Calculate initial approximation, and allow for odd exponent */
1591169695Skan      workset.digits = set->digits;	/* p for initial calculation */
1592169695Skan      t->bits = 0;
1593169695Skan      t->digits = 3;
1594169695Skan      a->bits = 0;
1595169695Skan      a->digits = 3;
1596169695Skan      if ((exp & 1) == 0)
1597169695Skan	{			/* even exponent */
1598169695Skan	  /* Set t=0.259, a=0.819 */
1599169695Skan	  t->exponent = -3;
1600169695Skan	  a->exponent = -3;
1601169695Skan#if DECDPUN>=3
1602169695Skan	  t->lsu[0] = 259;
1603169695Skan	  a->lsu[0] = 819;
1604169695Skan#elif DECDPUN==2
1605169695Skan	  t->lsu[0] = 59;
1606169695Skan	  t->lsu[1] = 2;
1607169695Skan	  a->lsu[0] = 19;
1608169695Skan	  a->lsu[1] = 8;
1609169695Skan#else
1610169695Skan	  t->lsu[0] = 9;
1611169695Skan	  t->lsu[1] = 5;
1612169695Skan	  t->lsu[2] = 2;
1613169695Skan	  a->lsu[0] = 9;
1614169695Skan	  a->lsu[1] = 1;
1615169695Skan	  a->lsu[2] = 8;
1616169695Skan#endif
1617169695Skan	}
1618169695Skan      else
1619169695Skan	{			/* odd exponent */
1620169695Skan	  /* Set t=0.0819, a=2.59 */
1621169695Skan	  f->exponent--;	/* f=f/10 */
1622169695Skan	  exp++;		/* e=e+1 */
1623169695Skan	  t->exponent = -4;
1624169695Skan	  a->exponent = -2;
1625169695Skan#if DECDPUN>=3
1626169695Skan	  t->lsu[0] = 819;
1627169695Skan	  a->lsu[0] = 259;
1628169695Skan#elif DECDPUN==2
1629169695Skan	  t->lsu[0] = 19;
1630169695Skan	  t->lsu[1] = 8;
1631169695Skan	  a->lsu[0] = 59;
1632169695Skan	  a->lsu[1] = 2;
1633169695Skan#else
1634169695Skan	  t->lsu[0] = 9;
1635169695Skan	  t->lsu[1] = 1;
1636169695Skan	  t->lsu[2] = 8;
1637169695Skan	  a->lsu[0] = 9;
1638169695Skan	  a->lsu[1] = 5;
1639169695Skan	  a->lsu[2] = 2;
1640169695Skan#endif
1641169695Skan	}
1642169695Skan      decMultiplyOp (a, a, f, &workset, &ignore);	/* a=a*f */
1643169695Skan      decAddOp (a, a, t, &workset, 0, &ignore);	/* ..+t */
1644169695Skan      /* [a is now the initial approximation for sqrt(f), calculated with */
1645169695Skan      /* currentprecision, which is also a's precision.] */
1646169695Skan
1647169695Skan      /* the main calculation loop */
1648169695Skan      decNumberZero (&dzero);	/* make 0 */
1649169695Skan      decNumberZero (t);	/* set t = 0.5 */
1650169695Skan      t->lsu[0] = 5;		/* .. */
1651169695Skan      t->exponent = -1;		/* .. */
1652169695Skan      workset.digits = 3;	/* initial p */
1653169695Skan      for (;;)
1654169695Skan	{
1655169695Skan	  /* set p to min(2*p - 2, maxp)  [hence 3; or: 4, 6, 10, ... , maxp] */
1656169695Skan	  workset.digits = workset.digits * 2 - 2;
1657169695Skan	  if (workset.digits > maxp)
1658169695Skan	    workset.digits = maxp;
1659169695Skan	  /* a = 0.5 * (a + f/a) */
1660169695Skan	  /* [calculated at p then rounded to currentprecision] */
1661169695Skan	  decDivideOp (b, f, a, &workset, DIVIDE, &ignore);	/* b=f/a */
1662169695Skan	  decAddOp (b, b, a, &workset, 0, &ignore);	/* b=b+a */
1663169695Skan	  decMultiplyOp (a, b, t, &workset, &ignore);	/* a=b*0.5 */
1664169695Skan	  /* assign to approx [round to length] */
1665169695Skan	  decAddOp (a, &dzero, a, &approxset, 0, &ignore);
1666169695Skan	  if (workset.digits == maxp)
1667169695Skan	    break;		/* just did final */
1668169695Skan	}			/* loop */
1669169695Skan
1670169695Skan      /* a is now at currentprecision and within 1 ulp of the properly */
1671169695Skan      /* rounded square root of f; to ensure proper rounding, compare */
1672169695Skan      /* squares of (a - l/2 ulp) and (a + l/2 ulp) with f. */
1673169695Skan      /* Here workset.digits=maxp and t=0.5 */
1674169695Skan      workset.digits--;		/* maxp-1 is OK now */
1675169695Skan      t->exponent = -set->digits - 1;	/* make 0.5 ulp */
1676169695Skan      decNumberCopy (b, a);
1677169695Skan      decAddOp (b, b, t, &workset, DECNEG, &ignore);	/* b = a - 0.5 ulp */
1678169695Skan      workset.round = DEC_ROUND_UP;
1679169695Skan      decMultiplyOp (b, b, b, &workset, &ignore);	/* b = mulru(b, b) */
1680169695Skan      decCompareOp (b, f, b, &workset, COMPARE, &ignore);	/* b ? f, reversed */
1681169695Skan      if (decNumberIsNegative (b))
1682169695Skan	{			/* f < b [i.e., b > f] */
1683169695Skan	  /* this is the more common adjustment, though both are rare */
1684169695Skan	  t->exponent++;	/* make 1.0 ulp */
1685169695Skan	  t->lsu[0] = 1;	/* .. */
1686169695Skan	  decAddOp (a, a, t, &workset, DECNEG, &ignore);	/* a = a - 1 ulp */
1687169695Skan	  /* assign to approx [round to length] */
1688169695Skan	  decAddOp (a, &dzero, a, &approxset, 0, &ignore);
1689169695Skan	}
1690169695Skan      else
1691169695Skan	{
1692169695Skan	  decNumberCopy (b, a);
1693169695Skan	  decAddOp (b, b, t, &workset, 0, &ignore);	/* b = a + 0.5 ulp */
1694169695Skan	  workset.round = DEC_ROUND_DOWN;
1695169695Skan	  decMultiplyOp (b, b, b, &workset, &ignore);	/* b = mulrd(b, b) */
1696169695Skan	  decCompareOp (b, b, f, &workset, COMPARE, &ignore);	/* b ? f */
1697169695Skan	  if (decNumberIsNegative (b))
1698169695Skan	    {			/* b < f */
1699169695Skan	      t->exponent++;	/* make 1.0 ulp */
1700169695Skan	      t->lsu[0] = 1;	/* .. */
1701169695Skan	      decAddOp (a, a, t, &workset, 0, &ignore);	/* a = a + 1 ulp */
1702169695Skan	      /* assign to approx [round to length] */
1703169695Skan	      decAddOp (a, &dzero, a, &approxset, 0, &ignore);
1704169695Skan	    }
1705169695Skan	}
1706169695Skan      /* [no errors are possible in the above, and rounding/inexact during */
1707169695Skan      /* estimation are irrelevant, so status was not accumulated] */
1708169695Skan
1709169695Skan      /* Here, 0.1 <= a < 1  [Hull] */
1710169695Skan      a->exponent += exp / 2;	/* set correct exponent */
1711169695Skan
1712169695Skan      /* Process Subnormals */
1713169695Skan      decFinalize (a, set, &residue, &status);
1714169695Skan
1715169695Skan      /* count dropable zeros [after any subnormal rounding] */
1716169695Skan      decNumberCopy (b, a);
1717169695Skan      decTrim (b, 1, &dropped);	/* [drops trailing zeros] */
1718169695Skan
1719169695Skan      /* Finally set Inexact and Rounded.  The answer can only be exact if */
1720169695Skan      /* it is short enough so that squaring it could fit in set->digits, */
1721169695Skan      /* so this is the only (relatively rare) time we have to check */
1722169695Skan      /* carefully */
1723169695Skan      if (b->digits * 2 - 1 > set->digits)
1724169695Skan	{			/* cannot fit */
1725169695Skan	  status |= DEC_Inexact | DEC_Rounded;
1726169695Skan	}
1727169695Skan      else
1728169695Skan	{			/* could be exact/unrounded */
1729169695Skan	  uInt mstatus = 0;	/* local status */
1730169695Skan	  decMultiplyOp (b, b, b, &workset, &mstatus);	/* try the multiply */
1731169695Skan	  if (mstatus != 0)
1732169695Skan	    {			/* result won't fit */
1733169695Skan	      status |= DEC_Inexact | DEC_Rounded;
1734169695Skan	    }
1735169695Skan	  else
1736169695Skan	    {			/* plausible */
1737169695Skan	      decCompareOp (t, b, rhs, &workset, COMPARE, &mstatus);	/* b ? rhs */
1738169695Skan	      if (!ISZERO (t))
1739169695Skan		{
1740169695Skan		  status |= DEC_Inexact | DEC_Rounded;
1741169695Skan		}
1742169695Skan	      else
1743169695Skan		{		/* is Exact */
1744169695Skan		  /* here, dropped is the count of trailing zeros in 'a' */
1745169695Skan		  /* use closest exponent to ideal... */
1746169695Skan		  Int todrop = ideal - a->exponent;	/* most we can drop */
1747169695Skan
1748169695Skan		  if (todrop < 0)
1749169695Skan		    {		/* ideally would add 0s */
1750169695Skan		      status |= DEC_Rounded;
1751169695Skan		    }
1752169695Skan		  else
1753169695Skan		    {		/* unrounded */
1754169695Skan		      if (dropped < todrop)
1755169695Skan			todrop = dropped;	/* clamp to those available */
1756169695Skan		      if (todrop > 0)
1757169695Skan			{	/* OK, some to drop */
1758169695Skan			  decShiftToLeast (a->lsu, D2U (a->digits), todrop);
1759169695Skan			  a->exponent += todrop;	/* maintain numerical value */
1760169695Skan			  a->digits -= todrop;	/* new length */
1761169695Skan			}
1762169695Skan		    }
1763169695Skan		}
1764169695Skan	    }
1765169695Skan	}
1766169695Skan      decNumberCopy (res, a);	/* assume this is the result */
1767169695Skan    }
1768169695Skan  while (0);			/* end protected */
1769169695Skan
1770169695Skan  if (allocbuff != NULL)
1771169695Skan    free (allocbuff);		/* drop any storage we used */
1772169695Skan  if (allocbufa != NULL)
1773169695Skan    free (allocbufa);		/* .. */
1774169695Skan  if (allocbufb != NULL)
1775169695Skan    free (allocbufb);		/* .. */
1776169695Skan  if (allocrhs != NULL)
1777169695Skan    free (allocrhs);		/* .. */
1778169695Skan  if (status != 0)
1779169695Skan    decStatus (res, status, set);	/* then report status */
1780169695Skan  return res;
1781169695Skan}
1782169695Skan
1783169695Skan/* ------------------------------------------------------------------ */
1784169695Skan/* decNumberSubtract -- subtract two Numbers                          */
1785169695Skan/*                                                                    */
1786169695Skan/*   This computes C = A - B                                          */
1787169695Skan/*                                                                    */
1788169695Skan/*   res is C, the result.  C may be A and/or B (e.g., X=X-X)         */
1789169695Skan/*   lhs is A                                                         */
1790169695Skan/*   rhs is B                                                         */
1791169695Skan/*   set is the context                                               */
1792169695Skan/*                                                                    */
1793169695Skan/* C must have space for set->digits digits.                          */
1794169695Skan/* ------------------------------------------------------------------ */
1795169695SkandecNumber *
1796169695SkandecNumberSubtract (decNumber * res, const decNumber * lhs,
1797169695Skan		   const decNumber * rhs, decContext * set)
1798169695Skan{
1799169695Skan  uInt status = 0;		/* accumulator */
1800169695Skan
1801169695Skan  decAddOp (res, lhs, rhs, set, DECNEG, &status);
1802169695Skan  if (status != 0)
1803169695Skan    decStatus (res, status, set);
1804169695Skan  return res;
1805169695Skan}
1806169695Skan
1807169695Skan/* ------------------------------------------------------------------ */
1808169695Skan/* decNumberToIntegralValue -- round-to-integral-value                */
1809169695Skan/*                                                                    */
1810169695Skan/*   res is the result                                                */
1811169695Skan/*   rhs is input number                                              */
1812169695Skan/*   set is the context                                               */
1813169695Skan/*                                                                    */
1814169695Skan/* res must have space for any value of rhs.                          */
1815169695Skan/*                                                                    */
1816169695Skan/* This implements the IEEE special operator and therefore treats     */
1817169695Skan/* special values as valid, and also never sets Inexact.  For finite  */
1818169695Skan/* numbers it returns rescale(rhs, 0) if rhs->exponent is <0.         */
1819169695Skan/* Otherwise the result is rhs (so no error is possible).             */
1820169695Skan/*                                                                    */
1821169695Skan/* The context is used for rounding mode and status after sNaN, but   */
1822169695Skan/* the digits setting is ignored.                                     */
1823169695Skan/* ------------------------------------------------------------------ */
1824169695SkandecNumber *
1825169695SkandecNumberToIntegralValue (decNumber * res, const decNumber * rhs, decContext * set)
1826169695Skan{
1827169695Skan  decNumber dn;
1828169695Skan  decContext workset;		/* working context */
1829169695Skan
1830169695Skan#if DECCHECK
1831169695Skan  if (decCheckOperands (res, DECUNUSED, rhs, set))
1832169695Skan    return res;
1833169695Skan#endif
1834169695Skan
1835169695Skan  /* handle infinities and NaNs */
1836169695Skan  if (rhs->bits & DECSPECIAL)
1837169695Skan    {
1838169695Skan      uInt status = 0;
1839169695Skan      if (decNumberIsInfinite (rhs))
1840169695Skan	decNumberCopy (res, rhs);	/* an Infinity */
1841169695Skan      else
1842169695Skan	decNaNs (res, rhs, NULL, &status);	/* a NaN */
1843169695Skan      if (status != 0)
1844169695Skan	decStatus (res, status, set);
1845169695Skan      return res;
1846169695Skan    }
1847169695Skan
1848169695Skan  /* we have a finite number; no error possible */
1849169695Skan  if (rhs->exponent >= 0)
1850169695Skan    return decNumberCopy (res, rhs);
1851169695Skan  /* that was easy, but if negative exponent we have work to do... */
1852169695Skan  workset = *set;		/* clone rounding, etc. */
1853169695Skan  workset.digits = rhs->digits;	/* no length rounding */
1854169695Skan  workset.traps = 0;		/* no traps */
1855169695Skan  decNumberZero (&dn);		/* make a number with exponent 0 */
1856169695Skan  return decNumberQuantize (res, rhs, &dn, &workset);
1857169695Skan}
1858169695Skan
1859169695Skan/* ================================================================== */
1860169695Skan/* Utility routines                                                   */
1861169695Skan/* ================================================================== */
1862169695Skan
1863169695Skan/* ------------------------------------------------------------------ */
1864169695Skan/* decNumberCopy -- copy a number                                     */
1865169695Skan/*                                                                    */
1866169695Skan/*   dest is the target decNumber                                     */
1867169695Skan/*   src  is the source decNumber                                     */
1868169695Skan/*   returns dest                                                     */
1869169695Skan/*                                                                    */
1870169695Skan/* (dest==src is allowed and is a no-op)                              */
1871169695Skan/* All fields are updated as required.  This is a utility operation,  */
1872169695Skan/* so special values are unchanged and no error is possible.          */
1873169695Skan/* ------------------------------------------------------------------ */
1874169695SkandecNumber *
1875169695SkandecNumberCopy (decNumber * dest, const decNumber * src)
1876169695Skan{
1877169695Skan
1878169695Skan#if DECCHECK
1879169695Skan  if (src == NULL)
1880169695Skan    return decNumberZero (dest);
1881169695Skan#endif
1882169695Skan
1883169695Skan  if (dest == src)
1884169695Skan    return dest;		/* no copy required */
1885169695Skan
1886169695Skan  /* We use explicit assignments here as structure assignment can copy */
1887169695Skan  /* more than just the lsu (for small DECDPUN).  This would not affect */
1888169695Skan  /* the value of the results, but would disturb test harness spill */
1889169695Skan  /* checking. */
1890169695Skan  dest->bits = src->bits;
1891169695Skan  dest->exponent = src->exponent;
1892169695Skan  dest->digits = src->digits;
1893169695Skan  dest->lsu[0] = src->lsu[0];
1894169695Skan  if (src->digits > DECDPUN)
1895169695Skan    {				/* more Units to come */
1896169695Skan      Unit *d;			/* work */
1897169695Skan      const Unit *s, *smsup;	/* work */
1898169695Skan      /* memcpy for the remaining Units would be safe as they cannot */
1899169695Skan      /* overlap.  However, this explicit loop is faster in short cases. */
1900169695Skan      d = dest->lsu + 1;	/* -> first destination */
1901169695Skan      smsup = src->lsu + D2U (src->digits);	/* -> source msu+1 */
1902169695Skan      for (s = src->lsu + 1; s < smsup; s++, d++)
1903169695Skan	*d = *s;
1904169695Skan    }
1905169695Skan  return dest;
1906169695Skan}
1907169695Skan
1908169695Skan/* ------------------------------------------------------------------ */
1909169695Skan/* decNumberTrim -- remove insignificant zeros                        */
1910169695Skan/*                                                                    */
1911169695Skan/*   dn is the number to trim                                         */
1912169695Skan/*   returns dn                                                       */
1913169695Skan/*                                                                    */
1914169695Skan/* All fields are updated as required.  This is a utility operation,  */
1915169695Skan/* so special values are unchanged and no error is possible.          */
1916169695Skan/* ------------------------------------------------------------------ */
1917169695SkandecNumber *
1918169695SkandecNumberTrim (decNumber * dn)
1919169695Skan{
1920169695Skan  Int dropped;			/* work */
1921169695Skan  return decTrim (dn, 0, &dropped);
1922169695Skan}
1923169695Skan
1924169695Skan/* ------------------------------------------------------------------ */
1925169695Skan/* decNumberVersion -- return the name and version of this module     */
1926169695Skan/*                                                                    */
1927169695Skan/* No error is possible.                                              */
1928169695Skan/* ------------------------------------------------------------------ */
1929169695Skanconst char *
1930169695SkandecNumberVersion (void)
1931169695Skan{
1932169695Skan  return DECVERSION;
1933169695Skan}
1934169695Skan
1935169695Skan/* ------------------------------------------------------------------ */
1936169695Skan/* decNumberZero -- set a number to 0                                 */
1937169695Skan/*                                                                    */
1938169695Skan/*   dn is the number to set, with space for one digit                */
1939169695Skan/*   returns dn                                                       */
1940169695Skan/*                                                                    */
1941169695Skan/* No error is possible.                                              */
1942169695Skan/* ------------------------------------------------------------------ */
1943169695Skan/* Memset is not used as it is much slower in some environments. */
1944169695SkandecNumber *
1945169695SkandecNumberZero (decNumber * dn)
1946169695Skan{
1947169695Skan
1948169695Skan#if DECCHECK
1949169695Skan  if (decCheckOperands (dn, DECUNUSED, DECUNUSED, DECUNUSED))
1950169695Skan    return dn;
1951169695Skan#endif
1952169695Skan
1953169695Skan  dn->bits = 0;
1954169695Skan  dn->exponent = 0;
1955169695Skan  dn->digits = 1;
1956169695Skan  dn->lsu[0] = 0;
1957169695Skan  return dn;
1958169695Skan}
1959169695Skan
1960169695Skan/* ================================================================== */
1961169695Skan/* Local routines                                                     */
1962169695Skan/* ================================================================== */
1963169695Skan
1964169695Skan/* ------------------------------------------------------------------ */
1965169695Skan/* decToString -- lay out a number into a string                      */
1966169695Skan/*                                                                    */
1967169695Skan/*   dn     is the number to lay out                                  */
1968169695Skan/*   string is where to lay out the number                            */
1969169695Skan/*   eng    is 1 if Engineering, 0 if Scientific                      */
1970169695Skan/*                                                                    */
1971169695Skan/* str must be at least dn->digits+14 characters long                 */
1972169695Skan/* No error is possible.                                              */
1973169695Skan/*                                                                    */
1974169695Skan/* Note that this routine can generate a -0 or 0.000.  These are      */
1975169695Skan/* never generated in subset to-number or arithmetic, but can occur   */
1976169695Skan/* in non-subset arithmetic (e.g., -1*0 or 1.234-1.234).              */
1977169695Skan/* ------------------------------------------------------------------ */
1978169695Skan/* If DECCHECK is enabled the string "?" is returned if a number is */
1979169695Skan/* invalid. */
1980169695Skan
1981169695Skan/* TODIGIT -- macro to remove the leading digit from the unsigned */
1982169695Skan/* integer u at column cut (counting from the right, LSD=0) and place */
1983169695Skan/* it as an ASCII character into the character pointed to by c.  Note */
1984169695Skan/* that cut must be <= 9, and the maximum value for u is 2,000,000,000 */
1985169695Skan/* (as is needed for negative exponents of subnormals).  The unsigned */
1986169695Skan/* integer pow is used as a temporary variable. */
1987169695Skan#define TODIGIT(u, cut, c) {            \
1988169695Skan  *(c)='0';                             \
1989169695Skan  pow=powers[cut]*2;                    \
1990169695Skan  if ((u)>pow) {                        \
1991169695Skan    pow*=4;                             \
1992169695Skan    if ((u)>=pow) {(u)-=pow; *(c)+=8;}  \
1993169695Skan    pow/=2;                             \
1994169695Skan    if ((u)>=pow) {(u)-=pow; *(c)+=4;}  \
1995169695Skan    pow/=2;                             \
1996169695Skan    }                                   \
1997169695Skan  if ((u)>=pow) {(u)-=pow; *(c)+=2;}    \
1998169695Skan  pow/=2;                               \
1999169695Skan  if ((u)>=pow) {(u)-=pow; *(c)+=1;}    \
2000169695Skan  }
2001169695Skan
2002169695Skanstatic void
2003169695SkandecToString (const decNumber * dn, char *string, Flag eng)
2004169695Skan{
2005169695Skan  Int exp = dn->exponent;	/* local copy */
2006169695Skan  Int e;			/* E-part value */
2007169695Skan  Int pre;			/* digits before the '.' */
2008169695Skan  Int cut;			/* for counting digits in a Unit */
2009169695Skan  char *c = string;		/* work [output pointer] */
2010169695Skan  const Unit *up = dn->lsu + D2U (dn->digits) - 1;	/* -> msu [input pointer] */
2011169695Skan  uInt u, pow;			/* work */
2012169695Skan
2013169695Skan#if DECCHECK
2014169695Skan  if (decCheckOperands (DECUNUSED, dn, DECUNUSED, DECUNUSED))
2015169695Skan    {
2016169695Skan      strcpy (string, "?");
2017169695Skan      return;
2018169695Skan    }
2019169695Skan#endif
2020169695Skan
2021169695Skan  if (decNumberIsNegative (dn))
2022169695Skan    {				/* Negatives get a minus (except */
2023169695Skan      *c = '-';			/* NaNs, which remove the '-' below) */
2024169695Skan      c++;
2025169695Skan    }
2026169695Skan  if (dn->bits & DECSPECIAL)
2027169695Skan    {				/* Is a special value */
2028169695Skan      if (decNumberIsInfinite (dn))
2029169695Skan	{
2030169695Skan	  strcpy (c, "Infinity");
2031169695Skan	  return;
2032169695Skan	}
2033169695Skan      /* a NaN */
2034169695Skan      if (dn->bits & DECSNAN)
2035169695Skan	{			/* signalling NaN */
2036169695Skan	  *c = 's';
2037169695Skan	  c++;
2038169695Skan	}
2039169695Skan      strcpy (c, "NaN");
2040169695Skan      c += 3;			/* step past */
2041169695Skan      /* if not a clean non-zero coefficient, that's all we have in a */
2042169695Skan      /* NaN string */
2043169695Skan      if (exp != 0 || (*dn->lsu == 0 && dn->digits == 1))
2044169695Skan	return;
2045169695Skan      /* [drop through to add integer] */
2046169695Skan    }
2047169695Skan
2048169695Skan  /* calculate how many digits in msu, and hence first cut */
2049169695Skan  cut = dn->digits % DECDPUN;
2050169695Skan  if (cut == 0)
2051169695Skan    cut = DECDPUN;		/* msu is full */
2052169695Skan  cut--;			/* power of ten for digit */
2053169695Skan
2054169695Skan  if (exp == 0)
2055169695Skan    {				/* simple integer [common fastpath, */
2056169695Skan      /*   used for NaNs, too] */
2057169695Skan      for (; up >= dn->lsu; up--)
2058169695Skan	{			/* each Unit from msu */
2059169695Skan	  u = *up;		/* contains DECDPUN digits to lay out */
2060169695Skan	  for (; cut >= 0; c++, cut--)
2061169695Skan	    TODIGIT (u, cut, c);
2062169695Skan	  cut = DECDPUN - 1;	/* next Unit has all digits */
2063169695Skan	}
2064169695Skan      *c = '\0';		/* terminate the string */
2065169695Skan      return;
2066169695Skan    }
2067169695Skan
2068169695Skan  /* non-0 exponent -- assume plain form */
2069169695Skan  pre = dn->digits + exp;	/* digits before '.' */
2070169695Skan  e = 0;			/* no E */
2071169695Skan  if ((exp > 0) || (pre < -5))
2072169695Skan    {				/* need exponential form */
2073169695Skan      e = exp + dn->digits - 1;	/* calculate E value */
2074169695Skan      pre = 1;			/* assume one digit before '.' */
2075169695Skan      if (eng && (e != 0))
2076169695Skan	{			/* may need to adjust */
2077169695Skan	  Int adj;		/* adjustment */
2078169695Skan	  /* The C remainder operator is undefined for negative numbers, so */
2079169695Skan	  /* we must use positive remainder calculation here */
2080169695Skan	  if (e < 0)
2081169695Skan	    {
2082169695Skan	      adj = (-e) % 3;
2083169695Skan	      if (adj != 0)
2084169695Skan		adj = 3 - adj;
2085169695Skan	    }
2086169695Skan	  else
2087169695Skan	    {			/* e>0 */
2088169695Skan	      adj = e % 3;
2089169695Skan	    }
2090169695Skan	  e = e - adj;
2091169695Skan	  /* if we are dealing with zero we will use exponent which is a */
2092169695Skan	  /* multiple of three, as expected, but there will only be the */
2093169695Skan	  /* one zero before the E, still.  Otherwise note the padding. */
2094169695Skan	  if (!ISZERO (dn))
2095169695Skan	    pre += adj;
2096169695Skan	  else
2097169695Skan	    {			/* is zero */
2098169695Skan	      if (adj != 0)
2099169695Skan		{		/* 0.00Esnn needed */
2100169695Skan		  e = e + 3;
2101169695Skan		  pre = -(2 - adj);
2102169695Skan		}
2103169695Skan	    }			/* zero */
2104169695Skan	}			/* eng */
2105169695Skan    }
2106169695Skan
2107169695Skan  /* lay out the digits of the coefficient, adding 0s and . as needed */
2108169695Skan  u = *up;
2109169695Skan  if (pre > 0)
2110169695Skan    {				/* xxx.xxx or xx00 (engineering) form */
2111169695Skan      for (; pre > 0; pre--, c++, cut--)
2112169695Skan	{
2113169695Skan	  if (cut < 0)
2114169695Skan	    {			/* need new Unit */
2115169695Skan	      if (up == dn->lsu)
2116169695Skan		break;		/* out of input digits (pre>digits) */
2117169695Skan	      up--;
2118169695Skan	      cut = DECDPUN - 1;
2119169695Skan	      u = *up;
2120169695Skan	    }
2121169695Skan	  TODIGIT (u, cut, c);
2122169695Skan	}
2123169695Skan      if (up > dn->lsu || (up == dn->lsu && cut >= 0))
2124169695Skan	{			/* more to come, after '.' */
2125169695Skan	  *c = '.';
2126169695Skan	  c++;
2127169695Skan	  for (;; c++, cut--)
2128169695Skan	    {
2129169695Skan	      if (cut < 0)
2130169695Skan		{		/* need new Unit */
2131169695Skan		  if (up == dn->lsu)
2132169695Skan		    break;	/* out of input digits */
2133169695Skan		  up--;
2134169695Skan		  cut = DECDPUN - 1;
2135169695Skan		  u = *up;
2136169695Skan		}
2137169695Skan	      TODIGIT (u, cut, c);
2138169695Skan	    }
2139169695Skan	}
2140169695Skan      else
2141169695Skan	for (; pre > 0; pre--, c++)
2142169695Skan	  *c = '0';		/* 0 padding (for engineering) needed */
2143169695Skan    }
2144169695Skan  else
2145169695Skan    {				/* 0.xxx or 0.000xxx form */
2146169695Skan      *c = '0';
2147169695Skan      c++;
2148169695Skan      *c = '.';
2149169695Skan      c++;
2150169695Skan      for (; pre < 0; pre++, c++)
2151169695Skan	*c = '0';		/* add any 0's after '.' */
2152169695Skan      for (;; c++, cut--)
2153169695Skan	{
2154169695Skan	  if (cut < 0)
2155169695Skan	    {			/* need new Unit */
2156169695Skan	      if (up == dn->lsu)
2157169695Skan		break;		/* out of input digits */
2158169695Skan	      up--;
2159169695Skan	      cut = DECDPUN - 1;
2160169695Skan	      u = *up;
2161169695Skan	    }
2162169695Skan	  TODIGIT (u, cut, c);
2163169695Skan	}
2164169695Skan    }
2165169695Skan
2166169695Skan  /* Finally add the E-part, if needed.  It will never be 0, has a
2167169695Skan     base maximum and minimum of +999999999 through -999999999, but
2168169695Skan     could range down to -1999999998 for subnormal numbers */
2169169695Skan  if (e != 0)
2170169695Skan    {
2171169695Skan      Flag had = 0;		/* 1=had non-zero */
2172169695Skan      *c = 'E';
2173169695Skan      c++;
2174169695Skan      *c = '+';
2175169695Skan      c++;			/* assume positive */
2176169695Skan      u = e;			/* .. */
2177169695Skan      if (e < 0)
2178169695Skan	{
2179169695Skan	  *(c - 1) = '-';	/* oops, need - */
2180169695Skan	  u = -e;		/* uInt, please */
2181169695Skan	}
2182169695Skan      /* layout the exponent (_itoa is not ANSI C) */
2183169695Skan      for (cut = 9; cut >= 0; cut--)
2184169695Skan	{
2185169695Skan	  TODIGIT (u, cut, c);
2186169695Skan	  if (*c == '0' && !had)
2187169695Skan	    continue;		/* skip leading zeros */
2188169695Skan	  had = 1;		/* had non-0 */
2189169695Skan	  c++;			/* step for next */
2190169695Skan	}			/* cut */
2191169695Skan    }
2192169695Skan  *c = '\0';			/* terminate the string (all paths) */
2193169695Skan  return;
2194169695Skan}
2195169695Skan
2196169695Skan/* ------------------------------------------------------------------ */
2197169695Skan/* decAddOp -- add/subtract operation                                 */
2198169695Skan/*                                                                    */
2199169695Skan/*   This computes C = A + B                                          */
2200169695Skan/*                                                                    */
2201169695Skan/*   res is C, the result.  C may be A and/or B (e.g., X=X+X)         */
2202169695Skan/*   lhs is A                                                         */
2203169695Skan/*   rhs is B                                                         */
2204169695Skan/*   set is the context                                               */
2205169695Skan/*   negate is DECNEG if rhs should be negated, or 0 otherwise        */
2206169695Skan/*   status accumulates status for the caller                         */
2207169695Skan/*                                                                    */
2208169695Skan/* C must have space for set->digits digits.                          */
2209169695Skan/* ------------------------------------------------------------------ */
2210169695Skan/* If possible, we calculate the coefficient directly into C.         */
2211169695Skan/* However, if:                                                       */
2212169695Skan/*   -- we need a digits+1 calculation because numbers are unaligned  */
2213169695Skan/*      and span more than set->digits digits                         */
2214169695Skan/*   -- a carry to digits+1 digits looks possible                     */
2215169695Skan/*   -- C is the same as A or B, and the result would destructively   */
2216169695Skan/*      overlap the A or B coefficient                                */
2217169695Skan/* then we must calculate into a temporary buffer.  In this latter    */
2218169695Skan/* case we use the local (stack) buffer if possible, and only if too  */
2219169695Skan/* long for that do we resort to malloc.                              */
2220169695Skan/*                                                                    */
2221169695Skan/* Misalignment is handled as follows:                                */
2222169695Skan/*   Apad: (AExp>BExp) Swap operands and proceed as for BExp>AExp.    */
2223169695Skan/*   BPad: Apply the padding by a combination of shifting (whole      */
2224169695Skan/*         units) and multiplication (part units).                    */
2225169695Skan/*                                                                    */
2226169695Skan/* Addition, especially x=x+1, is speed-critical, so we take pains    */
2227169695Skan/* to make returning as fast as possible, by flagging any allocation. */
2228169695Skan/* ------------------------------------------------------------------ */
2229169695Skanstatic decNumber *
2230169695SkandecAddOp (decNumber * res, const decNumber * lhs,
2231169695Skan	  const decNumber * rhs, decContext * set, uByte negate, uInt * status)
2232169695Skan{
2233169695Skan  decNumber *alloclhs = NULL;	/* non-NULL if rounded lhs allocated */
2234169695Skan  decNumber *allocrhs = NULL;	/* .., rhs */
2235169695Skan  Int rhsshift;			/* working shift (in Units) */
2236169695Skan  Int maxdigits;		/* longest logical length */
2237169695Skan  Int mult;			/* multiplier */
2238169695Skan  Int residue;			/* rounding accumulator */
2239169695Skan  uByte bits;			/* result bits */
2240169695Skan  Flag diffsign;		/* non-0 if arguments have different sign */
2241169695Skan  Unit *acc;			/* accumulator for result */
2242169695Skan  Unit accbuff[D2U (DECBUFFER + 1)];	/* local buffer [+1 is for possible */
2243169695Skan  /* final carry digit or DECBUFFER=0] */
2244169695Skan  Unit *allocacc = NULL;	/* -> allocated acc buffer, iff allocated */
2245169695Skan  Flag alloced = 0;		/* set non-0 if any allocations */
2246169695Skan  Int reqdigits = set->digits;	/* local copy; requested DIGITS */
2247169695Skan  uByte merged;			/* merged flags */
2248169695Skan  Int padding;			/* work */
2249169695Skan
2250169695Skan#if DECCHECK
2251169695Skan  if (decCheckOperands (res, lhs, rhs, set))
2252169695Skan    return res;
2253169695Skan#endif
2254169695Skan
2255169695Skan  do
2256169695Skan    {				/* protect allocated storage */
2257169695Skan#if DECSUBSET
2258169695Skan      if (!set->extended)
2259169695Skan	{
2260169695Skan	  /* reduce operands and set lostDigits status, as needed */
2261169695Skan	  if (lhs->digits > reqdigits)
2262169695Skan	    {
2263169695Skan	      alloclhs = decRoundOperand (lhs, set, status);
2264169695Skan	      if (alloclhs == NULL)
2265169695Skan		break;
2266169695Skan	      lhs = alloclhs;
2267169695Skan	      alloced = 1;
2268169695Skan	    }
2269169695Skan	  if (rhs->digits > reqdigits)
2270169695Skan	    {
2271169695Skan	      allocrhs = decRoundOperand (rhs, set, status);
2272169695Skan	      if (allocrhs == NULL)
2273169695Skan		break;
2274169695Skan	      rhs = allocrhs;
2275169695Skan	      alloced = 1;
2276169695Skan	    }
2277169695Skan	}
2278169695Skan#endif
2279169695Skan      /* [following code does not require input rounding] */
2280169695Skan
2281169695Skan      /* note whether signs differ */
2282169695Skan      diffsign = (Flag) ((lhs->bits ^ rhs->bits ^ negate) & DECNEG);
2283169695Skan
2284169695Skan      /* handle infinities and NaNs */
2285169695Skan      merged = (lhs->bits | rhs->bits) & DECSPECIAL;
2286169695Skan      if (merged)
2287169695Skan	{			/* a special bit set */
2288169695Skan	  if (merged & (DECSNAN | DECNAN))	/* a NaN */
2289169695Skan	    decNaNs (res, lhs, rhs, status);
2290169695Skan	  else
2291169695Skan	    {			/* one or two infinities */
2292169695Skan	      if (decNumberIsInfinite (lhs))
2293169695Skan		{		/* LHS is infinity */
2294169695Skan		  /* two infinities with different signs is invalid */
2295169695Skan		  if (decNumberIsInfinite (rhs) && diffsign)
2296169695Skan		    {
2297169695Skan		      *status |= DEC_Invalid_operation;
2298169695Skan		      break;
2299169695Skan		    }
2300169695Skan		  bits = lhs->bits & DECNEG;	/* get sign from LHS */
2301169695Skan		}
2302169695Skan	      else
2303169695Skan		bits = (rhs->bits ^ negate) & DECNEG;	/* RHS must be Infinity */
2304169695Skan	      bits |= DECINF;
2305169695Skan	      decNumberZero (res);
2306169695Skan	      res->bits = bits;	/* set +/- infinity */
2307169695Skan	    }			/* an infinity */
2308169695Skan	  break;
2309169695Skan	}
2310169695Skan
2311169695Skan      /* Quick exit for add 0s; return the non-0, modified as need be */
2312169695Skan      if (ISZERO (lhs))
2313169695Skan	{
2314169695Skan	  Int adjust;		/* work */
2315169695Skan	  Int lexp = lhs->exponent;	/* save in case LHS==RES */
2316169695Skan	  bits = lhs->bits;	/* .. */
2317169695Skan	  residue = 0;		/* clear accumulator */
2318169695Skan	  decCopyFit (res, rhs, set, &residue, status);	/* copy (as needed) */
2319169695Skan	  res->bits ^= negate;	/* flip if rhs was negated */
2320169695Skan#if DECSUBSET
2321169695Skan	  if (set->extended)
2322169695Skan	    {			/* exponents on zeros count */
2323169695Skan#endif
2324169695Skan	      /* exponent will be the lower of the two */
2325169695Skan	      adjust = lexp - res->exponent;	/* adjustment needed [if -ve] */
2326169695Skan	      if (ISZERO (res))
2327169695Skan		{		/* both 0: special IEEE 854 rules */
2328169695Skan		  if (adjust < 0)
2329169695Skan		    res->exponent = lexp;	/* set exponent */
2330169695Skan		  /* 0-0 gives +0 unless rounding to -infinity, and -0-0 gives -0 */
2331169695Skan		  if (diffsign)
2332169695Skan		    {
2333169695Skan		      if (set->round != DEC_ROUND_FLOOR)
2334169695Skan			res->bits = 0;
2335169695Skan		      else
2336169695Skan			res->bits = DECNEG;	/* preserve 0 sign */
2337169695Skan		    }
2338169695Skan		}
2339169695Skan	      else
2340169695Skan		{		/* non-0 res */
2341169695Skan		  if (adjust < 0)
2342169695Skan		    {		/* 0-padding needed */
2343169695Skan		      if ((res->digits - adjust) > set->digits)
2344169695Skan			{
2345169695Skan			  adjust = res->digits - set->digits;	/* to fit exactly */
2346169695Skan			  *status |= DEC_Rounded;	/* [but exact] */
2347169695Skan			}
2348169695Skan		      res->digits =
2349169695Skan			decShiftToMost (res->lsu, res->digits, -adjust);
2350169695Skan		      res->exponent += adjust;	/* set the exponent. */
2351169695Skan		    }
2352169695Skan		}		/* non-0 res */
2353169695Skan#if DECSUBSET
2354169695Skan	    }			/* extended */
2355169695Skan#endif
2356169695Skan	  decFinish (res, set, &residue, status);	/* clean and finalize */
2357169695Skan	  break;
2358169695Skan	}
2359169695Skan
2360169695Skan      if (ISZERO (rhs))
2361169695Skan	{			/* [lhs is non-zero] */
2362169695Skan	  Int adjust;		/* work */
2363169695Skan	  Int rexp = rhs->exponent;	/* save in case RHS==RES */
2364169695Skan	  bits = rhs->bits;	/* be clean */
2365169695Skan	  residue = 0;		/* clear accumulator */
2366169695Skan	  decCopyFit (res, lhs, set, &residue, status);	/* copy (as needed) */
2367169695Skan#if DECSUBSET
2368169695Skan	  if (set->extended)
2369169695Skan	    {			/* exponents on zeros count */
2370169695Skan#endif
2371169695Skan	      /* exponent will be the lower of the two */
2372169695Skan	      /* [0-0 case handled above] */
2373169695Skan	      adjust = rexp - res->exponent;	/* adjustment needed [if -ve] */
2374169695Skan	      if (adjust < 0)
2375169695Skan		{		/* 0-padding needed */
2376169695Skan		  if ((res->digits - adjust) > set->digits)
2377169695Skan		    {
2378169695Skan		      adjust = res->digits - set->digits;	/* to fit exactly */
2379169695Skan		      *status |= DEC_Rounded;	/* [but exact] */
2380169695Skan		    }
2381169695Skan		  res->digits =
2382169695Skan		    decShiftToMost (res->lsu, res->digits, -adjust);
2383169695Skan		  res->exponent += adjust;	/* set the exponent. */
2384169695Skan		}
2385169695Skan#if DECSUBSET
2386169695Skan	    }			/* extended */
2387169695Skan#endif
2388169695Skan	  decFinish (res, set, &residue, status);	/* clean and finalize */
2389169695Skan	  break;
2390169695Skan	}
2391169695Skan      /* [both fastpath and mainpath code below assume these cases */
2392169695Skan      /* (notably 0-0) have already been handled] */
2393169695Skan
2394169695Skan      /* calculate the padding needed to align the operands */
2395169695Skan      padding = rhs->exponent - lhs->exponent;
2396169695Skan
2397169695Skan      /* Fastpath cases where the numbers are aligned and normal, the RHS */
2398169695Skan      /* is all in one unit, no operand rounding is needed, and no carry, */
2399169695Skan      /* lengthening, or borrow is needed */
2400169695Skan      if (rhs->digits <= DECDPUN && padding == 0 && rhs->exponent >= set->emin	/* [some normals drop through] */
2401169695Skan	  && rhs->digits <= reqdigits && lhs->digits <= reqdigits)
2402169695Skan	{
2403169695Skan	  Int partial = *lhs->lsu;
2404169695Skan	  if (!diffsign)
2405169695Skan	    {			/* adding */
2406169695Skan	      Int maxv = DECDPUNMAX;	/* highest no-overflow */
2407169695Skan	      if (lhs->digits < DECDPUN)
2408169695Skan		maxv = powers[lhs->digits] - 1;
2409169695Skan	      partial += *rhs->lsu;
2410169695Skan	      if (partial <= maxv)
2411169695Skan		{		/* no carry */
2412169695Skan		  if (res != lhs)
2413169695Skan		    decNumberCopy (res, lhs);	/* not in place */
2414169695Skan		  *res->lsu = (Unit) partial;	/* [copy could have overwritten RHS] */
2415169695Skan		  break;
2416169695Skan		}
2417169695Skan	      /* else drop out for careful add */
2418169695Skan	    }
2419169695Skan	  else
2420169695Skan	    {			/* signs differ */
2421169695Skan	      partial -= *rhs->lsu;
2422169695Skan	      if (partial > 0)
2423169695Skan		{		/* no borrow needed, and non-0 result */
2424169695Skan		  if (res != lhs)
2425169695Skan		    decNumberCopy (res, lhs);	/* not in place */
2426169695Skan		  *res->lsu = (Unit) partial;
2427169695Skan		  /* this could have reduced digits [but result>0] */
2428169695Skan		  res->digits = decGetDigits (res->lsu, D2U (res->digits));
2429169695Skan		  break;
2430169695Skan		}
2431169695Skan	      /* else drop out for careful subtract */
2432169695Skan	    }
2433169695Skan	}
2434169695Skan
2435169695Skan      /* Now align (pad) the lhs or rhs so we can add or subtract them, as
2436169695Skan         necessary.  If one number is much larger than the other (that is,
2437169695Skan         if in plain form there is a least one digit between the lowest
2438169695Skan         digit or one and the highest of the other) we need to pad with up
2439169695Skan         to DIGITS-1 trailing zeros, and then apply rounding (as exotic
2440169695Skan         rounding modes may be affected by the residue).
2441169695Skan       */
2442169695Skan      rhsshift = 0;		/* rhs shift to left (padding) in Units */
2443169695Skan      bits = lhs->bits;		/* assume sign is that of LHS */
2444169695Skan      mult = 1;			/* likely multiplier */
2445169695Skan
2446169695Skan      /* if padding==0 the operands are aligned; no padding needed */
2447169695Skan      if (padding != 0)
2448169695Skan	{
2449169695Skan	  /* some padding needed */
2450169695Skan	  /* We always pad the RHS, as we can then effect any required */
2451169695Skan	  /* padding by a combination of shifts and a multiply */
2452169695Skan	  Flag swapped = 0;
2453169695Skan	  if (padding < 0)
2454169695Skan	    {			/* LHS needs the padding */
2455169695Skan	      const decNumber *t;
2456169695Skan	      padding = -padding;	/* will be +ve */
2457169695Skan	      bits = (uByte) (rhs->bits ^ negate);	/* assumed sign is now that of RHS */
2458169695Skan	      t = lhs;
2459169695Skan	      lhs = rhs;
2460169695Skan	      rhs = t;
2461169695Skan	      swapped = 1;
2462169695Skan	    }
2463169695Skan
2464169695Skan	  /* If, after pad, rhs would be longer than lhs by digits+1 or */
2465169695Skan	  /* more then lhs cannot affect the answer, except as a residue, */
2466169695Skan	  /* so we only need to pad up to a length of DIGITS+1. */
2467169695Skan	  if (rhs->digits + padding > lhs->digits + reqdigits + 1)
2468169695Skan	    {
2469169695Skan	      /* The RHS is sufficient */
2470169695Skan	      /* for residue we use the relative sign indication... */
2471169695Skan	      Int shift = reqdigits - rhs->digits;	/* left shift needed */
2472169695Skan	      residue = 1;	/* residue for rounding */
2473169695Skan	      if (diffsign)
2474169695Skan		residue = -residue;	/* signs differ */
2475169695Skan	      /* copy, shortening if necessary */
2476169695Skan	      decCopyFit (res, rhs, set, &residue, status);
2477169695Skan	      /* if it was already shorter, then need to pad with zeros */
2478169695Skan	      if (shift > 0)
2479169695Skan		{
2480169695Skan		  res->digits = decShiftToMost (res->lsu, res->digits, shift);
2481169695Skan		  res->exponent -= shift;	/* adjust the exponent. */
2482169695Skan		}
2483169695Skan	      /* flip the result sign if unswapped and rhs was negated */
2484169695Skan	      if (!swapped)
2485169695Skan		res->bits ^= negate;
2486169695Skan	      decFinish (res, set, &residue, status);	/* done */
2487169695Skan	      break;
2488169695Skan	    }
2489169695Skan
2490169695Skan	  /* LHS digits may affect result */
2491169695Skan	  rhsshift = D2U (padding + 1) - 1;	/* this much by Unit shift .. */
2492169695Skan	  mult = powers[padding - (rhsshift * DECDPUN)];	/* .. this by multiplication */
2493169695Skan	}			/* padding needed */
2494169695Skan
2495169695Skan      if (diffsign)
2496169695Skan	mult = -mult;		/* signs differ */
2497169695Skan
2498169695Skan      /* determine the longer operand */
2499169695Skan      maxdigits = rhs->digits + padding;	/* virtual length of RHS */
2500169695Skan      if (lhs->digits > maxdigits)
2501169695Skan	maxdigits = lhs->digits;
2502169695Skan
2503169695Skan      /* Decide on the result buffer to use; if possible place directly */
2504169695Skan      /* into result. */
2505169695Skan      acc = res->lsu;		/* assume build direct */
2506169695Skan      /* If destructive overlap, or the number is too long, or a carry or */
2507169695Skan      /* borrow to DIGITS+1 might be possible we must use a buffer. */
2508169695Skan      /* [Might be worth more sophisticated tests when maxdigits==reqdigits] */
2509169695Skan      if ((maxdigits >= reqdigits)	/* is, or could be, too large */
2510169695Skan	  || (res == rhs && rhsshift > 0))
2511169695Skan	{			/* destructive overlap */
2512169695Skan	  /* buffer needed; choose it */
2513169695Skan	  /* we'll need units for maxdigits digits, +1 Unit for carry or borrow */
2514169695Skan	  Int need = D2U (maxdigits) + 1;
2515169695Skan	  acc = accbuff;	/* assume use local buffer */
2516169695Skan	  if (need * sizeof (Unit) > sizeof (accbuff))
2517169695Skan	    {
2518169695Skan	      allocacc = (Unit *) malloc (need * sizeof (Unit));
2519169695Skan	      if (allocacc == NULL)
2520169695Skan		{		/* hopeless -- abandon */
2521169695Skan		  *status |= DEC_Insufficient_storage;
2522169695Skan		  break;
2523169695Skan		}
2524169695Skan	      acc = allocacc;
2525169695Skan	      alloced = 1;
2526169695Skan	    }
2527169695Skan	}
2528169695Skan
2529169695Skan      res->bits = (uByte) (bits & DECNEG);	/* it's now safe to overwrite.. */
2530169695Skan      res->exponent = lhs->exponent;	/* .. operands (even if aliased) */
2531169695Skan
2532169695Skan#if DECTRACE
2533169695Skan      decDumpAr ('A', lhs->lsu, D2U (lhs->digits));
2534169695Skan      decDumpAr ('B', rhs->lsu, D2U (rhs->digits));
2535169695Skan      printf ("  :h: %d %d\n", rhsshift, mult);
2536169695Skan#endif
2537169695Skan
2538169695Skan      /* add [A+B*m] or subtract [A+B*(-m)] */
2539169695Skan      res->digits = decUnitAddSub (lhs->lsu, D2U (lhs->digits), rhs->lsu, D2U (rhs->digits), rhsshift, acc, mult) * DECDPUN;	/* [units -> digits] */
2540169695Skan      if (res->digits < 0)
2541169695Skan	{			/* we borrowed */
2542169695Skan	  res->digits = -res->digits;
2543169695Skan	  res->bits ^= DECNEG;	/* flip the sign */
2544169695Skan	}
2545169695Skan#if DECTRACE
2546169695Skan      decDumpAr ('+', acc, D2U (res->digits));
2547169695Skan#endif
2548169695Skan
2549169695Skan      /* If we used a buffer we need to copy back, possibly shortening */
2550169695Skan      /* (If we didn't use buffer it must have fit, so can't need rounding */
2551169695Skan      /* and residue must be 0.) */
2552169695Skan      residue = 0;		/* clear accumulator */
2553169695Skan      if (acc != res->lsu)
2554169695Skan	{
2555169695Skan#if DECSUBSET
2556169695Skan	  if (set->extended)
2557169695Skan	    {			/* round from first significant digit */
2558169695Skan#endif
2559169695Skan	      /* remove leading zeros that we added due to rounding up to */
2560169695Skan	      /* integral Units -- before the test for rounding. */
2561169695Skan	      if (res->digits > reqdigits)
2562169695Skan		res->digits = decGetDigits (acc, D2U (res->digits));
2563169695Skan	      decSetCoeff (res, set, acc, res->digits, &residue, status);
2564169695Skan#if DECSUBSET
2565169695Skan	    }
2566169695Skan	  else
2567169695Skan	    {			/* subset arithmetic rounds from original significant digit */
2568169695Skan	      /* We may have an underestimate.  This only occurs when both */
2569169695Skan	      /* numbers fit in DECDPUN digits and we are padding with a */
2570169695Skan	      /* negative multiple (-10, -100...) and the top digit(s) become */
2571169695Skan	      /* 0.  (This only matters if we are using X3.274 rules where the */
2572169695Skan	      /* leading zero could be included in the rounding.) */
2573169695Skan	      if (res->digits < maxdigits)
2574169695Skan		{
2575169695Skan		  *(acc + D2U (res->digits)) = 0;	/* ensure leading 0 is there */
2576169695Skan		  res->digits = maxdigits;
2577169695Skan		}
2578169695Skan	      else
2579169695Skan		{
2580169695Skan		  /* remove leading zeros that we added due to rounding up to */
2581169695Skan		  /* integral Units (but only those in excess of the original */
2582169695Skan		  /* maxdigits length, unless extended) before test for rounding. */
2583169695Skan		  if (res->digits > reqdigits)
2584169695Skan		    {
2585169695Skan		      res->digits = decGetDigits (acc, D2U (res->digits));
2586169695Skan		      if (res->digits < maxdigits)
2587169695Skan			res->digits = maxdigits;
2588169695Skan		    }
2589169695Skan		}
2590169695Skan	      decSetCoeff (res, set, acc, res->digits, &residue, status);
2591169695Skan	      /* Now apply rounding if needed before removing leading zeros. */
2592169695Skan	      /* This is safe because subnormals are not a possibility */
2593169695Skan	      if (residue != 0)
2594169695Skan		{
2595169695Skan		  decApplyRound (res, set, residue, status);
2596169695Skan		  residue = 0;	/* we did what we had to do */
2597169695Skan		}
2598169695Skan	    }			/* subset */
2599169695Skan#endif
2600169695Skan	}			/* used buffer */
2601169695Skan
2602169695Skan      /* strip leading zeros [these were left on in case of subset subtract] */
2603169695Skan      res->digits = decGetDigits (res->lsu, D2U (res->digits));
2604169695Skan
2605169695Skan      /* apply checks and rounding */
2606169695Skan      decFinish (res, set, &residue, status);
2607169695Skan
2608169695Skan      /* "When the sum of two operands with opposite signs is exactly */
2609169695Skan      /* zero, the sign of that sum shall be '+' in all rounding modes */
2610169695Skan      /* except round toward -Infinity, in which mode that sign shall be */
2611169695Skan      /* '-'."  [Subset zeros also never have '-', set by decFinish.] */
2612169695Skan      if (ISZERO (res) && diffsign
2613169695Skan#if DECSUBSET
2614169695Skan	  && set->extended
2615169695Skan#endif
2616169695Skan	  && (*status & DEC_Inexact) == 0)
2617169695Skan	{
2618169695Skan	  if (set->round == DEC_ROUND_FLOOR)
2619169695Skan	    res->bits |= DECNEG;	/* sign - */
2620169695Skan	  else
2621169695Skan	    res->bits &= ~DECNEG;	/* sign + */
2622169695Skan	}
2623169695Skan    }
2624169695Skan  while (0);			/* end protected */
2625169695Skan
2626169695Skan  if (alloced)
2627169695Skan    {
2628169695Skan      if (allocacc != NULL)
2629169695Skan	free (allocacc);	/* drop any storage we used */
2630169695Skan      if (allocrhs != NULL)
2631169695Skan	free (allocrhs);	/* .. */
2632169695Skan      if (alloclhs != NULL)
2633169695Skan	free (alloclhs);	/* .. */
2634169695Skan    }
2635169695Skan  return res;
2636169695Skan}
2637169695Skan
2638169695Skan/* ------------------------------------------------------------------ */
2639169695Skan/* decDivideOp -- division operation                                  */
2640169695Skan/*                                                                    */
2641169695Skan/*  This routine performs the calculations for all four division      */
2642169695Skan/*  operators (divide, divideInteger, remainder, remainderNear).      */
2643169695Skan/*                                                                    */
2644169695Skan/*  C=A op B                                                          */
2645169695Skan/*                                                                    */
2646169695Skan/*   res is C, the result.  C may be A and/or B (e.g., X=X/X)         */
2647169695Skan/*   lhs is A                                                         */
2648169695Skan/*   rhs is B                                                         */
2649169695Skan/*   set is the context                                               */
2650169695Skan/*   op  is DIVIDE, DIVIDEINT, REMAINDER, or REMNEAR respectively.    */
2651169695Skan/*   status is the usual accumulator                                  */
2652169695Skan/*                                                                    */
2653169695Skan/* C must have space for set->digits digits.                          */
2654169695Skan/*                                                                    */
2655169695Skan/* ------------------------------------------------------------------ */
2656169695Skan/*   The underlying algorithm of this routine is the same as in the   */
2657169695Skan/*   1981 S/370 implementation, that is, non-restoring long division  */
2658169695Skan/*   with bi-unit (rather than bi-digit) estimation for each unit     */
2659169695Skan/*   multiplier.  In this pseudocode overview, complications for the  */
2660169695Skan/*   Remainder operators and division residues for exact rounding are */
2661169695Skan/*   omitted for clarity.                                             */
2662169695Skan/*                                                                    */
2663169695Skan/*     Prepare operands and handle special values                     */
2664169695Skan/*     Test for x/0 and then 0/x                                      */
2665169695Skan/*     Exp =Exp1 - Exp2                                               */
2666169695Skan/*     Exp =Exp +len(var1) -len(var2)                                 */
2667169695Skan/*     Sign=Sign1 * Sign2                                             */
2668169695Skan/*     Pad accumulator (Var1) to double-length with 0's (pad1)        */
2669169695Skan/*     Pad Var2 to same length as Var1                                */
2670169695Skan/*     msu2pair/plus=1st 2 or 1 units of var2, +1 to allow for round  */
2671169695Skan/*     have=0                                                         */
2672169695Skan/*     Do until (have=digits+1 OR residue=0)                          */
2673169695Skan/*       if exp<0 then if integer divide/residue then leave           */
2674169695Skan/*       this_unit=0                                                  */
2675169695Skan/*       Do forever                                                   */
2676169695Skan/*          compare numbers                                           */
2677169695Skan/*          if <0 then leave inner_loop                               */
2678169695Skan/*          if =0 then (* quick exit without subtract *) do           */
2679169695Skan/*             this_unit=this_unit+1; output this_unit                */
2680169695Skan/*             leave outer_loop; end                                  */
2681169695Skan/*          Compare lengths of numbers (mantissae):                   */
2682169695Skan/*          If same then tops2=msu2pair -- {units 1&2 of var2}        */
2683169695Skan/*                  else tops2=msu2plus -- {0, unit 1 of var2}        */
2684169695Skan/*          tops1=first_unit_of_Var1*10**DECDPUN +second_unit_of_var1 */
2685169695Skan/*          mult=tops1/tops2  -- Good and safe guess at divisor       */
2686169695Skan/*          if mult=0 then mult=1                                     */
2687169695Skan/*          this_unit=this_unit+mult                                  */
2688169695Skan/*          subtract                                                  */
2689169695Skan/*          end inner_loop                                            */
2690169695Skan/*        if have\=0 | this_unit\=0 then do                           */
2691169695Skan/*          output this_unit                                          */
2692169695Skan/*          have=have+1; end                                          */
2693169695Skan/*        var2=var2/10                                                */
2694169695Skan/*        exp=exp-1                                                   */
2695169695Skan/*        end outer_loop                                              */
2696169695Skan/*     exp=exp+1   -- set the proper exponent                         */
2697169695Skan/*     if have=0 then generate answer=0                               */
2698169695Skan/*     Return (Result is defined by Var1)                             */
2699169695Skan/*                                                                    */
2700169695Skan/* ------------------------------------------------------------------ */
2701169695Skan/* We need two working buffers during the long division; one (digits+ */
2702169695Skan/* 1) to accumulate the result, and the other (up to 2*digits+1) for  */
2703169695Skan/* long subtractions.  These are acc and var1 respectively.           */
2704169695Skan/* var1 is a copy of the lhs coefficient, var2 is the rhs coefficient.*/
2705169695Skan/* ------------------------------------------------------------------ */
2706169695Skanstatic decNumber *
2707169695SkandecDivideOp (decNumber * res,
2708169695Skan	     const decNumber * lhs, const decNumber * rhs,
2709169695Skan	     decContext * set, Flag op, uInt * status)
2710169695Skan{
2711169695Skan  decNumber *alloclhs = NULL;	/* non-NULL if rounded lhs allocated */
2712169695Skan  decNumber *allocrhs = NULL;	/* .., rhs */
2713169695Skan  Unit accbuff[D2U (DECBUFFER + DECDPUN)];	/* local buffer */
2714169695Skan  Unit *acc = accbuff;		/* -> accumulator array for result */
2715169695Skan  Unit *allocacc = NULL;	/* -> allocated buffer, iff allocated */
2716169695Skan  Unit *accnext;		/* -> where next digit will go */
2717169695Skan  Int acclength;		/* length of acc needed [Units] */
2718169695Skan  Int accunits;			/* count of units accumulated */
2719169695Skan  Int accdigits;		/* count of digits accumulated */
2720169695Skan
2721169695Skan  Unit varbuff[D2U (DECBUFFER * 2 + DECDPUN) * sizeof (Unit)];	/* buffer for var1 */
2722169695Skan  Unit *var1 = varbuff;		/* -> var1 array for long subtraction */
2723169695Skan  Unit *varalloc = NULL;	/* -> allocated buffer, iff used */
2724169695Skan
2725169695Skan  const Unit *var2;		/* -> var2 array */
2726169695Skan
2727169695Skan  Int var1units, var2units;	/* actual lengths */
2728169695Skan  Int var2ulen;			/* logical length (units) */
2729169695Skan  Int var1initpad = 0;		/* var1 initial padding (digits) */
2730169695Skan  Unit *msu1;			/* -> msu of each var */
2731169695Skan  const Unit *msu2;		/* -> msu of each var */
2732169695Skan  Int msu2plus;			/* msu2 plus one [does not vary] */
2733169695Skan  eInt msu2pair;		/* msu2 pair plus one [does not vary] */
2734169695Skan  Int maxdigits;		/* longest LHS or required acc length */
2735169695Skan  Int mult;			/* multiplier for subtraction */
2736169695Skan  Unit thisunit;		/* current unit being accumulated */
2737169695Skan  Int residue;			/* for rounding */
2738169695Skan  Int reqdigits = set->digits;	/* requested DIGITS */
2739169695Skan  Int exponent;			/* working exponent */
2740169695Skan  Int maxexponent = 0;		/* DIVIDE maximum exponent if unrounded */
2741169695Skan  uByte bits;			/* working sign */
2742169695Skan  uByte merged;			/* merged flags */
2743169695Skan  Unit *target;			/* work */
2744169695Skan  const Unit *source;		/* work */
2745169695Skan  uInt const *pow;		/* .. */
2746169695Skan  Int shift, cut;		/* .. */
2747169695Skan#if DECSUBSET
2748169695Skan  Int dropped;			/* work */
2749169695Skan#endif
2750169695Skan
2751169695Skan#if DECCHECK
2752169695Skan  if (decCheckOperands (res, lhs, rhs, set))
2753169695Skan    return res;
2754169695Skan#endif
2755169695Skan
2756169695Skan  do
2757169695Skan    {				/* protect allocated storage */
2758169695Skan#if DECSUBSET
2759169695Skan      if (!set->extended)
2760169695Skan	{
2761169695Skan	  /* reduce operands and set lostDigits status, as needed */
2762169695Skan	  if (lhs->digits > reqdigits)
2763169695Skan	    {
2764169695Skan	      alloclhs = decRoundOperand (lhs, set, status);
2765169695Skan	      if (alloclhs == NULL)
2766169695Skan		break;
2767169695Skan	      lhs = alloclhs;
2768169695Skan	    }
2769169695Skan	  if (rhs->digits > reqdigits)
2770169695Skan	    {
2771169695Skan	      allocrhs = decRoundOperand (rhs, set, status);
2772169695Skan	      if (allocrhs == NULL)
2773169695Skan		break;
2774169695Skan	      rhs = allocrhs;
2775169695Skan	    }
2776169695Skan	}
2777169695Skan#endif
2778169695Skan      /* [following code does not require input rounding] */
2779169695Skan
2780169695Skan      bits = (lhs->bits ^ rhs->bits) & DECNEG;	/* assumed sign for divisions */
2781169695Skan
2782169695Skan      /* handle infinities and NaNs */
2783169695Skan      merged = (lhs->bits | rhs->bits) & DECSPECIAL;
2784169695Skan      if (merged)
2785169695Skan	{			/* a special bit set */
2786169695Skan	  if (merged & (DECSNAN | DECNAN))
2787169695Skan	    {			/* one or two NaNs */
2788169695Skan	      decNaNs (res, lhs, rhs, status);
2789169695Skan	      break;
2790169695Skan	    }
2791169695Skan	  /* one or two infinities */
2792169695Skan	  if (decNumberIsInfinite (lhs))
2793169695Skan	    {			/* LHS (dividend) is infinite */
2794169695Skan	      if (decNumberIsInfinite (rhs) ||	/* two infinities are invalid .. */
2795169695Skan		  op & (REMAINDER | REMNEAR))
2796169695Skan		{		/* as is remainder of infinity */
2797169695Skan		  *status |= DEC_Invalid_operation;
2798169695Skan		  break;
2799169695Skan		}
2800169695Skan	      /* [Note that infinity/0 raises no exceptions] */
2801169695Skan	      decNumberZero (res);
2802169695Skan	      res->bits = bits | DECINF;	/* set +/- infinity */
2803169695Skan	      break;
2804169695Skan	    }
2805169695Skan	  else
2806169695Skan	    {			/* RHS (divisor) is infinite */
2807169695Skan	      residue = 0;
2808169695Skan	      if (op & (REMAINDER | REMNEAR))
2809169695Skan		{
2810169695Skan		  /* result is [finished clone of] lhs */
2811169695Skan		  decCopyFit (res, lhs, set, &residue, status);
2812169695Skan		}
2813169695Skan	      else
2814169695Skan		{		/* a division */
2815169695Skan		  decNumberZero (res);
2816169695Skan		  res->bits = bits;	/* set +/- zero */
2817169695Skan		  /* for DIVIDEINT the exponent is always 0.  For DIVIDE, result */
2818169695Skan		  /* is a 0 with infinitely negative exponent, clamped to minimum */
2819169695Skan		  if (op & DIVIDE)
2820169695Skan		    {
2821169695Skan		      res->exponent = set->emin - set->digits + 1;
2822169695Skan		      *status |= DEC_Clamped;
2823169695Skan		    }
2824169695Skan		}
2825169695Skan	      decFinish (res, set, &residue, status);
2826169695Skan	      break;
2827169695Skan	    }
2828169695Skan	}
2829169695Skan
2830169695Skan      /* handle 0 rhs (x/0) */
2831169695Skan      if (ISZERO (rhs))
2832169695Skan	{			/* x/0 is always exceptional */
2833169695Skan	  if (ISZERO (lhs))
2834169695Skan	    {
2835169695Skan	      decNumberZero (res);	/* [after lhs test] */
2836169695Skan	      *status |= DEC_Division_undefined;	/* 0/0 will become NaN */
2837169695Skan	    }
2838169695Skan	  else
2839169695Skan	    {
2840169695Skan	      decNumberZero (res);
2841169695Skan	      if (op & (REMAINDER | REMNEAR))
2842169695Skan		*status |= DEC_Invalid_operation;
2843169695Skan	      else
2844169695Skan		{
2845169695Skan		  *status |= DEC_Division_by_zero;	/* x/0 */
2846169695Skan		  res->bits = bits | DECINF;	/* .. is +/- Infinity */
2847169695Skan		}
2848169695Skan	    }
2849169695Skan	  break;
2850169695Skan	}
2851169695Skan
2852169695Skan      /* handle 0 lhs (0/x) */
2853169695Skan      if (ISZERO (lhs))
2854169695Skan	{			/* 0/x [x!=0] */
2855169695Skan#if DECSUBSET
2856169695Skan	  if (!set->extended)
2857169695Skan	    decNumberZero (res);
2858169695Skan	  else
2859169695Skan	    {
2860169695Skan#endif
2861169695Skan	      if (op & DIVIDE)
2862169695Skan		{
2863169695Skan		  residue = 0;
2864169695Skan		  exponent = lhs->exponent - rhs->exponent;	/* ideal exponent */
2865169695Skan		  decNumberCopy (res, lhs);	/* [zeros always fit] */
2866169695Skan		  res->bits = bits;	/* sign as computed */
2867169695Skan		  res->exponent = exponent;	/* exponent, too */
2868169695Skan		  decFinalize (res, set, &residue, status);	/* check exponent */
2869169695Skan		}
2870169695Skan	      else if (op & DIVIDEINT)
2871169695Skan		{
2872169695Skan		  decNumberZero (res);	/* integer 0 */
2873169695Skan		  res->bits = bits;	/* sign as computed */
2874169695Skan		}
2875169695Skan	      else
2876169695Skan		{		/* a remainder */
2877169695Skan		  exponent = rhs->exponent;	/* [save in case overwrite] */
2878169695Skan		  decNumberCopy (res, lhs);	/* [zeros always fit] */
2879169695Skan		  if (exponent < res->exponent)
2880169695Skan		    res->exponent = exponent;	/* use lower */
2881169695Skan		}
2882169695Skan#if DECSUBSET
2883169695Skan	    }
2884169695Skan#endif
2885169695Skan	  break;
2886169695Skan	}
2887169695Skan
2888169695Skan      /* Precalculate exponent.  This starts off adjusted (and hence fits */
2889169695Skan      /* in 31 bits) and becomes the usual unadjusted exponent as the */
2890169695Skan      /* division proceeds.  The order of evaluation is important, here, */
2891169695Skan      /* to avoid wrap. */
2892169695Skan      exponent =
2893169695Skan	(lhs->exponent + lhs->digits) - (rhs->exponent + rhs->digits);
2894169695Skan
2895169695Skan      /* If the working exponent is -ve, then some quick exits are */
2896169695Skan      /* possible because the quotient is known to be <1 */
2897169695Skan      /* [for REMNEAR, it needs to be < -1, as -0.5 could need work] */
2898169695Skan      if (exponent < 0 && !(op == DIVIDE))
2899169695Skan	{
2900169695Skan	  if (op & DIVIDEINT)
2901169695Skan	    {
2902169695Skan	      decNumberZero (res);	/* integer part is 0 */
2903169695Skan#if DECSUBSET
2904169695Skan	      if (set->extended)
2905169695Skan#endif
2906169695Skan		res->bits = bits;	/* set +/- zero */
2907169695Skan	      break;
2908169695Skan	    }
2909169695Skan	  /* we can fastpath remainders so long as the lhs has the */
2910169695Skan	  /* smaller (or equal) exponent */
2911169695Skan	  if (lhs->exponent <= rhs->exponent)
2912169695Skan	    {
2913169695Skan	      if (op & REMAINDER || exponent < -1)
2914169695Skan		{
2915169695Skan		  /* It is REMAINDER or safe REMNEAR; result is [finished */
2916169695Skan		  /* clone of] lhs  (r = x - 0*y) */
2917169695Skan		  residue = 0;
2918169695Skan		  decCopyFit (res, lhs, set, &residue, status);
2919169695Skan		  decFinish (res, set, &residue, status);
2920169695Skan		  break;
2921169695Skan		}
2922169695Skan	      /* [unsafe REMNEAR drops through] */
2923169695Skan	    }
2924169695Skan	}			/* fastpaths */
2925169695Skan
2926169695Skan      /* We need long (slow) division; roll up the sleeves... */
2927169695Skan
2928169695Skan      /* The accumulator will hold the quotient of the division. */
2929169695Skan      /* If it needs to be too long for stack storage, then allocate. */
2930169695Skan      acclength = D2U (reqdigits + DECDPUN);	/* in Units */
2931169695Skan      if (acclength * sizeof (Unit) > sizeof (accbuff))
2932169695Skan	{
2933169695Skan	  allocacc = (Unit *) malloc (acclength * sizeof (Unit));
2934169695Skan	  if (allocacc == NULL)
2935169695Skan	    {			/* hopeless -- abandon */
2936169695Skan	      *status |= DEC_Insufficient_storage;
2937169695Skan	      break;
2938169695Skan	    }
2939169695Skan	  acc = allocacc;	/* use the allocated space */
2940169695Skan	}
2941169695Skan
2942169695Skan      /* var1 is the padded LHS ready for subtractions. */
2943169695Skan      /* If it needs to be too long for stack storage, then allocate. */
2944169695Skan      /* The maximum units we need for var1 (long subtraction) is: */
2945169695Skan      /* Enough for */
2946169695Skan      /*     (rhs->digits+reqdigits-1) -- to allow full slide to right */
2947169695Skan      /* or  (lhs->digits)             -- to allow for long lhs */
2948169695Skan      /* whichever is larger */
2949169695Skan      /*   +1                -- for rounding of slide to right */
2950169695Skan      /*   +1                -- for leading 0s */
2951169695Skan      /*   +1                -- for pre-adjust if a remainder or DIVIDEINT */
2952169695Skan      /* [Note: unused units do not participate in decUnitAddSub data] */
2953169695Skan      maxdigits = rhs->digits + reqdigits - 1;
2954169695Skan      if (lhs->digits > maxdigits)
2955169695Skan	maxdigits = lhs->digits;
2956169695Skan      var1units = D2U (maxdigits) + 2;
2957169695Skan      /* allocate a guard unit above msu1 for REMAINDERNEAR */
2958169695Skan      if (!(op & DIVIDE))
2959169695Skan	var1units++;
2960169695Skan      if ((var1units + 1) * sizeof (Unit) > sizeof (varbuff))
2961169695Skan	{
2962169695Skan	  varalloc = (Unit *) malloc ((var1units + 1) * sizeof (Unit));
2963169695Skan	  if (varalloc == NULL)
2964169695Skan	    {			/* hopeless -- abandon */
2965169695Skan	      *status |= DEC_Insufficient_storage;
2966169695Skan	      break;
2967169695Skan	    }
2968169695Skan	  var1 = varalloc;	/* use the allocated space */
2969169695Skan	}
2970169695Skan
2971169695Skan      /* Extend the lhs and rhs to full long subtraction length.  The lhs */
2972169695Skan      /* is truly extended into the var1 buffer, with 0 padding, so we can */
2973169695Skan      /* subtract in place.  The rhs (var2) has virtual padding */
2974169695Skan      /* (implemented by decUnitAddSub). */
2975169695Skan      /* We allocated one guard unit above msu1 for rem=rem+rem in REMAINDERNEAR */
2976169695Skan      msu1 = var1 + var1units - 1;	/* msu of var1 */
2977169695Skan      source = lhs->lsu + D2U (lhs->digits) - 1;	/* msu of input array */
2978169695Skan      for (target = msu1; source >= lhs->lsu; source--, target--)
2979169695Skan	*target = *source;
2980169695Skan      for (; target >= var1; target--)
2981169695Skan	*target = 0;
2982169695Skan
2983169695Skan      /* rhs (var2) is left-aligned with var1 at the start */
2984169695Skan      var2ulen = var1units;	/* rhs logical length (units) */
2985169695Skan      var2units = D2U (rhs->digits);	/* rhs actual length (units) */
2986169695Skan      var2 = rhs->lsu;		/* -> rhs array */
2987169695Skan      msu2 = var2 + var2units - 1;	/* -> msu of var2 [never changes] */
2988169695Skan      /* now set up the variables which we'll use for estimating the */
2989169695Skan      /* multiplication factor.  If these variables are not exact, we add */
2990169695Skan      /* 1 to make sure that we never overestimate the multiplier. */
2991169695Skan      msu2plus = *msu2;		/* it's value .. */
2992169695Skan      if (var2units > 1)
2993169695Skan	msu2plus++;		/* .. +1 if any more */
2994169695Skan      msu2pair = (eInt) * msu2 * (DECDPUNMAX + 1);	/* top two pair .. */
2995169695Skan      if (var2units > 1)
2996169695Skan	{			/* .. [else treat 2nd as 0] */
2997169695Skan	  msu2pair += *(msu2 - 1);	/* .. */
2998169695Skan	  if (var2units > 2)
2999169695Skan	    msu2pair++;		/* .. +1 if any more */
3000169695Skan	}
3001169695Skan
3002169695Skan      /* Since we are working in units, the units may have leading zeros, */
3003169695Skan      /* but we calculated the exponent on the assumption that they are */
3004169695Skan      /* both left-aligned.  Adjust the exponent to compensate: add the */
3005169695Skan      /* number of leading zeros in var1 msu and subtract those in var2 msu. */
3006169695Skan      /* [We actually do this by counting the digits and negating, as */
3007169695Skan      /* lead1=DECDPUN-digits1, and similarly for lead2.] */
3008169695Skan      for (pow = &powers[1]; *msu1 >= *pow; pow++)
3009169695Skan	exponent--;
3010169695Skan      for (pow = &powers[1]; *msu2 >= *pow; pow++)
3011169695Skan	exponent++;
3012169695Skan
3013169695Skan      /* Now, if doing an integer divide or remainder, we want to ensure */
3014169695Skan      /* that the result will be Unit-aligned.  To do this, we shift the */
3015169695Skan      /* var1 accumulator towards least if need be.  (It's much easier to */
3016169695Skan      /* do this now than to reassemble the residue afterwards, if we are */
3017169695Skan      /* doing a remainder.)  Also ensure the exponent is not negative. */
3018169695Skan      if (!(op & DIVIDE))
3019169695Skan	{
3020169695Skan	  Unit *u;
3021169695Skan	  /* save the initial 'false' padding of var1, in digits */
3022169695Skan	  var1initpad = (var1units - D2U (lhs->digits)) * DECDPUN;
3023169695Skan	  /* Determine the shift to do. */
3024169695Skan	  if (exponent < 0)
3025169695Skan	    cut = -exponent;
3026169695Skan	  else
3027169695Skan	    cut = DECDPUN - exponent % DECDPUN;
3028169695Skan	  decShiftToLeast (var1, var1units, cut);
3029169695Skan	  exponent += cut;	/* maintain numerical value */
3030169695Skan	  var1initpad -= cut;	/* .. and reduce padding */
3031169695Skan	  /* clean any most-significant units we just emptied */
3032169695Skan	  for (u = msu1; cut >= DECDPUN; cut -= DECDPUN, u--)
3033169695Skan	    *u = 0;
3034169695Skan	}			/* align */
3035169695Skan      else
3036169695Skan	{			/* is DIVIDE */
3037169695Skan	  maxexponent = lhs->exponent - rhs->exponent;	/* save */
3038169695Skan	  /* optimization: if the first iteration will just produce 0, */
3039169695Skan	  /* preadjust to skip it [valid for DIVIDE only] */
3040169695Skan	  if (*msu1 < *msu2)
3041169695Skan	    {
3042169695Skan	      var2ulen--;	/* shift down */
3043169695Skan	      exponent -= DECDPUN;	/* update the exponent */
3044169695Skan	    }
3045169695Skan	}
3046169695Skan
3047169695Skan      /* ---- start the long-division loops ------------------------------ */
3048169695Skan      accunits = 0;		/* no units accumulated yet */
3049169695Skan      accdigits = 0;		/* .. or digits */
3050169695Skan      accnext = acc + acclength - 1;	/* -> msu of acc [NB: allows digits+1] */
3051169695Skan      for (;;)
3052169695Skan	{			/* outer forever loop */
3053169695Skan	  thisunit = 0;		/* current unit assumed 0 */
3054169695Skan	  /* find the next unit */
3055169695Skan	  for (;;)
3056169695Skan	    {			/* inner forever loop */
3057169695Skan	      /* strip leading zero units [from either pre-adjust or from */
3058169695Skan	      /* subtract last time around].  Leave at least one unit. */
3059169695Skan	      for (; *msu1 == 0 && msu1 > var1; msu1--)
3060169695Skan		var1units--;
3061169695Skan
3062169695Skan	      if (var1units < var2ulen)
3063169695Skan		break;		/* var1 too low for subtract */
3064169695Skan	      if (var1units == var2ulen)
3065169695Skan		{		/* unit-by-unit compare needed */
3066169695Skan		  /* compare the two numbers, from msu */
3067169695Skan		  Unit *pv1, v2;	/* units to compare */
3068169695Skan		  const Unit *pv2;	/* units to compare */
3069169695Skan		  pv2 = msu2;	/* -> msu */
3070169695Skan		  for (pv1 = msu1;; pv1--, pv2--)
3071169695Skan		    {
3072169695Skan		      /* v1=*pv1 -- always OK */
3073169695Skan		      v2 = 0;	/* assume in padding */
3074169695Skan		      if (pv2 >= var2)
3075169695Skan			v2 = *pv2;	/* in range */
3076169695Skan		      if (*pv1 != v2)
3077169695Skan			break;	/* no longer the same */
3078169695Skan		      if (pv1 == var1)
3079169695Skan			break;	/* done; leave pv1 as is */
3080169695Skan		    }
3081169695Skan		  /* here when all inspected or a difference seen */
3082169695Skan		  if (*pv1 < v2)
3083169695Skan		    break;	/* var1 too low to subtract */
3084169695Skan		  if (*pv1 == v2)
3085169695Skan		    {		/* var1 == var2 */
3086169695Skan		      /* reach here if var1 and var2 are identical; subtraction */
3087169695Skan		      /* would increase digit by one, and the residue will be 0 so */
3088169695Skan		      /* we are done; leave the loop with residue set to 0. */
3089169695Skan		      thisunit++;	/* as though subtracted */
3090169695Skan		      *var1 = 0;	/* set var1 to 0 */
3091169695Skan		      var1units = 1;	/* .. */
3092169695Skan		      break;	/* from inner */
3093169695Skan		    }		/* var1 == var2 */
3094169695Skan		  /* *pv1>v2.  Prepare for real subtraction; the lengths are equal */
3095169695Skan		  /* Estimate the multiplier (there's always a msu1-1)... */
3096169695Skan		  /* Bring in two units of var2 to provide a good estimate. */
3097169695Skan		  mult =
3098169695Skan		    (Int) (((eInt) * msu1 * (DECDPUNMAX + 1) +
3099169695Skan			    *(msu1 - 1)) / msu2pair);
3100169695Skan		}		/* lengths the same */
3101169695Skan	      else
3102169695Skan		{		/* var1units > var2ulen, so subtraction is safe */
3103169695Skan		  /* The var2 msu is one unit towards the lsu of the var1 msu, */
3104169695Skan		  /* so we can only use one unit for var2. */
3105169695Skan		  mult =
3106169695Skan		    (Int) (((eInt) * msu1 * (DECDPUNMAX + 1) +
3107169695Skan			    *(msu1 - 1)) / msu2plus);
3108169695Skan		}
3109169695Skan	      if (mult == 0)
3110169695Skan		mult = 1;	/* must always be at least 1 */
3111169695Skan	      /* subtraction needed; var1 is > var2 */
3112169695Skan	      thisunit = (Unit) (thisunit + mult);	/* accumulate */
3113169695Skan	      /* subtract var1-var2, into var1; only the overlap needs */
3114169695Skan	      /* processing, as we are in place */
3115169695Skan	      shift = var2ulen - var2units;
3116169695Skan#if DECTRACE
3117169695Skan	      decDumpAr ('1', &var1[shift], var1units - shift);
3118169695Skan	      decDumpAr ('2', var2, var2units);
3119169695Skan	      printf ("m=%d\n", -mult);
3120169695Skan#endif
3121169695Skan	      decUnitAddSub (&var1[shift], var1units - shift,
3122169695Skan			     var2, var2units, 0, &var1[shift], -mult);
3123169695Skan#if DECTRACE
3124169695Skan	      decDumpAr ('#', &var1[shift], var1units - shift);
3125169695Skan#endif
3126169695Skan	      /* var1 now probably has leading zeros; these are removed at the */
3127169695Skan	      /* top of the inner loop. */
3128169695Skan	    }			/* inner loop */
3129169695Skan
3130169695Skan	  /* We have the next unit; unless it's a leading zero, add to acc */
3131169695Skan	  if (accunits != 0 || thisunit != 0)
3132169695Skan	    {			/* put the unit we got */
3133169695Skan	      *accnext = thisunit;	/* store in accumulator */
3134169695Skan	      /* account exactly for the digits we got */
3135169695Skan	      if (accunits == 0)
3136169695Skan		{
3137169695Skan		  accdigits++;	/* at least one */
3138169695Skan		  for (pow = &powers[1]; thisunit >= *pow; pow++)
3139169695Skan		    accdigits++;
3140169695Skan		}
3141169695Skan	      else
3142169695Skan		accdigits += DECDPUN;
3143169695Skan	      accunits++;	/* update count */
3144169695Skan	      accnext--;	/* ready for next */
3145169695Skan	      if (accdigits > reqdigits)
3146169695Skan		break;		/* we have all we need */
3147169695Skan	    }
3148169695Skan
3149169695Skan	  /* if the residue is zero, we're done (unless divide or */
3150169695Skan	  /* divideInteger and we haven't got enough digits yet) */
3151169695Skan	  if (*var1 == 0 && var1units == 1)
3152169695Skan	    {			/* residue is 0 */
3153169695Skan	      if (op & (REMAINDER | REMNEAR))
3154169695Skan		break;
3155169695Skan	      if ((op & DIVIDE) && (exponent <= maxexponent))
3156169695Skan		break;
3157169695Skan	      /* [drop through if divideInteger] */
3158169695Skan	    }
3159169695Skan	  /* we've also done enough if calculating remainder or integer */
3160169695Skan	  /* divide and we just did the last ('units') unit */
3161169695Skan	  if (exponent == 0 && !(op & DIVIDE))
3162169695Skan	    break;
3163169695Skan
3164169695Skan	  /* to get here, var1 is less than var2, so divide var2 by the per- */
3165169695Skan	  /* Unit power of ten and go for the next digit */
3166169695Skan	  var2ulen--;		/* shift down */
3167169695Skan	  exponent -= DECDPUN;	/* update the exponent */
3168169695Skan	}			/* outer loop */
3169169695Skan
3170169695Skan      /* ---- division is complete --------------------------------------- */
3171169695Skan      /* here: acc      has at least reqdigits+1 of good results (or fewer */
3172169695Skan      /*                if early stop), starting at accnext+1 (its lsu) */
3173169695Skan      /*       var1     has any residue at the stopping point */
3174169695Skan      /*       accunits is the number of digits we collected in acc */
3175169695Skan      if (accunits == 0)
3176169695Skan	{			/* acc is 0 */
3177169695Skan	  accunits = 1;		/* show we have one .. */
3178169695Skan	  accdigits = 1;	/* .. */
3179169695Skan	  *accnext = 0;		/* .. whose value is 0 */
3180169695Skan	}
3181169695Skan      else
3182169695Skan	accnext++;		/* back to last placed */
3183169695Skan      /* accnext now -> lowest unit of result */
3184169695Skan
3185169695Skan      residue = 0;		/* assume no residue */
3186169695Skan      if (op & DIVIDE)
3187169695Skan	{
3188169695Skan	  /* record the presence of any residue, for rounding */
3189169695Skan	  if (*var1 != 0 || var1units > 1)
3190169695Skan	    residue = 1;
3191169695Skan	  else
3192169695Skan	    {			/* no residue */
3193169695Skan	      /* We had an exact division; clean up spurious trailing 0s. */
3194169695Skan	      /* There will be at most DECDPUN-1, from the final multiply, */
3195169695Skan	      /* and then only if the result is non-0 (and even) and the */
3196169695Skan	      /* exponent is 'loose'. */
3197169695Skan#if DECDPUN>1
3198169695Skan	      Unit lsu = *accnext;
3199169695Skan	      if (!(lsu & 0x01) && (lsu != 0))
3200169695Skan		{
3201169695Skan		  /* count the trailing zeros */
3202169695Skan		  Int drop = 0;
3203169695Skan		  for (;; drop++)
3204169695Skan		    {		/* [will terminate because lsu!=0] */
3205169695Skan		      if (exponent >= maxexponent)
3206169695Skan			break;	/* don't chop real 0s */
3207169695Skan#if DECDPUN<=4
3208169695Skan		      if ((lsu - QUOT10 (lsu, drop + 1)
3209169695Skan			   * powers[drop + 1]) != 0)
3210169695Skan			break;	/* found non-0 digit */
3211169695Skan#else
3212169695Skan		      if (lsu % powers[drop + 1] != 0)
3213169695Skan			break;	/* found non-0 digit */
3214169695Skan#endif
3215169695Skan		      exponent++;
3216169695Skan		    }
3217169695Skan		  if (drop > 0)
3218169695Skan		    {
3219169695Skan		      accunits = decShiftToLeast (accnext, accunits, drop);
3220169695Skan		      accdigits = decGetDigits (accnext, accunits);
3221169695Skan		      accunits = D2U (accdigits);
3222169695Skan		      /* [exponent was adjusted in the loop] */
3223169695Skan		    }
3224169695Skan		}		/* neither odd nor 0 */
3225169695Skan#endif
3226169695Skan	    }			/* exact divide */
3227169695Skan	}			/* divide */
3228169695Skan      else			/* op!=DIVIDE */
3229169695Skan	{
3230169695Skan	  /* check for coefficient overflow */
3231169695Skan	  if (accdigits + exponent > reqdigits)
3232169695Skan	    {
3233169695Skan	      *status |= DEC_Division_impossible;
3234169695Skan	      break;
3235169695Skan	    }
3236169695Skan	  if (op & (REMAINDER | REMNEAR))
3237169695Skan	    {
3238169695Skan	      /* [Here, the exponent will be 0, because we adjusted var1 */
3239169695Skan	      /* appropriately.] */
3240169695Skan	      Int postshift;	/* work */
3241169695Skan	      Flag wasodd = 0;	/* integer was odd */
3242169695Skan	      Unit *quotlsu;	/* for save */
3243169695Skan	      Int quotdigits;	/* .. */
3244169695Skan
3245169695Skan	      /* Fastpath when residue is truly 0 is worthwhile [and */
3246169695Skan	      /* simplifies the code below] */
3247169695Skan	      if (*var1 == 0 && var1units == 1)
3248169695Skan		{		/* residue is 0 */
3249169695Skan		  Int exp = lhs->exponent;	/* save min(exponents) */
3250169695Skan		  if (rhs->exponent < exp)
3251169695Skan		    exp = rhs->exponent;
3252169695Skan		  decNumberZero (res);	/* 0 coefficient */
3253169695Skan#if DECSUBSET
3254169695Skan		  if (set->extended)
3255169695Skan#endif
3256169695Skan		    res->exponent = exp;	/* .. with proper exponent */
3257169695Skan		  break;
3258169695Skan		}
3259169695Skan	      /* note if the quotient was odd */
3260169695Skan	      if (*accnext & 0x01)
3261169695Skan		wasodd = 1;	/* acc is odd */
3262169695Skan	      quotlsu = accnext;	/* save in case need to reinspect */
3263169695Skan	      quotdigits = accdigits;	/* .. */
3264169695Skan
3265169695Skan	      /* treat the residue, in var1, as the value to return, via acc */
3266169695Skan	      /* calculate the unused zero digits.  This is the smaller of: */
3267169695Skan	      /*   var1 initial padding (saved above) */
3268169695Skan	      /*   var2 residual padding, which happens to be given by: */
3269169695Skan	      postshift =
3270169695Skan		var1initpad + exponent - lhs->exponent + rhs->exponent;
3271169695Skan	      /* [the 'exponent' term accounts for the shifts during divide] */
3272169695Skan	      if (var1initpad < postshift)
3273169695Skan		postshift = var1initpad;
3274169695Skan
3275169695Skan	      /* shift var1 the requested amount, and adjust its digits */
3276169695Skan	      var1units = decShiftToLeast (var1, var1units, postshift);
3277169695Skan	      accnext = var1;
3278169695Skan	      accdigits = decGetDigits (var1, var1units);
3279169695Skan	      accunits = D2U (accdigits);
3280169695Skan
3281169695Skan	      exponent = lhs->exponent;	/* exponent is smaller of lhs & rhs */
3282169695Skan	      if (rhs->exponent < exponent)
3283169695Skan		exponent = rhs->exponent;
3284169695Skan	      bits = lhs->bits;	/* remainder sign is always as lhs */
3285169695Skan
3286169695Skan	      /* Now correct the result if we are doing remainderNear; if it */
3287169695Skan	      /* (looking just at coefficients) is > rhs/2, or == rhs/2 and */
3288169695Skan	      /* the integer was odd then the result should be rem-rhs. */
3289169695Skan	      if (op & REMNEAR)
3290169695Skan		{
3291169695Skan		  Int compare, tarunits;	/* work */
3292169695Skan		  Unit *up;	/* .. */
3293169695Skan
3294169695Skan
3295169695Skan		  /* calculate remainder*2 into the var1 buffer (which has */
3296169695Skan		  /* 'headroom' of an extra unit and hence enough space) */
3297169695Skan		  /* [a dedicated 'double' loop would be faster, here] */
3298169695Skan		  tarunits =
3299169695Skan		    decUnitAddSub (accnext, accunits, accnext, accunits, 0,
3300169695Skan				   accnext, 1);
3301169695Skan		  /* decDumpAr('r', accnext, tarunits); */
3302169695Skan
3303169695Skan		  /* Here, accnext (var1) holds tarunits Units with twice the */
3304169695Skan		  /* remainder's coefficient, which we must now compare to the */
3305169695Skan		  /* RHS.  The remainder's exponent may be smaller than the RHS's. */
3306169695Skan		  compare =
3307169695Skan		    decUnitCompare (accnext, tarunits, rhs->lsu,
3308169695Skan				    D2U (rhs->digits),
3309169695Skan				    rhs->exponent - exponent);
3310169695Skan		  if (compare == BADINT)
3311169695Skan		    {		/* deep trouble */
3312169695Skan		      *status |= DEC_Insufficient_storage;
3313169695Skan		      break;
3314169695Skan		    }
3315169695Skan
3316169695Skan		  /* now restore the remainder by dividing by two; we know the */
3317169695Skan		  /* lsu is even. */
3318169695Skan		  for (up = accnext; up < accnext + tarunits; up++)
3319169695Skan		    {
3320169695Skan		      Int half;	/* half to add to lower unit */
3321169695Skan		      half = *up & 0x01;
3322169695Skan		      *up /= 2;	/* [shift] */
3323169695Skan		      if (!half)
3324169695Skan			continue;
3325169695Skan		      *(up - 1) += (DECDPUNMAX + 1) / 2;
3326169695Skan		    }
3327169695Skan		  /* [accunits still describes the original remainder length] */
3328169695Skan
3329169695Skan		  if (compare > 0 || (compare == 0 && wasodd))
3330169695Skan		    {		/* adjustment needed */
3331169695Skan		      Int exp, expunits, exprem;	/* work */
3332169695Skan		      /* This is effectively causing round-up of the quotient, */
3333169695Skan		      /* so if it was the rare case where it was full and all */
3334169695Skan		      /* nines, it would overflow and hence division-impossible */
3335169695Skan		      /* should be raised */
3336169695Skan		      Flag allnines = 0;	/* 1 if quotient all nines */
3337169695Skan		      if (quotdigits == reqdigits)
3338169695Skan			{	/* could be borderline */
3339169695Skan			  for (up = quotlsu;; up++)
3340169695Skan			    {
3341169695Skan			      if (quotdigits > DECDPUN)
3342169695Skan				{
3343169695Skan				  if (*up != DECDPUNMAX)
3344169695Skan				    break;	/* non-nines */
3345169695Skan				}
3346169695Skan			      else
3347169695Skan				{	/* this is the last Unit */
3348169695Skan				  if (*up == powers[quotdigits] - 1)
3349169695Skan				    allnines = 1;
3350169695Skan				  break;
3351169695Skan				}
3352169695Skan			      quotdigits -= DECDPUN;	/* checked those digits */
3353169695Skan			    }	/* up */
3354169695Skan			}	/* borderline check */
3355169695Skan		      if (allnines)
3356169695Skan			{
3357169695Skan			  *status |= DEC_Division_impossible;
3358169695Skan			  break;
3359169695Skan			}
3360169695Skan
3361169695Skan		      /* we need rem-rhs; the sign will invert.  Again we can */
3362169695Skan		      /* safely use var1 for the working Units array. */
3363169695Skan		      exp = rhs->exponent - exponent;	/* RHS padding needed */
3364169695Skan		      /* Calculate units and remainder from exponent. */
3365169695Skan		      expunits = exp / DECDPUN;
3366169695Skan		      exprem = exp % DECDPUN;
3367169695Skan		      /* subtract [A+B*(-m)]; the result will always be negative */
3368169695Skan		      accunits = -decUnitAddSub (accnext, accunits,
3369169695Skan						 rhs->lsu, D2U (rhs->digits),
3370169695Skan						 expunits, accnext,
3371169695Skan						 -(Int) powers[exprem]);
3372169695Skan		      accdigits = decGetDigits (accnext, accunits);	/* count digits exactly */
3373169695Skan		      accunits = D2U (accdigits);	/* and recalculate the units for copy */
3374169695Skan		      /* [exponent is as for original remainder] */
3375169695Skan		      bits ^= DECNEG;	/* flip the sign */
3376169695Skan		    }
3377169695Skan		}		/* REMNEAR */
3378169695Skan	    }			/* REMAINDER or REMNEAR */
3379169695Skan	}			/* not DIVIDE */
3380169695Skan
3381169695Skan      /* Set exponent and bits */
3382169695Skan      res->exponent = exponent;
3383169695Skan      res->bits = (uByte) (bits & DECNEG);	/* [cleaned] */
3384169695Skan
3385169695Skan      /* Now the coefficient. */
3386169695Skan      decSetCoeff (res, set, accnext, accdigits, &residue, status);
3387169695Skan
3388169695Skan      decFinish (res, set, &residue, status);	/* final cleanup */
3389169695Skan
3390169695Skan#if DECSUBSET
3391169695Skan      /* If a divide then strip trailing zeros if subset [after round] */
3392169695Skan      if (!set->extended && (op == DIVIDE))
3393169695Skan	decTrim (res, 0, &dropped);
3394169695Skan#endif
3395169695Skan    }
3396169695Skan  while (0);			/* end protected */
3397169695Skan
3398169695Skan  if (varalloc != NULL)
3399169695Skan    free (varalloc);		/* drop any storage we used */
3400169695Skan  if (allocacc != NULL)
3401169695Skan    free (allocacc);		/* .. */
3402169695Skan  if (allocrhs != NULL)
3403169695Skan    free (allocrhs);		/* .. */
3404169695Skan  if (alloclhs != NULL)
3405169695Skan    free (alloclhs);		/* .. */
3406169695Skan  return res;
3407169695Skan}
3408169695Skan
3409169695Skan/* ------------------------------------------------------------------ */
3410169695Skan/* decMultiplyOp -- multiplication operation                          */
3411169695Skan/*                                                                    */
3412169695Skan/*  This routine performs the multiplication C=A x B.                 */
3413169695Skan/*                                                                    */
3414169695Skan/*   res is C, the result.  C may be A and/or B (e.g., X=X*X)         */
3415169695Skan/*   lhs is A                                                         */
3416169695Skan/*   rhs is B                                                         */
3417169695Skan/*   set is the context                                               */
3418169695Skan/*   status is the usual accumulator                                  */
3419169695Skan/*                                                                    */
3420169695Skan/* C must have space for set->digits digits.                          */
3421169695Skan/*                                                                    */
3422169695Skan/* ------------------------------------------------------------------ */
3423169695Skan/* Note: We use 'long' multiplication rather than Karatsuba, as the   */
3424169695Skan/* latter would give only a minor improvement for the short numbers   */
3425169695Skan/* we expect to handle most (and uses much more memory).              */
3426169695Skan/*                                                                    */
3427169695Skan/* We always have to use a buffer for the accumulator.                */
3428169695Skan/* ------------------------------------------------------------------ */
3429169695Skanstatic decNumber *
3430169695SkandecMultiplyOp (decNumber * res, const decNumber * lhs,
3431169695Skan	       const decNumber * rhs, decContext * set, uInt * status)
3432169695Skan{
3433169695Skan  decNumber *alloclhs = NULL;	/* non-NULL if rounded lhs allocated */
3434169695Skan  decNumber *allocrhs = NULL;	/* .., rhs */
3435169695Skan  Unit accbuff[D2U (DECBUFFER * 2 + 1)];	/* local buffer (+1 in case DECBUFFER==0) */
3436169695Skan  Unit *acc = accbuff;		/* -> accumulator array for exact result */
3437169695Skan  Unit *allocacc = NULL;	/* -> allocated buffer, iff allocated */
3438169695Skan  const Unit *mer, *mermsup;	/* work */
3439169695Skan  Int accunits;			/* Units of accumulator in use */
3440169695Skan  Int madlength;		/* Units in multiplicand */
3441169695Skan  Int shift;			/* Units to shift multiplicand by */
3442169695Skan  Int need;			/* Accumulator units needed */
3443169695Skan  Int exponent;			/* work */
3444169695Skan  Int residue = 0;		/* rounding residue */
3445169695Skan  uByte bits;			/* result sign */
3446169695Skan  uByte merged;			/* merged flags */
3447169695Skan
3448169695Skan#if DECCHECK
3449169695Skan  if (decCheckOperands (res, lhs, rhs, set))
3450169695Skan    return res;
3451169695Skan#endif
3452169695Skan
3453169695Skan  do
3454169695Skan    {				/* protect allocated storage */
3455169695Skan#if DECSUBSET
3456169695Skan      if (!set->extended)
3457169695Skan	{
3458169695Skan	  /* reduce operands and set lostDigits status, as needed */
3459169695Skan	  if (lhs->digits > set->digits)
3460169695Skan	    {
3461169695Skan	      alloclhs = decRoundOperand (lhs, set, status);
3462169695Skan	      if (alloclhs == NULL)
3463169695Skan		break;
3464169695Skan	      lhs = alloclhs;
3465169695Skan	    }
3466169695Skan	  if (rhs->digits > set->digits)
3467169695Skan	    {
3468169695Skan	      allocrhs = decRoundOperand (rhs, set, status);
3469169695Skan	      if (allocrhs == NULL)
3470169695Skan		break;
3471169695Skan	      rhs = allocrhs;
3472169695Skan	    }
3473169695Skan	}
3474169695Skan#endif
3475169695Skan      /* [following code does not require input rounding] */
3476169695Skan
3477169695Skan      /* precalculate result sign */
3478169695Skan      bits = (uByte) ((lhs->bits ^ rhs->bits) & DECNEG);
3479169695Skan
3480169695Skan      /* handle infinities and NaNs */
3481169695Skan      merged = (lhs->bits | rhs->bits) & DECSPECIAL;
3482169695Skan      if (merged)
3483169695Skan	{			/* a special bit set */
3484169695Skan	  if (merged & (DECSNAN | DECNAN))
3485169695Skan	    {			/* one or two NaNs */
3486169695Skan	      decNaNs (res, lhs, rhs, status);
3487169695Skan	      break;
3488169695Skan	    }
3489169695Skan	  /* one or two infinities. Infinity * 0 is invalid */
3490169695Skan	  if (((lhs->bits & DECSPECIAL) == 0 && ISZERO (lhs))
3491169695Skan	      || ((rhs->bits & DECSPECIAL) == 0 && ISZERO (rhs)))
3492169695Skan	    {
3493169695Skan	      *status |= DEC_Invalid_operation;
3494169695Skan	      break;
3495169695Skan	    }
3496169695Skan	  decNumberZero (res);
3497169695Skan	  res->bits = bits | DECINF;	/* infinity */
3498169695Skan	  break;
3499169695Skan	}
3500169695Skan
3501169695Skan      /* For best speed, as in DMSRCN, we use the shorter number as the */
3502169695Skan      /* multiplier (rhs) and the longer as the multiplicand (lhs) */
3503169695Skan      if (lhs->digits < rhs->digits)
3504169695Skan	{			/* swap... */
3505169695Skan	  const decNumber *hold = lhs;
3506169695Skan	  lhs = rhs;
3507169695Skan	  rhs = hold;
3508169695Skan	}
3509169695Skan
3510169695Skan      /* if accumulator is too long for local storage, then allocate */
3511169695Skan      need = D2U (lhs->digits) + D2U (rhs->digits);	/* maximum units in result */
3512169695Skan      if (need * sizeof (Unit) > sizeof (accbuff))
3513169695Skan	{
3514169695Skan	  allocacc = (Unit *) malloc (need * sizeof (Unit));
3515169695Skan	  if (allocacc == NULL)
3516169695Skan	    {
3517169695Skan	      *status |= DEC_Insufficient_storage;
3518169695Skan	      break;
3519169695Skan	    }
3520169695Skan	  acc = allocacc;	/* use the allocated space */
3521169695Skan	}
3522169695Skan
3523169695Skan      /* Now the main long multiplication loop */
3524169695Skan      /* Unlike the equivalent in the IBM Java implementation, there */
3525169695Skan      /* is no advantage in calculating from msu to lsu.  So we do it */
3526169695Skan      /* by the book, as it were. */
3527169695Skan      /* Each iteration calculates ACC=ACC+MULTAND*MULT */
3528169695Skan      accunits = 1;		/* accumulator starts at '0' */
3529169695Skan      *acc = 0;			/* .. (lsu=0) */
3530169695Skan      shift = 0;		/* no multiplicand shift at first */
3531169695Skan      madlength = D2U (lhs->digits);	/* we know this won't change */
3532169695Skan      mermsup = rhs->lsu + D2U (rhs->digits);	/* -> msu+1 of multiplier */
3533169695Skan
3534169695Skan      for (mer = rhs->lsu; mer < mermsup; mer++)
3535169695Skan	{
3536169695Skan	  /* Here, *mer is the next Unit in the multiplier to use */
3537169695Skan	  /* If non-zero [optimization] add it... */
3538169695Skan	  if (*mer != 0)
3539169695Skan	    {
3540169695Skan	      accunits =
3541169695Skan		decUnitAddSub (&acc[shift], accunits - shift, lhs->lsu,
3542169695Skan			       madlength, 0, &acc[shift], *mer) + shift;
3543169695Skan	    }
3544169695Skan	  else
3545169695Skan	    {			/* extend acc with a 0; we'll use it shortly */
3546169695Skan	      /* [this avoids length of <=0 later] */
3547169695Skan	      *(acc + accunits) = 0;
3548169695Skan	      accunits++;
3549169695Skan	    }
3550169695Skan	  /* multiply multiplicand by 10**DECDPUN for next Unit to left */
3551169695Skan	  shift++;		/* add this for 'logical length' */
3552169695Skan	}			/* n */
3553169695Skan#if DECTRACE
3554169695Skan      /* Show exact result */
3555169695Skan      decDumpAr ('*', acc, accunits);
3556169695Skan#endif
3557169695Skan
3558169695Skan      /* acc now contains the exact result of the multiplication */
3559169695Skan      /* Build a decNumber from it, noting if any residue */
3560169695Skan      res->bits = bits;		/* set sign */
3561169695Skan      res->digits = decGetDigits (acc, accunits);	/* count digits exactly */
3562169695Skan
3563169695Skan      /* We might have a 31-bit wrap in calculating the exponent. */
3564169695Skan      /* This can only happen if both input exponents are negative and */
3565169695Skan      /* both their magnitudes are large.  If we did wrap, we set a safe */
3566169695Skan      /* very negative exponent, from which decFinalize() will raise a */
3567169695Skan      /* hard underflow. */
3568169695Skan      exponent = lhs->exponent + rhs->exponent;	/* calculate exponent */
3569169695Skan      if (lhs->exponent < 0 && rhs->exponent < 0 && exponent > 0)
3570169695Skan	exponent = -2 * DECNUMMAXE;	/* force underflow */
3571169695Skan      res->exponent = exponent;	/* OK to overwrite now */
3572169695Skan
3573169695Skan      /* Set the coefficient.  If any rounding, residue records */
3574169695Skan      decSetCoeff (res, set, acc, res->digits, &residue, status);
3575169695Skan
3576169695Skan      decFinish (res, set, &residue, status);	/* final cleanup */
3577169695Skan    }
3578169695Skan  while (0);			/* end protected */
3579169695Skan
3580169695Skan  if (allocacc != NULL)
3581169695Skan    free (allocacc);		/* drop any storage we used */
3582169695Skan  if (allocrhs != NULL)
3583169695Skan    free (allocrhs);		/* .. */
3584169695Skan  if (alloclhs != NULL)
3585169695Skan    free (alloclhs);		/* .. */
3586169695Skan  return res;
3587169695Skan}
3588169695Skan
3589169695Skan/* ------------------------------------------------------------------ */
3590169695Skan/* decQuantizeOp  -- force exponent to requested value                */
3591169695Skan/*                                                                    */
3592169695Skan/*   This computes C = op(A, B), where op adjusts the coefficient     */
3593169695Skan/*   of C (by rounding or shifting) such that the exponent (-scale)   */
3594169695Skan/*   of C has the value B or matches the exponent of B.               */
3595169695Skan/*   The numerical value of C will equal A, except for the effects of */
3596169695Skan/*   any rounding that occurred.                                      */
3597169695Skan/*                                                                    */
3598169695Skan/*   res is C, the result.  C may be A or B                           */
3599169695Skan/*   lhs is A, the number to adjust                                   */
3600169695Skan/*   rhs is B, the requested exponent                                 */
3601169695Skan/*   set is the context                                               */
3602169695Skan/*   quant is 1 for quantize or 0 for rescale                         */
3603169695Skan/*   status is the status accumulator (this can be called without     */
3604169695Skan/*          risk of control loss)                                     */
3605169695Skan/*                                                                    */
3606169695Skan/* C must have space for set->digits digits.                          */
3607169695Skan/*                                                                    */
3608169695Skan/* Unless there is an error or the result is infinite, the exponent   */
3609169695Skan/* after the operation is guaranteed to be that requested.            */
3610169695Skan/* ------------------------------------------------------------------ */
3611169695Skanstatic decNumber *
3612169695SkandecQuantizeOp (decNumber * res, const decNumber * lhs,
3613169695Skan	       const decNumber * rhs, decContext * set, Flag quant, uInt * status)
3614169695Skan{
3615169695Skan  decNumber *alloclhs = NULL;	/* non-NULL if rounded lhs allocated */
3616169695Skan  decNumber *allocrhs = NULL;	/* .., rhs */
3617169695Skan  const decNumber *inrhs = rhs;	/* save original rhs */
3618169695Skan  Int reqdigits = set->digits;	/* requested DIGITS */
3619169695Skan  Int reqexp;			/* requested exponent [-scale] */
3620169695Skan  Int residue = 0;		/* rounding residue */
3621169695Skan  uByte merged;			/* merged flags */
3622169695Skan  Int etiny = set->emin - (set->digits - 1);
3623169695Skan
3624169695Skan#if DECCHECK
3625169695Skan  if (decCheckOperands (res, lhs, rhs, set))
3626169695Skan    return res;
3627169695Skan#endif
3628169695Skan
3629169695Skan  do
3630169695Skan    {				/* protect allocated storage */
3631169695Skan#if DECSUBSET
3632169695Skan      if (!set->extended)
3633169695Skan	{
3634169695Skan	  /* reduce operands and set lostDigits status, as needed */
3635169695Skan	  if (lhs->digits > reqdigits)
3636169695Skan	    {
3637169695Skan	      alloclhs = decRoundOperand (lhs, set, status);
3638169695Skan	      if (alloclhs == NULL)
3639169695Skan		break;
3640169695Skan	      lhs = alloclhs;
3641169695Skan	    }
3642169695Skan	  if (rhs->digits > reqdigits)
3643169695Skan	    {			/* [this only checks lostDigits] */
3644169695Skan	      allocrhs = decRoundOperand (rhs, set, status);
3645169695Skan	      if (allocrhs == NULL)
3646169695Skan		break;
3647169695Skan	      rhs = allocrhs;
3648169695Skan	    }
3649169695Skan	}
3650169695Skan#endif
3651169695Skan      /* [following code does not require input rounding] */
3652169695Skan
3653169695Skan      /* Handle special values */
3654169695Skan      merged = (lhs->bits | rhs->bits) & DECSPECIAL;
3655169695Skan      if ((lhs->bits | rhs->bits) & DECSPECIAL)
3656169695Skan	{
3657169695Skan	  /* NaNs get usual processing */
3658169695Skan	  if (merged & (DECSNAN | DECNAN))
3659169695Skan	    decNaNs (res, lhs, rhs, status);
3660169695Skan	  /* one infinity but not both is bad */
3661169695Skan	  else if ((lhs->bits ^ rhs->bits) & DECINF)
3662169695Skan	    *status |= DEC_Invalid_operation;
3663169695Skan	  /* both infinity: return lhs */
3664169695Skan	  else
3665169695Skan	    decNumberCopy (res, lhs);	/* [nop if in place] */
3666169695Skan	  break;
3667169695Skan	}
3668169695Skan
3669169695Skan      /* set requested exponent */
3670169695Skan      if (quant)
3671169695Skan	reqexp = inrhs->exponent;	/* quantize -- match exponents */
3672169695Skan      else
3673169695Skan	{			/* rescale -- use value of rhs */
3674169695Skan	  /* Original rhs must be an integer that fits and is in range */
3675169695Skan#if DECSUBSET
3676169695Skan	  reqexp = decGetInt (inrhs, set);
3677169695Skan#else
3678169695Skan	  reqexp = decGetInt (inrhs);
3679169695Skan#endif
3680169695Skan	}
3681169695Skan
3682169695Skan#if DECSUBSET
3683169695Skan      if (!set->extended)
3684169695Skan	etiny = set->emin;	/* no subnormals */
3685169695Skan#endif
3686169695Skan
3687169695Skan      if (reqexp == BADINT	/* bad (rescale only) or .. */
3688169695Skan	  || (reqexp < etiny)	/* < lowest */
3689169695Skan	  || (reqexp > set->emax))
3690169695Skan	{			/* > Emax */
3691169695Skan	  *status |= DEC_Invalid_operation;
3692169695Skan	  break;
3693169695Skan	}
3694169695Skan
3695169695Skan      /* we've processed the RHS, so we can overwrite it now if necessary */
3696169695Skan      if (ISZERO (lhs))
3697169695Skan	{			/* zero coefficient unchanged */
3698169695Skan	  decNumberCopy (res, lhs);	/* [nop if in place] */
3699169695Skan	  res->exponent = reqexp;	/* .. just set exponent */
3700169695Skan#if DECSUBSET
3701169695Skan	  if (!set->extended)
3702169695Skan	    res->bits = 0;	/* subset specification; no -0 */
3703169695Skan#endif
3704169695Skan	}
3705169695Skan      else
3706169695Skan	{			/* non-zero lhs */
3707169695Skan	  Int adjust = reqexp - lhs->exponent;	/* digit adjustment needed */
3708169695Skan	  /* if adjusted coefficient will not fit, give up now */
3709169695Skan	  if ((lhs->digits - adjust) > reqdigits)
3710169695Skan	    {
3711169695Skan	      *status |= DEC_Invalid_operation;
3712169695Skan	      break;
3713169695Skan	    }
3714169695Skan
3715169695Skan	  if (adjust > 0)
3716169695Skan	    {			/* increasing exponent */
3717169695Skan	      /* this will decrease the length of the coefficient by adjust */
3718169695Skan	      /* digits, and must round as it does so */
3719169695Skan	      decContext workset;	/* work */
3720169695Skan	      workset = *set;	/* clone rounding, etc. */
3721169695Skan	      workset.digits = lhs->digits - adjust;	/* set requested length */
3722169695Skan	      /* [note that the latter can be <1, here] */
3723169695Skan	      decCopyFit (res, lhs, &workset, &residue, status);	/* fit to result */
3724169695Skan	      decApplyRound (res, &workset, residue, status);	/* .. and round */
3725169695Skan	      residue = 0;	/* [used] */
3726169695Skan	      /* If we rounded a 999s case, exponent will be off by one; */
3727169695Skan	      /* adjust back if so. */
3728169695Skan	      if (res->exponent > reqexp)
3729169695Skan		{
3730169695Skan		  res->digits = decShiftToMost (res->lsu, res->digits, 1);	/* shift */
3731169695Skan		  res->exponent--;	/* (re)adjust the exponent. */
3732169695Skan		}
3733169695Skan#if DECSUBSET
3734169695Skan	      if (ISZERO (res) && !set->extended)
3735169695Skan		res->bits = 0;	/* subset; no -0 */
3736169695Skan#endif
3737169695Skan	    }			/* increase */
3738169695Skan	  else			/* adjust<=0 */
3739169695Skan	    {			/* decreasing or = exponent */
3740169695Skan	      /* this will increase the length of the coefficient by -adjust */
3741169695Skan	      /* digits, by adding trailing zeros. */
3742169695Skan	      decNumberCopy (res, lhs);	/* [it will fit] */
3743169695Skan	      /* if padding needed (adjust<0), add it now... */
3744169695Skan	      if (adjust < 0)
3745169695Skan		{
3746169695Skan		  res->digits =
3747169695Skan		    decShiftToMost (res->lsu, res->digits, -adjust);
3748169695Skan		  res->exponent += adjust;	/* adjust the exponent */
3749169695Skan		}
3750169695Skan	    }			/* decrease */
3751169695Skan	}			/* non-zero */
3752169695Skan
3753169695Skan      /* Check for overflow [do not use Finalize in this case, as an */
3754169695Skan      /* overflow here is a "don't fit" situation] */
3755169695Skan      if (res->exponent > set->emax - res->digits + 1)
3756169695Skan	{			/* too big */
3757169695Skan	  *status |= DEC_Invalid_operation;
3758169695Skan	  break;
3759169695Skan	}
3760169695Skan      else
3761169695Skan	{
3762169695Skan	  decFinalize (res, set, &residue, status);	/* set subnormal flags */
3763169695Skan	  *status &= ~DEC_Underflow;	/* suppress Underflow [754r] */
3764169695Skan	}
3765169695Skan    }
3766169695Skan  while (0);			/* end protected */
3767169695Skan
3768169695Skan  if (allocrhs != NULL)
3769169695Skan    free (allocrhs);		/* drop any storage we used */
3770169695Skan  if (alloclhs != NULL)
3771169695Skan    free (alloclhs);		/* .. */
3772169695Skan  return res;
3773169695Skan}
3774169695Skan
3775169695Skan/* ------------------------------------------------------------------ */
3776169695Skan/* decCompareOp -- compare, min, or max two Numbers                   */
3777169695Skan/*                                                                    */
3778169695Skan/*   This computes C = A ? B and returns the signum (as a Number)     */
3779169695Skan/*   for COMPARE or the maximum or minimum (for COMPMAX and COMPMIN). */
3780169695Skan/*                                                                    */
3781169695Skan/*   res is C, the result.  C may be A and/or B (e.g., X=X?X)         */
3782169695Skan/*   lhs is A                                                         */
3783169695Skan/*   rhs is B                                                         */
3784169695Skan/*   set is the context                                               */
3785169695Skan/*   op  is the operation flag                                        */
3786169695Skan/*   status is the usual accumulator                                  */
3787169695Skan/*                                                                    */
3788169695Skan/* C must have space for one digit for COMPARE or set->digits for     */
3789169695Skan/* COMPMAX and COMPMIN.                                               */
3790169695Skan/* ------------------------------------------------------------------ */
3791169695Skan/* The emphasis here is on speed for common cases, and avoiding       */
3792169695Skan/* coefficient comparison if possible.                                */
3793169695Skan/* ------------------------------------------------------------------ */
3794169695SkandecNumber *
3795169695SkandecCompareOp (decNumber * res, const decNumber * lhs, const decNumber * rhs,
3796169695Skan	      decContext * set, Flag op, uInt * status)
3797169695Skan{
3798169695Skan  decNumber *alloclhs = NULL;	/* non-NULL if rounded lhs allocated */
3799169695Skan  decNumber *allocrhs = NULL;	/* .., rhs */
3800169695Skan  Int result = 0;		/* default result value */
3801169695Skan  uByte merged;			/* merged flags */
3802169695Skan  uByte bits = 0;		/* non-0 for NaN */
3803169695Skan
3804169695Skan#if DECCHECK
3805169695Skan  if (decCheckOperands (res, lhs, rhs, set))
3806169695Skan    return res;
3807169695Skan#endif
3808169695Skan
3809169695Skan  do
3810169695Skan    {				/* protect allocated storage */
3811169695Skan#if DECSUBSET
3812169695Skan      if (!set->extended)
3813169695Skan	{
3814169695Skan	  /* reduce operands and set lostDigits status, as needed */
3815169695Skan	  if (lhs->digits > set->digits)
3816169695Skan	    {
3817169695Skan	      alloclhs = decRoundOperand (lhs, set, status);
3818169695Skan	      if (alloclhs == NULL)
3819169695Skan		{
3820169695Skan		  result = BADINT;
3821169695Skan		  break;
3822169695Skan		}
3823169695Skan	      lhs = alloclhs;
3824169695Skan	    }
3825169695Skan	  if (rhs->digits > set->digits)
3826169695Skan	    {
3827169695Skan	      allocrhs = decRoundOperand (rhs, set, status);
3828169695Skan	      if (allocrhs == NULL)
3829169695Skan		{
3830169695Skan		  result = BADINT;
3831169695Skan		  break;
3832169695Skan		}
3833169695Skan	      rhs = allocrhs;
3834169695Skan	    }
3835169695Skan	}
3836169695Skan#endif
3837169695Skan      /* [following code does not require input rounding] */
3838169695Skan
3839169695Skan      /* handle NaNs now; let infinities drop through */
3840169695Skan      /* +++ review sNaN handling with 754r, for now assumes sNaN */
3841169695Skan      /* (even just one) leads to NaN. */
3842169695Skan      merged = (lhs->bits | rhs->bits) & (DECSNAN | DECNAN);
3843169695Skan      if (merged)
3844169695Skan	{			/* a NaN bit set */
3845169695Skan	  if (op == COMPARE);
3846169695Skan	  else if (merged & DECSNAN);
3847169695Skan	  else
3848169695Skan	    {			/* 754r rules for MIN and MAX ignore single NaN */
3849169695Skan	      /* here if MIN or MAX, and one or two quiet NaNs */
3850169695Skan	      if (lhs->bits & rhs->bits & DECNAN);
3851169695Skan	      else
3852169695Skan		{		/* just one quiet NaN */
3853169695Skan		  /* force choice to be the non-NaN operand */
3854169695Skan		  op = COMPMAX;
3855169695Skan		  if (lhs->bits & DECNAN)
3856169695Skan		    result = -1;	/* pick rhs */
3857169695Skan		  else
3858169695Skan		    result = +1;	/* pick lhs */
3859169695Skan		  break;
3860169695Skan		}
3861169695Skan	    }
3862169695Skan	  op = COMPNAN;		/* use special path */
3863169695Skan	  decNaNs (res, lhs, rhs, status);
3864169695Skan	  break;
3865169695Skan	}
3866169695Skan
3867169695Skan      result = decCompare (lhs, rhs);	/* we have numbers */
3868169695Skan    }
3869169695Skan  while (0);			/* end protected */
3870169695Skan
3871169695Skan  if (result == BADINT)
3872169695Skan    *status |= DEC_Insufficient_storage;	/* rare */
3873169695Skan  else
3874169695Skan    {
3875169695Skan      if (op == COMPARE)
3876169695Skan	{			/* return signum */
3877169695Skan	  decNumberZero (res);	/* [always a valid result] */
3878169695Skan	  if (result == 0)
3879169695Skan	    res->bits = bits;	/* (maybe qNaN) */
3880169695Skan	  else
3881169695Skan	    {
3882169695Skan	      *res->lsu = 1;
3883169695Skan	      if (result < 0)
3884169695Skan		res->bits = DECNEG;
3885169695Skan	    }
3886169695Skan	}
3887169695Skan      else if (op == COMPNAN);	/* special, drop through */
3888169695Skan      else
3889169695Skan	{			/* MAX or MIN, non-NaN result */
3890169695Skan	  Int residue = 0;	/* rounding accumulator */
3891169695Skan	  /* choose the operand for the result */
3892169695Skan	  const decNumber *choice;
3893169695Skan	  if (result == 0)
3894169695Skan	    {			/* operands are numerically equal */
3895169695Skan	      /* choose according to sign then exponent (see 754r) */
3896169695Skan	      uByte slhs = (lhs->bits & DECNEG);
3897169695Skan	      uByte srhs = (rhs->bits & DECNEG);
3898169695Skan#if DECSUBSET
3899169695Skan	      if (!set->extended)
3900169695Skan		{		/* subset: force left-hand */
3901169695Skan		  op = COMPMAX;
3902169695Skan		  result = +1;
3903169695Skan		}
3904169695Skan	      else
3905169695Skan#endif
3906169695Skan	      if (slhs != srhs)
3907169695Skan		{		/* signs differ */
3908169695Skan		  if (slhs)
3909169695Skan		    result = -1;	/* rhs is max */
3910169695Skan		  else
3911169695Skan		    result = +1;	/* lhs is max */
3912169695Skan		}
3913169695Skan	      else if (slhs && srhs)
3914169695Skan		{		/* both negative */
3915169695Skan		  if (lhs->exponent < rhs->exponent)
3916169695Skan		    result = +1;
3917169695Skan		  else
3918169695Skan		    result = -1;
3919169695Skan		  /* [if equal, we use lhs, technically identical] */
3920169695Skan		}
3921169695Skan	      else
3922169695Skan		{		/* both positive */
3923169695Skan		  if (lhs->exponent > rhs->exponent)
3924169695Skan		    result = +1;
3925169695Skan		  else
3926169695Skan		    result = -1;
3927169695Skan		  /* [ditto] */
3928169695Skan		}
3929169695Skan	    }			/* numerically equal */
3930169695Skan	  /* here result will be non-0 */
3931169695Skan	  if (op == COMPMIN)
3932169695Skan	    result = -result;	/* reverse if looking for MIN */
3933169695Skan	  choice = (result > 0 ? lhs : rhs);	/* choose */
3934169695Skan	  /* copy chosen to result, rounding if need be */
3935169695Skan	  decCopyFit (res, choice, set, &residue, status);
3936169695Skan	  decFinish (res, set, &residue, status);
3937169695Skan	}
3938169695Skan    }
3939169695Skan  if (allocrhs != NULL)
3940169695Skan    free (allocrhs);		/* free any storage we used */
3941169695Skan  if (alloclhs != NULL)
3942169695Skan    free (alloclhs);		/* .. */
3943169695Skan  return res;
3944169695Skan}
3945169695Skan
3946169695Skan/* ------------------------------------------------------------------ */
3947169695Skan/* decCompare -- compare two decNumbers by numerical value            */
3948169695Skan/*                                                                    */
3949169695Skan/*  This routine compares A ? B without altering them.                */
3950169695Skan/*                                                                    */
3951169695Skan/*  Arg1 is A, a decNumber which is not a NaN                         */
3952169695Skan/*  Arg2 is B, a decNumber which is not a NaN                         */
3953169695Skan/*                                                                    */
3954169695Skan/*  returns -1, 0, or 1 for A<B, A==B, or A>B, or BADINT if failure   */
3955169695Skan/*  (the only possible failure is an allocation error)                */
3956169695Skan/* ------------------------------------------------------------------ */
3957169695Skan/* This could be merged into decCompareOp */
3958169695Skanstatic Int
3959169695SkandecCompare (const decNumber * lhs, const decNumber * rhs)
3960169695Skan{
3961169695Skan  Int result;			/* result value */
3962169695Skan  Int sigr;			/* rhs signum */
3963169695Skan  Int compare;			/* work */
3964169695Skan  result = 1;			/* assume signum(lhs) */
3965169695Skan  if (ISZERO (lhs))
3966169695Skan    result = 0;
3967169695Skan  else if (decNumberIsNegative (lhs))
3968169695Skan    result = -1;
3969169695Skan  sigr = 1;			/* compute signum(rhs) */
3970169695Skan  if (ISZERO (rhs))
3971169695Skan    sigr = 0;
3972169695Skan  else if (decNumberIsNegative (rhs))
3973169695Skan    sigr = -1;
3974169695Skan  if (result > sigr)
3975169695Skan    return +1;			/* L > R, return 1 */
3976169695Skan  if (result < sigr)
3977169695Skan    return -1;			/* R < L, return -1 */
3978169695Skan
3979169695Skan  /* signums are the same */
3980169695Skan  if (result == 0)
3981169695Skan    return 0;			/* both 0 */
3982169695Skan  /* Both non-zero */
3983169695Skan  if ((lhs->bits | rhs->bits) & DECINF)
3984169695Skan    {				/* one or more infinities */
3985169695Skan      if (lhs->bits == rhs->bits)
3986169695Skan	result = 0;		/* both the same */
3987169695Skan      else if (decNumberIsInfinite (rhs))
3988169695Skan	result = -result;
3989169695Skan      return result;
3990169695Skan    }
3991169695Skan
3992169695Skan  /* we must compare the coefficients, allowing for exponents */
3993169695Skan  if (lhs->exponent > rhs->exponent)
3994169695Skan    {				/* LHS exponent larger */
3995169695Skan      /* swap sides, and sign */
3996169695Skan      const decNumber *temp = lhs;
3997169695Skan      lhs = rhs;
3998169695Skan      rhs = temp;
3999169695Skan      result = -result;
4000169695Skan    }
4001169695Skan
4002169695Skan  compare = decUnitCompare (lhs->lsu, D2U (lhs->digits),
4003169695Skan			    rhs->lsu, D2U (rhs->digits),
4004169695Skan			    rhs->exponent - lhs->exponent);
4005169695Skan
4006169695Skan  if (compare != BADINT)
4007169695Skan    compare *= result;		/* comparison succeeded */
4008169695Skan  return compare;		/* what we got */
4009169695Skan}
4010169695Skan
4011169695Skan/* ------------------------------------------------------------------ */
4012169695Skan/* decUnitCompare -- compare two >=0 integers in Unit arrays          */
4013169695Skan/*                                                                    */
4014169695Skan/*  This routine compares A ? B*10**E where A and B are unit arrays   */
4015169695Skan/*  A is a plain integer                                              */
4016169695Skan/*  B has an exponent of E (which must be non-negative)               */
4017169695Skan/*                                                                    */
4018169695Skan/*  Arg1 is A first Unit (lsu)                                        */
4019169695Skan/*  Arg2 is A length in Units                                         */
4020169695Skan/*  Arg3 is B first Unit (lsu)                                        */
4021169695Skan/*  Arg4 is B length in Units                                         */
4022169695Skan/*  Arg5 is E                                                         */
4023169695Skan/*                                                                    */
4024169695Skan/*  returns -1, 0, or 1 for A<B, A==B, or A>B, or BADINT if failure   */
4025169695Skan/*  (the only possible failure is an allocation error)                */
4026169695Skan/* ------------------------------------------------------------------ */
4027169695Skanstatic Int
4028169695SkandecUnitCompare (const Unit * a, Int alength, const Unit * b, Int blength, Int exp)
4029169695Skan{
4030169695Skan  Unit *acc;			/* accumulator for result */
4031169695Skan  Unit accbuff[D2U (DECBUFFER + 1)];	/* local buffer */
4032169695Skan  Unit *allocacc = NULL;	/* -> allocated acc buffer, iff allocated */
4033169695Skan  Int accunits, need;		/* units in use or needed for acc */
4034169695Skan  const Unit *l, *r, *u;	/* work */
4035169695Skan  Int expunits, exprem, result;	/* .. */
4036169695Skan
4037169695Skan  if (exp == 0)
4038169695Skan    {				/* aligned; fastpath */
4039169695Skan      if (alength > blength)
4040169695Skan	return 1;
4041169695Skan      if (alength < blength)
4042169695Skan	return -1;
4043169695Skan      /* same number of units in both -- need unit-by-unit compare */
4044169695Skan      l = a + alength - 1;
4045169695Skan      r = b + alength - 1;
4046169695Skan      for (; l >= a; l--, r--)
4047169695Skan	{
4048169695Skan	  if (*l > *r)
4049169695Skan	    return 1;
4050169695Skan	  if (*l < *r)
4051169695Skan	    return -1;
4052169695Skan	}
4053169695Skan      return 0;			/* all units match */
4054169695Skan    }				/* aligned */
4055169695Skan
4056169695Skan  /* Unaligned.  If one is >1 unit longer than the other, padded */
4057169695Skan  /* approximately, then we can return easily */
4058169695Skan  if (alength > blength + (Int) D2U (exp))
4059169695Skan    return 1;
4060169695Skan  if (alength + 1 < blength + (Int) D2U (exp))
4061169695Skan    return -1;
4062169695Skan
4063169695Skan  /* We need to do a real subtract.  For this, we need a result buffer */
4064169695Skan  /* even though we only are interested in the sign.  Its length needs */
4065169695Skan  /* to be the larger of alength and padded blength, +2 */
4066169695Skan  need = blength + D2U (exp);	/* maximum real length of B */
4067169695Skan  if (need < alength)
4068169695Skan    need = alength;
4069169695Skan  need += 2;
4070169695Skan  acc = accbuff;		/* assume use local buffer */
4071169695Skan  if (need * sizeof (Unit) > sizeof (accbuff))
4072169695Skan    {
4073169695Skan      allocacc = (Unit *) malloc (need * sizeof (Unit));
4074169695Skan      if (allocacc == NULL)
4075169695Skan	return BADINT;		/* hopeless -- abandon */
4076169695Skan      acc = allocacc;
4077169695Skan    }
4078169695Skan  /* Calculate units and remainder from exponent. */
4079169695Skan  expunits = exp / DECDPUN;
4080169695Skan  exprem = exp % DECDPUN;
4081169695Skan  /* subtract [A+B*(-m)] */
4082169695Skan  accunits = decUnitAddSub (a, alength, b, blength, expunits, acc,
4083169695Skan			    -(Int) powers[exprem]);
4084169695Skan  /* [UnitAddSub result may have leading zeros, even on zero] */
4085169695Skan  if (accunits < 0)
4086169695Skan    result = -1;		/* negative result */
4087169695Skan  else
4088169695Skan    {				/* non-negative result */
4089169695Skan      /* check units of the result before freeing any storage */
4090169695Skan      for (u = acc; u < acc + accunits - 1 && *u == 0;)
4091169695Skan	u++;
4092169695Skan      result = (*u == 0 ? 0 : +1);
4093169695Skan    }
4094169695Skan  /* clean up and return the result */
4095169695Skan  if (allocacc != NULL)
4096169695Skan    free (allocacc);		/* drop any storage we used */
4097169695Skan  return result;
4098169695Skan}
4099169695Skan
4100169695Skan/* ------------------------------------------------------------------ */
4101169695Skan/* decUnitAddSub -- add or subtract two >=0 integers in Unit arrays   */
4102169695Skan/*                                                                    */
4103169695Skan/*  This routine performs the calculation:                            */
4104169695Skan/*                                                                    */
4105169695Skan/*  C=A+(B*M)                                                         */
4106169695Skan/*                                                                    */
4107169695Skan/*  Where M is in the range -DECDPUNMAX through +DECDPUNMAX.          */
4108169695Skan/*                                                                    */
4109169695Skan/*  A may be shorter or longer than B.                                */
4110169695Skan/*                                                                    */
4111169695Skan/*  Leading zeros are not removed after a calculation.  The result is */
4112169695Skan/*  either the same length as the longer of A and B (adding any       */
4113169695Skan/*  shift), or one Unit longer than that (if a Unit carry occurred).  */
4114169695Skan/*                                                                    */
4115169695Skan/*  A and B content are not altered unless C is also A or B.          */
4116169695Skan/*  C may be the same array as A or B, but only if no zero padding is */
4117169695Skan/*  requested (that is, C may be B only if bshift==0).                */
4118169695Skan/*  C is filled from the lsu; only those units necessary to complete  */
4119169695Skan/*  the calculation are referenced.                                   */
4120169695Skan/*                                                                    */
4121169695Skan/*  Arg1 is A first Unit (lsu)                                        */
4122169695Skan/*  Arg2 is A length in Units                                         */
4123169695Skan/*  Arg3 is B first Unit (lsu)                                        */
4124169695Skan/*  Arg4 is B length in Units                                         */
4125169695Skan/*  Arg5 is B shift in Units  (>=0; pads with 0 units if positive)    */
4126169695Skan/*  Arg6 is C first Unit (lsu)                                        */
4127169695Skan/*  Arg7 is M, the multiplier                                         */
4128169695Skan/*                                                                    */
4129169695Skan/*  returns the count of Units written to C, which will be non-zero   */
4130169695Skan/*  and negated if the result is negative.  That is, the sign of the  */
4131169695Skan/*  returned Int is the sign of the result (positive for zero) and    */
4132169695Skan/*  the absolute value of the Int is the count of Units.              */
4133169695Skan/*                                                                    */
4134169695Skan/*  It is the caller's responsibility to make sure that C size is     */
4135169695Skan/*  safe, allowing space if necessary for a one-Unit carry.           */
4136169695Skan/*                                                                    */
4137169695Skan/*  This routine is severely performance-critical; *any* change here  */
4138169695Skan/*  must be measured (timed) to assure no performance degradation.    */
4139169695Skan/*  In particular, trickery here tends to be counter-productive, as   */
4140169695Skan/*  increased complexity of code hurts register optimizations on      */
4141169695Skan/*  register-poor architectures.  Avoiding divisions is nearly        */
4142169695Skan/*  always a Good Idea, however.                                      */
4143169695Skan/*                                                                    */
4144169695Skan/* Special thanks to Rick McGuire (IBM Cambridge, MA) and Dave Clark  */
4145169695Skan/* (IBM Warwick, UK) for some of the ideas used in this routine.      */
4146169695Skan/* ------------------------------------------------------------------ */
4147169695Skanstatic Int
4148169695SkandecUnitAddSub (const Unit * a, Int alength,
4149169695Skan	       const Unit * b, Int blength, Int bshift, Unit * c, Int m)
4150169695Skan{
4151169695Skan  const Unit *alsu = a;		/* A lsu [need to remember it] */
4152169695Skan  Unit *clsu = c;		/* C ditto */
4153169695Skan  Unit *minC;			/* low water mark for C */
4154169695Skan  Unit *maxC;			/* high water mark for C */
4155169695Skan  eInt carry = 0;		/* carry integer (could be Long) */
4156169695Skan  Int add;			/* work */
4157169695Skan#if DECDPUN==4			/* myriadal */
4158169695Skan  Int est;			/* estimated quotient */
4159169695Skan#endif
4160169695Skan
4161169695Skan#if DECTRACE
4162169695Skan  if (alength < 1 || blength < 1)
4163169695Skan    printf ("decUnitAddSub: alen blen m %d %d [%d]\n", alength, blength, m);
4164169695Skan#endif
4165169695Skan
4166169695Skan  maxC = c + alength;		/* A is usually the longer */
4167169695Skan  minC = c + blength;		/* .. and B the shorter */
4168169695Skan  if (bshift != 0)
4169169695Skan    {				/* B is shifted; low As copy across */
4170169695Skan      minC += bshift;
4171169695Skan      /* if in place [common], skip copy unless there's a gap [rare] */
4172169695Skan      if (a == c && bshift <= alength)
4173169695Skan	{
4174169695Skan	  c += bshift;
4175169695Skan	  a += bshift;
4176169695Skan	}
4177169695Skan      else
4178169695Skan	for (; c < clsu + bshift; a++, c++)
4179169695Skan	  {			/* copy needed */
4180169695Skan	    if (a < alsu + alength)
4181169695Skan	      *c = *a;
4182169695Skan	    else
4183169695Skan	      *c = 0;
4184169695Skan	  }
4185169695Skan    }
4186169695Skan  if (minC > maxC)
4187169695Skan    {				/* swap */
4188169695Skan      Unit *hold = minC;
4189169695Skan      minC = maxC;
4190169695Skan      maxC = hold;
4191169695Skan    }
4192169695Skan
4193169695Skan  /* For speed, we do the addition as two loops; the first where both A */
4194169695Skan  /* and B contribute, and the second (if necessary) where only one or */
4195169695Skan  /* other of the numbers contribute. */
4196169695Skan  /* Carry handling is the same (i.e., duplicated) in each case. */
4197169695Skan  for (; c < minC; c++)
4198169695Skan    {
4199169695Skan      carry += *a;
4200169695Skan      a++;
4201169695Skan      carry += ((eInt) * b) * m;	/* [special-casing m=1/-1 */
4202169695Skan      b++;			/* here is not a win] */
4203169695Skan      /* here carry is new Unit of digits; it could be +ve or -ve */
4204169695Skan      if ((ueInt) carry <= DECDPUNMAX)
4205169695Skan	{			/* fastpath 0-DECDPUNMAX */
4206169695Skan	  *c = (Unit) carry;
4207169695Skan	  carry = 0;
4208169695Skan	  continue;
4209169695Skan	}
4210169695Skan      /* remainder operator is undefined if negative, so we must test */
4211169695Skan#if DECDPUN==4			/* use divide-by-multiply */
4212169695Skan      if (carry >= 0)
4213169695Skan	{
4214169695Skan	  est = (((ueInt) carry >> 11) * 53687) >> 18;
4215169695Skan	  *c = (Unit) (carry - est * (DECDPUNMAX + 1));	/* remainder */
4216169695Skan	  carry = est;		/* likely quotient [89%] */
4217169695Skan	  if (*c < DECDPUNMAX + 1)
4218169695Skan	    continue;		/* estimate was correct */
4219169695Skan	  carry++;
4220169695Skan	  *c -= DECDPUNMAX + 1;
4221169695Skan	  continue;
4222169695Skan	}
4223169695Skan      /* negative case */
4224169695Skan      carry = carry + (eInt) (DECDPUNMAX + 1) * (DECDPUNMAX + 1);	/* make positive */
4225169695Skan      est = (((ueInt) carry >> 11) * 53687) >> 18;
4226169695Skan      *c = (Unit) (carry - est * (DECDPUNMAX + 1));
4227169695Skan      carry = est - (DECDPUNMAX + 1);	/* correctly negative */
4228169695Skan      if (*c < DECDPUNMAX + 1)
4229169695Skan	continue;		/* was OK */
4230169695Skan      carry++;
4231169695Skan      *c -= DECDPUNMAX + 1;
4232169695Skan#else
4233169695Skan      if ((ueInt) carry < (DECDPUNMAX + 1) * 2)
4234169695Skan	{			/* fastpath carry +1 */
4235169695Skan	  *c = (Unit) (carry - (DECDPUNMAX + 1));	/* [helps additions] */
4236169695Skan	  carry = 1;
4237169695Skan	  continue;
4238169695Skan	}
4239169695Skan      if (carry >= 0)
4240169695Skan	{
4241169695Skan	  *c = (Unit) (carry % (DECDPUNMAX + 1));
4242169695Skan	  carry = carry / (DECDPUNMAX + 1);
4243169695Skan	  continue;
4244169695Skan	}
4245169695Skan      /* negative case */
4246169695Skan      carry = carry + (eInt) (DECDPUNMAX + 1) * (DECDPUNMAX + 1);	/* make positive */
4247169695Skan      *c = (Unit) (carry % (DECDPUNMAX + 1));
4248169695Skan      carry = carry / (DECDPUNMAX + 1) - (DECDPUNMAX + 1);
4249169695Skan#endif
4250169695Skan    }				/* c */
4251169695Skan
4252169695Skan  /* we now may have one or other to complete */
4253169695Skan  /* [pretest to avoid loop setup/shutdown] */
4254169695Skan  if (c < maxC)
4255169695Skan    for (; c < maxC; c++)
4256169695Skan      {
4257169695Skan	if (a < alsu + alength)
4258169695Skan	  {			/* still in A */
4259169695Skan	    carry += *a;
4260169695Skan	    a++;
4261169695Skan	  }
4262169695Skan	else
4263169695Skan	  {			/* inside B */
4264169695Skan	    carry += ((eInt) * b) * m;
4265169695Skan	    b++;
4266169695Skan	  }
4267169695Skan	/* here carry is new Unit of digits; it could be +ve or -ve and */
4268169695Skan	/* magnitude up to DECDPUNMAX squared */
4269169695Skan	if ((ueInt) carry <= DECDPUNMAX)
4270169695Skan	  {			/* fastpath 0-DECDPUNMAX */
4271169695Skan	    *c = (Unit) carry;
4272169695Skan	    carry = 0;
4273169695Skan	    continue;
4274169695Skan	  }
4275169695Skan	/* result for this unit is negative or >DECDPUNMAX */
4276169695Skan#if DECDPUN==4			/* use divide-by-multiply */
4277169695Skan	/* remainder is undefined if negative, so we must test */
4278169695Skan	if (carry >= 0)
4279169695Skan	  {
4280169695Skan	    est = (((ueInt) carry >> 11) * 53687) >> 18;
4281169695Skan	    *c = (Unit) (carry - est * (DECDPUNMAX + 1));	/* remainder */
4282169695Skan	    carry = est;	/* likely quotient [79.7%] */
4283169695Skan	    if (*c < DECDPUNMAX + 1)
4284169695Skan	      continue;		/* estimate was correct */
4285169695Skan	    carry++;
4286169695Skan	    *c -= DECDPUNMAX + 1;
4287169695Skan	    continue;
4288169695Skan	  }
4289169695Skan	/* negative case */
4290169695Skan	carry = carry + (eInt) (DECDPUNMAX + 1) * (DECDPUNMAX + 1);	/* make positive */
4291169695Skan	est = (((ueInt) carry >> 11) * 53687) >> 18;
4292169695Skan	*c = (Unit) (carry - est * (DECDPUNMAX + 1));
4293169695Skan	carry = est - (DECDPUNMAX + 1);	/* correctly negative */
4294169695Skan	if (*c < DECDPUNMAX + 1)
4295169695Skan	  continue;		/* was OK */
4296169695Skan	carry++;
4297169695Skan	*c -= DECDPUNMAX + 1;
4298169695Skan#else
4299169695Skan	if ((ueInt) carry < (DECDPUNMAX + 1) * 2)
4300169695Skan	  {			/* fastpath carry 1 */
4301169695Skan	    *c = (Unit) (carry - (DECDPUNMAX + 1));
4302169695Skan	    carry = 1;
4303169695Skan	    continue;
4304169695Skan	  }
4305169695Skan	/* remainder is undefined if negative, so we must test */
4306169695Skan	if (carry >= 0)
4307169695Skan	  {
4308169695Skan	    *c = (Unit) (carry % (DECDPUNMAX + 1));
4309169695Skan	    carry = carry / (DECDPUNMAX + 1);
4310169695Skan	    continue;
4311169695Skan	  }
4312169695Skan	/* negative case */
4313169695Skan	carry = carry + (eInt) (DECDPUNMAX + 1) * (DECDPUNMAX + 1);	/* make positive */
4314169695Skan	*c = (Unit) (carry % (DECDPUNMAX + 1));
4315169695Skan	carry = carry / (DECDPUNMAX + 1) - (DECDPUNMAX + 1);
4316169695Skan#endif
4317169695Skan      }				/* c */
4318169695Skan
4319169695Skan  /* OK, all A and B processed; might still have carry or borrow */
4320169695Skan  /* return number of Units in the result, negated if a borrow */
4321169695Skan  if (carry == 0)
4322169695Skan    return c - clsu;		/* no carry, we're done */
4323169695Skan  if (carry > 0)
4324169695Skan    {				/* positive carry */
4325169695Skan      *c = (Unit) carry;	/* place as new unit */
4326169695Skan      c++;			/* .. */
4327169695Skan      return c - clsu;
4328169695Skan    }
4329169695Skan  /* -ve carry: it's a borrow; complement needed */
4330169695Skan  add = 1;			/* temporary carry... */
4331169695Skan  for (c = clsu; c < maxC; c++)
4332169695Skan    {
4333169695Skan      add = DECDPUNMAX + add - *c;
4334169695Skan      if (add <= DECDPUNMAX)
4335169695Skan	{
4336169695Skan	  *c = (Unit) add;
4337169695Skan	  add = 0;
4338169695Skan	}
4339169695Skan      else
4340169695Skan	{
4341169695Skan	  *c = 0;
4342169695Skan	  add = 1;
4343169695Skan	}
4344169695Skan    }
4345169695Skan  /* add an extra unit iff it would be non-zero */
4346169695Skan#if DECTRACE
4347169695Skan  printf ("UAS borrow: add %d, carry %d\n", add, carry);
4348169695Skan#endif
4349169695Skan  if ((add - carry - 1) != 0)
4350169695Skan    {
4351169695Skan      *c = (Unit) (add - carry - 1);
4352169695Skan      c++;			/* interesting, include it */
4353169695Skan    }
4354169695Skan  return clsu - c;		/* -ve result indicates borrowed */
4355169695Skan}
4356169695Skan
4357169695Skan/* ------------------------------------------------------------------ */
4358169695Skan/* decTrim -- trim trailing zeros or normalize                        */
4359169695Skan/*                                                                    */
4360169695Skan/*   dn is the number to trim or normalize                            */
4361169695Skan/*   all is 1 to remove all trailing zeros, 0 for just fraction ones  */
4362169695Skan/*   dropped returns the number of discarded trailing zeros           */
4363169695Skan/*   returns dn                                                       */
4364169695Skan/*                                                                    */
4365169695Skan/* All fields are updated as required.  This is a utility operation,  */
4366169695Skan/* so special values are unchanged and no error is possible.          */
4367169695Skan/* ------------------------------------------------------------------ */
4368169695Skanstatic decNumber *
4369169695SkandecTrim (decNumber * dn, Flag all, Int * dropped)
4370169695Skan{
4371169695Skan  Int d, exp;			/* work */
4372169695Skan  uInt cut;			/* .. */
4373169695Skan  Unit *up;			/* -> current Unit */
4374169695Skan
4375169695Skan#if DECCHECK
4376169695Skan  if (decCheckOperands (dn, DECUNUSED, DECUNUSED, DECUNUSED))
4377169695Skan    return dn;
4378169695Skan#endif
4379169695Skan
4380169695Skan  *dropped = 0;			/* assume no zeros dropped */
4381169695Skan  if ((dn->bits & DECSPECIAL)	/* fast exit if special .. */
4382169695Skan      || (*dn->lsu & 0x01))
4383169695Skan    return dn;			/* .. or odd */
4384169695Skan  if (ISZERO (dn))
4385169695Skan    {				/* .. or 0 */
4386169695Skan      dn->exponent = 0;		/* (sign is preserved) */
4387169695Skan      return dn;
4388169695Skan    }
4389169695Skan
4390169695Skan  /* we have a finite number which is even */
4391169695Skan  exp = dn->exponent;
4392169695Skan  cut = 1;			/* digit (1-DECDPUN) in Unit */
4393169695Skan  up = dn->lsu;			/* -> current Unit */
4394169695Skan  for (d = 0; d < dn->digits - 1; d++)
4395169695Skan    {				/* [don't strip the final digit] */
4396169695Skan      /* slice by powers */
4397169695Skan#if DECDPUN<=4
4398169695Skan      uInt quot = QUOT10 (*up, cut);
4399169695Skan      if ((*up - quot * powers[cut]) != 0)
4400169695Skan	break;			/* found non-0 digit */
4401169695Skan#else
4402169695Skan      if (*up % powers[cut] != 0)
4403169695Skan	break;			/* found non-0 digit */
4404169695Skan#endif
4405169695Skan      /* have a trailing 0 */
4406169695Skan      if (!all)
4407169695Skan	{			/* trimming */
4408169695Skan	  /* [if exp>0 then all trailing 0s are significant for trim] */
4409169695Skan	  if (exp <= 0)
4410169695Skan	    {			/* if digit might be significant */
4411169695Skan	      if (exp == 0)
4412169695Skan		break;		/* then quit */
4413169695Skan	      exp++;		/* next digit might be significant */
4414169695Skan	    }
4415169695Skan	}
4416169695Skan      cut++;			/* next power */
4417169695Skan      if (cut > DECDPUN)
4418169695Skan	{			/* need new Unit */
4419169695Skan	  up++;
4420169695Skan	  cut = 1;
4421169695Skan	}
4422169695Skan    }				/* d */
4423169695Skan  if (d == 0)
4424169695Skan    return dn;			/* none dropped */
4425169695Skan
4426169695Skan  /* effect the drop */
4427169695Skan  decShiftToLeast (dn->lsu, D2U (dn->digits), d);
4428169695Skan  dn->exponent += d;		/* maintain numerical value */
4429169695Skan  dn->digits -= d;		/* new length */
4430169695Skan  *dropped = d;			/* report the count */
4431169695Skan  return dn;
4432169695Skan}
4433169695Skan
4434169695Skan/* ------------------------------------------------------------------ */
4435169695Skan/* decShiftToMost -- shift digits in array towards most significant   */
4436169695Skan/*                                                                    */
4437169695Skan/*   uar    is the array                                              */
4438169695Skan/*   digits is the count of digits in use in the array                */
4439169695Skan/*   shift  is the number of zeros to pad with (least significant);   */
4440169695Skan/*     it must be zero or positive                                    */
4441169695Skan/*                                                                    */
4442169695Skan/*   returns the new length of the integer in the array, in digits    */
4443169695Skan/*                                                                    */
4444169695Skan/* No overflow is permitted (that is, the uar array must be known to  */
4445169695Skan/* be large enough to hold the result, after shifting).               */
4446169695Skan/* ------------------------------------------------------------------ */
4447169695Skanstatic Int
4448169695SkandecShiftToMost (Unit * uar, Int digits, Int shift)
4449169695Skan{
4450169695Skan  Unit *target, *source, *first;	/* work */
4451169695Skan  uInt rem;			/* for division */
4452169695Skan  Int cut;			/* odd 0's to add */
4453169695Skan  uInt next;			/* work */
4454169695Skan
4455169695Skan  if (shift == 0)
4456169695Skan    return digits;		/* [fastpath] nothing to do */
4457169695Skan  if ((digits + shift) <= DECDPUN)
4458169695Skan    {				/* [fastpath] single-unit case */
4459169695Skan      *uar = (Unit) (*uar * powers[shift]);
4460169695Skan      return digits + shift;
4461169695Skan    }
4462169695Skan
4463169695Skan  cut = (DECDPUN - shift % DECDPUN) % DECDPUN;
4464169695Skan  source = uar + D2U (digits) - 1;	/* where msu comes from */
4465169695Skan  first = uar + D2U (digits + shift) - 1;	/* where msu of source will end up */
4466169695Skan  target = source + D2U (shift);	/* where upper part of first cut goes */
4467169695Skan  next = 0;
4468169695Skan
4469169695Skan  for (; source >= uar; source--, target--)
4470169695Skan    {
4471169695Skan      /* split the source Unit and accumulate remainder for next */
4472169695Skan#if DECDPUN<=4
4473169695Skan      uInt quot = QUOT10 (*source, cut);
4474169695Skan      rem = *source - quot * powers[cut];
4475169695Skan      next += quot;
4476169695Skan#else
4477169695Skan      rem = *source % powers[cut];
4478169695Skan      next += *source / powers[cut];
4479169695Skan#endif
4480169695Skan      if (target <= first)
4481169695Skan	*target = (Unit) next;	/* write to target iff valid */
4482169695Skan      next = rem * powers[DECDPUN - cut];	/* save remainder for next Unit */
4483169695Skan    }
4484169695Skan  /* propagate to one below and clear the rest */
4485169695Skan  for (; target >= uar; target--)
4486169695Skan    {
4487169695Skan      *target = (Unit) next;
4488169695Skan      next = 0;
4489169695Skan    }
4490169695Skan  return digits + shift;
4491169695Skan}
4492169695Skan
4493169695Skan/* ------------------------------------------------------------------ */
4494169695Skan/* decShiftToLeast -- shift digits in array towards least significant */
4495169695Skan/*                                                                    */
4496169695Skan/*   uar   is the array                                               */
4497169695Skan/*   units is length of the array, in units                           */
4498169695Skan/*   shift is the number of digits to remove from the lsu end; it     */
4499169695Skan/*     must be zero or positive and less than units*DECDPUN.          */
4500169695Skan/*                                                                    */
4501169695Skan/*   returns the new length of the integer in the array, in units     */
4502169695Skan/*                                                                    */
4503169695Skan/* Removed digits are discarded (lost).  Units not required to hold   */
4504169695Skan/* the final result are unchanged.                                    */
4505169695Skan/* ------------------------------------------------------------------ */
4506169695Skanstatic Int
4507169695SkandecShiftToLeast (Unit * uar, Int units, Int shift)
4508169695Skan{
4509169695Skan  Unit *target, *up;		/* work */
4510169695Skan  Int cut, count;		/* work */
4511169695Skan  Int quot, rem;		/* for division */
4512169695Skan
4513169695Skan  if (shift == 0)
4514169695Skan    return units;		/* [fastpath] nothing to do */
4515169695Skan
4516169695Skan  up = uar + shift / DECDPUN;	/* source; allow for whole Units */
4517169695Skan  cut = shift % DECDPUN;	/* odd 0's to drop */
4518169695Skan  target = uar;			/* both paths */
4519169695Skan  if (cut == 0)
4520169695Skan    {				/* whole units shift */
4521169695Skan      for (; up < uar + units; target++, up++)
4522169695Skan	*target = *up;
4523169695Skan      return target - uar;
4524169695Skan    }
4525169695Skan  /* messier */
4526169695Skan  count = units * DECDPUN - shift;	/* the maximum new length */
4527169695Skan#if DECDPUN<=4
4528169695Skan  quot = QUOT10 (*up, cut);
4529169695Skan#else
4530169695Skan  quot = *up / powers[cut];
4531169695Skan#endif
4532169695Skan  for (;; target++)
4533169695Skan    {
4534169695Skan      *target = (Unit) quot;
4535169695Skan      count -= (DECDPUN - cut);
4536169695Skan      if (count <= 0)
4537169695Skan	break;
4538169695Skan      up++;
4539169695Skan      quot = *up;
4540169695Skan#if DECDPUN<=4
4541169695Skan      quot = QUOT10 (quot, cut);
4542169695Skan      rem = *up - quot * powers[cut];
4543169695Skan#else
4544169695Skan      rem = quot % powers[cut];
4545169695Skan      quot = quot / powers[cut];
4546169695Skan#endif
4547169695Skan      *target = (Unit) (*target + rem * powers[DECDPUN - cut]);
4548169695Skan      count -= cut;
4549169695Skan      if (count <= 0)
4550169695Skan	break;
4551169695Skan    }
4552169695Skan  return target - uar + 1;
4553169695Skan}
4554169695Skan
4555169695Skan#if DECSUBSET
4556169695Skan/* ------------------------------------------------------------------ */
4557169695Skan/* decRoundOperand -- round an operand  [used for subset only]        */
4558169695Skan/*                                                                    */
4559169695Skan/*   dn is the number to round (dn->digits is > set->digits)          */
4560169695Skan/*   set is the relevant context                                      */
4561169695Skan/*   status is the status accumulator                                 */
4562169695Skan/*                                                                    */
4563169695Skan/*   returns an allocated decNumber with the rounded result.          */
4564169695Skan/*                                                                    */
4565169695Skan/* lostDigits and other status may be set by this.                    */
4566169695Skan/*                                                                    */
4567169695Skan/* Since the input is an operand, we are not permitted to modify it.  */
4568169695Skan/* We therefore return an allocated decNumber, rounded as required.   */
4569169695Skan/* It is the caller's responsibility to free the allocated storage.   */
4570169695Skan/*                                                                    */
4571169695Skan/* If no storage is available then the result cannot be used, so NULL */
4572169695Skan/* is returned.                                                       */
4573169695Skan/* ------------------------------------------------------------------ */
4574169695Skanstatic decNumber *
4575169695SkandecRoundOperand (const decNumber * dn, decContext * set, uInt * status)
4576169695Skan{
4577169695Skan  decNumber *res;		/* result structure */
4578169695Skan  uInt newstatus = 0;		/* status from round */
4579169695Skan  Int residue = 0;		/* rounding accumulator */
4580169695Skan
4581169695Skan  /* Allocate storage for the returned decNumber, big enough for the */
4582169695Skan  /* length specified by the context */
4583169695Skan  res = (decNumber *) malloc (sizeof (decNumber)
4584169695Skan			      + (D2U (set->digits) - 1) * sizeof (Unit));
4585169695Skan  if (res == NULL)
4586169695Skan    {
4587169695Skan      *status |= DEC_Insufficient_storage;
4588169695Skan      return NULL;
4589169695Skan    }
4590169695Skan  decCopyFit (res, dn, set, &residue, &newstatus);
4591169695Skan  decApplyRound (res, set, residue, &newstatus);
4592169695Skan
4593169695Skan  /* If that set Inexact then we "lost digits" */
4594169695Skan  if (newstatus & DEC_Inexact)
4595169695Skan    newstatus |= DEC_Lost_digits;
4596169695Skan  *status |= newstatus;
4597169695Skan  return res;
4598169695Skan}
4599169695Skan#endif
4600169695Skan
4601169695Skan/* ------------------------------------------------------------------ */
4602169695Skan/* decCopyFit -- copy a number, shortening the coefficient if needed  */
4603169695Skan/*                                                                    */
4604169695Skan/*   dest is the target decNumber                                     */
4605169695Skan/*   src  is the source decNumber                                     */
4606169695Skan/*   set is the context [used for length (digits) and rounding mode]  */
4607169695Skan/*   residue is the residue accumulator                               */
4608169695Skan/*   status contains the current status to be updated                 */
4609169695Skan/*                                                                    */
4610169695Skan/* (dest==src is allowed and will be a no-op if fits)                 */
4611169695Skan/* All fields are updated as required.                                */
4612169695Skan/* ------------------------------------------------------------------ */
4613169695Skanstatic void
4614169695SkandecCopyFit (decNumber * dest, const decNumber * src, decContext * set,
4615169695Skan	    Int * residue, uInt * status)
4616169695Skan{
4617169695Skan  dest->bits = src->bits;
4618169695Skan  dest->exponent = src->exponent;
4619169695Skan  decSetCoeff (dest, set, src->lsu, src->digits, residue, status);
4620169695Skan}
4621169695Skan
4622169695Skan/* ------------------------------------------------------------------ */
4623169695Skan/* decSetCoeff -- set the coefficient of a number                     */
4624169695Skan/*                                                                    */
4625169695Skan/*   dn    is the number whose coefficient array is to be set.        */
4626169695Skan/*         It must have space for set->digits digits                  */
4627169695Skan/*   set   is the context [for size]                                  */
4628169695Skan/*   lsu   -> lsu of the source coefficient [may be dn->lsu]          */
4629169695Skan/*   len   is digits in the source coefficient [may be dn->digits]    */
4630169695Skan/*   residue is the residue accumulator.  This has values as in       */
4631169695Skan/*         decApplyRound, and will be unchanged unless the            */
4632169695Skan/*         target size is less than len.  In this case, the           */
4633169695Skan/*         coefficient is truncated and the residue is updated to     */
4634169695Skan/*         reflect the previous residue and the dropped digits.       */
4635169695Skan/*   status is the status accumulator, as usual                       */
4636169695Skan/*                                                                    */
4637169695Skan/* The coefficient may already be in the number, or it can be an      */
4638169695Skan/* external intermediate array.  If it is in the number, lsu must ==  */
4639169695Skan/* dn->lsu and len must == dn->digits.                                */
4640169695Skan/*                                                                    */
4641169695Skan/* Note that the coefficient length (len) may be < set->digits, and   */
4642169695Skan/* in this case this merely copies the coefficient (or is a no-op     */
4643169695Skan/* if dn->lsu==lsu).                                                  */
4644169695Skan/*                                                                    */
4645169695Skan/* Note also that (only internally, from decNumberRescale and         */
4646169695Skan/* decSetSubnormal) the value of set->digits may be less than one,    */
4647169695Skan/* indicating a round to left.                                        */
4648169695Skan/* This routine handles that case correctly; caller ensures space.    */
4649169695Skan/*                                                                    */
4650169695Skan/* dn->digits, dn->lsu (and as required), and dn->exponent are        */
4651169695Skan/* updated as necessary.   dn->bits (sign) is unchanged.              */
4652169695Skan/*                                                                    */
4653169695Skan/* DEC_Rounded status is set if any digits are discarded.             */
4654169695Skan/* DEC_Inexact status is set if any non-zero digits are discarded, or */
4655169695Skan/*                       incoming residue was non-0 (implies rounded) */
4656169695Skan/* ------------------------------------------------------------------ */
4657169695Skan/* mapping array: maps 0-9 to canonical residues, so that we can */
4658169695Skan/* adjust by a residue in range [-1, +1] and achieve correct rounding */
4659169695Skan/*                             0  1  2  3  4  5  6  7  8  9 */
4660169695Skanstatic const uByte resmap[10] = { 0, 3, 3, 3, 3, 5, 7, 7, 7, 7 };
4661169695Skanstatic void
4662169695SkandecSetCoeff (decNumber * dn, decContext * set, const Unit * lsu,
4663169695Skan	     Int len, Int * residue, uInt * status)
4664169695Skan{
4665169695Skan  Int discard;			/* number of digits to discard */
4666169695Skan  uInt discard1;		/* first discarded digit */
4667169695Skan  uInt cut;			/* cut point in Unit */
4668169695Skan  uInt quot, rem;		/* for divisions */
4669169695Skan  Unit *target;			/* work */
4670169695Skan  const Unit *up;		/* work */
4671169695Skan  Int count;			/* .. */
4672169695Skan#if DECDPUN<=4
4673169695Skan  uInt temp;			/* .. */
4674169695Skan#endif
4675169695Skan
4676169695Skan  discard = len - set->digits;	/* digits to discard */
4677169695Skan  if (discard <= 0)
4678169695Skan    {				/* no digits are being discarded */
4679169695Skan      if (dn->lsu != lsu)
4680169695Skan	{			/* copy needed */
4681169695Skan	  /* copy the coefficient array to the result number; no shift needed */
4682169695Skan	  up = lsu;
4683169695Skan	  for (target = dn->lsu; target < dn->lsu + D2U (len); target++, up++)
4684169695Skan	    {
4685169695Skan	      *target = *up;
4686169695Skan	    }
4687169695Skan	  dn->digits = len;	/* set the new length */
4688169695Skan	}
4689169695Skan      /* dn->exponent and residue are unchanged */
4690169695Skan      if (*residue != 0)
4691169695Skan	*status |= (DEC_Inexact | DEC_Rounded);	/* record inexactitude */
4692169695Skan      return;
4693169695Skan    }
4694169695Skan
4695169695Skan  /* we have to discard some digits */
4696169695Skan  *status |= DEC_Rounded;	/* accumulate Rounded status */
4697169695Skan  if (*residue > 1)
4698169695Skan    *residue = 1;		/* previous residue now to right, so -1 to +1 */
4699169695Skan
4700169695Skan  if (discard > len)
4701169695Skan    {				/* everything, +1, is being discarded */
4702169695Skan      /* guard digit is 0 */
4703169695Skan      /* residue is all the number [NB could be all 0s] */
4704169695Skan      if (*residue <= 0)
4705169695Skan	for (up = lsu + D2U (len) - 1; up >= lsu; up--)
4706169695Skan	  {
4707169695Skan	    if (*up != 0)
4708169695Skan	      {			/* found a non-0 */
4709169695Skan		*residue = 1;
4710169695Skan		break;		/* no need to check any others */
4711169695Skan	      }
4712169695Skan	  }
4713169695Skan      if (*residue != 0)
4714169695Skan	*status |= DEC_Inexact;	/* record inexactitude */
4715169695Skan      *dn->lsu = 0;		/* coefficient will now be 0 */
4716169695Skan      dn->digits = 1;		/* .. */
4717169695Skan      dn->exponent += discard;	/* maintain numerical value */
4718169695Skan      return;
4719169695Skan    }				/* total discard */
4720169695Skan
4721169695Skan  /* partial discard [most common case] */
4722169695Skan  /* here, at least the first (most significant) discarded digit exists */
4723169695Skan
4724169695Skan  /* spin up the number, noting residue as we pass, until we get to */
4725169695Skan  /* the Unit with the first discarded digit.  When we get there, */
4726169695Skan  /* extract it and remember where we're at */
4727169695Skan  count = 0;
4728169695Skan  for (up = lsu;; up++)
4729169695Skan    {
4730169695Skan      count += DECDPUN;
4731169695Skan      if (count >= discard)
4732169695Skan	break;			/* full ones all checked */
4733169695Skan      if (*up != 0)
4734169695Skan	*residue = 1;
4735169695Skan    }				/* up */
4736169695Skan
4737169695Skan  /* here up -> Unit with discarded digit */
4738169695Skan  cut = discard - (count - DECDPUN) - 1;
4739169695Skan  if (cut == DECDPUN - 1)
4740169695Skan    {				/* discard digit is at top */
4741169695Skan#if DECDPUN<=4
4742169695Skan      discard1 = QUOT10 (*up, DECDPUN - 1);
4743169695Skan      rem = *up - discard1 * powers[DECDPUN - 1];
4744169695Skan#else
4745169695Skan      rem = *up % powers[DECDPUN - 1];
4746169695Skan      discard1 = *up / powers[DECDPUN - 1];
4747169695Skan#endif
4748169695Skan      if (rem != 0)
4749169695Skan	*residue = 1;
4750169695Skan      up++;			/* move to next */
4751169695Skan      cut = 0;			/* bottom digit of result */
4752169695Skan      quot = 0;			/* keep a certain compiler happy */
4753169695Skan    }
4754169695Skan  else
4755169695Skan    {
4756169695Skan      /* discard digit is in low digit(s), not top digit */
4757169695Skan      if (cut == 0)
4758169695Skan	quot = *up;
4759169695Skan      else			/* cut>0 */
4760169695Skan	{			/* it's not at bottom of Unit */
4761169695Skan#if DECDPUN<=4
4762169695Skan	  quot = QUOT10 (*up, cut);
4763169695Skan	  rem = *up - quot * powers[cut];
4764169695Skan#else
4765169695Skan	  rem = *up % powers[cut];
4766169695Skan	  quot = *up / powers[cut];
4767169695Skan#endif
4768169695Skan	  if (rem != 0)
4769169695Skan	    *residue = 1;
4770169695Skan	}
4771169695Skan      /* discard digit is now at bottom of quot */
4772169695Skan#if DECDPUN<=4
4773169695Skan      temp = (quot * 6554) >> 16;	/* fast /10 */
4774169695Skan      /* Vowels algorithm here not a win (9 instructions) */
4775169695Skan      discard1 = quot - X10 (temp);
4776169695Skan      quot = temp;
4777169695Skan#else
4778169695Skan      discard1 = quot % 10;
4779169695Skan      quot = quot / 10;
4780169695Skan#endif
4781169695Skan      cut++;			/* update cut */
4782169695Skan    }
4783169695Skan
4784169695Skan  /* here: up -> Unit of the array with discarded digit */
4785169695Skan  /*       cut is the division point for each Unit */
4786169695Skan  /*       quot holds the uncut high-order digits for the current */
4787169695Skan  /*            Unit, unless cut==0 in which case it's still in *up */
4788169695Skan  /* copy the coefficient array to the result number, shifting as we go */
4789169695Skan  count = set->digits;		/* digits to end up with */
4790169695Skan  if (count <= 0)
4791169695Skan    {				/* special for Rescale/Subnormal :-( */
4792169695Skan      *dn->lsu = 0;		/* .. result is 0 */
4793169695Skan      dn->digits = 1;		/* .. */
4794169695Skan    }
4795169695Skan  else
4796169695Skan    {				/* shift to least */
4797169695Skan      /* [this is similar to decShiftToLeast code, with copy] */
4798169695Skan      dn->digits = count;	/* set the new length */
4799169695Skan      if (cut == 0)
4800169695Skan	{
4801169695Skan	  /* on unit boundary, so simple shift down copy loop suffices */
4802169695Skan	  for (target = dn->lsu; target < dn->lsu + D2U (count);
4803169695Skan	       target++, up++)
4804169695Skan	    {
4805169695Skan	      *target = *up;
4806169695Skan	    }
4807169695Skan	}
4808169695Skan      else
4809169695Skan	for (target = dn->lsu;; target++)
4810169695Skan	  {
4811169695Skan	    *target = (Unit) quot;
4812169695Skan	    count -= (DECDPUN - cut);
4813169695Skan	    if (count <= 0)
4814169695Skan	      break;
4815169695Skan	    up++;
4816169695Skan	    quot = *up;
4817169695Skan#if DECDPUN<=4
4818169695Skan	    quot = QUOT10 (quot, cut);
4819169695Skan	    rem = *up - quot * powers[cut];
4820169695Skan#else
4821169695Skan	    rem = quot % powers[cut];
4822169695Skan	    quot = quot / powers[cut];
4823169695Skan#endif
4824169695Skan	    *target = (Unit) (*target + rem * powers[DECDPUN - cut]);
4825169695Skan	    count -= cut;
4826169695Skan	    if (count <= 0)
4827169695Skan	      break;
4828169695Skan	  }
4829169695Skan    }				/* shift to least needed */
4830169695Skan  dn->exponent += discard;	/* maintain numerical value */
4831169695Skan
4832169695Skan  /* here, discard1 is the guard digit, and residue is everything else */
4833169695Skan  /* [use mapping to accumulate residue safely] */
4834169695Skan  *residue += resmap[discard1];
4835169695Skan
4836169695Skan  if (*residue != 0)
4837169695Skan    *status |= DEC_Inexact;	/* record inexactitude */
4838169695Skan  return;
4839169695Skan}
4840169695Skan
4841169695Skan/* ------------------------------------------------------------------ */
4842169695Skan/* decApplyRound -- apply pending rounding to a number                */
4843169695Skan/*                                                                    */
4844169695Skan/*   dn    is the number, with space for set->digits digits           */
4845169695Skan/*   set   is the context [for size and rounding mode]                */
4846169695Skan/*   residue indicates pending rounding, being any accumulated        */
4847169695Skan/*         guard and sticky information.  It may be:                  */
4848169695Skan/*         6-9: rounding digit is >5                                  */
4849169695Skan/*         5:   rounding digit is exactly half-way                    */
4850169695Skan/*         1-4: rounding digit is <5 and >0                           */
4851169695Skan/*         0:   the coefficient is exact                              */
4852169695Skan/*        -1:   as 1, but the hidden digits are subtractive, that     */
4853169695Skan/*              is, of the opposite sign to dn.  In this case the     */
4854169695Skan/*              coefficient must be non-0.                            */
4855169695Skan/*   status is the status accumulator, as usual                       */
4856169695Skan/*                                                                    */
4857169695Skan/* This routine applies rounding while keeping the length of the      */
4858169695Skan/* coefficient constant.  The exponent and status are unchanged       */
4859169695Skan/* except if:                                                         */
4860169695Skan/*                                                                    */
4861169695Skan/*   -- the coefficient was increased and is all nines (in which      */
4862169695Skan/*      case Overflow could occur, and is handled directly here so    */
4863169695Skan/*      the caller does not need to re-test for overflow)             */
4864169695Skan/*                                                                    */
4865169695Skan/*   -- the coefficient was decreased and becomes all nines (in which */
4866169695Skan/*      case Underflow could occur, and is also handled directly).    */
4867169695Skan/*                                                                    */
4868169695Skan/* All fields in dn are updated as required.                          */
4869169695Skan/*                                                                    */
4870169695Skan/* ------------------------------------------------------------------ */
4871169695Skanstatic void
4872169695SkandecApplyRound (decNumber * dn, decContext * set, Int residue, uInt * status)
4873169695Skan{
4874169695Skan  Int bump;			/* 1 if coefficient needs to be incremented */
4875169695Skan  /* -1 if coefficient needs to be decremented */
4876169695Skan
4877169695Skan  if (residue == 0)
4878169695Skan    return;			/* nothing to apply */
4879169695Skan
4880169695Skan  bump = 0;			/* assume a smooth ride */
4881169695Skan
4882169695Skan  /* now decide whether, and how, to round, depending on mode */
4883169695Skan  switch (set->round)
4884169695Skan    {
4885169695Skan    case DEC_ROUND_DOWN:
4886169695Skan      {
4887169695Skan	/* no change, except if negative residue */
4888169695Skan	if (residue < 0)
4889169695Skan	  bump = -1;
4890169695Skan	break;
4891169695Skan      }				/* r-d */
4892169695Skan
4893169695Skan    case DEC_ROUND_HALF_DOWN:
4894169695Skan      {
4895169695Skan	if (residue > 5)
4896169695Skan	  bump = 1;
4897169695Skan	break;
4898169695Skan      }				/* r-h-d */
4899169695Skan
4900169695Skan    case DEC_ROUND_HALF_EVEN:
4901169695Skan      {
4902169695Skan	if (residue > 5)
4903169695Skan	  bump = 1;		/* >0.5 goes up */
4904169695Skan	else if (residue == 5)
4905169695Skan	  {			/* exactly 0.5000... */
4906169695Skan	    /* 0.5 goes up iff [new] lsd is odd */
4907169695Skan	    if (*dn->lsu & 0x01)
4908169695Skan	      bump = 1;
4909169695Skan	  }
4910169695Skan	break;
4911169695Skan      }				/* r-h-e */
4912169695Skan
4913169695Skan    case DEC_ROUND_HALF_UP:
4914169695Skan      {
4915169695Skan	if (residue >= 5)
4916169695Skan	  bump = 1;
4917169695Skan	break;
4918169695Skan      }				/* r-h-u */
4919169695Skan
4920169695Skan    case DEC_ROUND_UP:
4921169695Skan      {
4922169695Skan	if (residue > 0)
4923169695Skan	  bump = 1;
4924169695Skan	break;
4925169695Skan      }				/* r-u */
4926169695Skan
4927169695Skan    case DEC_ROUND_CEILING:
4928169695Skan      {
4929169695Skan	/* same as _UP for positive numbers, and as _DOWN for negatives */
4930169695Skan	/* [negative residue cannot occur on 0] */
4931169695Skan	if (decNumberIsNegative (dn))
4932169695Skan	  {
4933169695Skan	    if (residue < 0)
4934169695Skan	      bump = -1;
4935169695Skan	  }
4936169695Skan	else
4937169695Skan	  {
4938169695Skan	    if (residue > 0)
4939169695Skan	      bump = 1;
4940169695Skan	  }
4941169695Skan	break;
4942169695Skan      }				/* r-c */
4943169695Skan
4944169695Skan    case DEC_ROUND_FLOOR:
4945169695Skan      {
4946169695Skan	/* same as _UP for negative numbers, and as _DOWN for positive */
4947169695Skan	/* [negative residue cannot occur on 0] */
4948169695Skan	if (!decNumberIsNegative (dn))
4949169695Skan	  {
4950169695Skan	    if (residue < 0)
4951169695Skan	      bump = -1;
4952169695Skan	  }
4953169695Skan	else
4954169695Skan	  {
4955169695Skan	    if (residue > 0)
4956169695Skan	      bump = 1;
4957169695Skan	  }
4958169695Skan	break;
4959169695Skan      }				/* r-f */
4960169695Skan
4961169695Skan    default:
4962169695Skan      {				/* e.g., DEC_ROUND_MAX */
4963169695Skan	*status |= DEC_Invalid_context;
4964169695Skan#if DECTRACE
4965169695Skan	printf ("Unknown rounding mode: %d\n", set->round);
4966169695Skan#endif
4967169695Skan	break;
4968169695Skan      }
4969169695Skan    }				/* switch */
4970169695Skan
4971169695Skan  /* now bump the number, up or down, if need be */
4972169695Skan  if (bump == 0)
4973169695Skan    return;			/* no action required */
4974169695Skan
4975169695Skan  /* Simply use decUnitAddSub unless we are bumping up and the number */
4976169695Skan  /* is all nines.  In this special case we set to 1000... and adjust */
4977169695Skan  /* the exponent by one (as otherwise we could overflow the array) */
4978169695Skan  /* Similarly handle all-nines result if bumping down. */
4979169695Skan  if (bump > 0)
4980169695Skan    {
4981169695Skan      Unit *up;			/* work */
4982169695Skan      uInt count = dn->digits;	/* digits to be checked */
4983169695Skan      for (up = dn->lsu;; up++)
4984169695Skan	{
4985169695Skan	  if (count <= DECDPUN)
4986169695Skan	    {
4987169695Skan	      /* this is the last Unit (the msu) */
4988169695Skan	      if (*up != powers[count] - 1)
4989169695Skan		break;		/* not still 9s */
4990169695Skan	      /* here if it, too, is all nines */
4991169695Skan	      *up = (Unit) powers[count - 1];	/* here 999 -> 100 etc. */
4992169695Skan	      for (up = up - 1; up >= dn->lsu; up--)
4993169695Skan		*up = 0;	/* others all to 0 */
4994169695Skan	      dn->exponent++;	/* and bump exponent */
4995169695Skan	      /* [which, very rarely, could cause Overflow...] */
4996169695Skan	      if ((dn->exponent + dn->digits) > set->emax + 1)
4997169695Skan		{
4998169695Skan		  decSetOverflow (dn, set, status);
4999169695Skan		}
5000169695Skan	      return;		/* done */
5001169695Skan	    }
5002169695Skan	  /* a full unit to check, with more to come */
5003169695Skan	  if (*up != DECDPUNMAX)
5004169695Skan	    break;		/* not still 9s */
5005169695Skan	  count -= DECDPUN;
5006169695Skan	}			/* up */
5007169695Skan    }				/* bump>0 */
5008169695Skan  else
5009169695Skan    {				/* -1 */
5010169695Skan      /* here we are lookng for a pre-bump of 1000... (leading 1, */
5011169695Skan      /* all other digits zero) */
5012169695Skan      Unit *up, *sup;		/* work */
5013169695Skan      uInt count = dn->digits;	/* digits to be checked */
5014169695Skan      for (up = dn->lsu;; up++)
5015169695Skan	{
5016169695Skan	  if (count <= DECDPUN)
5017169695Skan	    {
5018169695Skan	      /* this is the last Unit (the msu) */
5019169695Skan	      if (*up != powers[count - 1])
5020169695Skan		break;		/* not 100.. */
5021169695Skan	      /* here if we have the 1000... case */
5022169695Skan	      sup = up;		/* save msu pointer */
5023169695Skan	      *up = (Unit) powers[count] - 1;	/* here 100 in msu -> 999 */
5024169695Skan	      /* others all to all-nines, too */
5025169695Skan	      for (up = up - 1; up >= dn->lsu; up--)
5026169695Skan		*up = (Unit) powers[DECDPUN] - 1;
5027169695Skan	      dn->exponent--;	/* and bump exponent */
5028169695Skan
5029169695Skan	      /* iff the number was at the subnormal boundary (exponent=etiny) */
5030169695Skan	      /* then the exponent is now out of range, so it will in fact get */
5031169695Skan	      /* clamped to etiny and the final 9 dropped. */
5032169695Skan	      /* printf(">> emin=%d exp=%d sdig=%d\n", set->emin, */
5033169695Skan	      /*        dn->exponent, set->digits); */
5034169695Skan	      if (dn->exponent + 1 == set->emin - set->digits + 1)
5035169695Skan		{
5036169695Skan		  if (count == 1 && dn->digits == 1)
5037169695Skan		    *sup = 0;	/* here 9 -> 0[.9] */
5038169695Skan		  else
5039169695Skan		    {
5040169695Skan		      *sup = (Unit) powers[count - 1] - 1;	/* here 999.. in msu -> 99.. */
5041169695Skan		      dn->digits--;
5042169695Skan		    }
5043169695Skan		  dn->exponent++;
5044169695Skan		  *status |=
5045169695Skan		    DEC_Underflow | DEC_Subnormal | DEC_Inexact | DEC_Rounded;
5046169695Skan		}
5047169695Skan	      return;		/* done */
5048169695Skan	    }
5049169695Skan
5050169695Skan	  /* a full unit to check, with more to come */
5051169695Skan	  if (*up != 0)
5052169695Skan	    break;		/* not still 0s */
5053169695Skan	  count -= DECDPUN;
5054169695Skan	}			/* up */
5055169695Skan
5056169695Skan    }				/* bump<0 */
5057169695Skan
5058169695Skan  /* Actual bump needed.  Do it. */
5059169695Skan  decUnitAddSub (dn->lsu, D2U (dn->digits), one, 1, 0, dn->lsu, bump);
5060169695Skan}
5061169695Skan
5062169695Skan#if DECSUBSET
5063169695Skan/* ------------------------------------------------------------------ */
5064169695Skan/* decFinish -- finish processing a number                            */
5065169695Skan/*                                                                    */
5066169695Skan/*   dn is the number                                                 */
5067169695Skan/*   set is the context                                               */
5068169695Skan/*   residue is the rounding accumulator (as in decApplyRound)        */
5069169695Skan/*   status is the accumulator                                        */
5070169695Skan/*                                                                    */
5071169695Skan/* This finishes off the current number by:                           */
5072169695Skan/*    1. If not extended:                                             */
5073169695Skan/*       a. Converting a zero result to clean '0'                     */
5074169695Skan/*       b. Reducing positive exponents to 0, if would fit in digits  */
5075169695Skan/*    2. Checking for overflow and subnormals (always)                */
5076169695Skan/* Note this is just Finalize when no subset arithmetic.              */
5077169695Skan/* All fields are updated as required.                                */
5078169695Skan/* ------------------------------------------------------------------ */
5079169695Skanstatic void
5080169695SkandecFinish (decNumber * dn, decContext * set, Int * residue, uInt * status)
5081169695Skan{
5082169695Skan  if (!set->extended)
5083169695Skan    {
5084169695Skan      if ISZERO
5085169695Skan	(dn)
5086169695Skan	{			/* value is zero */
5087169695Skan	  dn->exponent = 0;	/* clean exponent .. */
5088169695Skan	  dn->bits = 0;		/* .. and sign */
5089169695Skan	  return;		/* no error possible */
5090169695Skan	}
5091169695Skan      if (dn->exponent >= 0)
5092169695Skan	{			/* non-negative exponent */
5093169695Skan	  /* >0; reduce to integer if possible */
5094169695Skan	  if (set->digits >= (dn->exponent + dn->digits))
5095169695Skan	    {
5096169695Skan	      dn->digits = decShiftToMost (dn->lsu, dn->digits, dn->exponent);
5097169695Skan	      dn->exponent = 0;
5098169695Skan	    }
5099169695Skan	}
5100169695Skan    }				/* !extended */
5101169695Skan
5102169695Skan  decFinalize (dn, set, residue, status);
5103169695Skan}
5104169695Skan#endif
5105169695Skan
5106169695Skan/* ------------------------------------------------------------------ */
5107169695Skan/* decFinalize -- final check, clamp, and round of a number           */
5108169695Skan/*                                                                    */
5109169695Skan/*   dn is the number                                                 */
5110169695Skan/*   set is the context                                               */
5111169695Skan/*   residue is the rounding accumulator (as in decApplyRound)        */
5112169695Skan/*   status is the status accumulator                                 */
5113169695Skan/*                                                                    */
5114169695Skan/* This finishes off the current number by checking for subnormal     */
5115169695Skan/* results, applying any pending rounding, checking for overflow,     */
5116169695Skan/* and applying any clamping.                                         */
5117169695Skan/* Underflow and overflow conditions are raised as appropriate.       */
5118169695Skan/* All fields are updated as required.                                */
5119169695Skan/* ------------------------------------------------------------------ */
5120169695Skanstatic void
5121169695SkandecFinalize (decNumber * dn, decContext * set, Int * residue, uInt * status)
5122169695Skan{
5123169695Skan  Int shift;			/* shift needed if clamping */
5124169695Skan
5125169695Skan  /* We have to be careful when checking the exponent as the adjusted */
5126169695Skan  /* exponent could overflow 31 bits [because it may already be up */
5127169695Skan  /* to twice the expected]. */
5128169695Skan
5129169695Skan  /* First test for subnormal.  This must be done before any final */
5130169695Skan  /* round as the result could be rounded to Nmin or 0. */
5131169695Skan  if (dn->exponent < 0		/* negative exponent */
5132169695Skan      && (dn->exponent < set->emin - dn->digits + 1))
5133169695Skan    {
5134169695Skan      /* Go handle subnormals; this will apply round if needed. */
5135169695Skan      decSetSubnormal (dn, set, residue, status);
5136169695Skan      return;
5137169695Skan    }
5138169695Skan
5139169695Skan  /* now apply any pending round (this could raise overflow). */
5140169695Skan  if (*residue != 0)
5141169695Skan    decApplyRound (dn, set, *residue, status);
5142169695Skan
5143169695Skan  /* Check for overflow [redundant in the 'rare' case] or clamp */
5144169695Skan  if (dn->exponent <= set->emax - set->digits + 1)
5145169695Skan    return;			/* neither needed */
5146169695Skan
5147169695Skan  /* here when we might have an overflow or clamp to do */
5148169695Skan  if (dn->exponent > set->emax - dn->digits + 1)
5149169695Skan    {				/* too big */
5150169695Skan      decSetOverflow (dn, set, status);
5151169695Skan      return;
5152169695Skan    }
5153169695Skan  /* here when the result is normal but in clamp range */
5154169695Skan  if (!set->clamp)
5155169695Skan    return;
5156169695Skan
5157169695Skan  /* here when we need to apply the IEEE exponent clamp (fold-down) */
5158169695Skan  shift = dn->exponent - (set->emax - set->digits + 1);
5159169695Skan
5160169695Skan  /* shift coefficient (if non-zero) */
5161169695Skan  if (!ISZERO (dn))
5162169695Skan    {
5163169695Skan      dn->digits = decShiftToMost (dn->lsu, dn->digits, shift);
5164169695Skan    }
5165169695Skan  dn->exponent -= shift;	/* adjust the exponent to match */
5166169695Skan  *status |= DEC_Clamped;	/* and record the dirty deed */
5167169695Skan  return;
5168169695Skan}
5169169695Skan
5170169695Skan/* ------------------------------------------------------------------ */
5171169695Skan/* decSetOverflow -- set number to proper overflow value              */
5172169695Skan/*                                                                    */
5173169695Skan/*   dn is the number (used for sign [only] and result)               */
5174169695Skan/*   set is the context [used for the rounding mode]                  */
5175169695Skan/*   status contains the current status to be updated                 */
5176169695Skan/*                                                                    */
5177169695Skan/* This sets the sign of a number and sets its value to either        */
5178169695Skan/* Infinity or the maximum finite value, depending on the sign of     */
5179169695Skan/* dn and therounding mode, following IEEE 854 rules.                 */
5180169695Skan/* ------------------------------------------------------------------ */
5181169695Skanstatic void
5182169695SkandecSetOverflow (decNumber * dn, decContext * set, uInt * status)
5183169695Skan{
5184169695Skan  Flag needmax = 0;		/* result is maximum finite value */
5185169695Skan  uByte sign = dn->bits & DECNEG;	/* clean and save sign bit */
5186169695Skan
5187169695Skan  if (ISZERO (dn))
5188169695Skan    {				/* zero does not overflow magnitude */
5189169695Skan      Int emax = set->emax;	/* limit value */
5190169695Skan      if (set->clamp)
5191169695Skan	emax -= set->digits - 1;	/* lower if clamping */
5192169695Skan      if (dn->exponent > emax)
5193169695Skan	{			/* clamp required */
5194169695Skan	  dn->exponent = emax;
5195169695Skan	  *status |= DEC_Clamped;
5196169695Skan	}
5197169695Skan      return;
5198169695Skan    }
5199169695Skan
5200169695Skan  decNumberZero (dn);
5201169695Skan  switch (set->round)
5202169695Skan    {
5203169695Skan    case DEC_ROUND_DOWN:
5204169695Skan      {
5205169695Skan	needmax = 1;		/* never Infinity */
5206169695Skan	break;
5207169695Skan      }				/* r-d */
5208169695Skan    case DEC_ROUND_CEILING:
5209169695Skan      {
5210169695Skan	if (sign)
5211169695Skan	  needmax = 1;		/* Infinity if non-negative */
5212169695Skan	break;
5213169695Skan      }				/* r-c */
5214169695Skan    case DEC_ROUND_FLOOR:
5215169695Skan      {
5216169695Skan	if (!sign)
5217169695Skan	  needmax = 1;		/* Infinity if negative */
5218169695Skan	break;
5219169695Skan      }				/* r-f */
5220169695Skan    default:
5221169695Skan      break;			/* Infinity in all other cases */
5222169695Skan    }
5223169695Skan  if (needmax)
5224169695Skan    {
5225169695Skan      Unit *up;			/* work */
5226169695Skan      Int count = set->digits;	/* nines to add */
5227169695Skan      dn->digits = count;
5228169695Skan      /* fill in all nines to set maximum value */
5229169695Skan      for (up = dn->lsu;; up++)
5230169695Skan	{
5231169695Skan	  if (count > DECDPUN)
5232169695Skan	    *up = DECDPUNMAX;	/* unit full o'nines */
5233169695Skan	  else
5234169695Skan	    {			/* this is the msu */
5235169695Skan	      *up = (Unit) (powers[count] - 1);
5236169695Skan	      break;
5237169695Skan	    }
5238169695Skan	  count -= DECDPUN;	/* we filled those digits */
5239169695Skan	}			/* up */
5240169695Skan      dn->bits = sign;		/* sign */
5241169695Skan      dn->exponent = set->emax - set->digits + 1;
5242169695Skan    }
5243169695Skan  else
5244169695Skan    dn->bits = sign | DECINF;	/* Value is +/-Infinity */
5245169695Skan  *status |= DEC_Overflow | DEC_Inexact | DEC_Rounded;
5246169695Skan}
5247169695Skan
5248169695Skan/* ------------------------------------------------------------------ */
5249169695Skan/* decSetSubnormal -- process value whose exponent is <Emin           */
5250169695Skan/*                                                                    */
5251169695Skan/*   dn is the number (used as input as well as output; it may have   */
5252169695Skan/*         an allowed subnormal value, which may need to be rounded)  */
5253169695Skan/*   set is the context [used for the rounding mode]                  */
5254169695Skan/*   residue is any pending residue                                   */
5255169695Skan/*   status contains the current status to be updated                 */
5256169695Skan/*                                                                    */
5257169695Skan/* If subset mode, set result to zero and set Underflow flags.        */
5258169695Skan/*                                                                    */
5259169695Skan/* Value may be zero with a low exponent; this does not set Subnormal */
5260169695Skan/* but the exponent will be clamped to Etiny.                         */
5261169695Skan/*                                                                    */
5262169695Skan/* Otherwise ensure exponent is not out of range, and round as        */
5263169695Skan/* necessary.  Underflow is set if the result is Inexact.             */
5264169695Skan/* ------------------------------------------------------------------ */
5265169695Skanstatic void
5266169695SkandecSetSubnormal (decNumber * dn, decContext * set,
5267169695Skan		 Int * residue, uInt * status)
5268169695Skan{
5269169695Skan  decContext workset;		/* work */
5270169695Skan  Int etiny, adjust;		/* .. */
5271169695Skan
5272169695Skan#if DECSUBSET
5273169695Skan  /* simple set to zero and 'hard underflow' for subset */
5274169695Skan  if (!set->extended)
5275169695Skan    {
5276169695Skan      decNumberZero (dn);
5277169695Skan      /* always full overflow */
5278169695Skan      *status |= DEC_Underflow | DEC_Subnormal | DEC_Inexact | DEC_Rounded;
5279169695Skan      return;
5280169695Skan    }
5281169695Skan#endif
5282169695Skan
5283169695Skan  /* Full arithmetic -- allow subnormals, rounded to minimum exponent */
5284169695Skan  /* (Etiny) if needed */
5285169695Skan  etiny = set->emin - (set->digits - 1);	/* smallest allowed exponent */
5286169695Skan
5287169695Skan  if ISZERO
5288169695Skan    (dn)
5289169695Skan    {				/* value is zero */
5290169695Skan      /* residue can never be non-zero here */
5291169695Skan#if DECCHECK
5292169695Skan      if (*residue != 0)
5293169695Skan	{
5294169695Skan	  printf ("++ Subnormal 0 residue %d\n", *residue);
5295169695Skan	  *status |= DEC_Invalid_operation;
5296169695Skan	}
5297169695Skan#endif
5298169695Skan      if (dn->exponent < etiny)
5299169695Skan	{			/* clamp required */
5300169695Skan	  dn->exponent = etiny;
5301169695Skan	  *status |= DEC_Clamped;
5302169695Skan	}
5303169695Skan      return;
5304169695Skan    }
5305169695Skan
5306169695Skan  *status |= DEC_Subnormal;	/* we have a non-zero subnormal */
5307169695Skan
5308169695Skan  adjust = etiny - dn->exponent;	/* calculate digits to remove */
5309169695Skan  if (adjust <= 0)
5310169695Skan    {				/* not out of range; unrounded */
5311169695Skan      /* residue can never be non-zero here, so fast-path out */
5312169695Skan#if DECCHECK
5313169695Skan      if (*residue != 0)
5314169695Skan	{
5315169695Skan	  printf ("++ Subnormal no-adjust residue %d\n", *residue);
5316169695Skan	  *status |= DEC_Invalid_operation;
5317169695Skan	}
5318169695Skan#endif
5319169695Skan      /* it may already be inexact (from setting the coefficient) */
5320169695Skan      if (*status & DEC_Inexact)
5321169695Skan	*status |= DEC_Underflow;
5322169695Skan      return;
5323169695Skan    }
5324169695Skan
5325169695Skan  /* adjust>0.  we need to rescale the result so exponent becomes Etiny */
5326169695Skan  /* [this code is similar to that in rescale] */
5327169695Skan  workset = *set;		/* clone rounding, etc. */
5328169695Skan  workset.digits = dn->digits - adjust;	/* set requested length */
5329169695Skan  workset.emin -= adjust;	/* and adjust emin to match */
5330169695Skan  /* [note that the latter can be <1, here, similar to Rescale case] */
5331169695Skan  decSetCoeff (dn, &workset, dn->lsu, dn->digits, residue, status);
5332169695Skan  decApplyRound (dn, &workset, *residue, status);
5333169695Skan
5334169695Skan  /* Use 754R/854 default rule: Underflow is set iff Inexact */
5335169695Skan  /* [independent of whether trapped] */
5336169695Skan  if (*status & DEC_Inexact)
5337169695Skan    *status |= DEC_Underflow;
5338169695Skan
5339169695Skan  /* if we rounded up a 999s case, exponent will be off by one; adjust */
5340169695Skan  /* back if so [it will fit, because we shortened] */
5341169695Skan  if (dn->exponent > etiny)
5342169695Skan    {
5343169695Skan      dn->digits = decShiftToMost (dn->lsu, dn->digits, 1);
5344169695Skan      dn->exponent--;		/* (re)adjust the exponent. */
5345169695Skan    }
5346169695Skan}
5347169695Skan
5348169695Skan/* ------------------------------------------------------------------ */
5349169695Skan/* decGetInt -- get integer from a number                             */
5350169695Skan/*                                                                    */
5351169695Skan/*   dn is the number [which will not be altered]                     */
5352169695Skan/*   set is the context [requested digits], subset only               */
5353169695Skan/*   returns the converted integer, or BADINT if error                */
5354169695Skan/*                                                                    */
5355169695Skan/* This checks and gets a whole number from the input decNumber.      */
5356169695Skan/* The magnitude of the integer must be <2^31.                        */
5357169695Skan/* Any discarded fractional part must be 0.                           */
5358169695Skan/* If subset it must also fit in set->digits                          */
5359169695Skan/* ------------------------------------------------------------------ */
5360169695Skan#if DECSUBSET
5361169695Skanstatic Int
5362169695SkandecGetInt (const decNumber * dn, decContext * set)
5363169695Skan{
5364169695Skan#else
5365169695Skanstatic Int
5366169695SkandecGetInt (const decNumber * dn)
5367169695Skan{
5368169695Skan#endif
5369169695Skan  Int theInt;			/* result accumulator */
5370169695Skan  const Unit *up;		/* work */
5371169695Skan  Int got;			/* digits (real or not) processed */
5372169695Skan  Int ilength = dn->digits + dn->exponent;	/* integral length */
5373169695Skan
5374169695Skan  /* The number must be an integer that fits in 10 digits */
5375169695Skan  /* Assert, here, that 10 is enough for any rescale Etiny */
5376169695Skan#if DEC_MAX_EMAX > 999999999
5377169695Skan#error GetInt may need updating [for Emax]
5378169695Skan#endif
5379169695Skan#if DEC_MIN_EMIN < -999999999
5380169695Skan#error GetInt may need updating [for Emin]
5381169695Skan#endif
5382169695Skan  if (ISZERO (dn))
5383169695Skan    return 0;			/* zeros are OK, with any exponent */
5384169695Skan  if (ilength > 10)
5385169695Skan    return BADINT;		/* always too big */
5386169695Skan#if DECSUBSET
5387169695Skan  if (!set->extended && ilength > set->digits)
5388169695Skan    return BADINT;
5389169695Skan#endif
5390169695Skan
5391169695Skan  up = dn->lsu;			/* ready for lsu */
5392169695Skan  theInt = 0;			/* ready to accumulate */
5393169695Skan  if (dn->exponent >= 0)
5394169695Skan    {				/* relatively easy */
5395169695Skan      /* no fractional part [usual]; allow for positive exponent */
5396169695Skan      got = dn->exponent;
5397169695Skan    }
5398169695Skan  else
5399169695Skan    {				/* -ve exponent; some fractional part to check and discard */
5400169695Skan      Int count = -dn->exponent;	/* digits to discard */
5401169695Skan      /* spin up whole units until we get to the Unit with the unit digit */
5402169695Skan      for (; count >= DECDPUN; up++)
5403169695Skan	{
5404169695Skan	  if (*up != 0)
5405169695Skan	    return BADINT;	/* non-zero Unit to discard */
5406169695Skan	  count -= DECDPUN;
5407169695Skan	}
5408169695Skan      if (count == 0)
5409169695Skan	got = 0;		/* [a multiple of DECDPUN] */
5410169695Skan      else
5411169695Skan	{			/* [not multiple of DECDPUN] */
5412169695Skan	  Int rem;		/* work */
5413169695Skan	  /* slice off fraction digits and check for non-zero */
5414169695Skan#if DECDPUN<=4
5415169695Skan	  theInt = QUOT10 (*up, count);
5416169695Skan	  rem = *up - theInt * powers[count];
5417169695Skan#else
5418169695Skan	  rem = *up % powers[count];	/* slice off discards */
5419169695Skan	  theInt = *up / powers[count];
5420169695Skan#endif
5421169695Skan	  if (rem != 0)
5422169695Skan	    return BADINT;	/* non-zero fraction */
5423169695Skan	  /* OK, we're good */
5424169695Skan	  got = DECDPUN - count;	/* number of digits so far */
5425169695Skan	  up++;			/* ready for next */
5426169695Skan	}
5427169695Skan    }
5428169695Skan  /* collect the rest */
5429169695Skan  for (; got < ilength; up++)
5430169695Skan    {
5431169695Skan      theInt += *up * powers[got];
5432169695Skan      got += DECDPUN;
5433169695Skan    }
5434169695Skan  if ((ilength == 10)		/* check no wrap */
5435169695Skan      && (theInt / (Int) powers[got - DECDPUN] != *(up - 1)))
5436169695Skan    return BADINT;
5437169695Skan  /* [that test also disallows the BADINT result case] */
5438169695Skan
5439169695Skan  /* apply any sign and return */
5440169695Skan  if (decNumberIsNegative (dn))
5441169695Skan    theInt = -theInt;
5442169695Skan  return theInt;
5443169695Skan}
5444169695Skan
5445169695Skan/* ------------------------------------------------------------------ */
5446169695Skan/* decStrEq -- caseless comparison of strings                         */
5447169695Skan/*                                                                    */
5448169695Skan/*   str1 is one of the strings to compare                            */
5449169695Skan/*   str2 is the other                                                */
5450169695Skan/*                                                                    */
5451169695Skan/*   returns 1 if strings caseless-compare equal, 0 otherwise         */
5452169695Skan/*                                                                    */
5453169695Skan/* Note that the strings must be the same length if they are to       */
5454169695Skan/* compare equal; there is no padding.                                */
5455169695Skan/* ------------------------------------------------------------------ */
5456169695Skan/* [strcmpi is not in ANSI C] */
5457169695Skanstatic Flag
5458169695SkandecStrEq (const char *str1, const char *str2)
5459169695Skan{
5460169695Skan  for (;; str1++, str2++)
5461169695Skan    {
5462169695Skan      unsigned char u1 = (unsigned char) *str1;
5463169695Skan      unsigned char u2 = (unsigned char) *str2;
5464169695Skan      if (u1 == u2)
5465169695Skan	{
5466169695Skan	  if (u1 == '\0')
5467169695Skan	    break;
5468169695Skan	}
5469169695Skan      else
5470169695Skan	{
5471169695Skan	  if (tolower (u1) != tolower (u2))
5472169695Skan	    return 0;
5473169695Skan	}
5474169695Skan    }				/* stepping */
5475169695Skan  return 1;
5476169695Skan}
5477169695Skan
5478169695Skan/* ------------------------------------------------------------------ */
5479169695Skan/* decNaNs -- handle NaN operand or operands                          */
5480169695Skan/*                                                                    */
5481169695Skan/*   res    is the result number                                      */
5482169695Skan/*   lhs    is the first operand                                      */
5483169695Skan/*   rhs    is the second operand, or NULL if none                    */
5484169695Skan/*   status contains the current status                               */
5485169695Skan/*   returns res in case convenient                                   */
5486169695Skan/*                                                                    */
5487169695Skan/* Called when one or both operands is a NaN, and propagates the      */
5488169695Skan/* appropriate result to res.  When an sNaN is found, it is changed   */
5489169695Skan/* to a qNaN and Invalid operation is set.                            */
5490169695Skan/* ------------------------------------------------------------------ */
5491169695Skanstatic decNumber *
5492169695SkandecNaNs (decNumber * res, const decNumber * lhs, const decNumber * rhs, uInt * status)
5493169695Skan{
5494169695Skan  /* This decision tree ends up with LHS being the source pointer, */
5495169695Skan  /* and status updated if need be */
5496169695Skan  if (lhs->bits & DECSNAN)
5497169695Skan    *status |= DEC_Invalid_operation | DEC_sNaN;
5498169695Skan  else if (rhs == NULL);
5499169695Skan  else if (rhs->bits & DECSNAN)
5500169695Skan    {
5501169695Skan      lhs = rhs;
5502169695Skan      *status |= DEC_Invalid_operation | DEC_sNaN;
5503169695Skan    }
5504169695Skan  else if (lhs->bits & DECNAN);
5505169695Skan  else
5506169695Skan    lhs = rhs;
5507169695Skan
5508169695Skan  decNumberCopy (res, lhs);
5509169695Skan  res->bits &= ~DECSNAN;	/* convert any sNaN to NaN, while */
5510169695Skan  res->bits |= DECNAN;		/* .. preserving sign */
5511169695Skan  res->exponent = 0;		/* clean exponent */
5512169695Skan  /* [coefficient was copied] */
5513169695Skan  return res;
5514169695Skan}
5515169695Skan
5516169695Skan/* ------------------------------------------------------------------ */
5517169695Skan/* decStatus -- apply non-zero status                                 */
5518169695Skan/*                                                                    */
5519169695Skan/*   dn     is the number to set if error                             */
5520169695Skan/*   status contains the current status (not yet in context)          */
5521169695Skan/*   set    is the context                                            */
5522169695Skan/*                                                                    */
5523169695Skan/* If the status is an error status, the number is set to a NaN,      */
5524169695Skan/* unless the error was an overflow, divide-by-zero, or underflow,    */
5525169695Skan/* in which case the number will have already been set.               */
5526169695Skan/*                                                                    */
5527169695Skan/* The context status is then updated with the new status.  Note that */
5528169695Skan/* this may raise a signal, so control may never return from this     */
5529169695Skan/* routine (hence resources must be recovered before it is called).   */
5530169695Skan/* ------------------------------------------------------------------ */
5531169695Skanstatic void
5532169695SkandecStatus (decNumber * dn, uInt status, decContext * set)
5533169695Skan{
5534169695Skan  if (status & DEC_NaNs)
5535169695Skan    {				/* error status -> NaN */
5536169695Skan      /* if cause was an sNaN, clear and propagate [NaN is already set up] */
5537169695Skan      if (status & DEC_sNaN)
5538169695Skan	status &= ~DEC_sNaN;
5539169695Skan      else
5540169695Skan	{
5541169695Skan	  decNumberZero (dn);	/* other error: clean throughout */
5542169695Skan	  dn->bits = DECNAN;	/* and make a quiet NaN */
5543169695Skan	}
5544169695Skan    }
5545169695Skan  decContextSetStatus (set, status);
5546169695Skan  return;
5547169695Skan}
5548169695Skan
5549169695Skan/* ------------------------------------------------------------------ */
5550169695Skan/* decGetDigits -- count digits in a Units array                      */
5551169695Skan/*                                                                    */
5552169695Skan/*   uar is the Unit array holding the number [this is often an       */
5553169695Skan/*          accumulator of some sort]                                 */
5554169695Skan/*   len is the length of the array in units                          */
5555169695Skan/*                                                                    */
5556169695Skan/*   returns the number of (significant) digits in the array          */
5557169695Skan/*                                                                    */
5558169695Skan/* All leading zeros are excluded, except the last if the array has   */
5559169695Skan/* only zero Units.                                                   */
5560169695Skan/* ------------------------------------------------------------------ */
5561169695Skan/* This may be called twice during some operations. */
5562169695Skanstatic Int
5563169695SkandecGetDigits (const Unit * uar, Int len)
5564169695Skan{
5565169695Skan  const Unit *up = uar + len - 1;	/* -> msu */
5566169695Skan  Int digits = len * DECDPUN;	/* maximum possible digits */
5567169695Skan  uInt const *pow;		/* work */
5568169695Skan
5569169695Skan  for (; up >= uar; up--)
5570169695Skan    {
5571169695Skan      digits -= DECDPUN;
5572169695Skan      if (*up == 0)
5573169695Skan	{			/* unit is 0 */
5574169695Skan	  if (digits != 0)
5575169695Skan	    continue;		/* more to check */
5576169695Skan	  /* all units were 0 */
5577169695Skan	  digits++;		/* .. so bump digits to 1 */
5578169695Skan	  break;
5579169695Skan	}
5580169695Skan      /* found the first non-zero Unit */
5581169695Skan      digits++;
5582169695Skan      if (*up < 10)
5583169695Skan	break;			/* fastpath 1-9 */
5584169695Skan      digits++;
5585169695Skan      for (pow = &powers[2]; *up >= *pow; pow++)
5586169695Skan	digits++;
5587169695Skan      break;
5588169695Skan    }				/* up */
5589169695Skan
5590169695Skan  return digits;
5591169695Skan}
5592169695Skan
5593169695Skan
5594169695Skan#if DECTRACE | DECCHECK
5595169695Skan/* ------------------------------------------------------------------ */
5596169695Skan/* decNumberShow -- display a number [debug aid]                      */
5597169695Skan/*   dn is the number to show                                         */
5598169695Skan/*                                                                    */
5599169695Skan/* Shows: sign, exponent, coefficient (msu first), digits             */
5600169695Skan/*    or: sign, special-value                                         */
5601169695Skan/* ------------------------------------------------------------------ */
5602169695Skan/* this is public so other modules can use it */
5603169695Skanvoid
5604169695SkandecNumberShow (const decNumber * dn)
5605169695Skan{
5606169695Skan  const Unit *up;		/* work */
5607169695Skan  uInt u, d;			/* .. */
5608169695Skan  Int cut;			/* .. */
5609169695Skan  char isign = '+';		/* main sign */
5610169695Skan  if (dn == NULL)
5611169695Skan    {
5612169695Skan      printf ("NULL\n");
5613169695Skan      return;
5614169695Skan    }
5615169695Skan  if (decNumberIsNegative (dn))
5616169695Skan    isign = '-';
5617169695Skan  printf (" >> %c ", isign);
5618169695Skan  if (dn->bits & DECSPECIAL)
5619169695Skan    {				/* Is a special value */
5620169695Skan      if (decNumberIsInfinite (dn))
5621169695Skan	printf ("Infinity");
5622169695Skan      else
5623169695Skan	{			/* a NaN */
5624169695Skan	  if (dn->bits & DECSNAN)
5625169695Skan	    printf ("sNaN");	/* signalling NaN */
5626169695Skan	  else
5627169695Skan	    printf ("NaN");
5628169695Skan	}
5629169695Skan      /* if coefficient and exponent are 0, we're done */
5630169695Skan      if (dn->exponent == 0 && dn->digits == 1 && *dn->lsu == 0)
5631169695Skan	{
5632169695Skan	  printf ("\n");
5633169695Skan	  return;
5634169695Skan	}
5635169695Skan      /* drop through to report other information */
5636169695Skan      printf (" ");
5637169695Skan    }
5638169695Skan
5639169695Skan  /* now carefully display the coefficient */
5640169695Skan  up = dn->lsu + D2U (dn->digits) - 1;	/* msu */
5641169695Skan  printf ("%d", *up);
5642169695Skan  for (up = up - 1; up >= dn->lsu; up--)
5643169695Skan    {
5644169695Skan      u = *up;
5645169695Skan      printf (":");
5646169695Skan      for (cut = DECDPUN - 1; cut >= 0; cut--)
5647169695Skan	{
5648169695Skan	  d = u / powers[cut];
5649169695Skan	  u -= d * powers[cut];
5650169695Skan	  printf ("%d", d);
5651169695Skan	}			/* cut */
5652169695Skan    }				/* up */
5653169695Skan  if (dn->exponent != 0)
5654169695Skan    {
5655169695Skan      char esign = '+';
5656169695Skan      if (dn->exponent < 0)
5657169695Skan	esign = '-';
5658169695Skan      printf (" E%c%d", esign, abs (dn->exponent));
5659169695Skan    }
5660169695Skan  printf (" [%d]\n", dn->digits);
5661169695Skan}
5662169695Skan#endif
5663169695Skan
5664169695Skan#if DECTRACE || DECCHECK
5665169695Skan/* ------------------------------------------------------------------ */
5666169695Skan/* decDumpAr -- display a unit array [debug aid]                      */
5667169695Skan/*   name is a single-character tag name                              */
5668169695Skan/*   ar   is the array to display                                     */
5669169695Skan/*   len  is the length of the array in Units                         */
5670169695Skan/* ------------------------------------------------------------------ */
5671169695Skanstatic void
5672169695SkandecDumpAr (char name, const Unit * ar, Int len)
5673169695Skan{
5674169695Skan  Int i;
5675169695Skan#if DECDPUN==4
5676169695Skan  const char *spec = "%04d ";
5677169695Skan#else
5678169695Skan  const char *spec = "%d ";
5679169695Skan#endif
5680169695Skan  printf ("  :%c: ", name);
5681169695Skan  for (i = len - 1; i >= 0; i--)
5682169695Skan    {
5683169695Skan      if (i == len - 1)
5684169695Skan	printf ("%d ", ar[i]);
5685169695Skan      else
5686169695Skan	printf (spec, ar[i]);
5687169695Skan    }
5688169695Skan  printf ("\n");
5689169695Skan  return;
5690169695Skan}
5691169695Skan#endif
5692169695Skan
5693169695Skan#if DECCHECK
5694169695Skan/* ------------------------------------------------------------------ */
5695169695Skan/* decCheckOperands -- check operand(s) to a routine                  */
5696169695Skan/*   res is the result structure (not checked; it will be set to      */
5697169695Skan/*          quiet NaN if error found (and it is not NULL))            */
5698169695Skan/*   lhs is the first operand (may be DECUNUSED)                      */
5699169695Skan/*   rhs is the second (may be DECUNUSED)                             */
5700169695Skan/*   set is the context (may be DECUNUSED)                            */
5701169695Skan/*   returns 0 if both operands, and the context are clean, or 1      */
5702169695Skan/*     otherwise (in which case the context will show an error,       */
5703169695Skan/*     unless NULL).  Note that res is not cleaned; caller should     */
5704169695Skan/*     handle this so res=NULL case is safe.                          */
5705169695Skan/* The caller is expected to abandon immediately if 1 is returned.    */
5706169695Skan/* ------------------------------------------------------------------ */
5707169695Skanstatic Flag
5708169695SkandecCheckOperands (decNumber * res, const decNumber * lhs,
5709169695Skan		  const decNumber * rhs, decContext * set)
5710169695Skan{
5711169695Skan  Flag bad = 0;
5712169695Skan  if (set == NULL)
5713169695Skan    {				/* oops; hopeless */
5714169695Skan#if DECTRACE
5715169695Skan      printf ("Context is NULL.\n");
5716169695Skan#endif
5717169695Skan      bad = 1;
5718169695Skan      return 1;
5719169695Skan    }
5720169695Skan  else if (set != DECUNUSED
5721169695Skan	   && (set->digits < 1 || set->round < 0
5722169695Skan	       || set->round >= DEC_ROUND_MAX))
5723169695Skan    {
5724169695Skan      bad = 1;
5725169695Skan#if DECTRACE
5726169695Skan      printf ("Bad context [digits=%d round=%d].\n", set->digits, set->round);
5727169695Skan#endif
5728169695Skan    }
5729169695Skan  else
5730169695Skan    {
5731169695Skan      if (res == NULL)
5732169695Skan	{
5733169695Skan	  bad = 1;
5734169695Skan#if DECTRACE
5735169695Skan	  printf ("Bad result [is NULL].\n");
5736169695Skan#endif
5737169695Skan	}
5738169695Skan      if (!bad && lhs != DECUNUSED)
5739169695Skan	bad = (decCheckNumber (lhs, set));
5740169695Skan      if (!bad && rhs != DECUNUSED)
5741169695Skan	bad = (decCheckNumber (rhs, set));
5742169695Skan    }
5743169695Skan  if (bad)
5744169695Skan    {
5745169695Skan      if (set != DECUNUSED)
5746169695Skan	decContextSetStatus (set, DEC_Invalid_operation);
5747169695Skan      if (res != DECUNUSED && res != NULL)
5748169695Skan	{
5749169695Skan	  decNumberZero (res);
5750169695Skan	  res->bits = DECNAN;	/* qNaN */
5751169695Skan	}
5752169695Skan    }
5753169695Skan  return bad;
5754169695Skan}
5755169695Skan
5756169695Skan/* ------------------------------------------------------------------ */
5757169695Skan/* decCheckNumber -- check a number                                   */
5758169695Skan/*   dn is the number to check                                        */
5759169695Skan/*   set is the context (may be DECUNUSED)                            */
5760169695Skan/*   returns 0 if the number is clean, or 1 otherwise                 */
5761169695Skan/*                                                                    */
5762169695Skan/* The number is considered valid if it could be a result from some   */
5763169695Skan/* operation in some valid context (not necessarily the current one). */
5764169695Skan/* ------------------------------------------------------------------ */
5765169695SkanFlag
5766169695SkandecCheckNumber (const decNumber * dn, decContext * set)
5767169695Skan{
5768169695Skan  const Unit *up;		/* work */
5769169695Skan  uInt maxuint;			/* .. */
5770169695Skan  Int ae, d, digits;		/* .. */
5771169695Skan  Int emin, emax;		/* .. */
5772169695Skan
5773169695Skan  if (dn == NULL)
5774169695Skan    {				/* hopeless */
5775169695Skan#if DECTRACE
5776169695Skan      printf ("Reference to decNumber is NULL.\n");
5777169695Skan#endif
5778169695Skan      return 1;
5779169695Skan    }
5780169695Skan
5781169695Skan  /* check special values */
5782169695Skan  if (dn->bits & DECSPECIAL)
5783169695Skan    {
5784169695Skan      if (dn->exponent != 0)
5785169695Skan	{
5786169695Skan#if DECTRACE
5787169695Skan	  printf ("Exponent %d (not 0) for a special value.\n", dn->exponent);
5788169695Skan#endif
5789169695Skan	  return 1;
5790169695Skan	}
5791169695Skan
5792169695Skan      /* 2003.09.08: NaNs may now have coefficients, so next tests Inf only */
5793169695Skan      if (decNumberIsInfinite (dn))
5794169695Skan	{
5795169695Skan	  if (dn->digits != 1)
5796169695Skan	    {
5797169695Skan#if DECTRACE
5798169695Skan	      printf ("Digits %d (not 1) for an infinity.\n", dn->digits);
5799169695Skan#endif
5800169695Skan	      return 1;
5801169695Skan	    }
5802169695Skan	  if (*dn->lsu != 0)
5803169695Skan	    {
5804169695Skan#if DECTRACE
5805169695Skan	      printf ("LSU %d (not 0) for an infinity.\n", *dn->lsu);
5806169695Skan#endif
5807169695Skan	      return 1;
5808169695Skan	    }
5809169695Skan	}			/* Inf */
5810169695Skan      /* 2002.12.26: negative NaNs can now appear through proposed IEEE */
5811169695Skan      /*             concrete formats (decimal64, etc.), though they are */
5812169695Skan      /*             never visible in strings. */
5813169695Skan      return 0;
5814169695Skan
5815169695Skan      /* if ((dn->bits & DECINF) || (dn->bits & DECNEG)==0) return 0; */
5816169695Skan      /* #if DECTRACE */
5817169695Skan      /* printf("Negative NaN in number.\n"); */
5818169695Skan      /* #endif */
5819169695Skan      /* return 1; */
5820169695Skan    }
5821169695Skan
5822169695Skan  /* check the coefficient */
5823169695Skan  if (dn->digits < 1 || dn->digits > DECNUMMAXP)
5824169695Skan    {
5825169695Skan#if DECTRACE
5826169695Skan      printf ("Digits %d in number.\n", dn->digits);
5827169695Skan#endif
5828169695Skan      return 1;
5829169695Skan    }
5830169695Skan
5831169695Skan  d = dn->digits;
5832169695Skan
5833169695Skan  for (up = dn->lsu; d > 0; up++)
5834169695Skan    {
5835169695Skan      if (d > DECDPUN)
5836169695Skan	maxuint = DECDPUNMAX;
5837169695Skan      else
5838169695Skan	{			/* we are at the msu */
5839169695Skan	  maxuint = powers[d] - 1;
5840169695Skan	  if (dn->digits > 1 && *up < powers[d - 1])
5841169695Skan	    {
5842169695Skan#if DECTRACE
5843169695Skan	      printf ("Leading 0 in number.\n");
5844169695Skan	      decNumberShow (dn);
5845169695Skan#endif
5846169695Skan	      return 1;
5847169695Skan	    }
5848169695Skan	}
5849169695Skan      if (*up > maxuint)
5850169695Skan	{
5851169695Skan#if DECTRACE
5852169695Skan	  printf ("Bad Unit [%08x] in number at offset %d [maxuint %d].\n",
5853169695Skan		  *up, up - dn->lsu, maxuint);
5854169695Skan#endif
5855169695Skan	  return 1;
5856169695Skan	}
5857169695Skan      d -= DECDPUN;
5858169695Skan    }
5859169695Skan
5860169695Skan  /* check the exponent.  Note that input operands can have exponents */
5861169695Skan  /* which are out of the set->emin/set->emax and set->digits range */
5862169695Skan  /* (just as they can have more digits than set->digits). */
5863169695Skan  ae = dn->exponent + dn->digits - 1;	/* adjusted exponent */
5864169695Skan  emax = DECNUMMAXE;
5865169695Skan  emin = DECNUMMINE;
5866169695Skan  digits = DECNUMMAXP;
5867169695Skan  if (ae < emin - (digits - 1))
5868169695Skan    {
5869169695Skan#if DECTRACE
5870169695Skan      printf ("Adjusted exponent underflow [%d].\n", ae);
5871169695Skan      decNumberShow (dn);
5872169695Skan#endif
5873169695Skan      return 1;
5874169695Skan    }
5875169695Skan  if (ae > +emax)
5876169695Skan    {
5877169695Skan#if DECTRACE
5878169695Skan      printf ("Adjusted exponent overflow [%d].\n", ae);
5879169695Skan      decNumberShow (dn);
5880169695Skan#endif
5881169695Skan      return 1;
5882169695Skan    }
5883169695Skan
5884169695Skan  return 0;			/* it's OK */
5885169695Skan}
5886169695Skan#endif
5887169695Skan
5888169695Skan#if DECALLOC
5889169695Skan#undef malloc
5890169695Skan#undef free
5891169695Skan/* ------------------------------------------------------------------ */
5892169695Skan/* decMalloc -- accountable allocation routine                        */
5893169695Skan/*   n is the number of bytes to allocate                             */
5894169695Skan/*                                                                    */
5895169695Skan/* Semantics is the same as the stdlib malloc routine, but bytes      */
5896169695Skan/* allocated are accounted for globally, and corruption fences are    */
5897169695Skan/* added before and after the 'actual' storage.                       */
5898169695Skan/* ------------------------------------------------------------------ */
5899169695Skan/* This routine allocates storage with an extra twelve bytes; 8 are   */
5900169695Skan/* at the start and hold:                                             */
5901169695Skan/*   0-3 the original length requested                                */
5902169695Skan/*   4-7 buffer corruption detection fence (DECFENCE, x4)             */
5903169695Skan/* The 4 bytes at the end also hold a corruption fence (DECFENCE, x4) */
5904169695Skan/* ------------------------------------------------------------------ */
5905169695Skanstatic void *
5906169695SkandecMalloc (uInt n)
5907169695Skan{
5908169695Skan  uInt size = n + 12;		/* true size */
5909169695Skan  void *alloc;			/* -> allocated storage */
5910169695Skan  uInt *j;			/* work */
5911169695Skan  uByte *b, *b0;		/* .. */
5912169695Skan
5913169695Skan  alloc = malloc (size);	/* -> allocated storage */
5914169695Skan  if (alloc == NULL)
5915169695Skan    return NULL;		/* out of strorage */
5916169695Skan  b0 = (uByte *) alloc;		/* as bytes */
5917169695Skan  decAllocBytes += n;		/* account for storage */
5918169695Skan  j = (uInt *) alloc;		/* -> first four bytes */
5919169695Skan  *j = n;			/* save n */
5920169695Skan  /* printf("++ alloc(%d)\n", n); */
5921169695Skan  for (b = b0 + 4; b < b0 + 8; b++)
5922169695Skan    *b = DECFENCE;
5923169695Skan  for (b = b0 + n + 8; b < b0 + n + 12; b++)
5924169695Skan    *b = DECFENCE;
5925169695Skan  return b0 + 8;		/* -> play area */
5926169695Skan}
5927169695Skan
5928169695Skan/* ------------------------------------------------------------------ */
5929169695Skan/* decFree -- accountable free routine                                */
5930169695Skan/*   alloc is the storage to free                                     */
5931169695Skan/*                                                                    */
5932169695Skan/* Semantics is the same as the stdlib malloc routine, except that    */
5933169695Skan/* the global storage accounting is updated and the fences are        */
5934169695Skan/* checked to ensure that no routine has written 'out of bounds'.     */
5935169695Skan/* ------------------------------------------------------------------ */
5936169695Skan/* This routine first checks that the fences have not been corrupted. */
5937169695Skan/* It then frees the storage using the 'truw' storage address (that   */
5938169695Skan/* is, offset by 8).                                                  */
5939169695Skan/* ------------------------------------------------------------------ */
5940169695Skanstatic void
5941169695SkandecFree (void *alloc)
5942169695Skan{
5943169695Skan  uInt *j, n;			/* pointer, original length */
5944169695Skan  uByte *b, *b0;		/* work */
5945169695Skan
5946169695Skan  if (alloc == NULL)
5947169695Skan    return;			/* allowed; it's a nop */
5948169695Skan  b0 = (uByte *) alloc;		/* as bytes */
5949169695Skan  b0 -= 8;			/* -> true start of storage */
5950169695Skan  j = (uInt *) b0;		/* -> first four bytes */
5951169695Skan  n = *j;			/* lift */
5952169695Skan  for (b = b0 + 4; b < b0 + 8; b++)
5953169695Skan    if (*b != DECFENCE)
5954169695Skan      printf ("=== Corrupt byte [%02x] at offset %d from %d ===\n", *b,
5955169695Skan	      b - b0 - 8, (Int) b0);
5956169695Skan  for (b = b0 + n + 8; b < b0 + n + 12; b++)
5957169695Skan    if (*b != DECFENCE)
5958169695Skan      printf ("=== Corrupt byte [%02x] at offset +%d from %d, n=%d ===\n", *b,
5959169695Skan	      b - b0 - 8, (Int) b0, n);
5960169695Skan  free (b0);			/* drop the storage */
5961169695Skan  decAllocBytes -= n;		/* account for storage */
5962169695Skan}
5963169695Skan#endif
5964