Cygwin: mmap: allow remapping part of an existing anonymous mapping
[newlib-cygwin.git] / newlib / libc / stdlib / ldtoa.c
blob36613faad8c113b25cf560d4f6db1490135ab6d1
1 /* Extended precision arithmetic functions for long double I/O.
2 * This program has been placed in the public domain.
3 */
5 #include <newlib.h>
6 #include <sys/config.h>
8 #ifndef _USE_GDTOA
9 #include <_ansi.h>
10 #include <reent.h>
11 #include <string.h>
12 #include <stdlib.h>
13 #include "mprec.h"
15 /* These are the externally visible entries. */
16 /* linux name: long double _IO_strtold (char *, char **); */
17 long double _strtold (char *, char **);
18 char *_ldtoa_r (struct _reent *, long double, int, int, int *, int *,
19 char **);
20 int _ldcheck (long double *);
21 #if 0
22 void _IO_ldtostr (long double *, char *, int, int, char);
23 #endif
25 /* Number of 16 bit words in external x type format */
26 #define NE 10
28 /* Number of 16 bit words in internal format */
29 #define NI (NE+3)
31 /* Array offset to exponent */
32 #define E 1
34 /* Array offset to high guard word */
35 #define M 2
37 /* Number of bits of precision */
38 #define NBITS ((NI-4)*16)
40 /* Maximum number of decimal digits in ASCII conversion */
41 #define NDEC 1023
42 /* Use static stack buffer for up to 44 digits */
43 #define NDEC_SML 44
45 /* The exponent of 1.0 */
46 #define EXONE (0x3fff)
48 /* Maximum exponent digits - base 10 */
49 #define MAX_EXP_DIGITS 5
51 /* Control structure for long double conversion including rounding precision values.
52 * rndprc can be set to 80 (if NE=6), 64, 56, 53, or 24 bits.
54 typedef struct
56 int rlast;
57 int rndprc;
58 int rw;
59 int re;
60 int outexpon;
61 unsigned short rmsk;
62 unsigned short rmbit;
63 unsigned short rebit;
64 unsigned short rbit[NI];
65 unsigned short equot[NI];
66 } LDPARMS;
68 static void esub (const short unsigned int *a, const short unsigned int *b,
69 short unsigned int *c, LDPARMS * ldp);
70 static void emul (const short unsigned int *a, const short unsigned int *b,
71 short unsigned int *c, LDPARMS * ldp);
72 static void ediv (const short unsigned int *a, const short unsigned int *b,
73 short unsigned int *c, LDPARMS * ldp);
74 static int ecmp (const short unsigned int *a, const short unsigned int *b);
75 static int enormlz (short unsigned int *x);
76 static int eshift (short unsigned int *x, int sc);
77 static void eshup1 (register short unsigned int *x);
78 static void eshup8 (register short unsigned int *x);
79 static void eshup6 (register short unsigned int *x);
80 static void eshdn1 (register short unsigned int *x);
81 static void eshdn8 (register short unsigned int *x);
82 static void eshdn6 (register short unsigned int *x);
83 static void eneg (short unsigned int *x);
84 static void emov (register const short unsigned int *a,
85 register short unsigned int *b);
86 static void eclear (register short unsigned int *x);
87 static void einfin (register short unsigned int *x, register LDPARMS * ldp);
88 static void efloor (short unsigned int *x, short unsigned int *y,
89 LDPARMS * ldp);
90 static void etoasc (short unsigned int *x, char *string, int ndec, int ndigs,
91 int outformat, LDPARMS * ldp);
93 union uconv
95 unsigned short pe;
96 long double d;
99 #if LDBL_MANT_DIG == 24
100 static void e24toe (short unsigned int *pe, short unsigned int *y,
101 LDPARMS * ldp);
102 #elif LDBL_MANT_DIG == 53
103 static void e53toe (short unsigned int *pe, short unsigned int *y,
104 LDPARMS * ldp);
105 #elif LDBL_MANT_DIG == 64
106 static void e64toe (short unsigned int *pe, short unsigned int *y,
107 LDPARMS * ldp);
108 #else
109 static void e113toe (short unsigned int *pe, short unsigned int *y,
110 LDPARMS * ldp);
111 #endif
113 /* econst.c */
114 /* e type constants used by high precision check routines */
116 #if NE == 10
117 /* 0.0 */
118 static const unsigned short ezero[NE] = { 0x0000, 0x0000, 0x0000, 0x0000,
119 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000,
122 /* 1.0E0 */
123 static const unsigned short eone[NE] = { 0x0000, 0x0000, 0x0000, 0x0000,
124 0x0000, 0x0000, 0x0000, 0x0000, 0x8000, 0x3fff,
127 #else
129 /* 0.0 */
130 static const unsigned short ezero[NE] = {
131 0, 0000000, 0000000, 0000000, 0000000, 0000000,
134 /* 1.0E0 */
135 static const unsigned short eone[NE] = {
136 0, 0000000, 0000000, 0000000, 0100000, 0x3fff,
139 #endif
141 /* Debugging routine for displaying errors */
142 #ifdef DEBUG
143 /* Notice: the order of appearance of the following
144 * messages is bound to the error codes defined
145 * in mconf.h.
147 static const char *const ermsg[7] = {
148 "unknown", /* error code 0 */
149 "domain", /* error code 1 */
150 "singularity", /* et seq. */
151 "overflow",
152 "underflow",
153 "total loss of precision",
154 "partial loss of precision"
157 #define mtherr(name, code) printf( "\n%s %s error\n", name, ermsg[code] );
158 #else
159 #define mtherr(name, code)
160 #endif
162 /* ieee.c
164 * Extended precision IEEE binary floating point arithmetic routines
166 * Numbers are stored in C language as arrays of 16-bit unsigned
167 * short integers. The arguments of the routines are pointers to
168 * the arrays.
171 * External e type data structure, simulates Intel 8087 chip
172 * temporary real format but possibly with a larger significand:
174 * NE-1 significand words (least significant word first,
175 * most significant bit is normally set)
176 * exponent (value = EXONE for 1.0,
177 * top bit is the sign)
180 * Internal data structure of a number (a "word" is 16 bits):
182 * ei[0] sign word (0 for positive, 0xffff for negative)
183 * ei[1] biased exponent (value = EXONE for the number 1.0)
184 * ei[2] high guard word (always zero after normalization)
185 * ei[3]
186 * to ei[NI-2] significand (NI-4 significand words,
187 * most significant word first,
188 * most significant bit is set)
189 * ei[NI-1] low guard word (0x8000 bit is rounding place)
193 * Routines for external format numbers
195 * asctoe( string, e ) ASCII string to extended double e type
196 * asctoe64( string, &d ) ASCII string to long double
197 * asctoe53( string, &d ) ASCII string to double
198 * asctoe24( string, &f ) ASCII string to single
199 * asctoeg( string, e, prec, ldp ) ASCII string to specified precision
200 * e24toe( &f, e, ldp ) IEEE single precision to e type
201 * e53toe( &d, e, ldp ) IEEE double precision to e type
202 * e64toe( &d, e, ldp ) IEEE long double precision to e type
203 * e113toe( &d, e, ldp ) IEEE long double precision to e type
204 * eabs(e) absolute value
205 * eadd( a, b, c ) c = b + a
206 * eclear(e) e = 0
207 * ecmp (a, b) Returns 1 if a > b, 0 if a == b,
208 * -1 if a < b, -2 if either a or b is a NaN.
209 * ediv( a, b, c, ldp ) c = b / a
210 * efloor( a, b, ldp ) truncate to integer, toward -infinity
211 * efrexp( a, exp, s ) extract exponent and significand
212 * eifrac( e, &l, frac ) e to long integer and e type fraction
213 * euifrac( e, &l, frac ) e to unsigned long integer and e type fraction
214 * einfin( e, ldp ) set e to infinity, leaving its sign alone
215 * eldexp( a, n, b ) multiply by 2**n
216 * emov( a, b ) b = a
217 * emul( a, b, c, ldp ) c = b * a
218 * eneg(e) e = -e
219 * eround( a, b ) b = nearest integer value to a
220 * esub( a, b, c, ldp ) c = b - a
221 * e24toasc( &f, str, n ) single to ASCII string, n digits after decimal
222 * e53toasc( &d, str, n ) double to ASCII string, n digits after decimal
223 * e64toasc( &d, str, n ) long double to ASCII string
224 * etoasc(e,str,ndec,n,fmt,ldp)e to ASCII string, n digits after decimal
225 * etoe24( e, &f ) convert e type to IEEE single precision
226 * etoe53( e, &d ) convert e type to IEEE double precision
227 * etoe64( e, &d ) convert e type to IEEE long double precision
228 * ltoe( &l, e ) long (32 bit) integer to e type
229 * ultoe( &l, e ) unsigned long (32 bit) integer to e type
230 * eisneg( e ) 1 if sign bit of e != 0, else 0
231 * eisinf( e ) 1 if e has maximum exponent (non-IEEE)
232 * or is infinite (IEEE)
233 * eisnan( e ) 1 if e is a NaN
234 * esqrt( a, b ) b = square root of a
237 * Routines for internal format numbers
239 * eaddm( ai, bi ) add significands, bi = bi + ai
240 * ecleaz(ei) ei = 0
241 * ecleazs(ei) set ei = 0 but leave its sign alone
242 * ecmpm( ai, bi ) compare significands, return 1, 0, or -1
243 * edivm( ai, bi, ldp ) divide significands, bi = bi / ai
244 * emdnorm(ai,l,s,exp,ldp) normalize and round off
245 * emovi( a, ai ) convert external a to internal ai
246 * emovo( ai, a, ldp ) convert internal ai to external a
247 * emovz( ai, bi ) bi = ai, low guard word of bi = 0
248 * emulm( ai, bi, ldp ) multiply significands, bi = bi * ai
249 * enormlz(ei) left-justify the significand
250 * eshdn1( ai ) shift significand and guards down 1 bit
251 * eshdn8( ai ) shift down 8 bits
252 * eshdn6( ai ) shift down 16 bits
253 * eshift( ai, n ) shift ai n bits up (or down if n < 0)
254 * eshup1( ai ) shift significand and guards up 1 bit
255 * eshup8( ai ) shift up 8 bits
256 * eshup6( ai ) shift up 16 bits
257 * esubm( ai, bi ) subtract significands, bi = bi - ai
260 * The result is always normalized and rounded to NI-4 word precision
261 * after each arithmetic operation.
263 * Exception flags are NOT fully supported.
265 * Define USE_INFINITY in mconf.h for support of infinity; otherwise a
266 * saturation arithmetic is implemented.
268 * Define NANS for support of Not-a-Number items; otherwise the
269 * arithmetic will never produce a NaN output, and might be confused
270 * by a NaN input.
271 * If NaN's are supported, the output of ecmp(a,b) is -2 if
272 * either a or b is a NaN. This means asking if(ecmp(a,b) < 0)
273 * may not be legitimate. Use if(ecmp(a,b) == -1) for less-than
274 * if in doubt.
275 * Signaling NaN's are NOT supported; they are treated the same
276 * as quiet NaN's.
278 * Denormals are always supported here where appropriate (e.g., not
279 * for conversion to DEC numbers).
283 * Revision history:
285 * 5 Jan 84 PDP-11 assembly language version
286 * 6 Dec 86 C language version
287 * 30 Aug 88 100 digit version, improved rounding
288 * 15 May 92 80-bit long double support
289 * 22 Nov 00 Revised to fit into newlib by Jeff Johnston <jjohnstn@redhat.com>
291 * Author: S. L. Moshier.
293 * Copyright (c) 1984,2000 S.L. Moshier
295 * Permission to use, copy, modify, and distribute this software for any
296 * purpose without fee is hereby granted, provided that this entire notice
297 * is included in all copies of any software which is or includes a copy
298 * or modification of this software and in all copies of the supporting
299 * documentation for such software.
301 * THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
302 * WARRANTY. IN PARTICULAR, THE AUTHOR MAKES NO REPRESENTATION
303 * OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY OF THIS
304 * SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
308 #include <stdio.h>
309 /* #include "\usr\include\stdio.h" */
310 /*#include "ehead.h"*/
311 /*#include "mconf.h"*/
312 /* mconf.h
314 * Common include file for math routines
318 * SYNOPSIS:
320 * #include "mconf.h"
324 * DESCRIPTION:
326 * This file contains definitions for error codes that are
327 * passed to the common error handling routine mtherr()
328 * (which see).
330 * The file also includes a conditional assembly definition
331 * for the type of computer arithmetic (IEEE, DEC, Motorola
332 * IEEE, or UNKnown).
334 * For Digital Equipment PDP-11 and VAX computers, certain
335 * IBM systems, and others that use numbers with a 56-bit
336 * significand, the symbol DEC should be defined. In this
337 * mode, most floating point constants are given as arrays
338 * of octal integers to eliminate decimal to binary conversion
339 * errors that might be introduced by the compiler.
341 * For computers, such as IBM PC, that follow the IEEE
342 * Standard for Binary Floating Point Arithmetic (ANSI/IEEE
343 * Std 754-1985), the symbol IBMPC should be defined. These
344 * numbers have 53-bit significands. In this mode, constants
345 * are provided as arrays of hexadecimal 16 bit integers.
347 * To accommodate other types of computer arithmetic, all
348 * constants are also provided in a normal decimal radix
349 * which one can hope are correctly converted to a suitable
350 * format by the available C language compiler. To invoke
351 * this mode, the symbol UNK is defined.
353 * An important difference among these modes is a predefined
354 * set of machine arithmetic constants for each. The numbers
355 * MACHEP (the machine roundoff error), MAXNUM (largest number
356 * represented), and several other parameters are preset by
357 * the configuration symbol. Check the file const.c to
358 * ensure that these values are correct for your computer.
360 * For ANSI C compatibility, define ANSIC equal to 1. Currently
361 * this affects only the atan2() function and others that use it.
364 /* Constant definitions for math error conditions
367 #define DOMAIN 1 /* argument domain error */
368 #define SING 2 /* argument singularity */
369 #define OVERFLOW 3 /* overflow range error */
370 #define UNDERFLOW 4 /* underflow range error */
371 #define TLOSS 5 /* total loss of precision */
372 #define PLOSS 6 /* partial loss of precision */
374 #define EDOM 33
375 #define ERANGE 34
377 typedef struct
379 double r;
380 double i;
381 } cmplx;
383 /* Type of computer arithmetic */
385 #ifndef DEC
386 #ifdef __IEEE_LITTLE_ENDIAN
387 #define IBMPC 1
388 #else /* !__IEEE_LITTLE_ENDIAN */
389 #define MIEEE 1
390 #endif /* !__IEEE_LITTLE_ENDIAN */
391 #endif /* !DEC */
393 /* Define 1 for ANSI C atan2() function
394 * See atan.c and clog.c.
396 #define ANSIC 1
398 /*define VOLATILE volatile*/
399 #define VOLATILE
401 #define NANS
402 #define USE_INFINITY
404 /* NaN's require infinity support. */
405 #ifdef NANS
406 #ifndef INFINITY
407 #define USE_INFINITY
408 #endif
409 #endif
411 /* This handles 64-bit long ints. */
412 #define LONGBITS (8 * sizeof(long))
415 static void eaddm (short unsigned int *x, short unsigned int *y);
416 static void esubm (short unsigned int *x, short unsigned int *y);
417 static void emdnorm (short unsigned int *s, int lost, int subflg,
418 long int exp, int rcntrl, LDPARMS * ldp);
419 #if 0 /* Broken, unusable implementation of strtold */
420 static int asctoeg (char *ss, short unsigned int *y, int oprec,
421 LDPARMS * ldp);
422 #endif
423 static void enan (short unsigned int *nan, int size);
424 #if LDBL_MANT_DIG == 24
425 static void toe24 (short unsigned int *x, short unsigned int *y);
426 #elif LDBL_MANT_DIG == 53
427 static void toe53 (short unsigned int *x, short unsigned int *y);
428 #elif LDBL_MANT_DIG == 64
429 static void toe64 (short unsigned int *a, short unsigned int *b);
430 #else
431 static void toe113 (short unsigned int *a, short unsigned int *b);
432 #endif
433 static void eiremain (short unsigned int *den, short unsigned int *num,
434 LDPARMS * ldp);
435 static int ecmpm (register short unsigned int *a,
436 register short unsigned int *b);
437 static int edivm (short unsigned int *den, short unsigned int *num,
438 LDPARMS * ldp);
439 static int emulm (short unsigned int *a, short unsigned int *b,
440 LDPARMS * ldp);
441 static int eisneg (const short unsigned int *x);
442 static int eisinf (const short unsigned int *x);
443 static void emovi (const short unsigned int *a, short unsigned int *b);
444 static void emovo (short unsigned int *a, short unsigned int *b,
445 LDPARMS * ldp);
446 static void emovz (register short unsigned int *a,
447 register short unsigned int *b);
448 static void ecleaz (register short unsigned int *xi);
449 static void eadd1 (const short unsigned int *a, const short unsigned int *b,
450 short unsigned int *c, int subflg, LDPARMS * ldp);
451 static int eisnan (const short unsigned int *x);
452 static int eiisnan (short unsigned int *x);
454 #ifdef DEC
455 static void etodec (), todec (), dectoe ();
456 #endif
459 ; Clear out entire external format number.
461 ; unsigned short x[];
462 ; eclear( x );
465 static void
466 eclear (register short unsigned int *x)
468 register int i;
470 for (i = 0; i < NE; i++)
471 *x++ = 0;
476 /* Move external format number from a to b.
478 * emov( a, b );
481 static void
482 emov (register const short unsigned int *a, register short unsigned int *b)
484 register int i;
486 for (i = 0; i < NE; i++)
487 *b++ = *a++;
492 ; Negate external format number
494 ; unsigned short x[NE];
495 ; eneg( x );
498 static void
499 eneg (short unsigned int *x)
502 #ifdef NANS
503 if (eisnan (x))
504 return;
505 #endif
506 x[NE - 1] ^= 0x8000; /* Toggle the sign bit */
511 /* Return 1 if external format number is negative,
512 * else return zero.
514 static int
515 eisneg (const short unsigned int *x)
518 #ifdef NANS
519 if (eisnan (x))
520 return (0);
521 #endif
522 if (x[NE - 1] & 0x8000)
523 return (1);
524 else
525 return (0);
529 /* Return 1 if external format number has maximum possible exponent,
530 * else return zero.
532 static int
533 eisinf (const short unsigned int *x)
536 if ((x[NE - 1] & 0x7fff) == 0x7fff)
538 #ifdef NANS
539 if (eisnan (x))
540 return (0);
541 #endif
542 return (1);
544 else
545 return (0);
548 /* Check if e-type number is not a number.
550 static int
551 eisnan (const short unsigned int *x)
554 #ifdef NANS
555 int i;
556 /* NaN has maximum exponent */
557 if ((x[NE - 1] & 0x7fff) != 0x7fff)
558 return (0);
559 /* ... and non-zero significand field. */
560 for (i = 0; i < NE - 1; i++)
562 if (*x++ != 0)
563 return (1);
565 #endif
566 return (0);
570 ; Fill entire number, including exponent and significand, with
571 ; largest possible number. These programs implement a saturation
572 ; value that is an ordinary, legal number. A special value
573 ; "infinity" may also be implemented; this would require tests
574 ; for that value and implementation of special rules for arithmetic
575 ; operations involving inifinity.
578 static void
579 einfin (register short unsigned int *x, register LDPARMS * ldp)
581 register int i;
583 #ifdef USE_INFINITY
584 for (i = 0; i < NE - 1; i++)
585 *x++ = 0;
586 *x |= 32767;
587 ldp = ldp;
588 #else
589 for (i = 0; i < NE - 1; i++)
590 *x++ = 0xffff;
591 *x |= 32766;
592 if (ldp->rndprc < NBITS)
594 if (ldp->rndprc == 113)
596 *(x - 9) = 0;
597 *(x - 8) = 0;
599 if (ldp->rndprc == 64)
601 *(x - 5) = 0;
603 if (ldp->rndprc == 53)
605 *(x - 4) = 0xf800;
607 else
609 *(x - 4) = 0;
610 *(x - 3) = 0;
611 *(x - 2) = 0xff00;
614 #endif
617 /* Move in external format number,
618 * converting it to internal format.
620 static void
621 emovi (const short unsigned int *a, short unsigned int *b)
623 register const unsigned short *p;
624 register unsigned short *q;
625 int i;
627 q = b;
628 p = a + (NE - 1); /* point to last word of external number */
629 /* get the sign bit */
630 if (*p & 0x8000)
631 *q++ = 0xffff;
632 else
633 *q++ = 0;
634 /* get the exponent */
635 *q = *p--;
636 *q++ &= 0x7fff; /* delete the sign bit */
637 #ifdef USE_INFINITY
638 if ((*(q - 1) & 0x7fff) == 0x7fff)
640 #ifdef NANS
641 if (eisnan (a))
643 *q++ = 0;
644 for (i = 3; i < NI; i++)
645 *q++ = *p--;
646 return;
648 #endif
649 for (i = 2; i < NI; i++)
650 *q++ = 0;
651 return;
653 #endif
654 /* clear high guard word */
655 *q++ = 0;
656 /* move in the significand */
657 for (i = 0; i < NE - 1; i++)
658 *q++ = *p--;
659 /* clear low guard word */
660 *q = 0;
664 /* Move internal format number out,
665 * converting it to external format.
667 static void
668 emovo (short unsigned int *a, short unsigned int *b, LDPARMS * ldp)
670 register unsigned short *p, *q;
671 unsigned short i;
673 p = a;
674 q = b + (NE - 1); /* point to output exponent */
675 /* combine sign and exponent */
676 i = *p++;
677 if (i)
678 *q-- = *p++ | 0x8000;
679 else
680 *q-- = *p++;
681 #ifdef USE_INFINITY
682 if (*(p - 1) == 0x7fff)
684 #ifdef NANS
685 if (eiisnan (a))
687 enan (b, NBITS);
688 return;
690 #endif
691 einfin (b, ldp);
692 return;
694 #endif
695 /* skip over guard word */
696 ++p;
697 /* move the significand */
698 for (i = 0; i < NE - 1; i++)
699 *q-- = *p++;
703 /* Clear out internal format number.
706 static void
707 ecleaz (register short unsigned int *xi)
709 register int i;
711 for (i = 0; i < NI; i++)
712 *xi++ = 0;
715 /* same, but don't touch the sign. */
717 static void
718 ecleazs (register short unsigned int *xi)
720 register int i;
722 ++xi;
723 for (i = 0; i < NI - 1; i++)
724 *xi++ = 0;
730 /* Move internal format number from a to b.
732 static void
733 emovz (register short unsigned int *a, register short unsigned int *b)
735 register int i;
737 for (i = 0; i < NI - 1; i++)
738 *b++ = *a++;
739 /* clear low guard word */
740 *b = 0;
743 /* Return nonzero if internal format number is a NaN.
746 static int
747 eiisnan (short unsigned int *x)
749 int i;
751 if ((x[E] & 0x7fff) == 0x7fff)
753 for (i = M + 1; i < NI; i++)
755 if (x[i] != 0)
756 return (1);
759 return (0);
762 #if LDBL_MANT_DIG == 64
764 /* Return nonzero if internal format number is infinite. */
765 static int
766 eiisinf (unsigned short x[])
769 #ifdef NANS
770 if (eiisnan (x))
771 return (0);
772 #endif
773 if ((x[E] & 0x7fff) == 0x7fff)
774 return (1);
775 return (0);
777 #endif /* LDBL_MANT_DIG == 64 */
780 ; Compare significands of numbers in internal format.
781 ; Guard words are included in the comparison.
783 ; unsigned short a[NI], b[NI];
784 ; cmpm( a, b );
786 ; for the significands:
787 ; returns +1 if a > b
788 ; 0 if a == b
789 ; -1 if a < b
791 static int
792 ecmpm (register short unsigned int *a, register short unsigned int *b)
794 int i;
796 a += M; /* skip up to significand area */
797 b += M;
798 for (i = M; i < NI; i++)
800 if (*a++ != *b++)
801 goto difrnt;
803 return (0);
805 difrnt:
806 if (*(--a) > *(--b))
807 return (1);
808 else
809 return (-1);
814 ; Shift significand down by 1 bit
817 static void
818 eshdn1 (register short unsigned int *x)
820 register unsigned short bits;
821 int i;
823 x += M; /* point to significand area */
825 bits = 0;
826 for (i = M; i < NI; i++)
828 if (*x & 1)
829 bits |= 1;
830 *x >>= 1;
831 if (bits & 2)
832 *x |= 0x8000;
833 bits <<= 1;
834 ++x;
841 ; Shift significand up by 1 bit
844 static void
845 eshup1 (register short unsigned int *x)
847 register unsigned short bits;
848 int i;
850 x += NI - 1;
851 bits = 0;
853 for (i = M; i < NI; i++)
855 if (*x & 0x8000)
856 bits |= 1;
857 *x <<= 1;
858 if (bits & 2)
859 *x |= 1;
860 bits <<= 1;
861 --x;
868 ; Shift significand down by 8 bits
871 static void
872 eshdn8 (register short unsigned int *x)
874 register unsigned short newbyt, oldbyt;
875 int i;
877 x += M;
878 oldbyt = 0;
879 for (i = M; i < NI; i++)
881 newbyt = *x << 8;
882 *x >>= 8;
883 *x |= oldbyt;
884 oldbyt = newbyt;
885 ++x;
890 ; Shift significand up by 8 bits
893 static void
894 eshup8 (register short unsigned int *x)
896 int i;
897 register unsigned short newbyt, oldbyt;
899 x += NI - 1;
900 oldbyt = 0;
902 for (i = M; i < NI; i++)
904 newbyt = *x >> 8;
905 *x <<= 8;
906 *x |= oldbyt;
907 oldbyt = newbyt;
908 --x;
913 ; Shift significand up by 16 bits
916 static void
917 eshup6 (register short unsigned int *x)
919 int i;
920 register unsigned short *p;
922 p = x + M;
923 x += M + 1;
925 for (i = M; i < NI - 1; i++)
926 *p++ = *x++;
928 *p = 0;
932 ; Shift significand down by 16 bits
935 static void
936 eshdn6 (register short unsigned int *x)
938 int i;
939 register unsigned short *p;
941 x += NI - 1;
942 p = x + 1;
944 for (i = M; i < NI - 1; i++)
945 *(--p) = *(--x);
947 *(--p) = 0;
951 ; Add significands
952 ; x + y replaces y
955 static void
956 eaddm (short unsigned int *x, short unsigned int *y)
958 register unsigned long a;
959 int i;
960 unsigned int carry;
962 x += NI - 1;
963 y += NI - 1;
964 carry = 0;
965 for (i = M; i < NI; i++)
967 a = (unsigned long) (*x) + (unsigned long) (*y) + carry;
968 if (a & 0x10000)
969 carry = 1;
970 else
971 carry = 0;
972 *y = (unsigned short) a;
973 --x;
974 --y;
979 ; Subtract significands
980 ; y - x replaces y
983 static void
984 esubm (short unsigned int *x, short unsigned int *y)
986 unsigned long a;
987 int i;
988 unsigned int carry;
990 x += NI - 1;
991 y += NI - 1;
992 carry = 0;
993 for (i = M; i < NI; i++)
995 a = (unsigned long) (*y) - (unsigned long) (*x) - carry;
996 if (a & 0x10000)
997 carry = 1;
998 else
999 carry = 0;
1000 *y = (unsigned short) a;
1001 --x;
1002 --y;
1007 /* Divide significands */
1010 /* Multiply significand of e-type number b
1011 by 16-bit quantity a, e-type result to c. */
1013 static void
1014 m16m (short unsigned int a, short unsigned int *b, short unsigned int *c)
1016 register unsigned short *pp;
1017 register unsigned long carry;
1018 unsigned short *ps;
1019 unsigned short p[NI];
1020 unsigned long aa, m;
1021 int i;
1023 aa = a;
1024 pp = &p[NI - 2];
1025 *pp++ = 0;
1026 *pp = 0;
1027 ps = &b[NI - 1];
1029 for (i = M + 1; i < NI; i++)
1031 if (*ps == 0)
1033 --ps;
1034 --pp;
1035 *(pp - 1) = 0;
1037 else
1039 m = (unsigned long) aa **ps--;
1040 carry = (m & 0xffff) + *pp;
1041 *pp-- = (unsigned short) carry;
1042 carry = (carry >> 16) + (m >> 16) + *pp;
1043 *pp = (unsigned short) carry;
1044 *(pp - 1) = carry >> 16;
1047 for (i = M; i < NI; i++)
1048 c[i] = p[i];
1052 /* Divide significands. Neither the numerator nor the denominator
1053 is permitted to have its high guard word nonzero. */
1056 static int
1057 edivm (short unsigned int *den, short unsigned int *num, LDPARMS * ldp)
1059 int i;
1060 register unsigned short *p;
1061 unsigned long tnum;
1062 unsigned short j, tdenm, tquot;
1063 unsigned short tprod[NI + 1];
1064 unsigned short *equot = ldp->equot;
1066 p = &equot[0];
1067 *p++ = num[0];
1068 *p++ = num[1];
1070 for (i = M; i < NI; i++)
1072 *p++ = 0;
1074 eshdn1 (num);
1075 tdenm = den[M + 1];
1076 for (i = M; i < NI; i++)
1078 /* Find trial quotient digit (the radix is 65536). */
1079 tnum = (((unsigned long) num[M]) << 16) + num[M + 1];
1081 /* Do not execute the divide instruction if it will overflow. */
1082 if ((tdenm * 0xffffUL) < tnum)
1083 tquot = 0xffff;
1084 else
1085 tquot = tnum / tdenm;
1087 /* Prove that the divide worked. */
1089 tcheck = (unsigned long )tquot * tdenm;
1090 if( tnum - tcheck > tdenm )
1091 tquot = 0xffff;
1093 /* Multiply denominator by trial quotient digit. */
1094 m16m (tquot, den, tprod);
1095 /* The quotient digit may have been overestimated. */
1096 if (ecmpm (tprod, num) > 0)
1098 tquot -= 1;
1099 esubm (den, tprod);
1100 if (ecmpm (tprod, num) > 0)
1102 tquot -= 1;
1103 esubm (den, tprod);
1107 if( ecmpm( tprod, num ) > 0 )
1109 eshow( "tprod", tprod );
1110 eshow( "num ", num );
1111 printf( "tnum = %08lx, tden = %04x, tquot = %04x\n",
1112 tnum, den[M+1], tquot );
1115 esubm (tprod, num);
1117 if( ecmpm( num, den ) >= 0 )
1119 eshow( "num ", num );
1120 eshow( "den ", den );
1121 printf( "tnum = %08lx, tden = %04x, tquot = %04x\n",
1122 tnum, den[M+1], tquot );
1125 equot[i] = tquot;
1126 eshup6 (num);
1128 /* test for nonzero remainder after roundoff bit */
1129 p = &num[M];
1130 j = 0;
1131 for (i = M; i < NI; i++)
1133 j |= *p++;
1135 if (j)
1136 j = 1;
1138 for (i = 0; i < NI; i++)
1139 num[i] = equot[i];
1141 return ((int) j);
1146 /* Multiply significands */
1147 static int
1148 emulm (short unsigned int *a, short unsigned int *b, LDPARMS * ldp)
1150 unsigned short *p, *q;
1151 unsigned short pprod[NI];
1152 unsigned short j;
1153 int i;
1154 unsigned short *equot = ldp->equot;
1156 equot[0] = b[0];
1157 equot[1] = b[1];
1158 for (i = M; i < NI; i++)
1159 equot[i] = 0;
1161 j = 0;
1162 p = &a[NI - 1];
1163 q = &equot[NI - 1];
1164 for (i = M + 1; i < NI; i++)
1166 if (*p == 0)
1168 --p;
1170 else
1172 m16m (*p--, b, pprod);
1173 eaddm (pprod, equot);
1175 j |= *q;
1176 eshdn6 (equot);
1179 for (i = 0; i < NI; i++)
1180 b[i] = equot[i];
1182 /* return flag for lost nonzero bits */
1183 return ((int) j);
1188 static void eshow(str, x)
1189 char *str;
1190 unsigned short *x;
1192 int i;
1194 printf( "%s ", str );
1195 for( i=0; i<NI; i++ )
1196 printf( "%04x ", *x++ );
1197 printf( "\n" );
1203 * Normalize and round off.
1205 * The internal format number to be rounded is "s".
1206 * Input "lost" indicates whether the number is exact.
1207 * This is the so-called sticky bit.
1209 * Input "subflg" indicates whether the number was obtained
1210 * by a subtraction operation. In that case if lost is nonzero
1211 * then the number is slightly smaller than indicated.
1213 * Input "exp" is the biased exponent, which may be negative.
1214 * the exponent field of "s" is ignored but is replaced by
1215 * "exp" as adjusted by normalization and rounding.
1217 * Input "rcntrl" is the rounding control.
1221 static void
1222 emdnorm (short unsigned int *s, int lost, int subflg, long int exp,
1223 int rcntrl, LDPARMS * ldp)
1225 int i, j;
1226 unsigned short r;
1228 /* Normalize */
1229 j = enormlz (s);
1231 /* a blank significand could mean either zero or infinity. */
1232 #ifndef USE_INFINITY
1233 if (j > NBITS)
1235 ecleazs (s);
1236 return;
1238 #endif
1239 exp -= j;
1240 #ifndef USE_INFINITY
1241 if (exp >= 32767L)
1242 goto overf;
1243 #else
1244 if ((j > NBITS) && (exp < 32767L))
1246 ecleazs (s);
1247 return;
1249 #endif
1250 if (exp < 0L)
1252 if (exp > (long) (-NBITS - 1))
1254 j = (int) exp;
1255 i = eshift (s, j);
1256 if (i)
1257 lost = 1;
1259 else
1261 ecleazs (s);
1262 return;
1265 /* Round off, unless told not to by rcntrl. */
1266 if (rcntrl == 0)
1267 goto mdfin;
1268 /* Set up rounding parameters if the control register changed. */
1269 if (ldp->rndprc != ldp->rlast)
1271 ecleaz (ldp->rbit);
1272 switch (ldp->rndprc)
1274 default:
1275 case NBITS:
1276 ldp->rw = NI - 1; /* low guard word */
1277 ldp->rmsk = 0xffff;
1278 ldp->rmbit = 0x8000;
1279 ldp->rebit = 1;
1280 ldp->re = ldp->rw - 1;
1281 break;
1282 case 113:
1283 ldp->rw = 10;
1284 ldp->rmsk = 0x7fff;
1285 ldp->rmbit = 0x4000;
1286 ldp->rebit = 0x8000;
1287 ldp->re = ldp->rw;
1288 break;
1289 case 64:
1290 ldp->rw = 7;
1291 ldp->rmsk = 0xffff;
1292 ldp->rmbit = 0x8000;
1293 ldp->rebit = 1;
1294 ldp->re = ldp->rw - 1;
1295 break;
1296 /* For DEC arithmetic */
1297 case 56:
1298 ldp->rw = 6;
1299 ldp->rmsk = 0xff;
1300 ldp->rmbit = 0x80;
1301 ldp->rebit = 0x100;
1302 ldp->re = ldp->rw;
1303 break;
1304 case 53:
1305 ldp->rw = 6;
1306 ldp->rmsk = 0x7ff;
1307 ldp->rmbit = 0x0400;
1308 ldp->rebit = 0x800;
1309 ldp->re = ldp->rw;
1310 break;
1311 case 24:
1312 ldp->rw = 4;
1313 ldp->rmsk = 0xff;
1314 ldp->rmbit = 0x80;
1315 ldp->rebit = 0x100;
1316 ldp->re = ldp->rw;
1317 break;
1319 ldp->rbit[ldp->re] = ldp->rebit;
1320 ldp->rlast = ldp->rndprc;
1323 /* Shift down 1 temporarily if the data structure has an implied
1324 * most significant bit and the number is denormal.
1325 * For rndprc = 64 or NBITS, there is no implied bit.
1326 * But Intel long double denormals lose one bit of significance even so.
1328 #if IBMPC
1329 if ((exp <= 0) && (ldp->rndprc != NBITS))
1330 #else
1331 if ((exp <= 0) && (ldp->rndprc != 64) && (ldp->rndprc != NBITS))
1332 #endif
1334 lost |= s[NI - 1] & 1;
1335 eshdn1 (s);
1337 /* Clear out all bits below the rounding bit,
1338 * remembering in r if any were nonzero.
1340 r = s[ldp->rw] & ldp->rmsk;
1341 if (ldp->rndprc < NBITS)
1343 i = ldp->rw + 1;
1344 while (i < NI)
1346 if (s[i])
1347 r |= 1;
1348 s[i] = 0;
1349 ++i;
1352 s[ldp->rw] &= ~ldp->rmsk;
1353 if ((r & ldp->rmbit) != 0)
1355 if (r == ldp->rmbit)
1357 if (lost == 0)
1358 { /* round to even */
1359 if ((s[ldp->re] & ldp->rebit) == 0)
1360 goto mddone;
1362 else
1364 if (subflg != 0)
1365 goto mddone;
1368 eaddm (ldp->rbit, s);
1370 mddone:
1371 #if IBMPC
1372 if ((exp <= 0) && (ldp->rndprc != NBITS))
1373 #else
1374 if ((exp <= 0) && (ldp->rndprc != 64) && (ldp->rndprc != NBITS))
1375 #endif
1377 eshup1 (s);
1379 if (s[2] != 0)
1380 { /* overflow on roundoff */
1381 eshdn1 (s);
1382 exp += 1;
1384 mdfin:
1385 s[NI - 1] = 0;
1386 if (exp >= 32767L)
1388 #ifndef USE_INFINITY
1389 overf:
1390 #endif
1391 #ifdef USE_INFINITY
1392 s[1] = 32767;
1393 for (i = 2; i < NI - 1; i++)
1394 s[i] = 0;
1395 #else
1396 s[1] = 32766;
1397 s[2] = 0;
1398 for (i = M + 1; i < NI - 1; i++)
1399 s[i] = 0xffff;
1400 s[NI - 1] = 0;
1401 if ((ldp->rndprc < 64) || (ldp->rndprc == 113))
1403 s[ldp->rw] &= ~ldp->rmsk;
1404 if (ldp->rndprc == 24)
1406 s[5] = 0;
1407 s[6] = 0;
1410 #endif
1411 return;
1413 if (exp < 0)
1414 s[1] = 0;
1415 else
1416 s[1] = (unsigned short) exp;
1422 ; Subtract external format numbers.
1424 ; unsigned short a[NE], b[NE], c[NE];
1425 ; LDPARMS *ldp;
1426 ; esub( a, b, c, ldp ); c = b - a
1429 static void
1430 esub (const short unsigned int *a, const short unsigned int *b,
1431 short unsigned int *c, LDPARMS * ldp)
1434 #ifdef NANS
1435 if (eisnan (a))
1437 emov (a, c);
1438 return;
1440 if (eisnan (b))
1442 emov (b, c);
1443 return;
1445 /* Infinity minus infinity is a NaN.
1446 * Test for subtracting infinities of the same sign.
1448 if (eisinf (a) && eisinf (b) && ((eisneg (a) ^ eisneg (b)) == 0))
1450 mtherr ("esub", DOMAIN);
1451 enan (c, NBITS);
1452 return;
1454 #endif
1455 eadd1 (a, b, c, 1, ldp);
1460 static void
1461 eadd1 (const short unsigned int *a, const short unsigned int *b,
1462 short unsigned int *c, int subflg, LDPARMS * ldp)
1464 unsigned short ai[NI], bi[NI], ci[NI];
1465 int i, lost, j, k;
1466 long lt, lta, ltb;
1468 #ifdef USE_INFINITY
1469 if (eisinf (a))
1471 emov (a, c);
1472 if (subflg)
1473 eneg (c);
1474 return;
1476 if (eisinf (b))
1478 emov (b, c);
1479 return;
1481 #endif
1482 emovi (a, ai);
1483 emovi (b, bi);
1484 if (subflg)
1485 ai[0] = ~ai[0];
1487 /* compare exponents */
1488 lta = ai[E];
1489 ltb = bi[E];
1490 lt = lta - ltb;
1491 if (lt > 0L)
1492 { /* put the larger number in bi */
1493 emovz (bi, ci);
1494 emovz (ai, bi);
1495 emovz (ci, ai);
1496 ltb = bi[E];
1497 lt = -lt;
1499 lost = 0;
1500 if (lt != 0L)
1502 if (lt < (long) (-NBITS - 1))
1503 goto done; /* answer same as larger addend */
1504 k = (int) lt;
1505 lost = eshift (ai, k); /* shift the smaller number down */
1507 else
1509 /* exponents were the same, so must compare significands */
1510 i = ecmpm (ai, bi);
1511 if (i == 0)
1512 { /* the numbers are identical in magnitude */
1513 /* if different signs, result is zero */
1514 if (ai[0] != bi[0])
1516 eclear (c);
1517 return;
1519 /* if same sign, result is double */
1520 /* double denomalized tiny number */
1521 if ((bi[E] == 0) && ((bi[3] & 0x8000) == 0))
1523 eshup1 (bi);
1524 goto done;
1526 /* add 1 to exponent unless both are zero! */
1527 for (j = 1; j < NI - 1; j++)
1529 if (bi[j] != 0)
1531 /* This could overflow, but let emovo take care of that. */
1532 ltb += 1;
1533 break;
1536 bi[E] = (unsigned short) ltb;
1537 goto done;
1539 if (i > 0)
1540 { /* put the larger number in bi */
1541 emovz (bi, ci);
1542 emovz (ai, bi);
1543 emovz (ci, ai);
1546 if (ai[0] == bi[0])
1548 eaddm (ai, bi);
1549 subflg = 0;
1551 else
1553 esubm (ai, bi);
1554 subflg = 1;
1556 emdnorm (bi, lost, subflg, ltb, 64, ldp);
1558 done:
1559 emovo (bi, c, ldp);
1565 ; Divide.
1567 ; unsigned short a[NE], b[NE], c[NE];
1568 ; LDPARMS *ldp;
1569 ; ediv( a, b, c, ldp ); c = b / a
1571 static void
1572 ediv (const short unsigned int *a, const short unsigned int *b,
1573 short unsigned int *c, LDPARMS * ldp)
1575 unsigned short ai[NI], bi[NI];
1576 int i;
1577 long lt, lta, ltb;
1579 #ifdef NANS
1580 /* Return any NaN input. */
1581 if (eisnan (a))
1583 emov (a, c);
1584 return;
1586 if (eisnan (b))
1588 emov (b, c);
1589 return;
1591 /* Zero over zero, or infinity over infinity, is a NaN. */
1592 if (((ecmp (a, ezero) == 0) && (ecmp (b, ezero) == 0))
1593 || (eisinf (a) && eisinf (b)))
1595 mtherr ("ediv", DOMAIN);
1596 enan (c, NBITS);
1597 return;
1599 #endif
1600 /* Infinity over anything else is infinity. */
1601 #ifdef USE_INFINITY
1602 if (eisinf (b))
1604 if (eisneg (a) ^ eisneg (b))
1605 *(c + (NE - 1)) = 0x8000;
1606 else
1607 *(c + (NE - 1)) = 0;
1608 einfin (c, ldp);
1609 return;
1611 if (eisinf (a))
1613 eclear (c);
1614 return;
1616 #endif
1617 emovi (a, ai);
1618 emovi (b, bi);
1619 lta = ai[E];
1620 ltb = bi[E];
1621 if (bi[E] == 0)
1622 { /* See if numerator is zero. */
1623 for (i = 1; i < NI - 1; i++)
1625 if (bi[i] != 0)
1627 ltb -= enormlz (bi);
1628 goto dnzro1;
1631 eclear (c);
1632 return;
1634 dnzro1:
1636 if (ai[E] == 0)
1637 { /* possible divide by zero */
1638 for (i = 1; i < NI - 1; i++)
1640 if (ai[i] != 0)
1642 lta -= enormlz (ai);
1643 goto dnzro2;
1646 if (ai[0] == bi[0])
1647 *(c + (NE - 1)) = 0;
1648 else
1649 *(c + (NE - 1)) = 0x8000;
1650 einfin (c, ldp);
1651 mtherr ("ediv", SING);
1652 return;
1654 dnzro2:
1656 i = edivm (ai, bi, ldp);
1657 /* calculate exponent */
1658 lt = ltb - lta + EXONE;
1659 emdnorm (bi, i, 0, lt, 64, ldp);
1660 /* set the sign */
1661 if (ai[0] == bi[0])
1662 bi[0] = 0;
1663 else
1664 bi[0] = 0Xffff;
1665 emovo (bi, c, ldp);
1671 ; Multiply.
1673 ; unsigned short a[NE], b[NE], c[NE];
1674 ; LDPARMS *ldp
1675 ; emul( a, b, c, ldp ); c = b * a
1677 static void
1678 emul (const short unsigned int *a, const short unsigned int *b,
1679 short unsigned int *c, LDPARMS * ldp)
1681 unsigned short ai[NI], bi[NI];
1682 int i, j;
1683 long lt, lta, ltb;
1685 #ifdef NANS
1686 /* NaN times anything is the same NaN. */
1687 if (eisnan (a))
1689 emov (a, c);
1690 return;
1692 if (eisnan (b))
1694 emov (b, c);
1695 return;
1697 /* Zero times infinity is a NaN. */
1698 if ((eisinf (a) && (ecmp (b, ezero) == 0))
1699 || (eisinf (b) && (ecmp (a, ezero) == 0)))
1701 mtherr ("emul", DOMAIN);
1702 enan (c, NBITS);
1703 return;
1705 #endif
1706 /* Infinity times anything else is infinity. */
1707 #ifdef USE_INFINITY
1708 if (eisinf (a) || eisinf (b))
1710 if (eisneg (a) ^ eisneg (b))
1711 *(c + (NE - 1)) = 0x8000;
1712 else
1713 *(c + (NE - 1)) = 0;
1714 einfin (c, ldp);
1715 return;
1717 #endif
1718 emovi (a, ai);
1719 emovi (b, bi);
1720 lta = ai[E];
1721 ltb = bi[E];
1722 if (ai[E] == 0)
1724 for (i = 1; i < NI - 1; i++)
1726 if (ai[i] != 0)
1728 lta -= enormlz (ai);
1729 goto mnzer1;
1732 eclear (c);
1733 return;
1735 mnzer1:
1737 if (bi[E] == 0)
1739 for (i = 1; i < NI - 1; i++)
1741 if (bi[i] != 0)
1743 ltb -= enormlz (bi);
1744 goto mnzer2;
1747 eclear (c);
1748 return;
1750 mnzer2:
1752 /* Multiply significands */
1753 j = emulm (ai, bi, ldp);
1754 /* calculate exponent */
1755 lt = lta + ltb - (EXONE - 1);
1756 emdnorm (bi, j, 0, lt, 64, ldp);
1757 /* calculate sign of product */
1758 if (ai[0] == bi[0])
1759 bi[0] = 0;
1760 else
1761 bi[0] = 0xffff;
1762 emovo (bi, c, ldp);
1767 #if LDBL_MANT_DIG > 64
1768 static void
1769 e113toe (short unsigned int *pe, short unsigned int *y, LDPARMS * ldp)
1771 register unsigned short r;
1772 unsigned short *e, *p;
1773 unsigned short yy[NI];
1774 int denorm, i;
1776 e = pe;
1777 denorm = 0;
1778 ecleaz (yy);
1779 #ifdef IBMPC
1780 e += 7;
1781 #endif
1782 r = *e;
1783 yy[0] = 0;
1784 if (r & 0x8000)
1785 yy[0] = 0xffff;
1786 r &= 0x7fff;
1787 #ifdef USE_INFINITY
1788 if (r == 0x7fff)
1790 #ifdef NANS
1791 #ifdef IBMPC
1792 for (i = 0; i < 7; i++)
1794 if (pe[i] != 0)
1796 enan (y, NBITS);
1797 return;
1800 #else /* !IBMPC */
1801 for (i = 1; i < 8; i++)
1803 if (pe[i] != 0)
1805 enan (y, NBITS);
1806 return;
1809 #endif /* !IBMPC */
1810 #endif /* NANS */
1811 eclear (y);
1812 einfin (y, ldp);
1813 if (*e & 0x8000)
1814 eneg (y);
1815 return;
1817 #endif /* INFINITY */
1818 yy[E] = r;
1819 p = &yy[M + 1];
1820 #ifdef IBMPC
1821 for (i = 0; i < 7; i++)
1822 *p++ = *(--e);
1823 #else /* IBMPC */
1824 ++e;
1825 for (i = 0; i < 7; i++)
1826 *p++ = *e++;
1827 #endif /* IBMPC */
1828 /* If denormal, remove the implied bit; else shift down 1. */
1829 if (r == 0)
1831 yy[M] = 0;
1833 else
1835 yy[M] = 1;
1836 eshift (yy, -1);
1838 emovo (yy, y, ldp);
1841 /* move out internal format to ieee long double */
1842 static void
1843 __attribute__ ((__unused__))
1844 toe113 (short unsigned int *a, short unsigned int *b)
1846 register unsigned short *p, *q;
1847 unsigned short i;
1849 #ifdef NANS
1850 if (eiisnan (a))
1852 enan (b, 113);
1853 return;
1855 #endif
1856 p = a;
1857 #ifdef MIEEE
1858 q = b;
1859 #else
1860 q = b + 7; /* point to output exponent */
1861 #endif
1863 /* If not denormal, delete the implied bit. */
1864 if (a[E] != 0)
1866 eshup1 (a);
1868 /* combine sign and exponent */
1869 i = *p++;
1870 #ifdef MIEEE
1871 if (i)
1872 *q++ = *p++ | 0x8000;
1873 else
1874 *q++ = *p++;
1875 #else
1876 if (i)
1877 *q-- = *p++ | 0x8000;
1878 else
1879 *q-- = *p++;
1880 #endif
1881 /* skip over guard word */
1882 ++p;
1883 /* move the significand */
1884 #ifdef MIEEE
1885 for (i = 0; i < 7; i++)
1886 *q++ = *p++;
1887 #else
1888 for (i = 0; i < 7; i++)
1889 *q-- = *p++;
1890 #endif
1892 #endif /* LDBL_MANT_DIG > 64 */
1895 #if LDBL_MANT_DIG == 64
1896 static void
1897 e64toe (short unsigned int *pe, short unsigned int *y, LDPARMS * ldp)
1899 unsigned short yy[NI];
1900 unsigned short *p, *q, *e;
1901 int i;
1903 e = pe;
1904 p = yy;
1906 for (i = 0; i < NE - 5; i++)
1907 *p++ = 0;
1908 #ifdef IBMPC
1909 for (i = 0; i < 5; i++)
1910 *p++ = *e++;
1911 #endif
1912 #ifdef DEC
1913 for (i = 0; i < 5; i++)
1914 *p++ = *e++;
1915 #endif
1916 #ifdef MIEEE
1917 p = &yy[0] + (NE - 1);
1918 *p-- = *e++;
1919 ++e; /* MIEEE skips over 2nd short */
1920 for (i = 0; i < 4; i++)
1921 *p-- = *e++;
1922 #endif
1924 #ifdef IBMPC
1925 /* For Intel long double, shift denormal significand up 1
1926 -- but only if the top significand bit is zero. */
1927 if ((yy[NE - 1] & 0x7fff) == 0 && (yy[NE - 2] & 0x8000) == 0)
1929 unsigned short temp[NI + 1];
1930 emovi (yy, temp);
1931 eshup1 (temp);
1932 emovo (temp, y, ldp);
1933 return;
1935 #endif
1936 #ifdef USE_INFINITY
1937 /* Point to the exponent field. */
1938 p = &yy[NE - 1];
1939 if ((*p & 0x7fff) == 0x7fff)
1941 #ifdef NANS
1942 #ifdef IBMPC
1943 for (i = 0; i < 4; i++)
1945 if ((i != 3 && pe[i] != 0)
1946 /* Check for Intel long double infinity pattern. */
1947 || (i == 3 && pe[i] != 0x8000))
1949 enan (y, NBITS);
1950 return;
1953 #endif
1954 #ifdef MIEEE
1955 for (i = 2; i <= 5; i++)
1957 if (pe[i] != 0)
1959 enan (y, NBITS);
1960 return;
1963 #endif
1964 #endif /* NANS */
1965 eclear (y);
1966 einfin (y, ldp);
1967 if (*p & 0x8000)
1968 eneg (y);
1969 return;
1971 #endif /* USE_INFINITY */
1972 p = yy;
1973 q = y;
1974 for (i = 0; i < NE; i++)
1975 *q++ = *p++;
1978 /* move out internal format to ieee long double */
1979 static void
1980 __attribute__ ((__unused__))
1981 toe64 (short unsigned int *a, short unsigned int *b)
1983 register unsigned short *p, *q;
1984 unsigned short i;
1986 #ifdef NANS
1987 if (eiisnan (a))
1989 enan (b, 64);
1990 return;
1992 #endif
1993 #ifdef IBMPC
1994 /* Shift Intel denormal significand down 1. */
1995 if (a[E] == 0)
1996 eshdn1 (a);
1997 #endif
1998 p = a;
1999 #ifdef MIEEE
2000 q = b;
2001 #else
2002 q = b + 4; /* point to output exponent */
2003 /* NOTE: Intel data type is 96 bits wide, clear the last word here. */
2004 *(q + 1) = 0;
2005 #endif
2007 /* combine sign and exponent */
2008 i = *p++;
2009 #ifdef MIEEE
2010 if (i)
2011 *q++ = *p++ | 0x8000;
2012 else
2013 *q++ = *p++;
2014 *q++ = 0; /* leave 2nd short blank */
2015 #else
2016 if (i)
2017 *q-- = *p++ | 0x8000;
2018 else
2019 *q-- = *p++;
2020 #endif
2021 /* skip over guard word */
2022 ++p;
2023 /* move the significand */
2024 #ifdef MIEEE
2025 for (i = 0; i < 4; i++)
2026 *q++ = *p++;
2027 #else
2028 #ifdef USE_INFINITY
2029 #ifdef IBMPC
2030 if (eiisinf (a))
2032 /* Intel long double infinity. */
2033 *q-- = 0x8000;
2034 *q-- = 0;
2035 *q-- = 0;
2036 *q = 0;
2037 return;
2039 #endif /* IBMPC */
2040 #endif /* USE_INFINITY */
2041 for (i = 0; i < 4; i++)
2042 *q-- = *p++;
2043 #endif
2046 #endif /* LDBL_MANT_DIG == 64 */
2048 #if LDBL_MANT_DIG == 53
2050 ; Convert IEEE double precision to e type
2051 ; double d;
2052 ; unsigned short x[N+2];
2053 ; e53toe( &d, x );
2055 static void
2056 e53toe (short unsigned int *pe, short unsigned int *y, LDPARMS * ldp)
2058 #ifdef DEC
2060 dectoe (pe, y); /* see etodec.c */
2062 #else
2064 register unsigned short r;
2065 register unsigned short *p, *e;
2066 unsigned short yy[NI];
2067 int denorm, k;
2069 e = pe;
2070 denorm = 0; /* flag if denormalized number */
2071 ecleaz (yy);
2072 #ifdef IBMPC
2073 e += 3;
2074 #endif
2075 #ifdef DEC
2076 e += 3;
2077 #endif
2078 r = *e;
2079 yy[0] = 0;
2080 if (r & 0x8000)
2081 yy[0] = 0xffff;
2082 yy[M] = (r & 0x0f) | 0x10;
2083 r &= ~0x800f; /* strip sign and 4 significand bits */
2084 #ifdef USE_INFINITY
2085 if (r == 0x7ff0)
2087 #ifdef NANS
2088 #ifdef IBMPC
2089 if (((pe[3] & 0xf) != 0) || (pe[2] != 0)
2090 || (pe[1] != 0) || (pe[0] != 0))
2092 enan (y, NBITS);
2093 return;
2095 #else /* !IBMPC */
2096 if (((pe[0] & 0xf) != 0) || (pe[1] != 0)
2097 || (pe[2] != 0) || (pe[3] != 0))
2099 enan (y, NBITS);
2100 return;
2102 #endif /* !IBMPC */
2103 #endif /* NANS */
2104 eclear (y);
2105 einfin (y, ldp);
2106 if (yy[0])
2107 eneg (y);
2108 return;
2110 #endif
2111 r >>= 4;
2112 /* If zero exponent, then the significand is denormalized.
2113 * So, take back the understood high significand bit. */
2114 if (r == 0)
2116 denorm = 1;
2117 yy[M] &= ~0x10;
2119 r += EXONE - 01777;
2120 yy[E] = r;
2121 p = &yy[M + 1];
2122 #ifdef IBMPC
2123 *p++ = *(--e);
2124 *p++ = *(--e);
2125 *p++ = *(--e);
2126 #else /* !IBMPC */
2127 ++e;
2128 *p++ = *e++;
2129 *p++ = *e++;
2130 *p++ = *e++;
2131 #endif /* !IBMPC */
2132 (void) eshift (yy, -5);
2133 if (denorm)
2134 { /* if zero exponent, then normalize the significand */
2135 if ((k = enormlz (yy)) > NBITS)
2136 ecleazs (yy);
2137 else
2138 yy[E] -= (unsigned short) (k - 1);
2140 emovo (yy, y, ldp);
2141 #endif /* !DEC */
2145 ; e type to IEEE double precision
2146 ; double d;
2147 ; unsigned short x[NE];
2148 ; etoe53( x, &d );
2151 #ifdef DEC
2153 static void
2154 etoe53 (x, e)
2155 unsigned short *x, *e;
2157 etodec (x, e); /* see etodec.c */
2160 static void
2161 __attribute__ ((__unused__))
2162 toe53 (x, y)
2163 unsigned short *x, *y;
2165 todec (x, y);
2168 #else
2170 static void
2171 __attribute__ ((__unused__))
2172 toe53 (short unsigned int *x, short unsigned int *y)
2174 unsigned short i;
2175 unsigned short *p;
2178 #ifdef NANS
2179 if (eiisnan (x))
2181 enan (y, 53);
2182 return;
2184 #endif
2185 p = &x[0];
2186 #ifdef IBMPC
2187 y += 3;
2188 #endif
2189 #ifdef DEC
2190 y += 3;
2191 #endif
2192 *y = 0; /* output high order */
2193 if (*p++)
2194 *y = 0x8000; /* output sign bit */
2196 i = *p++;
2197 if (i >= (unsigned int) 2047)
2198 { /* Saturate at largest number less than infinity. */
2199 #ifdef USE_INFINITY
2200 *y |= 0x7ff0;
2201 #ifdef IBMPC
2202 *(--y) = 0;
2203 *(--y) = 0;
2204 *(--y) = 0;
2205 #else /* !IBMPC */
2206 ++y;
2207 *y++ = 0;
2208 *y++ = 0;
2209 *y++ = 0;
2210 #endif /* IBMPC */
2211 #else /* !USE_INFINITY */
2212 *y |= (unsigned short) 0x7fef;
2213 #ifdef IBMPC
2214 *(--y) = 0xffff;
2215 *(--y) = 0xffff;
2216 *(--y) = 0xffff;
2217 #else /* !IBMPC */
2218 ++y;
2219 *y++ = 0xffff;
2220 *y++ = 0xffff;
2221 *y++ = 0xffff;
2222 #endif
2223 #endif /* !USE_INFINITY */
2224 return;
2226 if (i == 0)
2228 (void) eshift (x, 4);
2230 else
2232 i <<= 4;
2233 (void) eshift (x, 5);
2235 i |= *p++ & (unsigned short) 0x0f; /* *p = xi[M] */
2236 *y |= (unsigned short) i; /* high order output already has sign bit set */
2237 #ifdef IBMPC
2238 *(--y) = *p++;
2239 *(--y) = *p++;
2240 *(--y) = *p;
2241 #else /* !IBMPC */
2242 ++y;
2243 *y++ = *p++;
2244 *y++ = *p++;
2245 *y++ = *p++;
2246 #endif /* !IBMPC */
2249 #endif /* not DEC */
2250 #endif /* LDBL_MANT_DIG == 53 */
2252 #if LDBL_MANT_DIG == 24
2254 ; Convert IEEE single precision to e type
2255 ; float d;
2256 ; unsigned short x[N+2];
2257 ; dtox( &d, x );
2259 void
2260 e24toe (short unsigned int *pe, short unsigned int *y, LDPARMS * ldp)
2262 register unsigned short r;
2263 register unsigned short *p, *e;
2264 unsigned short yy[NI];
2265 int denorm, k;
2267 e = pe;
2268 denorm = 0; /* flag if denormalized number */
2269 ecleaz (yy);
2270 #ifdef IBMPC
2271 e += 1;
2272 #endif
2273 #ifdef DEC
2274 e += 1;
2275 #endif
2276 r = *e;
2277 yy[0] = 0;
2278 if (r & 0x8000)
2279 yy[0] = 0xffff;
2280 yy[M] = (r & 0x7f) | 0200;
2281 r &= ~0x807f; /* strip sign and 7 significand bits */
2282 #ifdef USE_INFINITY
2283 if (r == 0x7f80)
2285 #ifdef NANS
2286 #ifdef MIEEE
2287 if (((pe[0] & 0x7f) != 0) || (pe[1] != 0))
2289 enan (y, NBITS);
2290 return;
2292 #else /* !MIEEE */
2293 if (((pe[1] & 0x7f) != 0) || (pe[0] != 0))
2295 enan (y, NBITS);
2296 return;
2298 #endif /* !MIEEE */
2299 #endif /* NANS */
2300 eclear (y);
2301 einfin (y, ldp);
2302 if (yy[0])
2303 eneg (y);
2304 return;
2306 #endif
2307 r >>= 7;
2308 /* If zero exponent, then the significand is denormalized.
2309 * So, take back the understood high significand bit. */
2310 if (r == 0)
2312 denorm = 1;
2313 yy[M] &= ~0200;
2315 r += EXONE - 0177;
2316 yy[E] = r;
2317 p = &yy[M + 1];
2318 #ifdef IBMPC
2319 *p++ = *(--e);
2320 #endif
2321 #ifdef DEC
2322 *p++ = *(--e);
2323 #endif
2324 #ifdef MIEEE
2325 ++e;
2326 *p++ = *e++;
2327 #endif
2328 (void) eshift (yy, -8);
2329 if (denorm)
2330 { /* if zero exponent, then normalize the significand */
2331 if ((k = enormlz (yy)) > NBITS)
2332 ecleazs (yy);
2333 else
2334 yy[E] -= (unsigned short) (k - 1);
2336 emovo (yy, y, ldp);
2339 static void
2340 __attribute__ ((__unused__))
2341 toe24 (short unsigned int *x, short unsigned int *y)
2343 unsigned short i;
2344 unsigned short *p;
2346 #ifdef NANS
2347 if (eiisnan (x))
2349 enan (y, 24);
2350 return;
2352 #endif
2353 p = &x[0];
2354 #ifdef IBMPC
2355 y += 1;
2356 #endif
2357 #ifdef DEC
2358 y += 1;
2359 #endif
2360 *y = 0; /* output high order */
2361 if (*p++)
2362 *y = 0x8000; /* output sign bit */
2364 i = *p++;
2365 if (i >= 255)
2366 { /* Saturate at largest number less than infinity. */
2367 #ifdef USE_INFINITY
2368 *y |= (unsigned short) 0x7f80;
2369 #ifdef IBMPC
2370 *(--y) = 0;
2371 #endif
2372 #ifdef DEC
2373 *(--y) = 0;
2374 #endif
2375 #ifdef MIEEE
2376 ++y;
2377 *y = 0;
2378 #endif
2379 #else /* !USE_INFINITY */
2380 *y |= (unsigned short) 0x7f7f;
2381 #ifdef IBMPC
2382 *(--y) = 0xffff;
2383 #endif
2384 #ifdef DEC
2385 *(--y) = 0xffff;
2386 #endif
2387 #ifdef MIEEE
2388 ++y;
2389 *y = 0xffff;
2390 #endif
2391 #endif /* !USE_INFINITY */
2392 return;
2394 if (i == 0)
2396 (void) eshift (x, 7);
2398 else
2400 i <<= 7;
2401 (void) eshift (x, 8);
2403 i |= *p++ & (unsigned short) 0x7f; /* *p = xi[M] */
2404 *y |= i; /* high order output already has sign bit set */
2405 #ifdef IBMPC
2406 *(--y) = *p;
2407 #endif
2408 #ifdef DEC
2409 *(--y) = *p;
2410 #endif
2411 #ifdef MIEEE
2412 ++y;
2413 *y = *p;
2414 #endif
2416 #endif /* LDBL_MANT_DIG == 24 */
2418 /* Compare two e type numbers.
2420 * unsigned short a[NE], b[NE];
2421 * ecmp( a, b );
2423 * returns +1 if a > b
2424 * 0 if a == b
2425 * -1 if a < b
2426 * -2 if either a or b is a NaN.
2428 static int
2429 ecmp (const short unsigned int *a, const short unsigned int *b)
2431 unsigned short ai[NI], bi[NI];
2432 register unsigned short *p, *q;
2433 register int i;
2434 int msign;
2436 #ifdef NANS
2437 if (eisnan (a) || eisnan (b))
2438 return (-2);
2439 #endif
2440 emovi (a, ai);
2441 p = ai;
2442 emovi (b, bi);
2443 q = bi;
2445 if (*p != *q)
2446 { /* the signs are different */
2447 /* -0 equals + 0 */
2448 for (i = 1; i < NI - 1; i++)
2450 if (ai[i] != 0)
2451 goto nzro;
2452 if (bi[i] != 0)
2453 goto nzro;
2455 return (0);
2456 nzro:
2457 if (*p == 0)
2458 return (1);
2459 else
2460 return (-1);
2462 /* both are the same sign */
2463 if (*p == 0)
2464 msign = 1;
2465 else
2466 msign = -1;
2467 i = NI - 1;
2470 if (*p++ != *q++)
2472 goto diff;
2475 while (--i > 0);
2477 return (0); /* equality */
2481 diff:
2483 if (*(--p) > *(--q))
2484 return (msign); /* p is bigger */
2485 else
2486 return (-msign); /* p is littler */
2491 ; Shift significand
2493 ; Shifts significand area up or down by the number of bits
2494 ; given by the variable sc.
2496 static int
2497 eshift (short unsigned int *x, int sc)
2499 unsigned short lost;
2500 unsigned short *p;
2502 if (sc == 0)
2503 return (0);
2505 lost = 0;
2506 p = x + NI - 1;
2508 if (sc < 0)
2510 sc = -sc;
2511 while (sc >= 16)
2513 lost |= *p; /* remember lost bits */
2514 eshdn6 (x);
2515 sc -= 16;
2518 while (sc >= 8)
2520 lost |= *p & 0xff;
2521 eshdn8 (x);
2522 sc -= 8;
2525 while (sc > 0)
2527 lost |= *p & 1;
2528 eshdn1 (x);
2529 sc -= 1;
2532 else
2534 while (sc >= 16)
2536 eshup6 (x);
2537 sc -= 16;
2540 while (sc >= 8)
2542 eshup8 (x);
2543 sc -= 8;
2546 while (sc > 0)
2548 eshup1 (x);
2549 sc -= 1;
2552 if (lost)
2553 lost = 1;
2554 return ((int) lost);
2560 ; normalize
2562 ; Shift normalizes the significand area pointed to by argument
2563 ; shift count (up = positive) is returned.
2565 static int
2566 enormlz (short unsigned int *x)
2568 register unsigned short *p;
2569 int sc;
2571 sc = 0;
2572 p = &x[M];
2573 if (*p != 0)
2574 goto normdn;
2575 ++p;
2576 if (*p & 0x8000)
2577 return (0); /* already normalized */
2578 while (*p == 0)
2580 eshup6 (x);
2581 sc += 16;
2582 /* With guard word, there are NBITS+16 bits available.
2583 * return true if all are zero.
2585 if (sc > NBITS)
2586 return (sc);
2588 /* see if high byte is zero */
2589 while ((*p & 0xff00) == 0)
2591 eshup8 (x);
2592 sc += 8;
2594 /* now shift 1 bit at a time */
2595 while ((*p & 0x8000) == 0)
2597 eshup1 (x);
2598 sc += 1;
2599 if (sc > (NBITS + 16))
2601 mtherr ("enormlz", UNDERFLOW);
2602 return (sc);
2605 return (sc);
2607 /* Normalize by shifting down out of the high guard word
2608 of the significand */
2609 normdn:
2611 if (*p & 0xff00)
2613 eshdn8 (x);
2614 sc -= 8;
2616 while (*p != 0)
2618 eshdn1 (x);
2619 sc -= 1;
2621 if (sc < -NBITS)
2623 mtherr ("enormlz", OVERFLOW);
2624 return (sc);
2627 return (sc);
2633 /* Convert e type number to decimal format ASCII string.
2634 * The constants are for 64 bit precision.
2637 #define NTEN 12
2638 #define MAXP 4096
2640 #if NE == 10
2641 static const unsigned short etens[NTEN + 1][NE] = {
2642 {0x6576, 0x4a92, 0x804a, 0x153f,
2643 0xc94c, 0x979a, 0x8a20, 0x5202, 0xc460, 0x7525,}, /* 10**4096 */
2644 {0x6a32, 0xce52, 0x329a, 0x28ce,
2645 0xa74d, 0x5de4, 0xc53d, 0x3b5d, 0x9e8b, 0x5a92,}, /* 10**2048 */
2646 {0x526c, 0x50ce, 0xf18b, 0x3d28,
2647 0x650d, 0x0c17, 0x8175, 0x7586, 0xc976, 0x4d48,},
2648 {0x9c66, 0x58f8, 0xbc50, 0x5c54,
2649 0xcc65, 0x91c6, 0xa60e, 0xa0ae, 0xe319, 0x46a3,},
2650 {0x851e, 0xeab7, 0x98fe, 0x901b,
2651 0xddbb, 0xde8d, 0x9df9, 0xebfb, 0xaa7e, 0x4351,},
2652 {0x0235, 0x0137, 0x36b1, 0x336c,
2653 0xc66f, 0x8cdf, 0x80e9, 0x47c9, 0x93ba, 0x41a8,},
2654 {0x50f8, 0x25fb, 0xc76b, 0x6b71,
2655 0x3cbf, 0xa6d5, 0xffcf, 0x1f49, 0xc278, 0x40d3,},
2656 {0x0000, 0x0000, 0x0000, 0x0000,
2657 0xf020, 0xb59d, 0x2b70, 0xada8, 0x9dc5, 0x4069,},
2658 {0x0000, 0x0000, 0x0000, 0x0000,
2659 0x0000, 0x0000, 0x0400, 0xc9bf, 0x8e1b, 0x4034,},
2660 {0x0000, 0x0000, 0x0000, 0x0000,
2661 0x0000, 0x0000, 0x0000, 0x2000, 0xbebc, 0x4019,},
2662 {0x0000, 0x0000, 0x0000, 0x0000,
2663 0x0000, 0x0000, 0x0000, 0x0000, 0x9c40, 0x400c,},
2664 {0x0000, 0x0000, 0x0000, 0x0000,
2665 0x0000, 0x0000, 0x0000, 0x0000, 0xc800, 0x4005,},
2666 {0x0000, 0x0000, 0x0000, 0x0000,
2667 0x0000, 0x0000, 0x0000, 0x0000, 0xa000, 0x4002,}, /* 10**1 */
2670 static const unsigned short emtens[NTEN + 1][NE] = {
2671 {0x2030, 0xcffc, 0xa1c3, 0x8123,
2672 0x2de3, 0x9fde, 0xd2ce, 0x04c8, 0xa6dd, 0x0ad8,}, /* 10**-4096 */
2673 {0x8264, 0xd2cb, 0xf2ea, 0x12d4,
2674 0x4925, 0x2de4, 0x3436, 0x534f, 0xceae, 0x256b,}, /* 10**-2048 */
2675 {0xf53f, 0xf698, 0x6bd3, 0x0158,
2676 0x87a6, 0xc0bd, 0xda57, 0x82a5, 0xa2a6, 0x32b5,},
2677 {0xe731, 0x04d4, 0xe3f2, 0xd332,
2678 0x7132, 0xd21c, 0xdb23, 0xee32, 0x9049, 0x395a,},
2679 {0xa23e, 0x5308, 0xfefb, 0x1155,
2680 0xfa91, 0x1939, 0x637a, 0x4325, 0xc031, 0x3cac,},
2681 {0xe26d, 0xdbde, 0xd05d, 0xb3f6,
2682 0xac7c, 0xe4a0, 0x64bc, 0x467c, 0xddd0, 0x3e55,},
2683 {0x2a20, 0x6224, 0x47b3, 0x98d7,
2684 0x3f23, 0xe9a5, 0xa539, 0xea27, 0xa87f, 0x3f2a,},
2685 {0x0b5b, 0x4af2, 0xa581, 0x18ed,
2686 0x67de, 0x94ba, 0x4539, 0x1ead, 0xcfb1, 0x3f94,},
2687 {0xbf71, 0xa9b3, 0x7989, 0xbe68,
2688 0x4c2e, 0xe15b, 0xc44d, 0x94be, 0xe695, 0x3fc9,},
2689 {0x3d4d, 0x7c3d, 0x36ba, 0x0d2b,
2690 0xfdc2, 0xcefc, 0x8461, 0x7711, 0xabcc, 0x3fe4,},
2691 {0xc155, 0xa4a8, 0x404e, 0x6113,
2692 0xd3c3, 0x652b, 0xe219, 0x1758, 0xd1b7, 0x3ff1,},
2693 {0xd70a, 0x70a3, 0x0a3d, 0xa3d7,
2694 0x3d70, 0xd70a, 0x70a3, 0x0a3d, 0xa3d7, 0x3ff8,},
2695 {0xcccd, 0xcccc, 0xcccc, 0xcccc,
2696 0xcccc, 0xcccc, 0xcccc, 0xcccc, 0xcccc, 0x3ffb,}, /* 10**-1 */
2698 #else
2699 static const unsigned short etens[NTEN + 1][NE] = {
2700 {0xc94c, 0x979a, 0x8a20, 0x5202, 0xc460, 0x7525,}, /* 10**4096 */
2701 {0xa74d, 0x5de4, 0xc53d, 0x3b5d, 0x9e8b, 0x5a92,}, /* 10**2048 */
2702 {0x650d, 0x0c17, 0x8175, 0x7586, 0xc976, 0x4d48,},
2703 {0xcc65, 0x91c6, 0xa60e, 0xa0ae, 0xe319, 0x46a3,},
2704 {0xddbc, 0xde8d, 0x9df9, 0xebfb, 0xaa7e, 0x4351,},
2705 {0xc66f, 0x8cdf, 0x80e9, 0x47c9, 0x93ba, 0x41a8,},
2706 {0x3cbf, 0xa6d5, 0xffcf, 0x1f49, 0xc278, 0x40d3,},
2707 {0xf020, 0xb59d, 0x2b70, 0xada8, 0x9dc5, 0x4069,},
2708 {0x0000, 0x0000, 0x0400, 0xc9bf, 0x8e1b, 0x4034,},
2709 {0x0000, 0x0000, 0x0000, 0x2000, 0xbebc, 0x4019,},
2710 {0x0000, 0x0000, 0x0000, 0x0000, 0x9c40, 0x400c,},
2711 {0x0000, 0x0000, 0x0000, 0x0000, 0xc800, 0x4005,},
2712 {0x0000, 0x0000, 0x0000, 0x0000, 0xa000, 0x4002,}, /* 10**1 */
2715 static const unsigned short emtens[NTEN + 1][NE] = {
2716 {0x2de4, 0x9fde, 0xd2ce, 0x04c8, 0xa6dd, 0x0ad8,}, /* 10**-4096 */
2717 {0x4925, 0x2de4, 0x3436, 0x534f, 0xceae, 0x256b,}, /* 10**-2048 */
2718 {0x87a6, 0xc0bd, 0xda57, 0x82a5, 0xa2a6, 0x32b5,},
2719 {0x7133, 0xd21c, 0xdb23, 0xee32, 0x9049, 0x395a,},
2720 {0xfa91, 0x1939, 0x637a, 0x4325, 0xc031, 0x3cac,},
2721 {0xac7d, 0xe4a0, 0x64bc, 0x467c, 0xddd0, 0x3e55,},
2722 {0x3f24, 0xe9a5, 0xa539, 0xea27, 0xa87f, 0x3f2a,},
2723 {0x67de, 0x94ba, 0x4539, 0x1ead, 0xcfb1, 0x3f94,},
2724 {0x4c2f, 0xe15b, 0xc44d, 0x94be, 0xe695, 0x3fc9,},
2725 {0xfdc2, 0xcefc, 0x8461, 0x7711, 0xabcc, 0x3fe4,},
2726 {0xd3c3, 0x652b, 0xe219, 0x1758, 0xd1b7, 0x3ff1,},
2727 {0x3d71, 0xd70a, 0x70a3, 0x0a3d, 0xa3d7, 0x3ff8,},
2728 {0xcccd, 0xcccc, 0xcccc, 0xcccc, 0xcccc, 0x3ffb,}, /* 10**-1 */
2730 #endif
2734 /* ASCII string outputs for unix */
2737 #if 0
2738 void
2739 _IO_ldtostr (x, string, ndigs, flags, fmt)
2740 long double *x;
2741 char *string;
2742 int ndigs;
2743 int flags;
2744 char fmt;
2746 unsigned short w[NI];
2747 char *t, *u;
2748 LDPARMS rnd;
2749 LDPARMS *ldp = &rnd;
2751 rnd.rlast = -1;
2752 rnd.rndprc = NBITS;
2754 if (sizeof (long double) == 16)
2755 e113toe ((unsigned short *) x, w, ldp);
2756 else
2757 e64toe ((unsigned short *) x, w, ldp);
2759 etoasc (w, string, ndigs, -1, ldp);
2760 if (ndigs == 0 && flags == 0)
2762 /* Delete the decimal point unless alternate format. */
2763 t = string;
2764 while (*t != '.')
2765 ++t;
2766 u = t + 1;
2767 while (*t != '\0')
2768 *t++ = *u++;
2770 if (*string == ' ')
2772 t = string;
2773 u = t + 1;
2774 while (*t != '\0')
2775 *t++ = *u++;
2777 if (fmt == 'E')
2779 t = string;
2780 while (*t != 'e')
2781 ++t;
2782 *t = 'E';
2786 #endif
2788 /* This routine will not return more than NDEC+1 digits. */
2790 char *
2791 _ldtoa_r (struct _reent *ptr, long double d, int mode, int ndigits,
2792 int *decpt, int *sign, char **rve)
2794 unsigned short e[NI];
2795 char *s, *p;
2796 int i, j, k;
2797 int orig_ndigits;
2798 LDPARMS rnd;
2799 LDPARMS *ldp = &rnd;
2800 char *outstr;
2801 char outbuf_sml[NDEC_SML + MAX_EXP_DIGITS + 10];
2802 char *outbuf = outbuf_sml;
2803 union uconv du;
2804 du.d = d;
2806 orig_ndigits = ndigits;
2807 rnd.rlast = -1;
2808 rnd.rndprc = NBITS;
2810 _REENT_CHECK_MP (ptr);
2812 /* reentrancy addition to use mprec storage pool */
2813 if (_REENT_MP_RESULT (ptr))
2815 _REENT_MP_RESULT (ptr)->_k = _REENT_MP_RESULT_K (ptr);
2816 _REENT_MP_RESULT (ptr)->_maxwds = 1 << _REENT_MP_RESULT_K (ptr);
2817 Bfree (ptr, _REENT_MP_RESULT (ptr));
2818 _REENT_MP_RESULT (ptr) = 0;
2821 #if LDBL_MANT_DIG == 24
2822 e24toe (&du.pe, e, ldp);
2823 #elif LDBL_MANT_DIG == 53
2824 e53toe (&du.pe, e, ldp);
2825 #elif LDBL_MANT_DIG == 64
2826 e64toe (&du.pe, e, ldp);
2827 #else
2828 e113toe (&du.pe, e, ldp);
2829 #endif
2831 if (eisneg (e))
2832 *sign = 1;
2833 else
2834 *sign = 0;
2835 /* Mode 3 is "f" format. */
2836 if (mode != 3)
2837 ndigits -= 1;
2838 /* Mode 0 is for %.999 format, which is supposed to give a
2839 minimum length string that will convert back to the same binary value.
2840 For now, just ask for 20 digits which is enough but sometimes too many. */
2841 if (mode == 0)
2842 ndigits = 20;
2844 /* This sanity limit must agree with the corresponding one in etoasc, to
2845 keep straight the returned value of outexpon. Note that we use a dynamic
2846 limit now, either ndec (<= NDEC) or NDEC_SML, depending on ndigits. */
2847 __int32_t ndec;
2848 if (mode == 3) /* %f */
2850 __int32_t expon = (e[NE - 1] & 0x7fff) - (EXONE - 1); /* exponent part */
2851 /* log2(10) approximately 485/146 */
2852 ndec = expon * 146 / 485 + ndigits;
2854 else /* %g/%e */
2855 ndec = ndigits;
2856 if (ndec < 0)
2857 ndec = 0;
2858 if (ndec > NDEC)
2859 ndec = NDEC;
2861 /* Allocate buffer if more than NDEC_SML digits are requested. */
2862 if (ndec > NDEC_SML)
2864 outbuf = (char *) _malloc_r (ptr, ndec + MAX_EXP_DIGITS + 10);
2865 if (!outbuf)
2867 ndec = NDEC_SML;
2868 outbuf = outbuf_sml;
2872 etoasc (e, outbuf, (int) ndec, ndigits, mode, ldp);
2873 s = outbuf;
2874 if (eisinf (e) || eisnan (e))
2876 *decpt = 9999;
2877 goto stripspaces;
2879 *decpt = ldp->outexpon + 1;
2881 /* Transform the string returned by etoasc into what the caller wants. */
2883 /* Look for decimal point and delete it from the string. */
2884 s = outbuf;
2885 while (*s != '\0')
2887 if (*s == '.')
2888 goto yesdecpt;
2889 ++s;
2891 goto nodecpt;
2893 yesdecpt:
2895 /* Delete the decimal point. */
2896 while (*s != '\0')
2898 *s = *(s + 1);
2899 ++s;
2902 nodecpt:
2904 /* Back up over the exponent field. */
2905 while (*s != 'E' && s > outbuf)
2906 --s;
2907 *s = '\0';
2909 stripspaces:
2911 /* Strip leading spaces and sign. */
2912 p = outbuf;
2913 while (*p == ' ' || *p == '-')
2914 ++p;
2916 /* Find new end of string. */
2917 s = outbuf;
2918 while ((*s++ = *p++) != '\0')
2920 --s;
2922 /* Strip trailing zeros. */
2923 if (mode == 2)
2924 k = 1;
2925 else if (ndigits > ldp->outexpon)
2926 k = ndigits;
2927 else
2928 k = ldp->outexpon;
2930 while (*(s - 1) == '0' && ((s - outbuf) > k))
2931 *(--s) = '\0';
2933 /* In f format, flush small off-scale values to zero.
2934 Rounding has been taken care of by etoasc. */
2935 if (mode == 3 && ((ndigits + ldp->outexpon) < 0))
2937 s = outbuf;
2938 *s = '\0';
2939 *decpt = 0;
2942 /* reentrancy addition to use mprec storage pool */
2943 /* we want to have enough space to hold the formatted result */
2945 if (mode == 3) /* f format, account for sign + dec digits + decpt + frac */
2946 i = *decpt + orig_ndigits + 3;
2947 else /* account for sign + max precision digs + E + exp sign + exponent */
2948 i = orig_ndigits + MAX_EXP_DIGITS + 4;
2950 j = sizeof (__ULong);
2951 for (_REENT_MP_RESULT_K (ptr) = 0;
2952 sizeof (_Bigint) - sizeof (__ULong) + j <= i; j <<= 1)
2953 _REENT_MP_RESULT_K (ptr)++;
2954 _REENT_MP_RESULT (ptr) = eBalloc (ptr, _REENT_MP_RESULT_K (ptr));
2956 /* Copy from internal temporary buffer to permanent buffer. */
2957 outstr = (char *) _REENT_MP_RESULT (ptr);
2958 strcpy (outstr, outbuf);
2960 if (rve)
2961 *rve = outstr + (s - outbuf);
2963 if (outbuf != outbuf_sml)
2964 _free_r (ptr, outbuf);
2966 return outstr;
2969 /* Routine used to tell if long double is NaN or Infinity or regular number.
2970 Returns: 0 = regular number
2971 1 = Nan
2972 2 = Infinity
2975 _ldcheck (long double *d)
2977 unsigned short e[NI];
2978 LDPARMS rnd;
2979 LDPARMS *ldp = &rnd;
2981 union uconv du;
2983 rnd.rlast = -1;
2984 rnd.rndprc = NBITS;
2985 du.d = *d;
2986 #if LDBL_MANT_DIG == 24
2987 e24toe (&du.pe, e, ldp);
2988 #elif LDBL_MANT_DIG == 53
2989 e53toe (&du.pe, e, ldp);
2990 #elif LDBL_MANT_DIG == 64
2991 e64toe (&du.pe, e, ldp);
2992 #else
2993 e113toe (&du.pe, e, ldp);
2994 #endif
2996 if ((e[NE - 1] & 0x7fff) == 0x7fff)
2998 #ifdef NANS
2999 if (eisnan (e))
3000 return (1);
3001 #endif
3002 return (2);
3004 else
3005 return (0);
3006 } /* _ldcheck */
3008 static void
3009 etoasc (short unsigned int *x, char *string, int ndec, int ndigits,
3010 int outformat, LDPARMS * ldp)
3012 long digit;
3013 unsigned short y[NI], t[NI], u[NI], w[NI];
3014 const unsigned short *p, *r, *ten;
3015 unsigned short sign;
3016 int i, j, k, expon, rndsav, ndigs;
3017 char *s, *ss;
3018 unsigned short m;
3019 unsigned short *equot = ldp->equot;
3021 ndigs = ndigits;
3022 rndsav = ldp->rndprc;
3023 #ifdef NANS
3024 if (eisnan (x))
3026 sprintf (string, " NaN ");
3027 expon = 9999;
3028 goto bxit;
3030 #endif
3031 ldp->rndprc = NBITS; /* set to full precision */
3032 emov (x, y); /* retain external format */
3033 if (y[NE - 1] & 0x8000)
3035 sign = 0xffff;
3036 y[NE - 1] &= 0x7fff;
3038 else
3040 sign = 0;
3042 expon = 0;
3043 ten = &etens[NTEN][0];
3044 emov (eone, t);
3045 /* Test for zero exponent */
3046 if (y[NE - 1] == 0)
3048 for (k = 0; k < NE - 1; k++)
3050 if (y[k] != 0)
3051 goto tnzro; /* denormalized number */
3053 goto isone; /* legal all zeros */
3055 tnzro:
3057 /* Test for infinity.
3059 if (y[NE - 1] == 0x7fff)
3061 if (sign)
3062 sprintf (string, " -Infinity ");
3063 else
3064 sprintf (string, " Infinity ");
3065 expon = 9999;
3066 goto bxit;
3069 /* Test for exponent nonzero but significand denormalized.
3070 * This is an error condition.
3072 if ((y[NE - 1] != 0) && ((y[NE - 2] & 0x8000) == 0))
3074 mtherr ("etoasc", DOMAIN);
3075 sprintf (string, "NaN");
3076 expon = 9999;
3077 goto bxit;
3080 /* Compare to 1.0 */
3081 i = ecmp (eone, y);
3082 if (i == 0)
3083 goto isone;
3085 if (i < 0)
3086 { /* Number is greater than 1 */
3087 /* Convert significand to an integer and strip trailing decimal zeros. */
3088 emov (y, u);
3089 u[NE - 1] = EXONE + NBITS - 1;
3091 p = &etens[NTEN - 4][0];
3092 m = 16;
3095 ediv (p, u, t, ldp);
3096 efloor (t, w, ldp);
3097 for (j = 0; j < NE - 1; j++)
3099 if (t[j] != w[j])
3100 goto noint;
3102 emov (t, u);
3103 expon += (int) m;
3104 noint:
3105 p += NE;
3106 m >>= 1;
3108 while (m != 0);
3110 /* Rescale from integer significand */
3111 u[NE - 1] += y[NE - 1] - (unsigned int) (EXONE + NBITS - 1);
3112 emov (u, y);
3113 /* Find power of 10 */
3114 emov (eone, t);
3115 m = MAXP;
3116 p = &etens[0][0];
3117 while (ecmp (ten, u) <= 0)
3119 if (ecmp (p, u) <= 0)
3121 ediv (p, u, u, ldp);
3122 emul (p, t, t, ldp);
3123 expon += (int) m;
3125 m >>= 1;
3126 if (m == 0)
3127 break;
3128 p += NE;
3131 else
3132 { /* Number is less than 1.0 */
3133 /* Pad significand with trailing decimal zeros. */
3134 if (y[NE - 1] == 0)
3136 while ((y[NE - 2] & 0x8000) == 0)
3138 emul (ten, y, y, ldp);
3139 expon -= 1;
3142 else
3144 emovi (y, w);
3145 for (i = 0; i < ndec + 1; i++)
3147 if ((w[NI - 1] & 0x7) != 0)
3148 break;
3149 /* multiply by 10 */
3150 emovz (w, u);
3151 eshdn1 (u);
3152 eshdn1 (u);
3153 eaddm (w, u);
3154 u[1] += 3;
3155 while (u[2] != 0)
3157 eshdn1 (u);
3158 u[1] += 1;
3160 if (u[NI - 1] != 0)
3161 break;
3162 if (eone[NE - 1] <= u[1])
3163 break;
3164 emovz (u, w);
3165 expon -= 1;
3167 emovo (w, y, ldp);
3169 k = -MAXP;
3170 p = &emtens[0][0];
3171 r = &etens[0][0];
3172 emov (y, w);
3173 emov (eone, t);
3174 while (ecmp (eone, w) > 0)
3176 if (ecmp (p, w) >= 0)
3178 emul (r, w, w, ldp);
3179 emul (r, t, t, ldp);
3180 expon += k;
3182 k /= 2;
3183 if (k == 0)
3184 break;
3185 p += NE;
3186 r += NE;
3188 ediv (t, eone, t, ldp);
3190 isone:
3191 /* Find the first (leading) digit. */
3192 emovi (t, w);
3193 emovz (w, t);
3194 emovi (y, w);
3195 emovz (w, y);
3196 eiremain (t, y, ldp);
3197 digit = equot[NI - 1];
3198 while ((digit == 0) && (ecmp (y, ezero) != 0))
3200 eshup1 (y);
3201 emovz (y, u);
3202 eshup1 (u);
3203 eshup1 (u);
3204 eaddm (u, y);
3205 eiremain (t, y, ldp);
3206 digit = equot[NI - 1];
3207 expon -= 1;
3209 s = string;
3210 if (sign)
3211 *s++ = '-';
3212 else
3213 *s++ = ' ';
3214 /* Examine number of digits requested by caller. */
3215 if (outformat == 3)
3216 ndigs += expon;
3218 else if( ndigs < 0 )
3219 ndigs = 0;
3221 if (ndigs > ndec)
3222 ndigs = ndec;
3223 if (digit == 10)
3225 *s++ = '1';
3226 *s++ = '.';
3227 if (ndigs > 0)
3229 *s++ = '0';
3230 ndigs -= 1;
3232 expon += 1;
3233 if (ndigs < 0)
3235 ss = s;
3236 goto doexp;
3239 else
3241 *s++ = (char) digit + '0';
3242 *s++ = '.';
3244 /* Generate digits after the decimal point. */
3245 for (k = 0; k <= ndigs; k++)
3247 /* multiply current number by 10, without normalizing */
3248 eshup1 (y);
3249 emovz (y, u);
3250 eshup1 (u);
3251 eshup1 (u);
3252 eaddm (u, y);
3253 eiremain (t, y, ldp);
3254 *s++ = (char) equot[NI - 1] + '0';
3256 digit = equot[NI - 1];
3257 --s;
3258 ss = s;
3259 /* round off the ASCII string */
3260 if (digit > 4)
3262 /* Test for critical rounding case in ASCII output. */
3263 if (digit == 5)
3265 emovo (y, t, ldp);
3266 if (ecmp (t, ezero) != 0)
3267 goto roun; /* round to nearest */
3268 if (ndigs < 0 || (*(s - 1 - (*(s - 1) == '.')) & 1) == 0)
3269 goto doexp; /* round to even */
3271 /* Round up and propagate carry-outs */
3272 roun:
3273 --s;
3274 k = *s & 0x7f;
3275 /* Carry out to most significant digit? */
3276 if (ndigs < 0)
3278 /* This will print like "1E-6". */
3279 *s = '1';
3280 expon += 1;
3281 goto doexp;
3283 else if (k == '.')
3285 --s;
3286 k = *s;
3287 k += 1;
3288 *s = (char) k;
3289 /* Most significant digit carries to 10? */
3290 if (k > '9')
3292 expon += 1;
3293 *s = '1';
3295 goto doexp;
3297 /* Round up and carry out from less significant digits */
3298 k += 1;
3299 *s = (char) k;
3300 if (k > '9')
3302 *s = '0';
3303 goto roun;
3306 doexp:
3307 #ifdef __GO32__
3308 if (expon >= 0)
3309 sprintf (ss, "e+%02d", expon);
3310 else
3311 sprintf (ss, "e-%02d", -expon);
3312 #else
3313 sprintf (ss, "E%d", expon);
3314 #endif
3315 bxit:
3316 ldp->rndprc = rndsav;
3317 ldp->outexpon = expon;
3321 #if 0 /* Broken, unusable implementation of strtold */
3324 ; ASCTOQ
3325 ; ASCTOQ.MAC LATEST REV: 11 JAN 84
3326 ; SLM, 3 JAN 78
3328 ; Convert ASCII string to quadruple precision floating point
3330 ; Numeric input is free field decimal number
3331 ; with max of 15 digits with or without
3332 ; decimal point entered as ASCII from teletype.
3333 ; Entering E after the number followed by a second
3334 ; number causes the second number to be interpreted
3335 ; as a power of 10 to be multiplied by the first number
3336 ; (i.e., "scientific" notation).
3338 ; Usage:
3339 ; asctoq( string, q );
3342 long double
3343 _strtold (char *s, char **se)
3345 union uconv x;
3346 LDPARMS rnd;
3347 LDPARMS *ldp = &rnd;
3348 int lenldstr;
3350 rnd.rlast = -1;
3351 rnd.rndprc = NBITS;
3353 lenldstr = asctoeg (s, &x.pe, LDBL_MANT_DIG, ldp);
3354 if (se)
3355 *se = s + lenldstr;
3356 return x.d;
3359 #define REASONABLE_LEN 200
3361 static int
3362 asctoeg (char *ss, short unsigned int *y, int oprec, LDPARMS * ldp)
3364 unsigned short yy[NI], xt[NI], tt[NI];
3365 int esign, decflg, sgnflg, nexp, exp, prec, lost;
3366 int k, trail, c, rndsav;
3367 long lexp;
3368 unsigned short nsign;
3369 const unsigned short *p;
3370 char *sp, *s, *lstr;
3371 int lenldstr;
3372 int mflag = 0;
3373 char tmpstr[REASONABLE_LEN];
3375 /* Copy the input string. */
3376 c = strlen (ss) + 2;
3377 if (c <= REASONABLE_LEN)
3378 lstr = tmpstr;
3379 else
3381 lstr = (char *) calloc (c, 1);
3382 mflag = 1;
3384 s = ss;
3385 lenldstr = 0;
3386 while (*s == ' ') /* skip leading spaces */
3388 ++s;
3389 ++lenldstr;
3391 sp = lstr;
3392 for (k = 0; k < c; k++)
3394 if ((*sp++ = *s++) == '\0')
3395 break;
3397 *sp = '\0';
3398 s = lstr;
3400 rndsav = ldp->rndprc;
3401 ldp->rndprc = NBITS; /* Set to full precision */
3402 lost = 0;
3403 nsign = 0;
3404 decflg = 0;
3405 sgnflg = 0;
3406 nexp = 0;
3407 exp = 0;
3408 prec = 0;
3409 ecleaz (yy);
3410 trail = 0;
3412 nxtcom:
3413 k = *s - '0';
3414 if ((k >= 0) && (k <= 9))
3416 /* Ignore leading zeros */
3417 if ((prec == 0) && (decflg == 0) && (k == 0))
3418 goto donchr;
3419 /* Identify and strip trailing zeros after the decimal point. */
3420 if ((trail == 0) && (decflg != 0))
3422 sp = s;
3423 while ((*sp >= '0') && (*sp <= '9'))
3424 ++sp;
3425 /* Check for syntax error */
3426 c = *sp & 0x7f;
3427 if ((c != 'e') && (c != 'E') && (c != '\0')
3428 && (c != '\n') && (c != '\r') && (c != ' ') && (c != ','))
3429 goto error;
3430 --sp;
3431 while (*sp == '0')
3432 *sp-- = 'z';
3433 trail = 1;
3434 if (*s == 'z')
3435 goto donchr;
3437 /* If enough digits were given to more than fill up the yy register,
3438 * continuing until overflow into the high guard word yy[2]
3439 * guarantees that there will be a roundoff bit at the top
3440 * of the low guard word after normalization.
3442 if (yy[2] == 0)
3444 if (decflg)
3445 nexp += 1; /* count digits after decimal point */
3446 eshup1 (yy); /* multiply current number by 10 */
3447 emovz (yy, xt);
3448 eshup1 (xt);
3449 eshup1 (xt);
3450 eaddm (xt, yy);
3451 ecleaz (xt);
3452 xt[NI - 2] = (unsigned short) k;
3453 eaddm (xt, yy);
3455 else
3457 /* Mark any lost non-zero digit. */
3458 lost |= k;
3459 /* Count lost digits before the decimal point. */
3460 if (decflg == 0)
3461 nexp -= 1;
3463 prec += 1;
3464 goto donchr;
3467 switch (*s)
3469 case 'z':
3470 break;
3471 case 'E':
3472 case 'e':
3473 goto expnt;
3474 case '.': /* decimal point */
3475 if (decflg)
3476 goto error;
3477 ++decflg;
3478 break;
3479 case '-':
3480 nsign = 0xffff;
3481 if (sgnflg)
3482 goto error;
3483 ++sgnflg;
3484 break;
3485 case '+':
3486 if (sgnflg)
3487 goto error;
3488 ++sgnflg;
3489 break;
3490 case ',':
3491 case ' ':
3492 case '\0':
3493 case '\n':
3494 case '\r':
3495 goto daldone;
3496 case 'i':
3497 case 'I':
3498 goto infinite;
3499 default:
3500 error:
3501 #ifdef NANS
3502 enan (yy, NI * 16);
3503 #else
3504 mtherr ("asctoe", DOMAIN);
3505 ecleaz (yy);
3506 #endif
3507 goto aexit;
3509 donchr:
3510 ++s;
3511 goto nxtcom;
3513 /* Exponent interpretation */
3514 expnt:
3516 esign = 1;
3517 exp = 0;
3518 ++s;
3519 /* check for + or - */
3520 if (*s == '-')
3522 esign = -1;
3523 ++s;
3525 if (*s == '+')
3526 ++s;
3527 while ((*s >= '0') && (*s <= '9'))
3529 exp *= 10;
3530 exp += *s++ - '0';
3531 if (exp > 4977)
3533 if (esign < 0)
3534 goto zero;
3535 else
3536 goto infinite;
3539 if (esign < 0)
3540 exp = -exp;
3541 if (exp > 4932)
3543 infinite:
3544 ecleaz (yy);
3545 yy[E] = 0x7fff; /* infinity */
3546 goto aexit;
3548 if (exp < -4977)
3550 zero:
3551 ecleaz (yy);
3552 goto aexit;
3555 daldone:
3556 nexp = exp - nexp;
3557 /* Pad trailing zeros to minimize power of 10, per IEEE spec. */
3558 while ((nexp > 0) && (yy[2] == 0))
3560 emovz (yy, xt);
3561 eshup1 (xt);
3562 eshup1 (xt);
3563 eaddm (yy, xt);
3564 eshup1 (xt);
3565 if (xt[2] != 0)
3566 break;
3567 nexp -= 1;
3568 emovz (xt, yy);
3570 if ((k = enormlz (yy)) > NBITS)
3572 ecleaz (yy);
3573 goto aexit;
3575 lexp = (EXONE - 1 + NBITS) - k;
3576 emdnorm (yy, lost, 0, lexp, 64, ldp);
3577 /* convert to external format */
3580 /* Multiply by 10**nexp. If precision is 64 bits,
3581 * the maximum relative error incurred in forming 10**n
3582 * for 0 <= n <= 324 is 8.2e-20, at 10**180.
3583 * For 0 <= n <= 999, the peak relative error is 1.4e-19 at 10**947.
3584 * For 0 >= n >= -999, it is -1.55e-19 at 10**-435.
3586 lexp = yy[E];
3587 if (nexp == 0)
3589 k = 0;
3590 goto expdon;
3592 esign = 1;
3593 if (nexp < 0)
3595 nexp = -nexp;
3596 esign = -1;
3597 if (nexp > 4096)
3598 { /* Punt. Can't handle this without 2 divides. */
3599 emovi (etens[0], tt);
3600 lexp -= tt[E];
3601 k = edivm (tt, yy, ldp);
3602 lexp += EXONE;
3603 nexp -= 4096;
3606 p = &etens[NTEN][0];
3607 emov (eone, xt);
3608 exp = 1;
3611 if (exp & nexp)
3612 emul (p, xt, xt, ldp);
3613 p -= NE;
3614 exp = exp + exp;
3616 while (exp <= MAXP);
3618 emovi (xt, tt);
3619 if (esign < 0)
3621 lexp -= tt[E];
3622 k = edivm (tt, yy, ldp);
3623 lexp += EXONE;
3625 else
3627 lexp += tt[E];
3628 k = emulm (tt, yy, ldp);
3629 lexp -= EXONE - 1;
3632 expdon:
3634 /* Round and convert directly to the destination type */
3635 if (oprec == 53)
3636 lexp -= EXONE - 0x3ff;
3637 else if (oprec == 24)
3638 lexp -= EXONE - 0177;
3639 #ifdef DEC
3640 else if (oprec == 56)
3641 lexp -= EXONE - 0201;
3642 #endif
3643 ldp->rndprc = oprec;
3644 emdnorm (yy, k, 0, lexp, 64, ldp);
3646 aexit:
3648 ldp->rndprc = rndsav;
3649 yy[0] = nsign;
3650 switch (oprec)
3652 #ifdef DEC
3653 case 56:
3654 todec (yy, y); /* see etodec.c */
3655 break;
3656 #endif
3657 #if LDBL_MANT_DIG == 53
3658 case 53:
3659 toe53 (yy, y);
3660 break;
3661 #elif LDBL_MANT_DIG == 24
3662 case 24:
3663 toe24 (yy, y);
3664 break;
3665 #elif LDBL_MANT_DIG == 64
3666 case 64:
3667 toe64 (yy, y);
3668 break;
3669 #elif LDBL_MANT_DIG == 113
3670 case 113:
3671 toe113 (yy, y);
3672 break;
3673 #else
3674 case NBITS:
3675 emovo (yy, y, ldp);
3676 break;
3677 #endif
3679 lenldstr += s - lstr;
3680 if (mflag)
3681 free (lstr);
3682 return lenldstr;
3685 #endif
3687 /* y = largest integer not greater than x
3688 * (truncated toward minus infinity)
3690 * unsigned short x[NE], y[NE]
3691 * LDPARMS *ldp
3693 * efloor( x, y, ldp );
3695 static const unsigned short bmask[] = {
3696 0xffff,
3697 0xfffe,
3698 0xfffc,
3699 0xfff8,
3700 0xfff0,
3701 0xffe0,
3702 0xffc0,
3703 0xff80,
3704 0xff00,
3705 0xfe00,
3706 0xfc00,
3707 0xf800,
3708 0xf000,
3709 0xe000,
3710 0xc000,
3711 0x8000,
3712 0x0000,
3715 static void
3716 efloor (short unsigned int *x, short unsigned int *y, LDPARMS * ldp)
3718 register unsigned short *p;
3719 int e, expon, i;
3720 unsigned short f[NE];
3722 emov (x, f); /* leave in external format */
3723 expon = (int) f[NE - 1];
3724 e = (expon & 0x7fff) - (EXONE - 1);
3725 if (e <= 0)
3727 eclear (y);
3728 goto isitneg;
3730 /* number of bits to clear out */
3731 e = NBITS - e;
3732 emov (f, y);
3733 if (e <= 0)
3734 return;
3736 p = &y[0];
3737 while (e >= 16)
3739 *p++ = 0;
3740 e -= 16;
3742 /* clear the remaining bits */
3743 *p &= bmask[e];
3744 /* truncate negatives toward minus infinity */
3745 isitneg:
3747 if ((unsigned short) expon & (unsigned short) 0x8000)
3749 for (i = 0; i < NE - 1; i++)
3751 if (f[i] != y[i])
3753 esub (eone, y, y, ldp);
3754 break;
3762 static void
3763 eiremain (short unsigned int *den, short unsigned int *num, LDPARMS * ldp)
3765 long ld, ln;
3766 unsigned short j;
3767 unsigned short *equot = ldp->equot;
3769 ld = den[E];
3770 ld -= enormlz (den);
3771 ln = num[E];
3772 ln -= enormlz (num);
3773 ecleaz (equot);
3774 while (ln >= ld)
3776 if (ecmpm (den, num) <= 0)
3778 esubm (den, num);
3779 j = 1;
3781 else
3783 j = 0;
3785 eshup1 (equot);
3786 equot[NI - 1] |= j;
3787 eshup1 (num);
3788 ln -= 1;
3790 emdnorm (num, 0, 0, ln, 0, ldp);
3793 /* NaN bit patterns
3795 #ifdef MIEEE
3796 #if !defined(__mips)
3797 static const unsigned short nan113[8] = {
3798 0x7fff, 0xffff, 0xffff, 0xffff, 0xffff, 0xffff, 0xffff, 0xffff
3801 static const unsigned short nan64[6] = {
3802 0x7fff, 0xffff, 0xffff, 0xffff, 0xffff, 0xffff
3804 static const unsigned short nan53[4] = { 0x7fff, 0xffff, 0xffff, 0xffff };
3805 static const unsigned short nan24[2] = { 0x7fff, 0xffff };
3806 #elif defined(__mips_nan2008) /* __mips */
3807 static const unsigned short nan113[8] = { 0x7fff, 0x8000, 0, 0, 0, 0, 0, 0 };
3808 static const unsigned short nan64[6] = { 0x7fff, 0xc000, 0, 0, 0, 0 };
3809 static const unsigned short nan53[4] = { 0x7ff8, 0, 0, 0 };
3810 static const unsigned short nan24[2] = { 0x7fc0, 0 };
3811 #else /* __mips && !__mips_nan2008 */
3812 static const unsigned short nan113[8] = {
3813 0x7fff, 0x7fff, 0xffff, 0xffff, 0xffff, 0xffff, 0xffff, 0xffff
3816 static const unsigned short nan64[6] = {
3817 0x7fff, 0xbfff, 0xffff, 0xffff, 0xffff, 0xffff
3819 static const unsigned short nan53[4] = { 0x7ff7, 0xffff, 0xffff, 0xffff };
3820 static const unsigned short nan24[2] = { 0x7fbf, 0xffff };
3821 #endif /* __mips && !__mips_nan2008 */
3822 #else /* !MIEEE */
3823 #if !defined(__mips) || defined(__mips_nan2008)
3824 static const unsigned short nan113[8] = { 0, 0, 0, 0, 0, 0, 0x8000, 0x7fff };
3825 static const unsigned short nan64[6] = { 0, 0, 0, 0, 0xc000, 0x7fff };
3826 static const unsigned short nan53[4] = { 0, 0, 0, 0x7ff8 };
3827 static const unsigned short nan24[2] = { 0, 0x7fc0 };
3828 #else /* __mips && !__mips_nan2008 */
3829 static const unsigned short nan113[8] = {
3830 0xffff, 0xffff, 0xffff, 0xffff, 0xffff, 0xffff, 0x7fff, 0x7fff
3833 static const unsigned short nan64[6] = {
3834 0xffff, 0xffff, 0xffff, 0xffff, 0xbfff, 0x7fff
3836 static const unsigned short nan53[4] = { 0xffff, 0xffff, 0xffff, 0x7ff7 };
3837 static const unsigned short nan24[2] = { 0xffff, 0x7fbf };
3838 #endif /* __mips && !__mips_nan2008 */
3839 #endif /* !MIEEE */
3842 static void
3843 enan (short unsigned int *nan, int size)
3845 int i, n;
3846 const unsigned short *p;
3848 switch (size)
3850 #ifndef DEC
3851 case 113:
3852 n = 8;
3853 p = nan113;
3854 break;
3856 case 64:
3857 n = 6;
3858 p = nan64;
3859 break;
3861 case 53:
3862 n = 4;
3863 p = nan53;
3864 break;
3866 case 24:
3867 n = 2;
3868 p = nan24;
3869 break;
3871 case NBITS:
3872 #if !defined(__mips) || defined(__mips_nan2008)
3873 for (i = 0; i < NE - 2; i++)
3874 *nan++ = 0;
3875 *nan++ = 0xc000;
3876 #else /* __mips && !__mips_nan2008 */
3877 for (i = 0; i < NE - 2; i++)
3878 *nan++ = 0xffff;
3879 *nan++ = 0xbfff;
3880 #endif /* __mips && !__mips_nan2008 */
3881 *nan++ = 0x7fff;
3882 return;
3884 case NI * 16:
3885 *nan++ = 0;
3886 *nan++ = 0x7fff;
3887 *nan++ = 0;
3888 #if !defined(__mips) || defined(__mips_nan2008)
3889 *nan++ = 0xc000;
3890 for (i = 4; i < NI - 1; i++)
3891 *nan++ = 0;
3892 #else /* __mips && !__mips_nan2008 */
3893 *nan++ = 0xbfff;
3894 for (i = 4; i < NI - 1; i++)
3895 *nan++ = 0xffff;
3896 #endif /* __mips && !__mips_nan2008 */
3897 *nan++ = 0;
3898 return;
3899 #endif
3900 default:
3901 mtherr ("enan", DOMAIN);
3902 return;
3904 for (i = 0; i < n; i++)
3905 *nan++ = *p++;
3908 #endif /* !_USE_GDTOA */