1 /* Extended precision arithmetic functions for long double I/O.
2 * This program has been placed in the public domain.
6 #include <sys/config.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 *,
20 int _ldcheck (long double *);
22 void _IO_ldtostr (long double *, char *, int, int, char);
25 /* Number of 16 bit words in external x type format */
28 /* Number of 16 bit words in internal format */
31 /* Array offset to exponent */
34 /* Array offset to high guard word */
37 /* Number of bits of precision */
38 #define NBITS ((NI-4)*16)
40 /* Maximum number of decimal digits in ASCII conversion */
42 /* Use static stack buffer for up to 44 digits */
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.
64 unsigned short rbit
[NI
];
65 unsigned short equot
[NI
];
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
,
90 static void etoasc (short unsigned int *x
, char *string
, int ndec
, int ndigs
,
91 int outformat
, LDPARMS
* ldp
);
99 #if LDBL_MANT_DIG == 24
100 static void e24toe (short unsigned int *pe
, short unsigned int *y
,
102 #elif LDBL_MANT_DIG == 53
103 static void e53toe (short unsigned int *pe
, short unsigned int *y
,
105 #elif LDBL_MANT_DIG == 64
106 static void e64toe (short unsigned int *pe
, short unsigned int *y
,
109 static void e113toe (short unsigned int *pe
, short unsigned int *y
,
114 /* e type constants used by high precision check routines */
118 static const unsigned short ezero
[NE
] = { 0x0000, 0x0000, 0x0000, 0x0000,
119 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000,
123 static const unsigned short eone
[NE
] = { 0x0000, 0x0000, 0x0000, 0x0000,
124 0x0000, 0x0000, 0x0000, 0x0000, 0x8000, 0x3fff,
130 static const unsigned short ezero
[NE
] = {
131 0, 0000000, 0000000, 0000000, 0000000, 0000000,
135 static const unsigned short eone
[NE
] = {
136 0, 0000000, 0000000, 0000000, 0100000, 0x3fff,
141 /* Debugging routine for displaying errors */
143 /* Notice: the order of appearance of the following
144 * messages is bound to the error codes defined
147 static const char *const ermsg
[7] = {
148 "unknown", /* error code 0 */
149 "domain", /* error code 1 */
150 "singularity", /* et seq. */
153 "total loss of precision",
154 "partial loss of precision"
157 #define mtherr(name, code) printf( "\n%s %s error\n", name, ermsg[code] );
159 #define mtherr(name, code)
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
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)
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
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
217 * emul( a, b, c, ldp ) c = b * a
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
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
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
275 * Signaling NaN's are NOT supported; they are treated the same
278 * Denormals are always supported here where appropriate (e.g., not
279 * for conversion to DEC numbers).
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.
309 /* #include "\usr\include\stdio.h" */
310 /*#include "ehead.h"*/
311 /*#include "mconf.h"*/
314 * Common include file for math routines
326 * This file contains definitions for error codes that are
327 * passed to the common error handling routine mtherr()
330 * The file also includes a conditional assembly definition
331 * for the type of computer arithmetic (IEEE, DEC, Motorola
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 */
383 /* Type of computer arithmetic */
386 #ifdef __IEEE_LITTLE_ENDIAN
388 #else /* !__IEEE_LITTLE_ENDIAN */
390 #endif /* !__IEEE_LITTLE_ENDIAN */
393 /* Define 1 for ANSI C atan2() function
394 * See atan.c and clog.c.
398 /*define VOLATILE volatile*/
404 /* NaN's require infinity support. */
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
,
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
);
431 static void toe113 (short unsigned int *a
, short unsigned int *b
);
433 static void eiremain (short unsigned int *den
, short unsigned int *num
,
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
,
439 static int emulm (short unsigned int *a
, short unsigned int *b
,
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
,
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
);
455 static void etodec (), todec (), dectoe ();
459 ; Clear out entire external format number.
461 ; unsigned short x[];
466 eclear (register short unsigned int *x
)
470 for (i
= 0; i
< NE
; i
++)
476 /* Move external format number from a to b.
482 emov (register const short unsigned int *a
, register short unsigned int *b
)
486 for (i
= 0; i
< NE
; i
++)
492 ; Negate external format number
494 ; unsigned short x[NE];
499 eneg (short unsigned int *x
)
506 x
[NE
- 1] ^= 0x8000; /* Toggle the sign bit */
511 /* Return 1 if external format number is negative,
515 eisneg (const short unsigned int *x
)
522 if (x
[NE
- 1] & 0x8000)
529 /* Return 1 if external format number has maximum possible exponent,
533 eisinf (const short unsigned int *x
)
536 if ((x
[NE
- 1] & 0x7fff) == 0x7fff)
548 /* Check if e-type number is not a number.
551 eisnan (const short unsigned int *x
)
556 /* NaN has maximum exponent */
557 if ((x
[NE
- 1] & 0x7fff) != 0x7fff)
559 /* ... and non-zero significand field. */
560 for (i
= 0; i
< NE
- 1; i
++)
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.
579 einfin (register short unsigned int *x
, register LDPARMS
* ldp
)
584 for (i
= 0; i
< NE
- 1; i
++)
589 for (i
= 0; i
< NE
- 1; i
++)
592 if (ldp
->rndprc
< NBITS
)
594 if (ldp
->rndprc
== 113)
599 if (ldp
->rndprc
== 64)
603 if (ldp
->rndprc
== 53)
617 /* Move in external format number,
618 * converting it to internal format.
621 emovi (const short unsigned int *a
, short unsigned int *b
)
623 register const unsigned short *p
;
624 register unsigned short *q
;
628 p
= a
+ (NE
- 1); /* point to last word of external number */
629 /* get the sign bit */
634 /* get the exponent */
636 *q
++ &= 0x7fff; /* delete the sign bit */
638 if ((*(q
- 1) & 0x7fff) == 0x7fff)
644 for (i
= 3; i
< NI
; i
++)
649 for (i
= 2; i
< NI
; i
++)
654 /* clear high guard word */
656 /* move in the significand */
657 for (i
= 0; i
< NE
- 1; i
++)
659 /* clear low guard word */
664 /* Move internal format number out,
665 * converting it to external format.
668 emovo (short unsigned int *a
, short unsigned int *b
, LDPARMS
* ldp
)
670 register unsigned short *p
, *q
;
674 q
= b
+ (NE
- 1); /* point to output exponent */
675 /* combine sign and exponent */
678 *q
-- = *p
++ | 0x8000;
682 if (*(p
- 1) == 0x7fff)
695 /* skip over guard word */
697 /* move the significand */
698 for (i
= 0; i
< NE
- 1; i
++)
703 /* Clear out internal format number.
707 ecleaz (register short unsigned int *xi
)
711 for (i
= 0; i
< NI
; i
++)
715 /* same, but don't touch the sign. */
718 ecleazs (register short unsigned int *xi
)
723 for (i
= 0; i
< NI
- 1; i
++)
730 /* Move internal format number from a to b.
733 emovz (register short unsigned int *a
, register short unsigned int *b
)
737 for (i
= 0; i
< NI
- 1; i
++)
739 /* clear low guard word */
743 /* Return nonzero if internal format number is a NaN.
747 eiisnan (short unsigned int *x
)
751 if ((x
[E
] & 0x7fff) == 0x7fff)
753 for (i
= M
+ 1; i
< NI
; i
++)
762 #if LDBL_MANT_DIG == 64
764 /* Return nonzero if internal format number is infinite. */
766 eiisinf (unsigned short x
[])
773 if ((x
[E
] & 0x7fff) == 0x7fff)
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];
786 ; for the significands:
787 ; returns +1 if a > b
792 ecmpm (register short unsigned int *a
, register short unsigned int *b
)
796 a
+= M
; /* skip up to significand area */
798 for (i
= M
; i
< NI
; i
++)
814 ; Shift significand down by 1 bit
818 eshdn1 (register short unsigned int *x
)
820 register unsigned short bits
;
823 x
+= M
; /* point to significand area */
826 for (i
= M
; i
< NI
; i
++)
841 ; Shift significand up by 1 bit
845 eshup1 (register short unsigned int *x
)
847 register unsigned short bits
;
853 for (i
= M
; i
< NI
; i
++)
868 ; Shift significand down by 8 bits
872 eshdn8 (register short unsigned int *x
)
874 register unsigned short newbyt
, oldbyt
;
879 for (i
= M
; i
< NI
; i
++)
890 ; Shift significand up by 8 bits
894 eshup8 (register short unsigned int *x
)
897 register unsigned short newbyt
, oldbyt
;
902 for (i
= M
; i
< NI
; i
++)
913 ; Shift significand up by 16 bits
917 eshup6 (register short unsigned int *x
)
920 register unsigned short *p
;
925 for (i
= M
; i
< NI
- 1; i
++)
932 ; Shift significand down by 16 bits
936 eshdn6 (register short unsigned int *x
)
939 register unsigned short *p
;
944 for (i
= M
; i
< NI
- 1; i
++)
956 eaddm (short unsigned int *x
, short unsigned int *y
)
958 register unsigned long a
;
965 for (i
= M
; i
< NI
; i
++)
967 a
= (unsigned long) (*x
) + (unsigned long) (*y
) + carry
;
972 *y
= (unsigned short) a
;
979 ; Subtract significands
984 esubm (short unsigned int *x
, short unsigned int *y
)
993 for (i
= M
; i
< NI
; i
++)
995 a
= (unsigned long) (*y
) - (unsigned long) (*x
) - carry
;
1000 *y
= (unsigned short) a
;
1007 /* Divide significands */
1010 /* Multiply significand of e-type number b
1011 by 16-bit quantity a, e-type result to c. */
1014 m16m (short unsigned int a
, short unsigned int *b
, short unsigned int *c
)
1016 register unsigned short *pp
;
1017 register unsigned long carry
;
1019 unsigned short p
[NI
];
1020 unsigned long aa
, m
;
1029 for (i
= M
+ 1; i
< NI
; i
++)
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
++)
1052 /* Divide significands. Neither the numerator nor the denominator
1053 is permitted to have its high guard word nonzero. */
1057 edivm (short unsigned int *den
, short unsigned int *num
, LDPARMS
* ldp
)
1060 register unsigned short *p
;
1062 unsigned short j
, tdenm
, tquot
;
1063 unsigned short tprod
[NI
+ 1];
1064 unsigned short *equot
= ldp
->equot
;
1070 for (i
= M
; i
< NI
; i
++)
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
)
1085 tquot
= tnum
/ tdenm
;
1087 /* Prove that the divide worked. */
1089 tcheck = (unsigned long )tquot * tdenm;
1090 if( tnum - tcheck > tdenm )
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)
1100 if (ecmpm (tprod
, num
) > 0)
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 );
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 );
1128 /* test for nonzero remainder after roundoff bit */
1131 for (i
= M
; i
< NI
; i
++)
1138 for (i
= 0; i
< NI
; i
++)
1146 /* Multiply significands */
1148 emulm (short unsigned int *a
, short unsigned int *b
, LDPARMS
* ldp
)
1150 unsigned short *p
, *q
;
1151 unsigned short pprod
[NI
];
1154 unsigned short *equot
= ldp
->equot
;
1158 for (i
= M
; i
< NI
; i
++)
1164 for (i
= M
+ 1; i
< NI
; i
++)
1172 m16m (*p
--, b
, pprod
);
1173 eaddm (pprod
, equot
);
1179 for (i
= 0; i
< NI
; i
++)
1182 /* return flag for lost nonzero bits */
1188 static void eshow(str, x)
1194 printf( "%s ", str );
1195 for( i=0; i<NI; i++ )
1196 printf( "%04x ", *x++ );
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.
1222 emdnorm (short unsigned int *s
, int lost
, int subflg
, long int exp
,
1223 int rcntrl
, LDPARMS
* ldp
)
1231 /* a blank significand could mean either zero or infinity. */
1232 #ifndef USE_INFINITY
1240 #ifndef USE_INFINITY
1244 if ((j
> NBITS
) && (exp
< 32767L))
1252 if (exp
> (long) (-NBITS
- 1))
1265 /* Round off, unless told not to by rcntrl. */
1268 /* Set up rounding parameters if the control register changed. */
1269 if (ldp
->rndprc
!= ldp
->rlast
)
1272 switch (ldp
->rndprc
)
1276 ldp
->rw
= NI
- 1; /* low guard word */
1278 ldp
->rmbit
= 0x8000;
1280 ldp
->re
= ldp
->rw
- 1;
1285 ldp
->rmbit
= 0x4000;
1286 ldp
->rebit
= 0x8000;
1292 ldp
->rmbit
= 0x8000;
1294 ldp
->re
= ldp
->rw
- 1;
1296 /* For DEC arithmetic */
1307 ldp
->rmbit
= 0x0400;
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.
1329 if ((exp
<= 0) && (ldp
->rndprc
!= NBITS
))
1331 if ((exp
<= 0) && (ldp
->rndprc
!= 64) && (ldp
->rndprc
!= NBITS
))
1334 lost
|= s
[NI
- 1] & 1;
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
)
1352 s
[ldp
->rw
] &= ~ldp
->rmsk
;
1353 if ((r
& ldp
->rmbit
) != 0)
1355 if (r
== ldp
->rmbit
)
1358 { /* round to even */
1359 if ((s
[ldp
->re
] & ldp
->rebit
) == 0)
1368 eaddm (ldp
->rbit
, s
);
1372 if ((exp
<= 0) && (ldp
->rndprc
!= NBITS
))
1374 if ((exp
<= 0) && (ldp
->rndprc
!= 64) && (ldp
->rndprc
!= NBITS
))
1380 { /* overflow on roundoff */
1388 #ifndef USE_INFINITY
1393 for (i
= 2; i
< NI
- 1; i
++)
1398 for (i
= M
+ 1; i
< NI
- 1; i
++)
1401 if ((ldp
->rndprc
< 64) || (ldp
->rndprc
== 113))
1403 s
[ldp
->rw
] &= ~ldp
->rmsk
;
1404 if (ldp
->rndprc
== 24)
1416 s
[1] = (unsigned short) exp
;
1422 ; Subtract external format numbers.
1424 ; unsigned short a[NE], b[NE], c[NE];
1426 ; esub( a, b, c, ldp ); c = b - a
1430 esub (const short unsigned int *a
, const short unsigned int *b
,
1431 short unsigned int *c
, LDPARMS
* ldp
)
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
);
1455 eadd1 (a
, b
, c
, 1, ldp
);
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
];
1487 /* compare exponents */
1492 { /* put the larger number in bi */
1502 if (lt
< (long) (-NBITS
- 1))
1503 goto done
; /* answer same as larger addend */
1505 lost
= eshift (ai
, k
); /* shift the smaller number down */
1509 /* exponents were the same, so must compare significands */
1512 { /* the numbers are identical in magnitude */
1513 /* if different signs, result is zero */
1519 /* if same sign, result is double */
1520 /* double denomalized tiny number */
1521 if ((bi
[E
] == 0) && ((bi
[3] & 0x8000) == 0))
1526 /* add 1 to exponent unless both are zero! */
1527 for (j
= 1; j
< NI
- 1; j
++)
1531 /* This could overflow, but let emovo take care of that. */
1536 bi
[E
] = (unsigned short) ltb
;
1540 { /* put the larger number in bi */
1556 emdnorm (bi
, lost
, subflg
, ltb
, 64, ldp
);
1567 ; unsigned short a[NE], b[NE], c[NE];
1569 ; ediv( a, b, c, ldp ); c = b / a
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
];
1580 /* Return any NaN input. */
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
);
1600 /* Infinity over anything else is infinity. */
1604 if (eisneg (a
) ^ eisneg (b
))
1605 *(c
+ (NE
- 1)) = 0x8000;
1607 *(c
+ (NE
- 1)) = 0;
1622 { /* See if numerator is zero. */
1623 for (i
= 1; i
< NI
- 1; i
++)
1627 ltb
-= enormlz (bi
);
1637 { /* possible divide by zero */
1638 for (i
= 1; i
< NI
- 1; i
++)
1642 lta
-= enormlz (ai
);
1647 *(c
+ (NE
- 1)) = 0;
1649 *(c
+ (NE
- 1)) = 0x8000;
1651 mtherr ("ediv", SING
);
1656 i
= edivm (ai
, bi
, ldp
);
1657 /* calculate exponent */
1658 lt
= ltb
- lta
+ EXONE
;
1659 emdnorm (bi
, i
, 0, lt
, 64, ldp
);
1673 ; unsigned short a[NE], b[NE], c[NE];
1675 ; emul( a, b, c, ldp ); c = b * a
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
];
1686 /* NaN times anything is the same NaN. */
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
);
1706 /* Infinity times anything else is infinity. */
1708 if (eisinf (a
) || eisinf (b
))
1710 if (eisneg (a
) ^ eisneg (b
))
1711 *(c
+ (NE
- 1)) = 0x8000;
1713 *(c
+ (NE
- 1)) = 0;
1724 for (i
= 1; i
< NI
- 1; i
++)
1728 lta
-= enormlz (ai
);
1739 for (i
= 1; i
< NI
- 1; i
++)
1743 ltb
-= enormlz (bi
);
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 */
1767 #if LDBL_MANT_DIG > 64
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
];
1792 for (i
= 0; i
< 7; i
++)
1801 for (i
= 1; i
< 8; i
++)
1817 #endif /* INFINITY */
1821 for (i
= 0; i
< 7; i
++)
1825 for (i
= 0; i
< 7; i
++)
1828 /* If denormal, remove the implied bit; else shift down 1. */
1841 /* move out internal format to ieee long double */
1843 __attribute__ ((__unused__
))
1844 toe113 (short unsigned int *a
, short unsigned int *b
)
1846 register unsigned short *p
, *q
;
1860 q
= b
+ 7; /* point to output exponent */
1863 /* If not denormal, delete the implied bit. */
1868 /* combine sign and exponent */
1872 *q
++ = *p
++ | 0x8000;
1877 *q
-- = *p
++ | 0x8000;
1881 /* skip over guard word */
1883 /* move the significand */
1885 for (i
= 0; i
< 7; i
++)
1888 for (i
= 0; i
< 7; i
++)
1892 #endif /* LDBL_MANT_DIG > 64 */
1895 #if LDBL_MANT_DIG == 64
1897 e64toe (short unsigned int *pe
, short unsigned int *y
, LDPARMS
* ldp
)
1899 unsigned short yy
[NI
];
1900 unsigned short *p
, *q
, *e
;
1906 for (i
= 0; i
< NE
- 5; i
++)
1909 for (i
= 0; i
< 5; i
++)
1913 for (i
= 0; i
< 5; i
++)
1917 p
= &yy
[0] + (NE
- 1);
1919 ++e
; /* MIEEE skips over 2nd short */
1920 for (i
= 0; i
< 4; i
++)
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];
1932 emovo (temp
, y
, ldp
);
1937 /* Point to the exponent field. */
1939 if ((*p
& 0x7fff) == 0x7fff)
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))
1955 for (i
= 2; i
<= 5; i
++)
1971 #endif /* USE_INFINITY */
1974 for (i
= 0; i
< NE
; i
++)
1978 /* move out internal format to ieee long double */
1980 __attribute__ ((__unused__
))
1981 toe64 (short unsigned int *a
, short unsigned int *b
)
1983 register unsigned short *p
, *q
;
1994 /* Shift Intel denormal significand down 1. */
2002 q
= b
+ 4; /* point to output exponent */
2003 /* NOTE: Intel data type is 96 bits wide, clear the last word here. */
2007 /* combine sign and exponent */
2011 *q
++ = *p
++ | 0x8000;
2014 *q
++ = 0; /* leave 2nd short blank */
2017 *q
-- = *p
++ | 0x8000;
2021 /* skip over guard word */
2023 /* move the significand */
2025 for (i
= 0; i
< 4; i
++)
2032 /* Intel long double infinity. */
2040 #endif /* USE_INFINITY */
2041 for (i
= 0; i
< 4; i
++)
2046 #endif /* LDBL_MANT_DIG == 64 */
2048 #if LDBL_MANT_DIG == 53
2050 ; Convert IEEE double precision to e type
2052 ; unsigned short x[N+2];
2056 e53toe (short unsigned int *pe
, short unsigned int *y
, LDPARMS
* ldp
)
2060 dectoe (pe
, y
); /* see etodec.c */
2064 register unsigned short r
;
2065 register unsigned short *p
, *e
;
2066 unsigned short yy
[NI
];
2070 denorm
= 0; /* flag if denormalized number */
2082 yy
[M
] = (r
& 0x0f) | 0x10;
2083 r
&= ~0x800f; /* strip sign and 4 significand bits */
2089 if (((pe
[3] & 0xf) != 0) || (pe
[2] != 0)
2090 || (pe
[1] != 0) || (pe
[0] != 0))
2096 if (((pe
[0] & 0xf) != 0) || (pe
[1] != 0)
2097 || (pe
[2] != 0) || (pe
[3] != 0))
2112 /* If zero exponent, then the significand is denormalized.
2113 * So, take back the understood high significand bit. */
2132 (void) eshift (yy
, -5);
2134 { /* if zero exponent, then normalize the significand */
2135 if ((k
= enormlz (yy
)) > NBITS
)
2138 yy
[E
] -= (unsigned short) (k
- 1);
2145 ; e type to IEEE double precision
2147 ; unsigned short x[NE];
2155 unsigned short *x
, *e
;
2157 etodec (x
, e
); /* see etodec.c */
2161 __attribute__ ((__unused__
))
2163 unsigned short *x
, *y
;
2171 __attribute__ ((__unused__
))
2172 toe53 (short unsigned int *x
, short unsigned int *y
)
2192 *y
= 0; /* output high order */
2194 *y
= 0x8000; /* output sign bit */
2197 if (i
>= (unsigned int) 2047)
2198 { /* Saturate at largest number less than infinity. */
2211 #else /* !USE_INFINITY */
2212 *y
|= (unsigned short) 0x7fef;
2223 #endif /* !USE_INFINITY */
2228 (void) eshift (x
, 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 */
2249 #endif /* not DEC */
2250 #endif /* LDBL_MANT_DIG == 53 */
2252 #if LDBL_MANT_DIG == 24
2254 ; Convert IEEE single precision to e type
2256 ; unsigned short x[N+2];
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
];
2268 denorm
= 0; /* flag if denormalized number */
2280 yy
[M
] = (r
& 0x7f) | 0200;
2281 r
&= ~0x807f; /* strip sign and 7 significand bits */
2287 if (((pe
[0] & 0x7f) != 0) || (pe
[1] != 0))
2293 if (((pe
[1] & 0x7f) != 0) || (pe
[0] != 0))
2308 /* If zero exponent, then the significand is denormalized.
2309 * So, take back the understood high significand bit. */
2328 (void) eshift (yy
, -8);
2330 { /* if zero exponent, then normalize the significand */
2331 if ((k
= enormlz (yy
)) > NBITS
)
2334 yy
[E
] -= (unsigned short) (k
- 1);
2340 __attribute__ ((__unused__
))
2341 toe24 (short unsigned int *x
, short unsigned int *y
)
2360 *y
= 0; /* output high order */
2362 *y
= 0x8000; /* output sign bit */
2366 { /* Saturate at largest number less than infinity. */
2368 *y
|= (unsigned short) 0x7f80;
2379 #else /* !USE_INFINITY */
2380 *y
|= (unsigned short) 0x7f7f;
2391 #endif /* !USE_INFINITY */
2396 (void) eshift (x
, 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 */
2416 #endif /* LDBL_MANT_DIG == 24 */
2418 /* Compare two e type numbers.
2420 * unsigned short a[NE], b[NE];
2423 * returns +1 if a > b
2426 * -2 if either a or b is a NaN.
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
;
2437 if (eisnan (a
) || eisnan (b
))
2446 { /* the signs are different */
2448 for (i
= 1; i
< NI
- 1; i
++)
2462 /* both are the same sign */
2477 return (0); /* equality */
2483 if (*(--p
) > *(--q
))
2484 return (msign
); /* p is bigger */
2486 return (-msign
); /* p is littler */
2493 ; Shifts significand area up or down by the number of bits
2494 ; given by the variable sc.
2497 eshift (short unsigned int *x
, int sc
)
2499 unsigned short lost
;
2513 lost
|= *p
; /* remember lost bits */
2554 return ((int) lost
);
2562 ; Shift normalizes the significand area pointed to by argument
2563 ; shift count (up = positive) is returned.
2566 enormlz (short unsigned int *x
)
2568 register unsigned short *p
;
2577 return (0); /* already normalized */
2582 /* With guard word, there are NBITS+16 bits available.
2583 * return true if all are zero.
2588 /* see if high byte is zero */
2589 while ((*p
& 0xff00) == 0)
2594 /* now shift 1 bit at a time */
2595 while ((*p
& 0x8000) == 0)
2599 if (sc
> (NBITS
+ 16))
2601 mtherr ("enormlz", UNDERFLOW
);
2607 /* Normalize by shifting down out of the high guard word
2608 of the significand */
2623 mtherr ("enormlz", OVERFLOW
);
2633 /* Convert e type number to decimal format ASCII string.
2634 * The constants are for 64 bit precision.
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 */
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 */
2734 /* ASCII string outputs for unix */
2739 _IO_ldtostr (x
, string
, ndigs
, flags
, fmt
)
2746 unsigned short w
[NI
];
2749 LDPARMS
*ldp
= &rnd
;
2754 if (sizeof (long double) == 16)
2755 e113toe ((unsigned short *) x
, w
, ldp
);
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. */
2788 /* This routine will not return more than NDEC+1 digits. */
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
];
2799 LDPARMS
*ldp
= &rnd
;
2801 char outbuf_sml
[NDEC_SML
+ MAX_EXP_DIGITS
+ 10];
2802 char *outbuf
= outbuf_sml
;
2806 orig_ndigits
= ndigits
;
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
);
2828 e113toe (&du
.pe
, e
, ldp
);
2835 /* Mode 3 is "f" format. */
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. */
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. */
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
;
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);
2868 outbuf
= outbuf_sml
;
2872 etoasc (e
, outbuf
, (int) ndec
, ndigits
, mode
, ldp
);
2874 if (eisinf (e
) || eisnan (e
))
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. */
2895 /* Delete the decimal point. */
2904 /* Back up over the exponent field. */
2905 while (*s
!= 'E' && s
> outbuf
)
2911 /* Strip leading spaces and sign. */
2913 while (*p
== ' ' || *p
== '-')
2916 /* Find new end of string. */
2918 while ((*s
++ = *p
++) != '\0')
2922 /* Strip trailing zeros. */
2925 else if (ndigits
> ldp
->outexpon
)
2930 while (*(s
- 1) == '0' && ((s
- outbuf
) > k
))
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))
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
);
2961 *rve
= outstr
+ (s
- outbuf
);
2963 if (outbuf
!= outbuf_sml
)
2964 _free_r (ptr
, outbuf
);
2969 /* Routine used to tell if long double is NaN or Infinity or regular number.
2970 Returns: 0 = regular number
2975 _ldcheck (long double *d
)
2977 unsigned short e
[NI
];
2979 LDPARMS
*ldp
= &rnd
;
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
);
2993 e113toe (&du
.pe
, e
, ldp
);
2996 if ((e
[NE
- 1] & 0x7fff) == 0x7fff)
3009 etoasc (short unsigned int *x
, char *string
, int ndec
, int ndigits
,
3010 int outformat
, LDPARMS
* ldp
)
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
;
3019 unsigned short *equot
= ldp
->equot
;
3022 rndsav
= ldp
->rndprc
;
3026 sprintf (string
, " NaN ");
3031 ldp
->rndprc
= NBITS
; /* set to full precision */
3032 emov (x
, y
); /* retain external format */
3033 if (y
[NE
- 1] & 0x8000)
3036 y
[NE
- 1] &= 0x7fff;
3043 ten
= &etens
[NTEN
][0];
3045 /* Test for zero exponent */
3048 for (k
= 0; k
< NE
- 1; k
++)
3051 goto tnzro
; /* denormalized number */
3053 goto isone
; /* legal all zeros */
3057 /* Test for infinity.
3059 if (y
[NE
- 1] == 0x7fff)
3062 sprintf (string
, " -Infinity ");
3064 sprintf (string
, " Infinity ");
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");
3080 /* Compare to 1.0 */
3086 { /* Number is greater than 1 */
3087 /* Convert significand to an integer and strip trailing decimal zeros. */
3089 u
[NE
- 1] = EXONE
+ NBITS
- 1;
3091 p
= &etens
[NTEN
- 4][0];
3095 ediv (p
, u
, t
, ldp
);
3097 for (j
= 0; j
< NE
- 1; j
++)
3110 /* Rescale from integer significand */
3111 u
[NE
- 1] += y
[NE
- 1] - (unsigned int) (EXONE
+ NBITS
- 1);
3113 /* Find power of 10 */
3117 while (ecmp (ten
, u
) <= 0)
3119 if (ecmp (p
, u
) <= 0)
3121 ediv (p
, u
, u
, ldp
);
3122 emul (p
, t
, t
, ldp
);
3132 { /* Number is less than 1.0 */
3133 /* Pad significand with trailing decimal zeros. */
3136 while ((y
[NE
- 2] & 0x8000) == 0)
3138 emul (ten
, y
, y
, ldp
);
3145 for (i
= 0; i
< ndec
+ 1; i
++)
3147 if ((w
[NI
- 1] & 0x7) != 0)
3149 /* multiply by 10 */
3162 if (eone
[NE
- 1] <= u
[1])
3174 while (ecmp (eone
, w
) > 0)
3176 if (ecmp (p
, w
) >= 0)
3178 emul (r
, w
, w
, ldp
);
3179 emul (r
, t
, t
, ldp
);
3188 ediv (t
, eone
, t
, ldp
);
3191 /* Find the first (leading) digit. */
3196 eiremain (t
, y
, ldp
);
3197 digit
= equot
[NI
- 1];
3198 while ((digit
== 0) && (ecmp (y
, ezero
) != 0))
3205 eiremain (t
, y
, ldp
);
3206 digit
= equot
[NI
- 1];
3214 /* Examine number of digits requested by caller. */
3218 else if( ndigs < 0 )
3241 *s
++ = (char) digit
+ '0';
3244 /* Generate digits after the decimal point. */
3245 for (k
= 0; k
<= ndigs
; k
++)
3247 /* multiply current number by 10, without normalizing */
3253 eiremain (t
, y
, ldp
);
3254 *s
++ = (char) equot
[NI
- 1] + '0';
3256 digit
= equot
[NI
- 1];
3259 /* round off the ASCII string */
3262 /* Test for critical rounding case in ASCII output. */
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 */
3275 /* Carry out to most significant digit? */
3278 /* This will print like "1E-6". */
3289 /* Most significant digit carries to 10? */
3297 /* Round up and carry out from less significant digits */
3309 sprintf (ss
, "e+%02d", expon
);
3311 sprintf (ss
, "e-%02d", -expon
);
3313 sprintf (ss
, "E%d", expon
);
3316 ldp
->rndprc
= rndsav
;
3317 ldp
->outexpon
= expon
;
3321 #if 0 /* Broken, unusable implementation of strtold */
3325 ; ASCTOQ.MAC LATEST REV: 11 JAN 84
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).
3339 ; asctoq( string, q );
3343 _strtold (char *s
, char **se
)
3347 LDPARMS
*ldp
= &rnd
;
3353 lenldstr
= asctoeg (s
, &x
.pe
, LDBL_MANT_DIG
, ldp
);
3359 #define REASONABLE_LEN 200
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
;
3368 unsigned short nsign
;
3369 const unsigned short *p
;
3370 char *sp
, *s
, *lstr
;
3373 char tmpstr
[REASONABLE_LEN
];
3375 /* Copy the input string. */
3376 c
= strlen (ss
) + 2;
3377 if (c
<= REASONABLE_LEN
)
3381 lstr
= (char *) calloc (c
, 1);
3386 while (*s
== ' ') /* skip leading spaces */
3392 for (k
= 0; k
< c
; k
++)
3394 if ((*sp
++ = *s
++) == '\0')
3400 rndsav
= ldp
->rndprc
;
3401 ldp
->rndprc
= NBITS
; /* Set to full precision */
3414 if ((k
>= 0) && (k
<= 9))
3416 /* Ignore leading zeros */
3417 if ((prec
== 0) && (decflg
== 0) && (k
== 0))
3419 /* Identify and strip trailing zeros after the decimal point. */
3420 if ((trail
== 0) && (decflg
!= 0))
3423 while ((*sp
>= '0') && (*sp
<= '9'))
3425 /* Check for syntax error */
3427 if ((c
!= 'e') && (c
!= 'E') && (c
!= '\0')
3428 && (c
!= '\n') && (c
!= '\r') && (c
!= ' ') && (c
!= ','))
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.
3445 nexp
+= 1; /* count digits after decimal point */
3446 eshup1 (yy
); /* multiply current number by 10 */
3452 xt
[NI
- 2] = (unsigned short) k
;
3457 /* Mark any lost non-zero digit. */
3459 /* Count lost digits before the decimal point. */
3474 case '.': /* decimal point */
3504 mtherr ("asctoe", DOMAIN
);
3513 /* Exponent interpretation */
3519 /* check for + or - */
3527 while ((*s
>= '0') && (*s
<= '9'))
3545 yy
[E
] = 0x7fff; /* infinity */
3557 /* Pad trailing zeros to minimize power of 10, per IEEE spec. */
3558 while ((nexp
> 0) && (yy
[2] == 0))
3570 if ((k
= enormlz (yy
)) > NBITS
)
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.
3598 { /* Punt. Can't handle this without 2 divides. */
3599 emovi (etens
[0], tt
);
3601 k
= edivm (tt
, yy
, ldp
);
3606 p
= &etens
[NTEN
][0];
3612 emul (p
, xt
, xt
, ldp
);
3616 while (exp
<= MAXP
);
3622 k
= edivm (tt
, yy
, ldp
);
3628 k
= emulm (tt
, yy
, ldp
);
3634 /* Round and convert directly to the destination type */
3636 lexp
-= EXONE
- 0x3ff;
3637 else if (oprec
== 24)
3638 lexp
-= EXONE
- 0177;
3640 else if (oprec
== 56)
3641 lexp
-= EXONE
- 0201;
3643 ldp
->rndprc
= oprec
;
3644 emdnorm (yy
, k
, 0, lexp
, 64, ldp
);
3648 ldp
->rndprc
= rndsav
;
3654 todec (yy
, y
); /* see etodec.c */
3657 #if LDBL_MANT_DIG == 53
3661 #elif LDBL_MANT_DIG == 24
3665 #elif LDBL_MANT_DIG == 64
3669 #elif LDBL_MANT_DIG == 113
3679 lenldstr
+= s
- lstr
;
3687 /* y = largest integer not greater than x
3688 * (truncated toward minus infinity)
3690 * unsigned short x[NE], y[NE]
3693 * efloor( x, y, ldp );
3695 static const unsigned short bmask
[] = {
3716 efloor (short unsigned int *x
, short unsigned int *y
, LDPARMS
* ldp
)
3718 register unsigned short *p
;
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);
3730 /* number of bits to clear out */
3742 /* clear the remaining bits */
3744 /* truncate negatives toward minus infinity */
3747 if ((unsigned short) expon
& (unsigned short) 0x8000)
3749 for (i
= 0; i
< NE
- 1; i
++)
3753 esub (eone
, y
, y
, ldp
);
3763 eiremain (short unsigned int *den
, short unsigned int *num
, LDPARMS
* ldp
)
3767 unsigned short *equot
= ldp
->equot
;
3770 ld
-= enormlz (den
);
3772 ln
-= enormlz (num
);
3776 if (ecmpm (den
, num
) <= 0)
3790 emdnorm (num
, 0, 0, ln
, 0, ldp
);
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 */
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 */
3843 enan (short unsigned int *nan
, int size
)
3846 const unsigned short *p
;
3872 #if !defined(__mips) || defined(__mips_nan2008)
3873 for (i
= 0; i
< NE
- 2; i
++)
3876 #else /* __mips && !__mips_nan2008 */
3877 for (i
= 0; i
< NE
- 2; i
++)
3880 #endif /* __mips && !__mips_nan2008 */
3888 #if !defined(__mips) || defined(__mips_nan2008)
3890 for (i
= 4; i
< NI
- 1; i
++)
3892 #else /* __mips && !__mips_nan2008 */
3894 for (i
= 4; i
< NI
- 1; i
++)
3896 #endif /* __mips && !__mips_nan2008 */
3901 mtherr ("enan", DOMAIN
);
3904 for (i
= 0; i
< n
; i
++)
3908 #endif /* !_USE_GDTOA */