Pass -mno-regnames to assembler.
[official-gcc.git] / gcc / real.c
blob3ebf8f32e7a1995114482386f14935c73e973da4
1 /* real.c - implementation of REAL_ARITHMETIC, REAL_VALUE_ATOF,
2 and support for XFmode IEEE extended real floating point arithmetic.
3 Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
4 Contributed by Stephen L. Moshier (moshier@world.std.com).
6 This file is part of GNU CC.
8 GNU CC is free software; you can redistribute it and/or modify
9 it under the terms of the GNU General Public License as published by
10 the Free Software Foundation; either version 2, or (at your option)
11 any later version.
13 GNU CC is distributed in the hope that it will be useful,
14 but WITHOUT ANY WARRANTY; without even the implied warranty of
15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 GNU General Public License for more details.
18 You should have received a copy of the GNU General Public License
19 along with GNU CC; see the file COPYING. If not, write to
20 the Free Software Foundation, 59 Temple Place - Suite 330,
21 Boston, MA 02111-1307, USA. */
23 #include <stdio.h>
24 #include <errno.h>
25 #include "config.h"
26 #include "tree.h"
28 #ifndef errno
29 extern int errno;
30 #endif
32 /* To enable support of XFmode extended real floating point, define
33 LONG_DOUBLE_TYPE_SIZE 96 in the tm.h file (m68k.h or i386.h).
35 To support cross compilation between IEEE, VAX and IBM floating
36 point formats, define REAL_ARITHMETIC in the tm.h file.
38 In either case the machine files (tm.h) must not contain any code
39 that tries to use host floating point arithmetic to convert
40 REAL_VALUE_TYPEs from `double' to `float', pass them to fprintf,
41 etc. In cross-compile situations a REAL_VALUE_TYPE may not
42 be intelligible to the host computer's native arithmetic.
44 The emulator defaults to the host's floating point format so that
45 its decimal conversion functions can be used if desired (see
46 real.h).
48 The first part of this file interfaces gcc to a floating point
49 arithmetic suite that was not written with gcc in mind. Avoid
50 changing the low-level arithmetic routines unless you have suitable
51 test programs available. A special version of the PARANOIA floating
52 point arithmetic tester, modified for this purpose, can be found on
53 usc.edu: /pub/C-numanal/ieeetest.zoo. Other tests, and libraries of
54 XFmode and TFmode transcendental functions, can be obtained by ftp from
55 netlib.att.com: netlib/cephes. */
57 /* Type of computer arithmetic.
58 Only one of DEC, IBM, IEEE, or UNK should get defined.
60 `IEEE', when REAL_WORDS_BIG_ENDIAN is non-zero, refers generically
61 to big-endian IEEE floating-point data structure. This definition
62 should work in SFmode `float' type and DFmode `double' type on
63 virtually all big-endian IEEE machines. If LONG_DOUBLE_TYPE_SIZE
64 has been defined to be 96, then IEEE also invokes the particular
65 XFmode (`long double' type) data structure used by the Motorola
66 680x0 series processors.
68 `IEEE', when REAL_WORDS_BIG_ENDIAN is zero, refers generally to
69 little-endian IEEE machines. In this case, if LONG_DOUBLE_TYPE_SIZE
70 has been defined to be 96, then IEEE also invokes the particular
71 XFmode `long double' data structure used by the Intel 80x86 series
72 processors.
74 `DEC' refers specifically to the Digital Equipment Corp PDP-11
75 and VAX floating point data structure. This model currently
76 supports no type wider than DFmode.
78 `IBM' refers specifically to the IBM System/370 and compatible
79 floating point data structure. This model currently supports
80 no type wider than DFmode. The IBM conversions were contributed by
81 frank@atom.ansto.gov.au (Frank Crawford).
83 If LONG_DOUBLE_TYPE_SIZE = 64 (the default, unless tm.h defines it)
84 then `long double' and `double' are both implemented, but they
85 both mean DFmode. In this case, the software floating-point
86 support available here is activated by writing
87 #define REAL_ARITHMETIC
88 in tm.h.
90 The case LONG_DOUBLE_TYPE_SIZE = 128 activates TFmode support
91 and may deactivate XFmode since `long double' is used to refer
92 to both modes.
94 The macros FLOAT_WORDS_BIG_ENDIAN, HOST_FLOAT_WORDS_BIG_ENDIAN,
95 contributed by Richard Earnshaw <Richard.Earnshaw@cl.cam.ac.uk>,
96 separate the floating point unit's endian-ness from that of
97 the integer addressing. This permits one to define a big-endian
98 FPU on a little-endian machine (e.g., ARM). An extension to
99 BYTES_BIG_ENDIAN may be required for some machines in the future.
100 These optional macros may be defined in tm.h. In real.h, they
101 default to WORDS_BIG_ENDIAN, etc., so there is no need to define
102 them for any normal host or target machine on which the floats
103 and the integers have the same endian-ness. */
106 /* The following converts gcc macros into the ones used by this file. */
108 /* REAL_ARITHMETIC defined means that macros in real.h are
109 defined to call emulator functions. */
110 #ifdef REAL_ARITHMETIC
112 #if TARGET_FLOAT_FORMAT == VAX_FLOAT_FORMAT
113 /* PDP-11, Pro350, VAX: */
114 #define DEC 1
115 #else /* it's not VAX */
116 #if TARGET_FLOAT_FORMAT == IBM_FLOAT_FORMAT
117 /* IBM System/370 style */
118 #define IBM 1
119 #else /* it's also not an IBM */
120 #if TARGET_FLOAT_FORMAT == IEEE_FLOAT_FORMAT
121 #define IEEE
122 #else /* it's not IEEE either */
123 /* UNKnown arithmetic. We don't support this and can't go on. */
124 unknown arithmetic type
125 #define UNK 1
126 #endif /* not IEEE */
127 #endif /* not IBM */
128 #endif /* not VAX */
130 #define REAL_WORDS_BIG_ENDIAN FLOAT_WORDS_BIG_ENDIAN
132 #else
133 /* REAL_ARITHMETIC not defined means that the *host's* data
134 structure will be used. It may differ by endian-ness from the
135 target machine's structure and will get its ends swapped
136 accordingly (but not here). Probably only the decimal <-> binary
137 functions in this file will actually be used in this case. */
139 #if HOST_FLOAT_FORMAT == VAX_FLOAT_FORMAT
140 #define DEC 1
141 #else /* it's not VAX */
142 #if HOST_FLOAT_FORMAT == IBM_FLOAT_FORMAT
143 /* IBM System/370 style */
144 #define IBM 1
145 #else /* it's also not an IBM */
146 #if HOST_FLOAT_FORMAT == IEEE_FLOAT_FORMAT
147 #define IEEE
148 #else /* it's not IEEE either */
149 unknown arithmetic type
150 #define UNK 1
151 #endif /* not IEEE */
152 #endif /* not IBM */
153 #endif /* not VAX */
155 #define REAL_WORDS_BIG_ENDIAN HOST_FLOAT_WORDS_BIG_ENDIAN
157 #endif /* REAL_ARITHMETIC not defined */
159 /* Define INFINITY for support of infinity.
160 Define NANS for support of Not-a-Number's (NaN's). */
161 #if !defined(DEC) && !defined(IBM)
162 #define INFINITY
163 #define NANS
164 #endif
166 /* Support of NaNs requires support of infinity. */
167 #ifdef NANS
168 #ifndef INFINITY
169 #define INFINITY
170 #endif
171 #endif
173 /* Find a host integer type that is at least 16 bits wide,
174 and another type at least twice whatever that size is. */
176 #if HOST_BITS_PER_CHAR >= 16
177 #define EMUSHORT char
178 #define EMUSHORT_SIZE HOST_BITS_PER_CHAR
179 #define EMULONG_SIZE (2 * HOST_BITS_PER_CHAR)
180 #else
181 #if HOST_BITS_PER_SHORT >= 16
182 #define EMUSHORT short
183 #define EMUSHORT_SIZE HOST_BITS_PER_SHORT
184 #define EMULONG_SIZE (2 * HOST_BITS_PER_SHORT)
185 #else
186 #if HOST_BITS_PER_INT >= 16
187 #define EMUSHORT int
188 #define EMUSHORT_SIZE HOST_BITS_PER_INT
189 #define EMULONG_SIZE (2 * HOST_BITS_PER_INT)
190 #else
191 #if HOST_BITS_PER_LONG >= 16
192 #define EMUSHORT long
193 #define EMUSHORT_SIZE HOST_BITS_PER_LONG
194 #define EMULONG_SIZE (2 * HOST_BITS_PER_LONG)
195 #else
196 /* You will have to modify this program to have a smaller unit size. */
197 #define EMU_NON_COMPILE
198 #endif
199 #endif
200 #endif
201 #endif
203 #if HOST_BITS_PER_SHORT >= EMULONG_SIZE
204 #define EMULONG short
205 #else
206 #if HOST_BITS_PER_INT >= EMULONG_SIZE
207 #define EMULONG int
208 #else
209 #if HOST_BITS_PER_LONG >= EMULONG_SIZE
210 #define EMULONG long
211 #else
212 #if HOST_BITS_PER_LONG_LONG >= EMULONG_SIZE
213 #define EMULONG long long int
214 #else
215 /* You will have to modify this program to have a smaller unit size. */
216 #define EMU_NON_COMPILE
217 #endif
218 #endif
219 #endif
220 #endif
223 /* The host interface doesn't work if no 16-bit size exists. */
224 #if EMUSHORT_SIZE != 16
225 #define EMU_NON_COMPILE
226 #endif
228 /* OK to continue compilation. */
229 #ifndef EMU_NON_COMPILE
231 /* Construct macros to translate between REAL_VALUE_TYPE and e type.
232 In GET_REAL and PUT_REAL, r and e are pointers.
233 A REAL_VALUE_TYPE is guaranteed to occupy contiguous locations
234 in memory, with no holes. */
236 #if LONG_DOUBLE_TYPE_SIZE == 96
237 /* Number of 16 bit words in external e type format */
238 #define NE 6
239 #define MAXDECEXP 4932
240 #define MINDECEXP -4956
241 #define GET_REAL(r,e) bcopy ((char *) r, (char *) e, 2*NE)
242 #define PUT_REAL(e,r) bcopy ((char *) e, (char *) r, 2*NE)
243 #else /* no XFmode */
244 #if LONG_DOUBLE_TYPE_SIZE == 128
245 #define NE 10
246 #define MAXDECEXP 4932
247 #define MINDECEXP -4977
248 #define GET_REAL(r,e) bcopy ((char *) r, (char *) e, 2*NE)
249 #define PUT_REAL(e,r) bcopy ((char *) e, (char *) r, 2*NE)
250 #else
251 #define NE 6
252 #define MAXDECEXP 4932
253 #define MINDECEXP -4956
254 #ifdef REAL_ARITHMETIC
255 /* Emulator uses target format internally
256 but host stores it in host endian-ness. */
258 #define GET_REAL(r,e) \
259 do { \
260 if (HOST_FLOAT_WORDS_BIG_ENDIAN == REAL_WORDS_BIG_ENDIAN) \
261 e53toe ((unsigned EMUSHORT*) (r), (e)); \
262 else \
264 unsigned EMUSHORT w[4]; \
265 w[3] = ((EMUSHORT *) r)[0]; \
266 w[2] = ((EMUSHORT *) r)[1]; \
267 w[1] = ((EMUSHORT *) r)[2]; \
268 w[0] = ((EMUSHORT *) r)[3]; \
269 e53toe (w, (e)); \
271 } while (0)
273 #define PUT_REAL(e,r) \
274 do { \
275 if (HOST_FLOAT_WORDS_BIG_ENDIAN == REAL_WORDS_BIG_ENDIAN) \
276 etoe53 ((e), (unsigned EMUSHORT *) (r)); \
277 else \
279 unsigned EMUSHORT w[4]; \
280 etoe53 ((e), w); \
281 *((EMUSHORT *) r) = w[3]; \
282 *((EMUSHORT *) r + 1) = w[2]; \
283 *((EMUSHORT *) r + 2) = w[1]; \
284 *((EMUSHORT *) r + 3) = w[0]; \
286 } while (0)
288 #else /* not REAL_ARITHMETIC */
290 /* emulator uses host format */
291 #define GET_REAL(r,e) e53toe ((unsigned EMUSHORT *) (r), (e))
292 #define PUT_REAL(e,r) etoe53 ((e), (unsigned EMUSHORT *) (r))
294 #endif /* not REAL_ARITHMETIC */
295 #endif /* not TFmode */
296 #endif /* no XFmode */
299 /* Number of 16 bit words in internal format */
300 #define NI (NE+3)
302 /* Array offset to exponent */
303 #define E 1
305 /* Array offset to high guard word */
306 #define M 2
308 /* Number of bits of precision */
309 #define NBITS ((NI-4)*16)
311 /* Maximum number of decimal digits in ASCII conversion
312 * = NBITS*log10(2)
314 #define NDEC (NBITS*8/27)
316 /* The exponent of 1.0 */
317 #define EXONE (0x3fff)
319 extern int extra_warnings;
320 extern unsigned EMUSHORT ezero[], ehalf[], eone[], etwo[];
321 extern unsigned EMUSHORT elog2[], esqrt2[];
323 static void endian PROTO((unsigned EMUSHORT *, long *,
324 enum machine_mode));
325 static void eclear PROTO((unsigned EMUSHORT *));
326 static void emov PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
327 static void eabs PROTO((unsigned EMUSHORT *));
328 static void eneg PROTO((unsigned EMUSHORT *));
329 static int eisneg PROTO((unsigned EMUSHORT *));
330 static int eisinf PROTO((unsigned EMUSHORT *));
331 static int eisnan PROTO((unsigned EMUSHORT *));
332 static void einfin PROTO((unsigned EMUSHORT *));
333 static void enan PROTO((unsigned EMUSHORT *, int));
334 static void emovi PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
335 static void emovo PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
336 static void ecleaz PROTO((unsigned EMUSHORT *));
337 static void ecleazs PROTO((unsigned EMUSHORT *));
338 static void emovz PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
339 static void einan PROTO((unsigned EMUSHORT *));
340 static int eiisnan PROTO((unsigned EMUSHORT *));
341 static int eiisneg PROTO((unsigned EMUSHORT *));
342 static void eiinfin PROTO((unsigned EMUSHORT *));
343 static int eiisinf PROTO((unsigned EMUSHORT *));
344 static int ecmpm PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
345 static void eshdn1 PROTO((unsigned EMUSHORT *));
346 static void eshup1 PROTO((unsigned EMUSHORT *));
347 static void eshdn8 PROTO((unsigned EMUSHORT *));
348 static void eshup8 PROTO((unsigned EMUSHORT *));
349 static void eshup6 PROTO((unsigned EMUSHORT *));
350 static void eshdn6 PROTO((unsigned EMUSHORT *));
351 static void eaddm PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));\f
352 static void esubm PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
353 static void m16m PROTO((unsigned int, unsigned short *,
354 unsigned short *));
355 static int edivm PROTO((unsigned short *, unsigned short *));
356 static int emulm PROTO((unsigned short *, unsigned short *));
357 static void emdnorm PROTO((unsigned EMUSHORT *, int, int, EMULONG, int));
358 static void esub PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *,
359 unsigned EMUSHORT *));
360 static void eadd PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *,
361 unsigned EMUSHORT *));
362 static void eadd1 PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *,
363 unsigned EMUSHORT *));
364 static void ediv PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *,
365 unsigned EMUSHORT *));
366 static void emul PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *,
367 unsigned EMUSHORT *));
368 static void e53toe PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
369 static void e64toe PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
370 static void e113toe PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
371 static void e24toe PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
372 static void etoe113 PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
373 static void toe113 PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
374 static void etoe64 PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
375 static void toe64 PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
376 static void etoe53 PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
377 static void toe53 PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
378 static void etoe24 PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
379 static void toe24 PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
380 static int ecmp PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
381 static void eround PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
382 static void ltoe PROTO((HOST_WIDE_INT *, unsigned EMUSHORT *));
383 static void ultoe PROTO((unsigned HOST_WIDE_INT *, unsigned EMUSHORT *));
384 static void eifrac PROTO((unsigned EMUSHORT *, HOST_WIDE_INT *,
385 unsigned EMUSHORT *));
386 static void euifrac PROTO((unsigned EMUSHORT *, unsigned HOST_WIDE_INT *,
387 unsigned EMUSHORT *));
388 static int eshift PROTO((unsigned EMUSHORT *, int));
389 static int enormlz PROTO((unsigned EMUSHORT *));
390 static void e24toasc PROTO((unsigned EMUSHORT *, char *, int));
391 static void e53toasc PROTO((unsigned EMUSHORT *, char *, int));
392 static void e64toasc PROTO((unsigned EMUSHORT *, char *, int));
393 static void e113toasc PROTO((unsigned EMUSHORT *, char *, int));
394 static void etoasc PROTO((unsigned EMUSHORT *, char *, int));
395 static void asctoe24 PROTO((char *, unsigned EMUSHORT *));
396 static void asctoe53 PROTO((char *, unsigned EMUSHORT *));
397 static void asctoe64 PROTO((char *, unsigned EMUSHORT *));
398 static void asctoe113 PROTO((char *, unsigned EMUSHORT *));
399 static void asctoe PROTO((char *, unsigned EMUSHORT *));
400 static void asctoeg PROTO((char *, unsigned EMUSHORT *, int));
401 static void efloor PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
402 static void efrexp PROTO((unsigned EMUSHORT *, int *,
403 unsigned EMUSHORT *));
404 static void eldexp PROTO((unsigned EMUSHORT *, int, unsigned EMUSHORT *));
405 static void eremain PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *,
406 unsigned EMUSHORT *));
407 static void eiremain PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
408 static void mtherr PROTO((char *, int));
409 static void dectoe PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
410 static void etodec PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
411 static void todec PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
412 static void ibmtoe PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *,
413 enum machine_mode));
414 static void etoibm PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *,
415 enum machine_mode));
416 static void toibm PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *,
417 enum machine_mode));
418 static void make_nan PROTO((unsigned EMUSHORT *, int, enum machine_mode));
419 static void uditoe PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
420 static void ditoe PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
421 static void etoudi PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
422 static void etodi PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
423 static void esqrt PROTO((unsigned EMUSHORT *, unsigned EMUSHORT *));
425 /* Copy 32-bit numbers obtained from array containing 16-bit numbers,
426 swapping ends if required, into output array of longs. The
427 result is normally passed to fprintf by the ASM_OUTPUT_ macros. */
429 static void
430 endian (e, x, mode)
431 unsigned EMUSHORT e[];
432 long x[];
433 enum machine_mode mode;
435 unsigned long th, t;
437 if (REAL_WORDS_BIG_ENDIAN)
439 switch (mode)
442 case TFmode:
443 /* Swap halfwords in the fourth long. */
444 th = (unsigned long) e[6] & 0xffff;
445 t = (unsigned long) e[7] & 0xffff;
446 t |= th << 16;
447 x[3] = (long) t;
449 case XFmode:
451 /* Swap halfwords in the third long. */
452 th = (unsigned long) e[4] & 0xffff;
453 t = (unsigned long) e[5] & 0xffff;
454 t |= th << 16;
455 x[2] = (long) t;
456 /* fall into the double case */
458 case DFmode:
460 /* swap halfwords in the second word */
461 th = (unsigned long) e[2] & 0xffff;
462 t = (unsigned long) e[3] & 0xffff;
463 t |= th << 16;
464 x[1] = (long) t;
465 /* fall into the float case */
467 case HFmode:
468 case SFmode:
470 /* swap halfwords in the first word */
471 th = (unsigned long) e[0] & 0xffff;
472 t = (unsigned long) e[1] & 0xffff;
473 t |= th << 16;
474 x[0] = (long) t;
475 break;
477 default:
478 abort ();
481 else
483 /* Pack the output array without swapping. */
485 switch (mode)
488 case TFmode:
490 /* Pack the fourth long. */
491 th = (unsigned long) e[7] & 0xffff;
492 t = (unsigned long) e[6] & 0xffff;
493 t |= th << 16;
494 x[3] = (long) t;
496 case XFmode:
498 /* Pack the third long.
499 Each element of the input REAL_VALUE_TYPE array has 16 useful bits
500 in it. */
501 th = (unsigned long) e[5] & 0xffff;
502 t = (unsigned long) e[4] & 0xffff;
503 t |= th << 16;
504 x[2] = (long) t;
505 /* fall into the double case */
507 case DFmode:
509 /* pack the second long */
510 th = (unsigned long) e[3] & 0xffff;
511 t = (unsigned long) e[2] & 0xffff;
512 t |= th << 16;
513 x[1] = (long) t;
514 /* fall into the float case */
516 case HFmode:
517 case SFmode:
519 /* pack the first long */
520 th = (unsigned long) e[1] & 0xffff;
521 t = (unsigned long) e[0] & 0xffff;
522 t |= th << 16;
523 x[0] = (long) t;
524 break;
526 default:
527 abort ();
533 /* This is the implementation of the REAL_ARITHMETIC macro. */
535 void
536 earith (value, icode, r1, r2)
537 REAL_VALUE_TYPE *value;
538 int icode;
539 REAL_VALUE_TYPE *r1;
540 REAL_VALUE_TYPE *r2;
542 unsigned EMUSHORT d1[NE], d2[NE], v[NE];
543 enum tree_code code;
545 GET_REAL (r1, d1);
546 GET_REAL (r2, d2);
547 #ifdef NANS
548 /* Return NaN input back to the caller. */
549 if (eisnan (d1))
551 PUT_REAL (d1, value);
552 return;
554 if (eisnan (d2))
556 PUT_REAL (d2, value);
557 return;
559 #endif
560 code = (enum tree_code) icode;
561 switch (code)
563 case PLUS_EXPR:
564 eadd (d2, d1, v);
565 break;
567 case MINUS_EXPR:
568 esub (d2, d1, v); /* d1 - d2 */
569 break;
571 case MULT_EXPR:
572 emul (d2, d1, v);
573 break;
575 case RDIV_EXPR:
576 #ifndef REAL_INFINITY
577 if (ecmp (d2, ezero) == 0)
579 #ifdef NANS
580 enan (v, eisneg (d1) ^ eisneg (d2));
581 break;
582 #else
583 abort ();
584 #endif
586 #endif
587 ediv (d2, d1, v); /* d1/d2 */
588 break;
590 case MIN_EXPR: /* min (d1,d2) */
591 if (ecmp (d1, d2) < 0)
592 emov (d1, v);
593 else
594 emov (d2, v);
595 break;
597 case MAX_EXPR: /* max (d1,d2) */
598 if (ecmp (d1, d2) > 0)
599 emov (d1, v);
600 else
601 emov (d2, v);
602 break;
603 default:
604 emov (ezero, v);
605 break;
607 PUT_REAL (v, value);
611 /* Truncate REAL_VALUE_TYPE toward zero to signed HOST_WIDE_INT.
612 implements REAL_VALUE_RNDZINT (x) (etrunci (x)). */
614 REAL_VALUE_TYPE
615 etrunci (x)
616 REAL_VALUE_TYPE x;
618 unsigned EMUSHORT f[NE], g[NE];
619 REAL_VALUE_TYPE r;
620 HOST_WIDE_INT l;
622 GET_REAL (&x, g);
623 #ifdef NANS
624 if (eisnan (g))
625 return (x);
626 #endif
627 eifrac (g, &l, f);
628 ltoe (&l, g);
629 PUT_REAL (g, &r);
630 return (r);
634 /* Truncate REAL_VALUE_TYPE toward zero to unsigned HOST_WIDE_INT;
635 implements REAL_VALUE_UNSIGNED_RNDZINT (x) (etruncui (x)). */
637 REAL_VALUE_TYPE
638 etruncui (x)
639 REAL_VALUE_TYPE x;
641 unsigned EMUSHORT f[NE], g[NE];
642 REAL_VALUE_TYPE r;
643 unsigned HOST_WIDE_INT l;
645 GET_REAL (&x, g);
646 #ifdef NANS
647 if (eisnan (g))
648 return (x);
649 #endif
650 euifrac (g, &l, f);
651 ultoe (&l, g);
652 PUT_REAL (g, &r);
653 return (r);
657 /* This is the REAL_VALUE_ATOF function. It converts a decimal string to
658 binary, rounding off as indicated by the machine_mode argument. Then it
659 promotes the rounded value to REAL_VALUE_TYPE. */
661 REAL_VALUE_TYPE
662 ereal_atof (s, t)
663 char *s;
664 enum machine_mode t;
666 unsigned EMUSHORT tem[NE], e[NE];
667 REAL_VALUE_TYPE r;
669 switch (t)
671 case HFmode:
672 case SFmode:
673 asctoe24 (s, tem);
674 e24toe (tem, e);
675 break;
676 case DFmode:
677 asctoe53 (s, tem);
678 e53toe (tem, e);
679 break;
680 case XFmode:
681 asctoe64 (s, tem);
682 e64toe (tem, e);
683 break;
684 case TFmode:
685 asctoe113 (s, tem);
686 e113toe (tem, e);
687 break;
688 default:
689 asctoe (s, e);
691 PUT_REAL (e, &r);
692 return (r);
696 /* Expansion of REAL_NEGATE. */
698 REAL_VALUE_TYPE
699 ereal_negate (x)
700 REAL_VALUE_TYPE x;
702 unsigned EMUSHORT e[NE];
703 REAL_VALUE_TYPE r;
705 GET_REAL (&x, e);
706 eneg (e);
707 PUT_REAL (e, &r);
708 return (r);
712 /* Round real toward zero to HOST_WIDE_INT;
713 implements REAL_VALUE_FIX (x). */
715 HOST_WIDE_INT
716 efixi (x)
717 REAL_VALUE_TYPE x;
719 unsigned EMUSHORT f[NE], g[NE];
720 HOST_WIDE_INT l;
722 GET_REAL (&x, f);
723 #ifdef NANS
724 if (eisnan (f))
726 warning ("conversion from NaN to int");
727 return (-1);
729 #endif
730 eifrac (f, &l, g);
731 return l;
734 /* Round real toward zero to unsigned HOST_WIDE_INT
735 implements REAL_VALUE_UNSIGNED_FIX (x).
736 Negative input returns zero. */
738 unsigned HOST_WIDE_INT
739 efixui (x)
740 REAL_VALUE_TYPE x;
742 unsigned EMUSHORT f[NE], g[NE];
743 unsigned HOST_WIDE_INT l;
745 GET_REAL (&x, f);
746 #ifdef NANS
747 if (eisnan (f))
749 warning ("conversion from NaN to unsigned int");
750 return (-1);
752 #endif
753 euifrac (f, &l, g);
754 return l;
758 /* REAL_VALUE_FROM_INT macro. */
760 void
761 ereal_from_int (d, i, j, mode)
762 REAL_VALUE_TYPE *d;
763 HOST_WIDE_INT i, j;
764 enum machine_mode mode;
766 unsigned EMUSHORT df[NE], dg[NE];
767 HOST_WIDE_INT low, high;
768 int sign;
770 if (GET_MODE_CLASS (mode) != MODE_FLOAT)
771 abort ();
772 sign = 0;
773 low = i;
774 if ((high = j) < 0)
776 sign = 1;
777 /* complement and add 1 */
778 high = ~high;
779 if (low)
780 low = -low;
781 else
782 high += 1;
784 eldexp (eone, HOST_BITS_PER_WIDE_INT, df);
785 ultoe ((unsigned HOST_WIDE_INT *) &high, dg);
786 emul (dg, df, dg);
787 ultoe ((unsigned HOST_WIDE_INT *) &low, df);
788 eadd (df, dg, dg);
789 if (sign)
790 eneg (dg);
792 /* A REAL_VALUE_TYPE may not be wide enough to hold the two HOST_WIDE_INTS.
793 Avoid double-rounding errors later by rounding off now from the
794 extra-wide internal format to the requested precision. */
795 switch (GET_MODE_BITSIZE (mode))
797 case 32:
798 etoe24 (dg, df);
799 e24toe (df, dg);
800 break;
802 case 64:
803 etoe53 (dg, df);
804 e53toe (df, dg);
805 break;
807 case 96:
808 etoe64 (dg, df);
809 e64toe (df, dg);
810 break;
812 case 128:
813 etoe113 (dg, df);
814 e113toe (df, dg);
815 break;
817 default:
818 abort ();
821 PUT_REAL (dg, d);
825 /* REAL_VALUE_FROM_UNSIGNED_INT macro. */
827 void
828 ereal_from_uint (d, i, j, mode)
829 REAL_VALUE_TYPE *d;
830 unsigned HOST_WIDE_INT i, j;
831 enum machine_mode mode;
833 unsigned EMUSHORT df[NE], dg[NE];
834 unsigned HOST_WIDE_INT low, high;
836 if (GET_MODE_CLASS (mode) != MODE_FLOAT)
837 abort ();
838 low = i;
839 high = j;
840 eldexp (eone, HOST_BITS_PER_WIDE_INT, df);
841 ultoe (&high, dg);
842 emul (dg, df, dg);
843 ultoe (&low, df);
844 eadd (df, dg, dg);
846 /* A REAL_VALUE_TYPE may not be wide enough to hold the two HOST_WIDE_INTS.
847 Avoid double-rounding errors later by rounding off now from the
848 extra-wide internal format to the requested precision. */
849 switch (GET_MODE_BITSIZE (mode))
851 case 32:
852 etoe24 (dg, df);
853 e24toe (df, dg);
854 break;
856 case 64:
857 etoe53 (dg, df);
858 e53toe (df, dg);
859 break;
861 case 96:
862 etoe64 (dg, df);
863 e64toe (df, dg);
864 break;
866 case 128:
867 etoe113 (dg, df);
868 e113toe (df, dg);
869 break;
871 default:
872 abort ();
875 PUT_REAL (dg, d);
879 /* REAL_VALUE_TO_INT macro. */
881 void
882 ereal_to_int (low, high, rr)
883 HOST_WIDE_INT *low, *high;
884 REAL_VALUE_TYPE rr;
886 unsigned EMUSHORT d[NE], df[NE], dg[NE], dh[NE];
887 int s;
889 GET_REAL (&rr, d);
890 #ifdef NANS
891 if (eisnan (d))
893 warning ("conversion from NaN to int");
894 *low = -1;
895 *high = -1;
896 return;
898 #endif
899 /* convert positive value */
900 s = 0;
901 if (eisneg (d))
903 eneg (d);
904 s = 1;
906 eldexp (eone, HOST_BITS_PER_WIDE_INT, df);
907 ediv (df, d, dg); /* dg = d / 2^32 is the high word */
908 euifrac (dg, (unsigned HOST_WIDE_INT *) high, dh);
909 emul (df, dh, dg); /* fractional part is the low word */
910 euifrac (dg, (unsigned HOST_WIDE_INT *)low, dh);
911 if (s)
913 /* complement and add 1 */
914 *high = ~(*high);
915 if (*low)
916 *low = -(*low);
917 else
918 *high += 1;
923 /* REAL_VALUE_LDEXP macro. */
925 REAL_VALUE_TYPE
926 ereal_ldexp (x, n)
927 REAL_VALUE_TYPE x;
928 int n;
930 unsigned EMUSHORT e[NE], y[NE];
931 REAL_VALUE_TYPE r;
933 GET_REAL (&x, e);
934 #ifdef NANS
935 if (eisnan (e))
936 return (x);
937 #endif
938 eldexp (e, n, y);
939 PUT_REAL (y, &r);
940 return (r);
943 /* These routines are conditionally compiled because functions
944 of the same names may be defined in fold-const.c. */
946 #ifdef REAL_ARITHMETIC
948 /* Check for infinity in a REAL_VALUE_TYPE. */
951 target_isinf (x)
952 REAL_VALUE_TYPE x;
954 unsigned EMUSHORT e[NE];
956 #ifdef INFINITY
957 GET_REAL (&x, e);
958 return (eisinf (e));
959 #else
960 return 0;
961 #endif
964 /* Check whether a REAL_VALUE_TYPE item is a NaN. */
967 target_isnan (x)
968 REAL_VALUE_TYPE x;
970 unsigned EMUSHORT e[NE];
972 #ifdef NANS
973 GET_REAL (&x, e);
974 return (eisnan (e));
975 #else
976 return (0);
977 #endif
981 /* Check for a negative REAL_VALUE_TYPE number.
982 This just checks the sign bit, so that -0 counts as negative. */
985 target_negative (x)
986 REAL_VALUE_TYPE x;
988 return ereal_isneg (x);
991 /* Expansion of REAL_VALUE_TRUNCATE.
992 The result is in floating point, rounded to nearest or even. */
994 REAL_VALUE_TYPE
995 real_value_truncate (mode, arg)
996 enum machine_mode mode;
997 REAL_VALUE_TYPE arg;
999 unsigned EMUSHORT e[NE], t[NE];
1000 REAL_VALUE_TYPE r;
1002 GET_REAL (&arg, e);
1003 #ifdef NANS
1004 if (eisnan (e))
1005 return (arg);
1006 #endif
1007 eclear (t);
1008 switch (mode)
1010 case TFmode:
1011 etoe113 (e, t);
1012 e113toe (t, t);
1013 break;
1015 case XFmode:
1016 etoe64 (e, t);
1017 e64toe (t, t);
1018 break;
1020 case DFmode:
1021 etoe53 (e, t);
1022 e53toe (t, t);
1023 break;
1025 case HFmode:
1026 case SFmode:
1027 etoe24 (e, t);
1028 e24toe (t, t);
1029 break;
1031 case SImode:
1032 r = etrunci (arg);
1033 return (r);
1035 /* If an unsupported type was requested, presume that
1036 the machine files know something useful to do with
1037 the unmodified value. */
1039 default:
1040 return (arg);
1042 PUT_REAL (t, &r);
1043 return (r);
1046 #endif /* REAL_ARITHMETIC defined */
1048 /* Used for debugging--print the value of R in human-readable format
1049 on stderr. */
1051 void
1052 debug_real (r)
1053 REAL_VALUE_TYPE r;
1055 char dstr[30];
1057 REAL_VALUE_TO_DECIMAL (r, "%.20g", dstr);
1058 fprintf (stderr, "%s", dstr);
1062 /* The following routines convert REAL_VALUE_TYPE to the various floating
1063 point formats that are meaningful to supported computers.
1065 The results are returned in 32-bit pieces, each piece stored in a `long'.
1066 This is so they can be printed by statements like
1068 fprintf (file, "%lx, %lx", L[0], L[1]);
1070 that will work on both narrow- and wide-word host computers. */
1072 /* Convert R to a 128-bit long double precision value. The output array L
1073 contains four 32-bit pieces of the result, in the order they would appear
1074 in memory. */
1076 void
1077 etartdouble (r, l)
1078 REAL_VALUE_TYPE r;
1079 long l[];
1081 unsigned EMUSHORT e[NE];
1083 GET_REAL (&r, e);
1084 etoe113 (e, e);
1085 endian (e, l, TFmode);
1088 /* Convert R to a double extended precision value. The output array L
1089 contains three 32-bit pieces of the result, in the order they would
1090 appear in memory. */
1092 void
1093 etarldouble (r, l)
1094 REAL_VALUE_TYPE r;
1095 long l[];
1097 unsigned EMUSHORT e[NE];
1099 GET_REAL (&r, e);
1100 etoe64 (e, e);
1101 endian (e, l, XFmode);
1104 /* Convert R to a double precision value. The output array L contains two
1105 32-bit pieces of the result, in the order they would appear in memory. */
1107 void
1108 etardouble (r, l)
1109 REAL_VALUE_TYPE r;
1110 long l[];
1112 unsigned EMUSHORT e[NE];
1114 GET_REAL (&r, e);
1115 etoe53 (e, e);
1116 endian (e, l, DFmode);
1119 /* Convert R to a single precision float value stored in the least-significant
1120 bits of a `long'. */
1122 long
1123 etarsingle (r)
1124 REAL_VALUE_TYPE r;
1126 unsigned EMUSHORT e[NE];
1127 long l;
1129 GET_REAL (&r, e);
1130 etoe24 (e, e);
1131 endian (e, &l, SFmode);
1132 return ((long) l);
1135 /* Convert X to a decimal ASCII string S for output to an assembly
1136 language file. Note, there is no standard way to spell infinity or
1137 a NaN, so these values may require special treatment in the tm.h
1138 macros. */
1140 void
1141 ereal_to_decimal (x, s)
1142 REAL_VALUE_TYPE x;
1143 char *s;
1145 unsigned EMUSHORT e[NE];
1147 GET_REAL (&x, e);
1148 etoasc (e, s, 20);
1151 /* Compare X and Y. Return 1 if X > Y, 0 if X == Y, -1 if X < Y,
1152 or -2 if either is a NaN. */
1155 ereal_cmp (x, y)
1156 REAL_VALUE_TYPE x, y;
1158 unsigned EMUSHORT ex[NE], ey[NE];
1160 GET_REAL (&x, ex);
1161 GET_REAL (&y, ey);
1162 return (ecmp (ex, ey));
1165 /* Return 1 if the sign bit of X is set, else return 0. */
1168 ereal_isneg (x)
1169 REAL_VALUE_TYPE x;
1171 unsigned EMUSHORT ex[NE];
1173 GET_REAL (&x, ex);
1174 return (eisneg (ex));
1177 /* End of REAL_ARITHMETIC interface */
1180 Extended precision IEEE binary floating point arithmetic routines
1182 Numbers are stored in C language as arrays of 16-bit unsigned
1183 short integers. The arguments of the routines are pointers to
1184 the arrays.
1186 External e type data structure, similar to Intel 8087 chip
1187 temporary real format but possibly with a larger significand:
1189 NE-1 significand words (least significant word first,
1190 most significant bit is normally set)
1191 exponent (value = EXONE for 1.0,
1192 top bit is the sign)
1195 Internal exploded e-type data structure of a number (a "word" is 16 bits):
1197 ei[0] sign word (0 for positive, 0xffff for negative)
1198 ei[1] biased exponent (value = EXONE for the number 1.0)
1199 ei[2] high guard word (always zero after normalization)
1200 ei[3]
1201 to ei[NI-2] significand (NI-4 significand words,
1202 most significant word first,
1203 most significant bit is set)
1204 ei[NI-1] low guard word (0x8000 bit is rounding place)
1208 Routines for external format e-type numbers
1210 asctoe (string, e) ASCII string to extended double e type
1211 asctoe64 (string, &d) ASCII string to long double
1212 asctoe53 (string, &d) ASCII string to double
1213 asctoe24 (string, &f) ASCII string to single
1214 asctoeg (string, e, prec) ASCII string to specified precision
1215 e24toe (&f, e) IEEE single precision to e type
1216 e53toe (&d, e) IEEE double precision to e type
1217 e64toe (&d, e) IEEE long double precision to e type
1218 e113toe (&d, e) 128-bit long double precision to e type
1219 eabs (e) absolute value
1220 eadd (a, b, c) c = b + a
1221 eclear (e) e = 0
1222 ecmp (a, b) Returns 1 if a > b, 0 if a == b,
1223 -1 if a < b, -2 if either a or b is a NaN.
1224 ediv (a, b, c) c = b / a
1225 efloor (a, b) truncate to integer, toward -infinity
1226 efrexp (a, exp, s) extract exponent and significand
1227 eifrac (e, &l, frac) e to HOST_WIDE_INT and e type fraction
1228 euifrac (e, &l, frac) e to unsigned HOST_WIDE_INT and e type fraction
1229 einfin (e) set e to infinity, leaving its sign alone
1230 eldexp (a, n, b) multiply by 2**n
1231 emov (a, b) b = a
1232 emul (a, b, c) c = b * a
1233 eneg (e) e = -e
1234 eround (a, b) b = nearest integer value to a
1235 esub (a, b, c) c = b - a
1236 e24toasc (&f, str, n) single to ASCII string, n digits after decimal
1237 e53toasc (&d, str, n) double to ASCII string, n digits after decimal
1238 e64toasc (&d, str, n) 80-bit long double to ASCII string
1239 e113toasc (&d, str, n) 128-bit long double to ASCII string
1240 etoasc (e, str, n) e to ASCII string, n digits after decimal
1241 etoe24 (e, &f) convert e type to IEEE single precision
1242 etoe53 (e, &d) convert e type to IEEE double precision
1243 etoe64 (e, &d) convert e type to IEEE long double precision
1244 ltoe (&l, e) HOST_WIDE_INT to e type
1245 ultoe (&l, e) unsigned HOST_WIDE_INT to e type
1246 eisneg (e) 1 if sign bit of e != 0, else 0
1247 eisinf (e) 1 if e has maximum exponent (non-IEEE)
1248 or is infinite (IEEE)
1249 eisnan (e) 1 if e is a NaN
1252 Routines for internal format exploded e-type numbers
1254 eaddm (ai, bi) add significands, bi = bi + ai
1255 ecleaz (ei) ei = 0
1256 ecleazs (ei) set ei = 0 but leave its sign alone
1257 ecmpm (ai, bi) compare significands, return 1, 0, or -1
1258 edivm (ai, bi) divide significands, bi = bi / ai
1259 emdnorm (ai,l,s,exp) normalize and round off
1260 emovi (a, ai) convert external a to internal ai
1261 emovo (ai, a) convert internal ai to external a
1262 emovz (ai, bi) bi = ai, low guard word of bi = 0
1263 emulm (ai, bi) multiply significands, bi = bi * ai
1264 enormlz (ei) left-justify the significand
1265 eshdn1 (ai) shift significand and guards down 1 bit
1266 eshdn8 (ai) shift down 8 bits
1267 eshdn6 (ai) shift down 16 bits
1268 eshift (ai, n) shift ai n bits up (or down if n < 0)
1269 eshup1 (ai) shift significand and guards up 1 bit
1270 eshup8 (ai) shift up 8 bits
1271 eshup6 (ai) shift up 16 bits
1272 esubm (ai, bi) subtract significands, bi = bi - ai
1273 eiisinf (ai) 1 if infinite
1274 eiisnan (ai) 1 if a NaN
1275 eiisneg (ai) 1 if sign bit of ai != 0, else 0
1276 einan (ai) set ai = NaN
1277 eiinfin (ai) set ai = infinity
1279 The result is always normalized and rounded to NI-4 word precision
1280 after each arithmetic operation.
1282 Exception flags are NOT fully supported.
1284 Signaling NaN's are NOT supported; they are treated the same
1285 as quiet NaN's.
1287 Define INFINITY for support of infinity; otherwise a
1288 saturation arithmetic is implemented.
1290 Define NANS for support of Not-a-Number items; otherwise the
1291 arithmetic will never produce a NaN output, and might be confused
1292 by a NaN input.
1293 If NaN's are supported, the output of `ecmp (a,b)' is -2 if
1294 either a or b is a NaN. This means asking `if (ecmp (a,b) < 0)'
1295 may not be legitimate. Use `if (ecmp (a,b) == -1)' for `less than'
1296 if in doubt.
1298 Denormals are always supported here where appropriate (e.g., not
1299 for conversion to DEC numbers). */
1301 /* Definitions for error codes that are passed to the common error handling
1302 routine mtherr.
1304 For Digital Equipment PDP-11 and VAX computers, certain
1305 IBM systems, and others that use numbers with a 56-bit
1306 significand, the symbol DEC should be defined. In this
1307 mode, most floating point constants are given as arrays
1308 of octal integers to eliminate decimal to binary conversion
1309 errors that might be introduced by the compiler.
1311 For computers, such as IBM PC, that follow the IEEE
1312 Standard for Binary Floating Point Arithmetic (ANSI/IEEE
1313 Std 754-1985), the symbol IEEE should be defined.
1314 These numbers have 53-bit significands. In this mode, constants
1315 are provided as arrays of hexadecimal 16 bit integers.
1316 The endian-ness of generated values is controlled by
1317 REAL_WORDS_BIG_ENDIAN.
1319 To accommodate other types of computer arithmetic, all
1320 constants are also provided in a normal decimal radix
1321 which one can hope are correctly converted to a suitable
1322 format by the available C language compiler. To invoke
1323 this mode, the symbol UNK is defined.
1325 An important difference among these modes is a predefined
1326 set of machine arithmetic constants for each. The numbers
1327 MACHEP (the machine roundoff error), MAXNUM (largest number
1328 represented), and several other parameters are preset by
1329 the configuration symbol. Check the file const.c to
1330 ensure that these values are correct for your computer.
1332 For ANSI C compatibility, define ANSIC equal to 1. Currently
1333 this affects only the atan2 function and others that use it. */
1335 /* Constant definitions for math error conditions. */
1337 #define DOMAIN 1 /* argument domain error */
1338 #define SING 2 /* argument singularity */
1339 #define OVERFLOW 3 /* overflow range error */
1340 #define UNDERFLOW 4 /* underflow range error */
1341 #define TLOSS 5 /* total loss of precision */
1342 #define PLOSS 6 /* partial loss of precision */
1343 #define INVALID 7 /* NaN-producing operation */
1345 /* e type constants used by high precision check routines */
1347 #if LONG_DOUBLE_TYPE_SIZE == 128
1348 /* 0.0 */
1349 unsigned EMUSHORT ezero[NE] =
1350 {0x0000, 0x0000, 0x0000, 0x0000,
1351 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000,};
1352 extern unsigned EMUSHORT ezero[];
1354 /* 5.0E-1 */
1355 unsigned EMUSHORT ehalf[NE] =
1356 {0x0000, 0x0000, 0x0000, 0x0000,
1357 0x0000, 0x0000, 0x0000, 0x0000, 0x8000, 0x3ffe,};
1358 extern unsigned EMUSHORT ehalf[];
1360 /* 1.0E0 */
1361 unsigned EMUSHORT eone[NE] =
1362 {0x0000, 0x0000, 0x0000, 0x0000,
1363 0x0000, 0x0000, 0x0000, 0x0000, 0x8000, 0x3fff,};
1364 extern unsigned EMUSHORT eone[];
1366 /* 2.0E0 */
1367 unsigned EMUSHORT etwo[NE] =
1368 {0x0000, 0x0000, 0x0000, 0x0000,
1369 0x0000, 0x0000, 0x0000, 0x0000, 0x8000, 0x4000,};
1370 extern unsigned EMUSHORT etwo[];
1372 /* 3.2E1 */
1373 unsigned EMUSHORT e32[NE] =
1374 {0x0000, 0x0000, 0x0000, 0x0000,
1375 0x0000, 0x0000, 0x0000, 0x0000, 0x8000, 0x4004,};
1376 extern unsigned EMUSHORT e32[];
1378 /* 6.93147180559945309417232121458176568075500134360255E-1 */
1379 unsigned EMUSHORT elog2[NE] =
1380 {0x40f3, 0xf6af, 0x03f2, 0xb398,
1381 0xc9e3, 0x79ab, 0150717, 0013767, 0130562, 0x3ffe,};
1382 extern unsigned EMUSHORT elog2[];
1384 /* 1.41421356237309504880168872420969807856967187537695E0 */
1385 unsigned EMUSHORT esqrt2[NE] =
1386 {0x1d6f, 0xbe9f, 0x754a, 0x89b3,
1387 0x597d, 0x6484, 0174736, 0171463, 0132404, 0x3fff,};
1388 extern unsigned EMUSHORT esqrt2[];
1390 /* 3.14159265358979323846264338327950288419716939937511E0 */
1391 unsigned EMUSHORT epi[NE] =
1392 {0x2902, 0x1cd1, 0x80dc, 0x628b,
1393 0xc4c6, 0xc234, 0020550, 0155242, 0144417, 0040000,};
1394 extern unsigned EMUSHORT epi[];
1396 #else
1397 /* LONG_DOUBLE_TYPE_SIZE is other than 128 */
1398 unsigned EMUSHORT ezero[NE] =
1399 {0, 0000000, 0000000, 0000000, 0000000, 0000000,};
1400 unsigned EMUSHORT ehalf[NE] =
1401 {0, 0000000, 0000000, 0000000, 0100000, 0x3ffe,};
1402 unsigned EMUSHORT eone[NE] =
1403 {0, 0000000, 0000000, 0000000, 0100000, 0x3fff,};
1404 unsigned EMUSHORT etwo[NE] =
1405 {0, 0000000, 0000000, 0000000, 0100000, 0040000,};
1406 unsigned EMUSHORT e32[NE] =
1407 {0, 0000000, 0000000, 0000000, 0100000, 0040004,};
1408 unsigned EMUSHORT elog2[NE] =
1409 {0xc9e4, 0x79ab, 0150717, 0013767, 0130562, 0x3ffe,};
1410 unsigned EMUSHORT esqrt2[NE] =
1411 {0x597e, 0x6484, 0174736, 0171463, 0132404, 0x3fff,};
1412 unsigned EMUSHORT epi[NE] =
1413 {0xc4c6, 0xc234, 0020550, 0155242, 0144417, 0040000,};
1414 #endif
1416 /* Control register for rounding precision.
1417 This can be set to 113 (if NE=10), 80 (if NE=6), 64, 56, 53, or 24 bits. */
1419 int rndprc = NBITS;
1420 extern int rndprc;
1422 /* Clear out entire e-type number X. */
1424 static void
1425 eclear (x)
1426 register unsigned EMUSHORT *x;
1428 register int i;
1430 for (i = 0; i < NE; i++)
1431 *x++ = 0;
1434 /* Move e-type number from A to B. */
1436 static void
1437 emov (a, b)
1438 register unsigned EMUSHORT *a, *b;
1440 register int i;
1442 for (i = 0; i < NE; i++)
1443 *b++ = *a++;
1447 /* Absolute value of e-type X. */
1449 static void
1450 eabs (x)
1451 unsigned EMUSHORT x[];
1453 /* sign is top bit of last word of external format */
1454 x[NE - 1] &= 0x7fff;
1457 /* Negate the e-type number X. */
1459 static void
1460 eneg (x)
1461 unsigned EMUSHORT x[];
1464 x[NE - 1] ^= 0x8000; /* Toggle the sign bit */
1467 /* Return 1 if sign bit of e-type number X is nonzero, else zero. */
1469 static int
1470 eisneg (x)
1471 unsigned EMUSHORT x[];
1474 if (x[NE - 1] & 0x8000)
1475 return (1);
1476 else
1477 return (0);
1480 /* Return 1 if e-type number X is infinity, else return zero. */
1482 static int
1483 eisinf (x)
1484 unsigned EMUSHORT x[];
1487 #ifdef NANS
1488 if (eisnan (x))
1489 return (0);
1490 #endif
1491 if ((x[NE - 1] & 0x7fff) == 0x7fff)
1492 return (1);
1493 else
1494 return (0);
1497 /* Check if e-type number is not a number. The bit pattern is one that we
1498 defined, so we know for sure how to detect it. */
1500 static int
1501 eisnan (x)
1502 unsigned EMUSHORT x[];
1504 #ifdef NANS
1505 int i;
1507 /* NaN has maximum exponent */
1508 if ((x[NE - 1] & 0x7fff) != 0x7fff)
1509 return (0);
1510 /* ... and non-zero significand field. */
1511 for (i = 0; i < NE - 1; i++)
1513 if (*x++ != 0)
1514 return (1);
1516 #endif
1518 return (0);
1521 /* Fill e-type number X with infinity pattern (IEEE)
1522 or largest possible number (non-IEEE). */
1524 static void
1525 einfin (x)
1526 register unsigned EMUSHORT *x;
1528 register int i;
1530 #ifdef INFINITY
1531 for (i = 0; i < NE - 1; i++)
1532 *x++ = 0;
1533 *x |= 32767;
1534 #else
1535 for (i = 0; i < NE - 1; i++)
1536 *x++ = 0xffff;
1537 *x |= 32766;
1538 if (rndprc < NBITS)
1540 if (rndprc == 113)
1542 *(x - 9) = 0;
1543 *(x - 8) = 0;
1545 if (rndprc == 64)
1547 *(x - 5) = 0;
1549 if (rndprc == 53)
1551 *(x - 4) = 0xf800;
1553 else
1555 *(x - 4) = 0;
1556 *(x - 3) = 0;
1557 *(x - 2) = 0xff00;
1560 #endif
1563 /* Output an e-type NaN.
1564 This generates Intel's quiet NaN pattern for extended real.
1565 The exponent is 7fff, the leading mantissa word is c000. */
1567 static void
1568 enan (x, sign)
1569 register unsigned EMUSHORT *x;
1570 int sign;
1572 register int i;
1574 for (i = 0; i < NE - 2; i++)
1575 *x++ = 0;
1576 *x++ = 0xc000;
1577 *x = (sign << 15) | 0x7fff;
1580 /* Move in an e-type number A, converting it to exploded e-type B. */
1582 static void
1583 emovi (a, b)
1584 unsigned EMUSHORT *a, *b;
1586 register unsigned EMUSHORT *p, *q;
1587 int i;
1589 q = b;
1590 p = a + (NE - 1); /* point to last word of external number */
1591 /* get the sign bit */
1592 if (*p & 0x8000)
1593 *q++ = 0xffff;
1594 else
1595 *q++ = 0;
1596 /* get the exponent */
1597 *q = *p--;
1598 *q++ &= 0x7fff; /* delete the sign bit */
1599 #ifdef INFINITY
1600 if ((*(q - 1) & 0x7fff) == 0x7fff)
1602 #ifdef NANS
1603 if (eisnan (a))
1605 *q++ = 0;
1606 for (i = 3; i < NI; i++)
1607 *q++ = *p--;
1608 return;
1610 #endif
1612 for (i = 2; i < NI; i++)
1613 *q++ = 0;
1614 return;
1616 #endif
1618 /* clear high guard word */
1619 *q++ = 0;
1620 /* move in the significand */
1621 for (i = 0; i < NE - 1; i++)
1622 *q++ = *p--;
1623 /* clear low guard word */
1624 *q = 0;
1627 /* Move out exploded e-type number A, converting it to e type B. */
1629 static void
1630 emovo (a, b)
1631 unsigned EMUSHORT *a, *b;
1633 register unsigned EMUSHORT *p, *q;
1634 unsigned EMUSHORT i;
1635 int j;
1637 p = a;
1638 q = b + (NE - 1); /* point to output exponent */
1639 /* combine sign and exponent */
1640 i = *p++;
1641 if (i)
1642 *q-- = *p++ | 0x8000;
1643 else
1644 *q-- = *p++;
1645 #ifdef INFINITY
1646 if (*(p - 1) == 0x7fff)
1648 #ifdef NANS
1649 if (eiisnan (a))
1651 enan (b, eiisneg (a));
1652 return;
1654 #endif
1655 einfin (b);
1656 return;
1658 #endif
1659 /* skip over guard word */
1660 ++p;
1661 /* move the significand */
1662 for (j = 0; j < NE - 1; j++)
1663 *q-- = *p++;
1666 /* Clear out exploded e-type number XI. */
1668 static void
1669 ecleaz (xi)
1670 register unsigned EMUSHORT *xi;
1672 register int i;
1674 for (i = 0; i < NI; i++)
1675 *xi++ = 0;
1678 /* Clear out exploded e-type XI, but don't touch the sign. */
1680 static void
1681 ecleazs (xi)
1682 register unsigned EMUSHORT *xi;
1684 register int i;
1686 ++xi;
1687 for (i = 0; i < NI - 1; i++)
1688 *xi++ = 0;
1691 /* Move exploded e-type number from A to B. */
1693 static void
1694 emovz (a, b)
1695 register unsigned EMUSHORT *a, *b;
1697 register int i;
1699 for (i = 0; i < NI - 1; i++)
1700 *b++ = *a++;
1701 /* clear low guard word */
1702 *b = 0;
1705 /* Generate exploded e-type NaN.
1706 The explicit pattern for this is maximum exponent and
1707 top two significant bits set. */
1709 static void
1710 einan (x)
1711 unsigned EMUSHORT x[];
1714 ecleaz (x);
1715 x[E] = 0x7fff;
1716 x[M + 1] = 0xc000;
1719 /* Return nonzero if exploded e-type X is a NaN. */
1721 static int
1722 eiisnan (x)
1723 unsigned EMUSHORT x[];
1725 int i;
1727 if ((x[E] & 0x7fff) == 0x7fff)
1729 for (i = M + 1; i < NI; i++)
1731 if (x[i] != 0)
1732 return (1);
1735 return (0);
1738 /* Return nonzero if sign of exploded e-type X is nonzero. */
1740 static int
1741 eiisneg (x)
1742 unsigned EMUSHORT x[];
1745 return x[0] != 0;
1748 /* Fill exploded e-type X with infinity pattern.
1749 This has maximum exponent and significand all zeros. */
1751 static void
1752 eiinfin (x)
1753 unsigned EMUSHORT x[];
1756 ecleaz (x);
1757 x[E] = 0x7fff;
1760 /* Return nonzero if exploded e-type X is infinite. */
1762 static int
1763 eiisinf (x)
1764 unsigned EMUSHORT x[];
1767 #ifdef NANS
1768 if (eiisnan (x))
1769 return (0);
1770 #endif
1771 if ((x[E] & 0x7fff) == 0x7fff)
1772 return (1);
1773 return (0);
1777 /* Compare significands of numbers in internal exploded e-type format.
1778 Guard words are included in the comparison.
1780 Returns +1 if a > b
1781 0 if a == b
1782 -1 if a < b */
1784 static int
1785 ecmpm (a, b)
1786 register unsigned EMUSHORT *a, *b;
1788 int i;
1790 a += M; /* skip up to significand area */
1791 b += M;
1792 for (i = M; i < NI; i++)
1794 if (*a++ != *b++)
1795 goto difrnt;
1797 return (0);
1799 difrnt:
1800 if (*(--a) > *(--b))
1801 return (1);
1802 else
1803 return (-1);
1806 /* Shift significand of exploded e-type X down by 1 bit. */
1808 static void
1809 eshdn1 (x)
1810 register unsigned EMUSHORT *x;
1812 register unsigned EMUSHORT bits;
1813 int i;
1815 x += M; /* point to significand area */
1817 bits = 0;
1818 for (i = M; i < NI; i++)
1820 if (*x & 1)
1821 bits |= 1;
1822 *x >>= 1;
1823 if (bits & 2)
1824 *x |= 0x8000;
1825 bits <<= 1;
1826 ++x;
1830 /* Shift significand of exploded e-type X up by 1 bit. */
1832 static void
1833 eshup1 (x)
1834 register unsigned EMUSHORT *x;
1836 register unsigned EMUSHORT bits;
1837 int i;
1839 x += NI - 1;
1840 bits = 0;
1842 for (i = M; i < NI; i++)
1844 if (*x & 0x8000)
1845 bits |= 1;
1846 *x <<= 1;
1847 if (bits & 2)
1848 *x |= 1;
1849 bits <<= 1;
1850 --x;
1855 /* Shift significand of exploded e-type X down by 8 bits. */
1857 static void
1858 eshdn8 (x)
1859 register unsigned EMUSHORT *x;
1861 register unsigned EMUSHORT newbyt, oldbyt;
1862 int i;
1864 x += M;
1865 oldbyt = 0;
1866 for (i = M; i < NI; i++)
1868 newbyt = *x << 8;
1869 *x >>= 8;
1870 *x |= oldbyt;
1871 oldbyt = newbyt;
1872 ++x;
1876 /* Shift significand of exploded e-type X up by 8 bits. */
1878 static void
1879 eshup8 (x)
1880 register unsigned EMUSHORT *x;
1882 int i;
1883 register unsigned EMUSHORT newbyt, oldbyt;
1885 x += NI - 1;
1886 oldbyt = 0;
1888 for (i = M; i < NI; i++)
1890 newbyt = *x >> 8;
1891 *x <<= 8;
1892 *x |= oldbyt;
1893 oldbyt = newbyt;
1894 --x;
1898 /* Shift significand of exploded e-type X up by 16 bits. */
1900 static void
1901 eshup6 (x)
1902 register unsigned EMUSHORT *x;
1904 int i;
1905 register unsigned EMUSHORT *p;
1907 p = x + M;
1908 x += M + 1;
1910 for (i = M; i < NI - 1; i++)
1911 *p++ = *x++;
1913 *p = 0;
1916 /* Shift significand of exploded e-type X down by 16 bits. */
1918 static void
1919 eshdn6 (x)
1920 register unsigned EMUSHORT *x;
1922 int i;
1923 register unsigned EMUSHORT *p;
1925 x += NI - 1;
1926 p = x + 1;
1928 for (i = M; i < NI - 1; i++)
1929 *(--p) = *(--x);
1931 *(--p) = 0;
1934 /* Add significands of exploded e-type X and Y. X + Y replaces Y. */
1936 static void
1937 eaddm (x, y)
1938 unsigned EMUSHORT *x, *y;
1940 register unsigned EMULONG a;
1941 int i;
1942 unsigned int carry;
1944 x += NI - 1;
1945 y += NI - 1;
1946 carry = 0;
1947 for (i = M; i < NI; i++)
1949 a = (unsigned EMULONG) (*x) + (unsigned EMULONG) (*y) + carry;
1950 if (a & 0x10000)
1951 carry = 1;
1952 else
1953 carry = 0;
1954 *y = (unsigned EMUSHORT) a;
1955 --x;
1956 --y;
1960 /* Subtract significands of exploded e-type X and Y. Y - X replaces Y. */
1962 static void
1963 esubm (x, y)
1964 unsigned EMUSHORT *x, *y;
1966 unsigned EMULONG a;
1967 int i;
1968 unsigned int carry;
1970 x += NI - 1;
1971 y += NI - 1;
1972 carry = 0;
1973 for (i = M; i < NI; i++)
1975 a = (unsigned EMULONG) (*y) - (unsigned EMULONG) (*x) - carry;
1976 if (a & 0x10000)
1977 carry = 1;
1978 else
1979 carry = 0;
1980 *y = (unsigned EMUSHORT) a;
1981 --x;
1982 --y;
1987 static unsigned EMUSHORT equot[NI];
1990 #if 0
1991 /* Radix 2 shift-and-add versions of multiply and divide */
1994 /* Divide significands */
1996 int
1997 edivm (den, num)
1998 unsigned EMUSHORT den[], num[];
2000 int i;
2001 register unsigned EMUSHORT *p, *q;
2002 unsigned EMUSHORT j;
2004 p = &equot[0];
2005 *p++ = num[0];
2006 *p++ = num[1];
2008 for (i = M; i < NI; i++)
2010 *p++ = 0;
2013 /* Use faster compare and subtraction if denominator has only 15 bits of
2014 significance. */
2016 p = &den[M + 2];
2017 if (*p++ == 0)
2019 for (i = M + 3; i < NI; i++)
2021 if (*p++ != 0)
2022 goto fulldiv;
2024 if ((den[M + 1] & 1) != 0)
2025 goto fulldiv;
2026 eshdn1 (num);
2027 eshdn1 (den);
2029 p = &den[M + 1];
2030 q = &num[M + 1];
2032 for (i = 0; i < NBITS + 2; i++)
2034 if (*p <= *q)
2036 *q -= *p;
2037 j = 1;
2039 else
2041 j = 0;
2043 eshup1 (equot);
2044 equot[NI - 2] |= j;
2045 eshup1 (num);
2047 goto divdon;
2050 /* The number of quotient bits to calculate is NBITS + 1 scaling guard
2051 bit + 1 roundoff bit. */
2053 fulldiv:
2055 p = &equot[NI - 2];
2056 for (i = 0; i < NBITS + 2; i++)
2058 if (ecmpm (den, num) <= 0)
2060 esubm (den, num);
2061 j = 1; /* quotient bit = 1 */
2063 else
2064 j = 0;
2065 eshup1 (equot);
2066 *p |= j;
2067 eshup1 (num);
2070 divdon:
2072 eshdn1 (equot);
2073 eshdn1 (equot);
2075 /* test for nonzero remainder after roundoff bit */
2076 p = &num[M];
2077 j = 0;
2078 for (i = M; i < NI; i++)
2080 j |= *p++;
2082 if (j)
2083 j = 1;
2086 for (i = 0; i < NI; i++)
2087 num[i] = equot[i];
2088 return ((int) j);
2092 /* Multiply significands */
2093 int
2094 emulm (a, b)
2095 unsigned EMUSHORT a[], b[];
2097 unsigned EMUSHORT *p, *q;
2098 int i, j, k;
2100 equot[0] = b[0];
2101 equot[1] = b[1];
2102 for (i = M; i < NI; i++)
2103 equot[i] = 0;
2105 p = &a[NI - 2];
2106 k = NBITS;
2107 while (*p == 0) /* significand is not supposed to be zero */
2109 eshdn6 (a);
2110 k -= 16;
2112 if ((*p & 0xff) == 0)
2114 eshdn8 (a);
2115 k -= 8;
2118 q = &equot[NI - 1];
2119 j = 0;
2120 for (i = 0; i < k; i++)
2122 if (*p & 1)
2123 eaddm (b, equot);
2124 /* remember if there were any nonzero bits shifted out */
2125 if (*q & 1)
2126 j |= 1;
2127 eshdn1 (a);
2128 eshdn1 (equot);
2131 for (i = 0; i < NI; i++)
2132 b[i] = equot[i];
2134 /* return flag for lost nonzero bits */
2135 return (j);
2138 #else
2140 /* Radix 65536 versions of multiply and divide. */
2142 /* Multiply significand of e-type number B
2143 by 16-bit quantity A, return e-type result to C. */
2145 static void
2146 m16m (a, b, c)
2147 unsigned int a;
2148 unsigned EMUSHORT b[], c[];
2150 register unsigned EMUSHORT *pp;
2151 register unsigned EMULONG carry;
2152 unsigned EMUSHORT *ps;
2153 unsigned EMUSHORT p[NI];
2154 unsigned EMULONG aa, m;
2155 int i;
2157 aa = a;
2158 pp = &p[NI-2];
2159 *pp++ = 0;
2160 *pp = 0;
2161 ps = &b[NI-1];
2163 for (i=M+1; i<NI; i++)
2165 if (*ps == 0)
2167 --ps;
2168 --pp;
2169 *(pp-1) = 0;
2171 else
2173 m = (unsigned EMULONG) aa * *ps--;
2174 carry = (m & 0xffff) + *pp;
2175 *pp-- = (unsigned EMUSHORT)carry;
2176 carry = (carry >> 16) + (m >> 16) + *pp;
2177 *pp = (unsigned EMUSHORT)carry;
2178 *(pp-1) = carry >> 16;
2181 for (i=M; i<NI; i++)
2182 c[i] = p[i];
2185 /* Divide significands of exploded e-types NUM / DEN. Neither the
2186 numerator NUM nor the denominator DEN is permitted to have its high guard
2187 word nonzero. */
2189 static int
2190 edivm (den, num)
2191 unsigned EMUSHORT den[], num[];
2193 int i;
2194 register unsigned EMUSHORT *p;
2195 unsigned EMULONG tnum;
2196 unsigned EMUSHORT j, tdenm, tquot;
2197 unsigned EMUSHORT tprod[NI+1];
2199 p = &equot[0];
2200 *p++ = num[0];
2201 *p++ = num[1];
2203 for (i=M; i<NI; i++)
2205 *p++ = 0;
2207 eshdn1 (num);
2208 tdenm = den[M+1];
2209 for (i=M; i<NI; i++)
2211 /* Find trial quotient digit (the radix is 65536). */
2212 tnum = (((unsigned EMULONG) num[M]) << 16) + num[M+1];
2214 /* Do not execute the divide instruction if it will overflow. */
2215 if ((tdenm * 0xffffL) < tnum)
2216 tquot = 0xffff;
2217 else
2218 tquot = tnum / tdenm;
2219 /* Multiply denominator by trial quotient digit. */
2220 m16m ((unsigned int)tquot, den, tprod);
2221 /* The quotient digit may have been overestimated. */
2222 if (ecmpm (tprod, num) > 0)
2224 tquot -= 1;
2225 esubm (den, tprod);
2226 if (ecmpm (tprod, num) > 0)
2228 tquot -= 1;
2229 esubm (den, tprod);
2232 esubm (tprod, num);
2233 equot[i] = tquot;
2234 eshup6(num);
2236 /* test for nonzero remainder after roundoff bit */
2237 p = &num[M];
2238 j = 0;
2239 for (i=M; i<NI; i++)
2241 j |= *p++;
2243 if (j)
2244 j = 1;
2246 for (i=0; i<NI; i++)
2247 num[i] = equot[i];
2249 return ((int)j);
2252 /* Multiply significands of exploded e-type A and B, result in B. */
2254 static int
2255 emulm (a, b)
2256 unsigned EMUSHORT a[], b[];
2258 unsigned EMUSHORT *p, *q;
2259 unsigned EMUSHORT pprod[NI];
2260 unsigned EMUSHORT j;
2261 int i;
2263 equot[0] = b[0];
2264 equot[1] = b[1];
2265 for (i=M; i<NI; i++)
2266 equot[i] = 0;
2268 j = 0;
2269 p = &a[NI-1];
2270 q = &equot[NI-1];
2271 for (i=M+1; i<NI; i++)
2273 if (*p == 0)
2275 --p;
2277 else
2279 m16m ((unsigned int) *p--, b, pprod);
2280 eaddm(pprod, equot);
2282 j |= *q;
2283 eshdn6(equot);
2286 for (i=0; i<NI; i++)
2287 b[i] = equot[i];
2289 /* return flag for lost nonzero bits */
2290 return ((int)j);
2292 #endif
2295 /* Normalize and round off.
2297 The internal format number to be rounded is S.
2298 Input LOST is 0 if the value is exact. This is the so-called sticky bit.
2300 Input SUBFLG indicates whether the number was obtained
2301 by a subtraction operation. In that case if LOST is nonzero
2302 then the number is slightly smaller than indicated.
2304 Input EXP is the biased exponent, which may be negative.
2305 the exponent field of S is ignored but is replaced by
2306 EXP as adjusted by normalization and rounding.
2308 Input RCNTRL is the rounding control. If it is nonzero, the
2309 returned value will be rounded to RNDPRC bits.
2311 For future reference: In order for emdnorm to round off denormal
2312 significands at the right point, the input exponent must be
2313 adjusted to be the actual value it would have after conversion to
2314 the final floating point type. This adjustment has been
2315 implemented for all type conversions (etoe53, etc.) and decimal
2316 conversions, but not for the arithmetic functions (eadd, etc.).
2317 Data types having standard 15-bit exponents are not affected by
2318 this, but SFmode and DFmode are affected. For example, ediv with
2319 rndprc = 24 will not round correctly to 24-bit precision if the
2320 result is denormal. */
2322 static int rlast = -1;
2323 static int rw = 0;
2324 static unsigned EMUSHORT rmsk = 0;
2325 static unsigned EMUSHORT rmbit = 0;
2326 static unsigned EMUSHORT rebit = 0;
2327 static int re = 0;
2328 static unsigned EMUSHORT rbit[NI];
2330 static void
2331 emdnorm (s, lost, subflg, exp, rcntrl)
2332 unsigned EMUSHORT s[];
2333 int lost;
2334 int subflg;
2335 EMULONG exp;
2336 int rcntrl;
2338 int i, j;
2339 unsigned EMUSHORT r;
2341 /* Normalize */
2342 j = enormlz (s);
2344 /* a blank significand could mean either zero or infinity. */
2345 #ifndef INFINITY
2346 if (j > NBITS)
2348 ecleazs (s);
2349 return;
2351 #endif
2352 exp -= j;
2353 #ifndef INFINITY
2354 if (exp >= 32767L)
2355 goto overf;
2356 #else
2357 if ((j > NBITS) && (exp < 32767))
2359 ecleazs (s);
2360 return;
2362 #endif
2363 if (exp < 0L)
2365 if (exp > (EMULONG) (-NBITS - 1))
2367 j = (int) exp;
2368 i = eshift (s, j);
2369 if (i)
2370 lost = 1;
2372 else
2374 ecleazs (s);
2375 return;
2378 /* Round off, unless told not to by rcntrl. */
2379 if (rcntrl == 0)
2380 goto mdfin;
2381 /* Set up rounding parameters if the control register changed. */
2382 if (rndprc != rlast)
2384 ecleaz (rbit);
2385 switch (rndprc)
2387 default:
2388 case NBITS:
2389 rw = NI - 1; /* low guard word */
2390 rmsk = 0xffff;
2391 rmbit = 0x8000;
2392 re = rw - 1;
2393 rebit = 1;
2394 break;
2395 case 113:
2396 rw = 10;
2397 rmsk = 0x7fff;
2398 rmbit = 0x4000;
2399 rebit = 0x8000;
2400 re = rw;
2401 break;
2402 case 64:
2403 rw = 7;
2404 rmsk = 0xffff;
2405 rmbit = 0x8000;
2406 re = rw - 1;
2407 rebit = 1;
2408 break;
2409 /* For DEC or IBM arithmetic */
2410 case 56:
2411 rw = 6;
2412 rmsk = 0xff;
2413 rmbit = 0x80;
2414 rebit = 0x100;
2415 re = rw;
2416 break;
2417 case 53:
2418 rw = 6;
2419 rmsk = 0x7ff;
2420 rmbit = 0x0400;
2421 rebit = 0x800;
2422 re = rw;
2423 break;
2424 case 24:
2425 rw = 4;
2426 rmsk = 0xff;
2427 rmbit = 0x80;
2428 rebit = 0x100;
2429 re = rw;
2430 break;
2432 rbit[re] = rebit;
2433 rlast = rndprc;
2436 /* Shift down 1 temporarily if the data structure has an implied
2437 most significant bit and the number is denormal.
2438 Intel long double denormals also lose one bit of precision. */
2439 if ((exp <= 0) && (rndprc != NBITS)
2440 && ((rndprc != 64) || ((rndprc == 64) && ! REAL_WORDS_BIG_ENDIAN)))
2442 lost |= s[NI - 1] & 1;
2443 eshdn1 (s);
2445 /* Clear out all bits below the rounding bit,
2446 remembering in r if any were nonzero. */
2447 r = s[rw] & rmsk;
2448 if (rndprc < NBITS)
2450 i = rw + 1;
2451 while (i < NI)
2453 if (s[i])
2454 r |= 1;
2455 s[i] = 0;
2456 ++i;
2459 s[rw] &= ~rmsk;
2460 if ((r & rmbit) != 0)
2462 if (r == rmbit)
2464 if (lost == 0)
2465 { /* round to even */
2466 if ((s[re] & rebit) == 0)
2467 goto mddone;
2469 else
2471 if (subflg != 0)
2472 goto mddone;
2475 eaddm (rbit, s);
2477 mddone:
2478 /* Undo the temporary shift for denormal values. */
2479 if ((exp <= 0) && (rndprc != NBITS)
2480 && ((rndprc != 64) || ((rndprc == 64) && ! REAL_WORDS_BIG_ENDIAN)))
2482 eshup1 (s);
2484 if (s[2] != 0)
2485 { /* overflow on roundoff */
2486 eshdn1 (s);
2487 exp += 1;
2489 mdfin:
2490 s[NI - 1] = 0;
2491 if (exp >= 32767L)
2493 #ifndef INFINITY
2494 overf:
2495 #endif
2496 #ifdef INFINITY
2497 s[1] = 32767;
2498 for (i = 2; i < NI - 1; i++)
2499 s[i] = 0;
2500 if (extra_warnings)
2501 warning ("floating point overflow");
2502 #else
2503 s[1] = 32766;
2504 s[2] = 0;
2505 for (i = M + 1; i < NI - 1; i++)
2506 s[i] = 0xffff;
2507 s[NI - 1] = 0;
2508 if ((rndprc < 64) || (rndprc == 113))
2510 s[rw] &= ~rmsk;
2511 if (rndprc == 24)
2513 s[5] = 0;
2514 s[6] = 0;
2517 #endif
2518 return;
2520 if (exp < 0)
2521 s[1] = 0;
2522 else
2523 s[1] = (unsigned EMUSHORT) exp;
2526 /* Subtract. C = B - A, all e type numbers. */
2528 static int subflg = 0;
2530 static void
2531 esub (a, b, c)
2532 unsigned EMUSHORT *a, *b, *c;
2535 #ifdef NANS
2536 if (eisnan (a))
2538 emov (a, c);
2539 return;
2541 if (eisnan (b))
2543 emov (b, c);
2544 return;
2546 /* Infinity minus infinity is a NaN.
2547 Test for subtracting infinities of the same sign. */
2548 if (eisinf (a) && eisinf (b)
2549 && ((eisneg (a) ^ eisneg (b)) == 0))
2551 mtherr ("esub", INVALID);
2552 enan (c, 0);
2553 return;
2555 #endif
2556 subflg = 1;
2557 eadd1 (a, b, c);
2560 /* Add. C = A + B, all e type. */
2562 static void
2563 eadd (a, b, c)
2564 unsigned EMUSHORT *a, *b, *c;
2567 #ifdef NANS
2568 /* NaN plus anything is a NaN. */
2569 if (eisnan (a))
2571 emov (a, c);
2572 return;
2574 if (eisnan (b))
2576 emov (b, c);
2577 return;
2579 /* Infinity minus infinity is a NaN.
2580 Test for adding infinities of opposite signs. */
2581 if (eisinf (a) && eisinf (b)
2582 && ((eisneg (a) ^ eisneg (b)) != 0))
2584 mtherr ("esub", INVALID);
2585 enan (c, 0);
2586 return;
2588 #endif
2589 subflg = 0;
2590 eadd1 (a, b, c);
2593 /* Arithmetic common to both addition and subtraction. */
2595 static void
2596 eadd1 (a, b, c)
2597 unsigned EMUSHORT *a, *b, *c;
2599 unsigned EMUSHORT ai[NI], bi[NI], ci[NI];
2600 int i, lost, j, k;
2601 EMULONG lt, lta, ltb;
2603 #ifdef INFINITY
2604 if (eisinf (a))
2606 emov (a, c);
2607 if (subflg)
2608 eneg (c);
2609 return;
2611 if (eisinf (b))
2613 emov (b, c);
2614 return;
2616 #endif
2617 emovi (a, ai);
2618 emovi (b, bi);
2619 if (subflg)
2620 ai[0] = ~ai[0];
2622 /* compare exponents */
2623 lta = ai[E];
2624 ltb = bi[E];
2625 lt = lta - ltb;
2626 if (lt > 0L)
2627 { /* put the larger number in bi */
2628 emovz (bi, ci);
2629 emovz (ai, bi);
2630 emovz (ci, ai);
2631 ltb = bi[E];
2632 lt = -lt;
2634 lost = 0;
2635 if (lt != 0L)
2637 if (lt < (EMULONG) (-NBITS - 1))
2638 goto done; /* answer same as larger addend */
2639 k = (int) lt;
2640 lost = eshift (ai, k); /* shift the smaller number down */
2642 else
2644 /* exponents were the same, so must compare significands */
2645 i = ecmpm (ai, bi);
2646 if (i == 0)
2647 { /* the numbers are identical in magnitude */
2648 /* if different signs, result is zero */
2649 if (ai[0] != bi[0])
2651 eclear (c);
2652 return;
2654 /* if same sign, result is double */
2655 /* double denormalized tiny number */
2656 if ((bi[E] == 0) && ((bi[3] & 0x8000) == 0))
2658 eshup1 (bi);
2659 goto done;
2661 /* add 1 to exponent unless both are zero! */
2662 for (j = 1; j < NI - 1; j++)
2664 if (bi[j] != 0)
2666 ltb += 1;
2667 if (ltb >= 0x7fff)
2669 eclear (c);
2670 if (ai[0] != 0)
2671 eneg (c);
2672 einfin (c);
2673 return;
2675 break;
2678 bi[E] = (unsigned EMUSHORT) ltb;
2679 goto done;
2681 if (i > 0)
2682 { /* put the larger number in bi */
2683 emovz (bi, ci);
2684 emovz (ai, bi);
2685 emovz (ci, ai);
2688 if (ai[0] == bi[0])
2690 eaddm (ai, bi);
2691 subflg = 0;
2693 else
2695 esubm (ai, bi);
2696 subflg = 1;
2698 emdnorm (bi, lost, subflg, ltb, 64);
2700 done:
2701 emovo (bi, c);
2704 /* Divide: C = B/A, all e type. */
2706 static void
2707 ediv (a, b, c)
2708 unsigned EMUSHORT *a, *b, *c;
2710 unsigned EMUSHORT ai[NI], bi[NI];
2711 int i, sign;
2712 EMULONG lt, lta, ltb;
2714 /* IEEE says if result is not a NaN, the sign is "-" if and only if
2715 operands have opposite signs -- but flush -0 to 0 later if not IEEE. */
2716 sign = eisneg(a) ^ eisneg(b);
2718 #ifdef NANS
2719 /* Return any NaN input. */
2720 if (eisnan (a))
2722 emov (a, c);
2723 return;
2725 if (eisnan (b))
2727 emov (b, c);
2728 return;
2730 /* Zero over zero, or infinity over infinity, is a NaN. */
2731 if (((ecmp (a, ezero) == 0) && (ecmp (b, ezero) == 0))
2732 || (eisinf (a) && eisinf (b)))
2734 mtherr ("ediv", INVALID);
2735 enan (c, sign);
2736 return;
2738 #endif
2739 /* Infinity over anything else is infinity. */
2740 #ifdef INFINITY
2741 if (eisinf (b))
2743 einfin (c);
2744 goto divsign;
2746 /* Anything else over infinity is zero. */
2747 if (eisinf (a))
2749 eclear (c);
2750 goto divsign;
2752 #endif
2753 emovi (a, ai);
2754 emovi (b, bi);
2755 lta = ai[E];
2756 ltb = bi[E];
2757 if (bi[E] == 0)
2758 { /* See if numerator is zero. */
2759 for (i = 1; i < NI - 1; i++)
2761 if (bi[i] != 0)
2763 ltb -= enormlz (bi);
2764 goto dnzro1;
2767 eclear (c);
2768 goto divsign;
2770 dnzro1:
2772 if (ai[E] == 0)
2773 { /* possible divide by zero */
2774 for (i = 1; i < NI - 1; i++)
2776 if (ai[i] != 0)
2778 lta -= enormlz (ai);
2779 goto dnzro2;
2782 /* Divide by zero is not an invalid operation.
2783 It is a divide-by-zero operation! */
2784 einfin (c);
2785 mtherr ("ediv", SING);
2786 goto divsign;
2788 dnzro2:
2790 i = edivm (ai, bi);
2791 /* calculate exponent */
2792 lt = ltb - lta + EXONE;
2793 emdnorm (bi, i, 0, lt, 64);
2794 emovo (bi, c);
2796 divsign:
2798 if (sign
2799 #ifndef IEEE
2800 && (ecmp (c, ezero) != 0)
2801 #endif
2803 *(c+(NE-1)) |= 0x8000;
2804 else
2805 *(c+(NE-1)) &= ~0x8000;
2808 /* Multiply e-types A and B, return e-type product C. */
2810 static void
2811 emul (a, b, c)
2812 unsigned EMUSHORT *a, *b, *c;
2814 unsigned EMUSHORT ai[NI], bi[NI];
2815 int i, j, sign;
2816 EMULONG lt, lta, ltb;
2818 /* IEEE says if result is not a NaN, the sign is "-" if and only if
2819 operands have opposite signs -- but flush -0 to 0 later if not IEEE. */
2820 sign = eisneg(a) ^ eisneg(b);
2822 #ifdef NANS
2823 /* NaN times anything is the same NaN. */
2824 if (eisnan (a))
2826 emov (a, c);
2827 return;
2829 if (eisnan (b))
2831 emov (b, c);
2832 return;
2834 /* Zero times infinity is a NaN. */
2835 if ((eisinf (a) && (ecmp (b, ezero) == 0))
2836 || (eisinf (b) && (ecmp (a, ezero) == 0)))
2838 mtherr ("emul", INVALID);
2839 enan (c, sign);
2840 return;
2842 #endif
2843 /* Infinity times anything else is infinity. */
2844 #ifdef INFINITY
2845 if (eisinf (a) || eisinf (b))
2847 einfin (c);
2848 goto mulsign;
2850 #endif
2851 emovi (a, ai);
2852 emovi (b, bi);
2853 lta = ai[E];
2854 ltb = bi[E];
2855 if (ai[E] == 0)
2857 for (i = 1; i < NI - 1; i++)
2859 if (ai[i] != 0)
2861 lta -= enormlz (ai);
2862 goto mnzer1;
2865 eclear (c);
2866 goto mulsign;
2868 mnzer1:
2870 if (bi[E] == 0)
2872 for (i = 1; i < NI - 1; i++)
2874 if (bi[i] != 0)
2876 ltb -= enormlz (bi);
2877 goto mnzer2;
2880 eclear (c);
2881 goto mulsign;
2883 mnzer2:
2885 /* Multiply significands */
2886 j = emulm (ai, bi);
2887 /* calculate exponent */
2888 lt = lta + ltb - (EXONE - 1);
2889 emdnorm (bi, j, 0, lt, 64);
2890 emovo (bi, c);
2892 mulsign:
2894 if (sign
2895 #ifndef IEEE
2896 && (ecmp (c, ezero) != 0)
2897 #endif
2899 *(c+(NE-1)) |= 0x8000;
2900 else
2901 *(c+(NE-1)) &= ~0x8000;
2904 /* Convert double precision PE to e-type Y. */
2906 static void
2907 e53toe (pe, y)
2908 unsigned EMUSHORT *pe, *y;
2910 #ifdef DEC
2912 dectoe (pe, y);
2914 #else
2915 #ifdef IBM
2917 ibmtoe (pe, y, DFmode);
2919 #else
2920 register unsigned EMUSHORT r;
2921 register unsigned EMUSHORT *e, *p;
2922 unsigned EMUSHORT yy[NI];
2923 int denorm, k;
2925 e = pe;
2926 denorm = 0; /* flag if denormalized number */
2927 ecleaz (yy);
2928 if (! REAL_WORDS_BIG_ENDIAN)
2929 e += 3;
2930 r = *e;
2931 yy[0] = 0;
2932 if (r & 0x8000)
2933 yy[0] = 0xffff;
2934 yy[M] = (r & 0x0f) | 0x10;
2935 r &= ~0x800f; /* strip sign and 4 significand bits */
2936 #ifdef INFINITY
2937 if (r == 0x7ff0)
2939 #ifdef NANS
2940 if (! REAL_WORDS_BIG_ENDIAN)
2942 if (((pe[3] & 0xf) != 0) || (pe[2] != 0)
2943 || (pe[1] != 0) || (pe[0] != 0))
2945 enan (y, yy[0] != 0);
2946 return;
2949 else
2951 if (((pe[0] & 0xf) != 0) || (pe[1] != 0)
2952 || (pe[2] != 0) || (pe[3] != 0))
2954 enan (y, yy[0] != 0);
2955 return;
2958 #endif /* NANS */
2959 eclear (y);
2960 einfin (y);
2961 if (yy[0])
2962 eneg (y);
2963 return;
2965 #endif /* INFINITY */
2966 r >>= 4;
2967 /* If zero exponent, then the significand is denormalized.
2968 So take back the understood high significand bit. */
2970 if (r == 0)
2972 denorm = 1;
2973 yy[M] &= ~0x10;
2975 r += EXONE - 01777;
2976 yy[E] = r;
2977 p = &yy[M + 1];
2978 #ifdef IEEE
2979 if (! REAL_WORDS_BIG_ENDIAN)
2981 *p++ = *(--e);
2982 *p++ = *(--e);
2983 *p++ = *(--e);
2985 else
2987 ++e;
2988 *p++ = *e++;
2989 *p++ = *e++;
2990 *p++ = *e++;
2992 #endif
2993 eshift (yy, -5);
2994 if (denorm)
2995 { /* if zero exponent, then normalize the significand */
2996 if ((k = enormlz (yy)) > NBITS)
2997 ecleazs (yy);
2998 else
2999 yy[E] -= (unsigned EMUSHORT) (k - 1);
3001 emovo (yy, y);
3002 #endif /* not IBM */
3003 #endif /* not DEC */
3006 /* Convert double extended precision float PE to e type Y. */
3008 static void
3009 e64toe (pe, y)
3010 unsigned EMUSHORT *pe, *y;
3012 unsigned EMUSHORT yy[NI];
3013 unsigned EMUSHORT *e, *p, *q;
3014 int i;
3016 e = pe;
3017 p = yy;
3018 for (i = 0; i < NE - 5; i++)
3019 *p++ = 0;
3020 /* This precision is not ordinarily supported on DEC or IBM. */
3021 #ifdef DEC
3022 for (i = 0; i < 5; i++)
3023 *p++ = *e++;
3024 #endif
3025 #ifdef IBM
3026 p = &yy[0] + (NE - 1);
3027 *p-- = *e++;
3028 ++e;
3029 for (i = 0; i < 5; i++)
3030 *p-- = *e++;
3031 #endif
3032 #ifdef IEEE
3033 if (! REAL_WORDS_BIG_ENDIAN)
3035 for (i = 0; i < 5; i++)
3036 *p++ = *e++;
3038 /* For denormal long double Intel format, shift significand up one
3039 -- but only if the top significand bit is zero. A top bit of 1
3040 is "pseudodenormal" when the exponent is zero. */
3041 if((yy[NE-1] & 0x7fff) == 0 && (yy[NE-2] & 0x8000) == 0)
3043 unsigned EMUSHORT temp[NI];
3045 emovi(yy, temp);
3046 eshup1(temp);
3047 emovo(temp,y);
3048 return;
3051 else
3053 p = &yy[0] + (NE - 1);
3054 #ifdef ARM_EXTENDED_IEEE_FORMAT
3055 /* For ARMs, the exponent is in the lowest 15 bits of the word. */
3056 *p-- = (e[0] & 0x8000) | (e[1] & 0x7ffff);
3057 e += 2;
3058 #else
3059 *p-- = *e++;
3060 ++e;
3061 #endif
3062 for (i = 0; i < 4; i++)
3063 *p-- = *e++;
3065 #endif
3066 #ifdef INFINITY
3067 /* Point to the exponent field and check max exponent cases. */
3068 p = &yy[NE - 1];
3069 if ((*p & 0x7fff) == 0x7fff)
3071 #ifdef NANS
3072 if (! REAL_WORDS_BIG_ENDIAN)
3074 for (i = 0; i < 4; i++)
3076 if ((i != 3 && pe[i] != 0)
3077 /* Anything but 0x8000 here, including 0, is a NaN. */
3078 || (i == 3 && pe[i] != 0x8000))
3080 enan (y, (*p & 0x8000) != 0);
3081 return;
3085 else
3087 #ifdef ARM_EXTENDED_IEEE_FORMAT
3088 for (i = 2; i <= 5; i++)
3090 if (pe[i] != 0)
3092 enan (y, (*p & 0x8000) != 0);
3093 return;
3096 #else /* not ARM */
3097 /* In Motorola extended precision format, the most significant
3098 bit of an infinity mantissa could be either 1 or 0. It is
3099 the lower order bits that tell whether the value is a NaN. */
3100 if ((pe[2] & 0x7fff) != 0)
3101 goto bigend_nan;
3103 for (i = 3; i <= 5; i++)
3105 if (pe[i] != 0)
3107 bigend_nan:
3108 enan (y, (*p & 0x8000) != 0);
3109 return;
3112 #endif /* not ARM */
3114 #endif /* NANS */
3115 eclear (y);
3116 einfin (y);
3117 if (*p & 0x8000)
3118 eneg (y);
3119 return;
3121 #endif /* INFINITY */
3122 p = yy;
3123 q = y;
3124 for (i = 0; i < NE; i++)
3125 *q++ = *p++;
3128 /* Convert 128-bit long double precision float PE to e type Y. */
3130 static void
3131 e113toe (pe, y)
3132 unsigned EMUSHORT *pe, *y;
3134 register unsigned EMUSHORT r;
3135 unsigned EMUSHORT *e, *p;
3136 unsigned EMUSHORT yy[NI];
3137 int denorm, i;
3139 e = pe;
3140 denorm = 0;
3141 ecleaz (yy);
3142 #ifdef IEEE
3143 if (! REAL_WORDS_BIG_ENDIAN)
3144 e += 7;
3145 #endif
3146 r = *e;
3147 yy[0] = 0;
3148 if (r & 0x8000)
3149 yy[0] = 0xffff;
3150 r &= 0x7fff;
3151 #ifdef INFINITY
3152 if (r == 0x7fff)
3154 #ifdef NANS
3155 if (! REAL_WORDS_BIG_ENDIAN)
3157 for (i = 0; i < 7; i++)
3159 if (pe[i] != 0)
3161 enan (y, yy[0] != 0);
3162 return;
3166 else
3168 for (i = 1; i < 8; i++)
3170 if (pe[i] != 0)
3172 enan (y, yy[0] != 0);
3173 return;
3177 #endif /* NANS */
3178 eclear (y);
3179 einfin (y);
3180 if (yy[0])
3181 eneg (y);
3182 return;
3184 #endif /* INFINITY */
3185 yy[E] = r;
3186 p = &yy[M + 1];
3187 #ifdef IEEE
3188 if (! REAL_WORDS_BIG_ENDIAN)
3190 for (i = 0; i < 7; i++)
3191 *p++ = *(--e);
3193 else
3195 ++e;
3196 for (i = 0; i < 7; i++)
3197 *p++ = *e++;
3199 #endif
3200 /* If denormal, remove the implied bit; else shift down 1. */
3201 if (r == 0)
3203 yy[M] = 0;
3205 else
3207 yy[M] = 1;
3208 eshift (yy, -1);
3210 emovo (yy, y);
3213 /* Convert single precision float PE to e type Y. */
3215 static void
3216 e24toe (pe, y)
3217 unsigned EMUSHORT *pe, *y;
3219 #ifdef IBM
3221 ibmtoe (pe, y, SFmode);
3223 #else
3224 register unsigned EMUSHORT r;
3225 register unsigned EMUSHORT *e, *p;
3226 unsigned EMUSHORT yy[NI];
3227 int denorm, k;
3229 e = pe;
3230 denorm = 0; /* flag if denormalized number */
3231 ecleaz (yy);
3232 #ifdef IEEE
3233 if (! REAL_WORDS_BIG_ENDIAN)
3234 e += 1;
3235 #endif
3236 #ifdef DEC
3237 e += 1;
3238 #endif
3239 r = *e;
3240 yy[0] = 0;
3241 if (r & 0x8000)
3242 yy[0] = 0xffff;
3243 yy[M] = (r & 0x7f) | 0200;
3244 r &= ~0x807f; /* strip sign and 7 significand bits */
3245 #ifdef INFINITY
3246 if (r == 0x7f80)
3248 #ifdef NANS
3249 if (REAL_WORDS_BIG_ENDIAN)
3251 if (((pe[0] & 0x7f) != 0) || (pe[1] != 0))
3253 enan (y, yy[0] != 0);
3254 return;
3257 else
3259 if (((pe[1] & 0x7f) != 0) || (pe[0] != 0))
3261 enan (y, yy[0] != 0);
3262 return;
3265 #endif /* NANS */
3266 eclear (y);
3267 einfin (y);
3268 if (yy[0])
3269 eneg (y);
3270 return;
3272 #endif /* INFINITY */
3273 r >>= 7;
3274 /* If zero exponent, then the significand is denormalized.
3275 So take back the understood high significand bit. */
3276 if (r == 0)
3278 denorm = 1;
3279 yy[M] &= ~0200;
3281 r += EXONE - 0177;
3282 yy[E] = r;
3283 p = &yy[M + 1];
3284 #ifdef DEC
3285 *p++ = *(--e);
3286 #endif
3287 #ifdef IEEE
3288 if (! REAL_WORDS_BIG_ENDIAN)
3289 *p++ = *(--e);
3290 else
3292 ++e;
3293 *p++ = *e++;
3295 #endif
3296 eshift (yy, -8);
3297 if (denorm)
3298 { /* if zero exponent, then normalize the significand */
3299 if ((k = enormlz (yy)) > NBITS)
3300 ecleazs (yy);
3301 else
3302 yy[E] -= (unsigned EMUSHORT) (k - 1);
3304 emovo (yy, y);
3305 #endif /* not IBM */
3308 /* Convert e-type X to IEEE 128-bit long double format E. */
3310 static void
3311 etoe113 (x, e)
3312 unsigned EMUSHORT *x, *e;
3314 unsigned EMUSHORT xi[NI];
3315 EMULONG exp;
3316 int rndsav;
3318 #ifdef NANS
3319 if (eisnan (x))
3321 make_nan (e, eisneg (x), TFmode);
3322 return;
3324 #endif
3325 emovi (x, xi);
3326 exp = (EMULONG) xi[E];
3327 #ifdef INFINITY
3328 if (eisinf (x))
3329 goto nonorm;
3330 #endif
3331 /* round off to nearest or even */
3332 rndsav = rndprc;
3333 rndprc = 113;
3334 emdnorm (xi, 0, 0, exp, 64);
3335 rndprc = rndsav;
3336 nonorm:
3337 toe113 (xi, e);
3340 /* Convert exploded e-type X, that has already been rounded to
3341 113-bit precision, to IEEE 128-bit long double format Y. */
3343 static void
3344 toe113 (a, b)
3345 unsigned EMUSHORT *a, *b;
3347 register unsigned EMUSHORT *p, *q;
3348 unsigned EMUSHORT i;
3350 #ifdef NANS
3351 if (eiisnan (a))
3353 make_nan (b, eiisneg (a), TFmode);
3354 return;
3356 #endif
3357 p = a;
3358 if (REAL_WORDS_BIG_ENDIAN)
3359 q = b;
3360 else
3361 q = b + 7; /* point to output exponent */
3363 /* If not denormal, delete the implied bit. */
3364 if (a[E] != 0)
3366 eshup1 (a);
3368 /* combine sign and exponent */
3369 i = *p++;
3370 if (REAL_WORDS_BIG_ENDIAN)
3372 if (i)
3373 *q++ = *p++ | 0x8000;
3374 else
3375 *q++ = *p++;
3377 else
3379 if (i)
3380 *q-- = *p++ | 0x8000;
3381 else
3382 *q-- = *p++;
3384 /* skip over guard word */
3385 ++p;
3386 /* move the significand */
3387 if (REAL_WORDS_BIG_ENDIAN)
3389 for (i = 0; i < 7; i++)
3390 *q++ = *p++;
3392 else
3394 for (i = 0; i < 7; i++)
3395 *q-- = *p++;
3399 /* Convert e-type X to IEEE double extended format E. */
3401 static void
3402 etoe64 (x, e)
3403 unsigned EMUSHORT *x, *e;
3405 unsigned EMUSHORT xi[NI];
3406 EMULONG exp;
3407 int rndsav;
3409 #ifdef NANS
3410 if (eisnan (x))
3412 make_nan (e, eisneg (x), XFmode);
3413 return;
3415 #endif
3416 emovi (x, xi);
3417 /* adjust exponent for offset */
3418 exp = (EMULONG) xi[E];
3419 #ifdef INFINITY
3420 if (eisinf (x))
3421 goto nonorm;
3422 #endif
3423 /* round off to nearest or even */
3424 rndsav = rndprc;
3425 rndprc = 64;
3426 emdnorm (xi, 0, 0, exp, 64);
3427 rndprc = rndsav;
3428 nonorm:
3429 toe64 (xi, e);
3432 /* Convert exploded e-type X, that has already been rounded to
3433 64-bit precision, to IEEE double extended format Y. */
3435 static void
3436 toe64 (a, b)
3437 unsigned EMUSHORT *a, *b;
3439 register unsigned EMUSHORT *p, *q;
3440 unsigned EMUSHORT i;
3442 #ifdef NANS
3443 if (eiisnan (a))
3445 make_nan (b, eiisneg (a), XFmode);
3446 return;
3448 #endif
3449 /* Shift denormal long double Intel format significand down one bit. */
3450 if ((a[E] == 0) && ! REAL_WORDS_BIG_ENDIAN)
3451 eshdn1 (a);
3452 p = a;
3453 #ifdef IBM
3454 q = b;
3455 #endif
3456 #ifdef DEC
3457 q = b + 4;
3458 #endif
3459 #ifdef IEEE
3460 if (REAL_WORDS_BIG_ENDIAN)
3461 q = b;
3462 else
3464 q = b + 4; /* point to output exponent */
3465 #if LONG_DOUBLE_TYPE_SIZE == 96
3466 /* Clear the last two bytes of 12-byte Intel format */
3467 *(q+1) = 0;
3468 #endif
3470 #endif
3472 /* combine sign and exponent */
3473 i = *p++;
3474 #ifdef IBM
3475 if (i)
3476 *q++ = *p++ | 0x8000;
3477 else
3478 *q++ = *p++;
3479 *q++ = 0;
3480 #endif
3481 #ifdef DEC
3482 if (i)
3483 *q-- = *p++ | 0x8000;
3484 else
3485 *q-- = *p++;
3486 #endif
3487 #ifdef IEEE
3488 if (REAL_WORDS_BIG_ENDIAN)
3490 #ifdef ARM_EXTENDED_IEEE_FORMAT
3491 /* The exponent is in the lowest 15 bits of the first word. */
3492 *q++ = i ? 0x8000 : 0;
3493 *q++ = *p++;
3494 #else
3495 if (i)
3496 *q++ = *p++ | 0x8000;
3497 else
3498 *q++ = *p++;
3499 *q++ = 0;
3500 #endif
3502 else
3504 if (i)
3505 *q-- = *p++ | 0x8000;
3506 else
3507 *q-- = *p++;
3509 #endif
3510 /* skip over guard word */
3511 ++p;
3512 /* move the significand */
3513 #ifdef IBM
3514 for (i = 0; i < 4; i++)
3515 *q++ = *p++;
3516 #endif
3517 #ifdef DEC
3518 for (i = 0; i < 4; i++)
3519 *q-- = *p++;
3520 #endif
3521 #ifdef IEEE
3522 if (REAL_WORDS_BIG_ENDIAN)
3524 for (i = 0; i < 4; i++)
3525 *q++ = *p++;
3527 else
3529 #ifdef INFINITY
3530 if (eiisinf (a))
3532 /* Intel long double infinity significand. */
3533 *q-- = 0x8000;
3534 *q-- = 0;
3535 *q-- = 0;
3536 *q = 0;
3537 return;
3539 #endif
3540 for (i = 0; i < 4; i++)
3541 *q-- = *p++;
3543 #endif
3546 /* e type to double precision. */
3548 #ifdef DEC
3549 /* Convert e-type X to DEC-format double E. */
3551 static void
3552 etoe53 (x, e)
3553 unsigned EMUSHORT *x, *e;
3555 etodec (x, e); /* see etodec.c */
3558 /* Convert exploded e-type X, that has already been rounded to
3559 56-bit double precision, to DEC double Y. */
3561 static void
3562 toe53 (x, y)
3563 unsigned EMUSHORT *x, *y;
3565 todec (x, y);
3568 #else
3569 #ifdef IBM
3570 /* Convert e-type X to IBM 370-format double E. */
3572 static void
3573 etoe53 (x, e)
3574 unsigned EMUSHORT *x, *e;
3576 etoibm (x, e, DFmode);
3579 /* Convert exploded e-type X, that has already been rounded to
3580 56-bit precision, to IBM 370 double Y. */
3582 static void
3583 toe53 (x, y)
3584 unsigned EMUSHORT *x, *y;
3586 toibm (x, y, DFmode);
3589 #else /* it's neither DEC nor IBM */
3591 /* Convert e-type X to IEEE double E. */
3593 static void
3594 etoe53 (x, e)
3595 unsigned EMUSHORT *x, *e;
3597 unsigned EMUSHORT xi[NI];
3598 EMULONG exp;
3599 int rndsav;
3601 #ifdef NANS
3602 if (eisnan (x))
3604 make_nan (e, eisneg (x), DFmode);
3605 return;
3607 #endif
3608 emovi (x, xi);
3609 /* adjust exponent for offsets */
3610 exp = (EMULONG) xi[E] - (EXONE - 0x3ff);
3611 #ifdef INFINITY
3612 if (eisinf (x))
3613 goto nonorm;
3614 #endif
3615 /* round off to nearest or even */
3616 rndsav = rndprc;
3617 rndprc = 53;
3618 emdnorm (xi, 0, 0, exp, 64);
3619 rndprc = rndsav;
3620 nonorm:
3621 toe53 (xi, e);
3624 /* Convert exploded e-type X, that has already been rounded to
3625 53-bit precision, to IEEE double Y. */
3627 static void
3628 toe53 (x, y)
3629 unsigned EMUSHORT *x, *y;
3631 unsigned EMUSHORT i;
3632 unsigned EMUSHORT *p;
3634 #ifdef NANS
3635 if (eiisnan (x))
3637 make_nan (y, eiisneg (x), DFmode);
3638 return;
3640 #endif
3641 p = &x[0];
3642 #ifdef IEEE
3643 if (! REAL_WORDS_BIG_ENDIAN)
3644 y += 3;
3645 #endif
3646 *y = 0; /* output high order */
3647 if (*p++)
3648 *y = 0x8000; /* output sign bit */
3650 i = *p++;
3651 if (i >= (unsigned int) 2047)
3652 { /* Saturate at largest number less than infinity. */
3653 #ifdef INFINITY
3654 *y |= 0x7ff0;
3655 if (! REAL_WORDS_BIG_ENDIAN)
3657 *(--y) = 0;
3658 *(--y) = 0;
3659 *(--y) = 0;
3661 else
3663 ++y;
3664 *y++ = 0;
3665 *y++ = 0;
3666 *y++ = 0;
3668 #else
3669 *y |= (unsigned EMUSHORT) 0x7fef;
3670 if (! REAL_WORDS_BIG_ENDIAN)
3672 *(--y) = 0xffff;
3673 *(--y) = 0xffff;
3674 *(--y) = 0xffff;
3676 else
3678 ++y;
3679 *y++ = 0xffff;
3680 *y++ = 0xffff;
3681 *y++ = 0xffff;
3683 #endif
3684 return;
3686 if (i == 0)
3688 eshift (x, 4);
3690 else
3692 i <<= 4;
3693 eshift (x, 5);
3695 i |= *p++ & (unsigned EMUSHORT) 0x0f; /* *p = xi[M] */
3696 *y |= (unsigned EMUSHORT) i; /* high order output already has sign bit set */
3697 if (! REAL_WORDS_BIG_ENDIAN)
3699 *(--y) = *p++;
3700 *(--y) = *p++;
3701 *(--y) = *p;
3703 else
3705 ++y;
3706 *y++ = *p++;
3707 *y++ = *p++;
3708 *y++ = *p++;
3712 #endif /* not IBM */
3713 #endif /* not DEC */
3717 /* e type to single precision. */
3719 #ifdef IBM
3720 /* Convert e-type X to IBM 370 float E. */
3722 static void
3723 etoe24 (x, e)
3724 unsigned EMUSHORT *x, *e;
3726 etoibm (x, e, SFmode);
3729 /* Convert exploded e-type X, that has already been rounded to
3730 float precision, to IBM 370 float Y. */
3732 static void
3733 toe24 (x, y)
3734 unsigned EMUSHORT *x, *y;
3736 toibm (x, y, SFmode);
3739 #else
3740 /* Convert e-type X to IEEE float E. DEC float is the same as IEEE float. */
3742 static void
3743 etoe24 (x, e)
3744 unsigned EMUSHORT *x, *e;
3746 EMULONG exp;
3747 unsigned EMUSHORT xi[NI];
3748 int rndsav;
3750 #ifdef NANS
3751 if (eisnan (x))
3753 make_nan (e, eisneg (x), SFmode);
3754 return;
3756 #endif
3757 emovi (x, xi);
3758 /* adjust exponent for offsets */
3759 exp = (EMULONG) xi[E] - (EXONE - 0177);
3760 #ifdef INFINITY
3761 if (eisinf (x))
3762 goto nonorm;
3763 #endif
3764 /* round off to nearest or even */
3765 rndsav = rndprc;
3766 rndprc = 24;
3767 emdnorm (xi, 0, 0, exp, 64);
3768 rndprc = rndsav;
3769 nonorm:
3770 toe24 (xi, e);
3773 /* Convert exploded e-type X, that has already been rounded to
3774 float precision, to IEEE float Y. */
3776 static void
3777 toe24 (x, y)
3778 unsigned EMUSHORT *x, *y;
3780 unsigned EMUSHORT i;
3781 unsigned EMUSHORT *p;
3783 #ifdef NANS
3784 if (eiisnan (x))
3786 make_nan (y, eiisneg (x), SFmode);
3787 return;
3789 #endif
3790 p = &x[0];
3791 #ifdef IEEE
3792 if (! REAL_WORDS_BIG_ENDIAN)
3793 y += 1;
3794 #endif
3795 #ifdef DEC
3796 y += 1;
3797 #endif
3798 *y = 0; /* output high order */
3799 if (*p++)
3800 *y = 0x8000; /* output sign bit */
3802 i = *p++;
3803 /* Handle overflow cases. */
3804 if (i >= 255)
3806 #ifdef INFINITY
3807 *y |= (unsigned EMUSHORT) 0x7f80;
3808 #ifdef DEC
3809 *(--y) = 0;
3810 #endif
3811 #ifdef IEEE
3812 if (! REAL_WORDS_BIG_ENDIAN)
3813 *(--y) = 0;
3814 else
3816 ++y;
3817 *y = 0;
3819 #endif
3820 #else /* no INFINITY */
3821 *y |= (unsigned EMUSHORT) 0x7f7f;
3822 #ifdef DEC
3823 *(--y) = 0xffff;
3824 #endif
3825 #ifdef IEEE
3826 if (! REAL_WORDS_BIG_ENDIAN)
3827 *(--y) = 0xffff;
3828 else
3830 ++y;
3831 *y = 0xffff;
3833 #endif
3834 #ifdef ERANGE
3835 errno = ERANGE;
3836 #endif
3837 #endif /* no INFINITY */
3838 return;
3840 if (i == 0)
3842 eshift (x, 7);
3844 else
3846 i <<= 7;
3847 eshift (x, 8);
3849 i |= *p++ & (unsigned EMUSHORT) 0x7f; /* *p = xi[M] */
3850 /* High order output already has sign bit set. */
3851 *y |= i;
3852 #ifdef DEC
3853 *(--y) = *p;
3854 #endif
3855 #ifdef IEEE
3856 if (! REAL_WORDS_BIG_ENDIAN)
3857 *(--y) = *p;
3858 else
3860 ++y;
3861 *y = *p;
3863 #endif
3865 #endif /* not IBM */
3867 /* Compare two e type numbers.
3868 Return +1 if a > b
3869 0 if a == b
3870 -1 if a < b
3871 -2 if either a or b is a NaN. */
3873 static int
3874 ecmp (a, b)
3875 unsigned EMUSHORT *a, *b;
3877 unsigned EMUSHORT ai[NI], bi[NI];
3878 register unsigned EMUSHORT *p, *q;
3879 register int i;
3880 int msign;
3882 #ifdef NANS
3883 if (eisnan (a) || eisnan (b))
3884 return (-2);
3885 #endif
3886 emovi (a, ai);
3887 p = ai;
3888 emovi (b, bi);
3889 q = bi;
3891 if (*p != *q)
3892 { /* the signs are different */
3893 /* -0 equals + 0 */
3894 for (i = 1; i < NI - 1; i++)
3896 if (ai[i] != 0)
3897 goto nzro;
3898 if (bi[i] != 0)
3899 goto nzro;
3901 return (0);
3902 nzro:
3903 if (*p == 0)
3904 return (1);
3905 else
3906 return (-1);
3908 /* both are the same sign */
3909 if (*p == 0)
3910 msign = 1;
3911 else
3912 msign = -1;
3913 i = NI - 1;
3916 if (*p++ != *q++)
3918 goto diff;
3921 while (--i > 0);
3923 return (0); /* equality */
3925 diff:
3927 if (*(--p) > *(--q))
3928 return (msign); /* p is bigger */
3929 else
3930 return (-msign); /* p is littler */
3933 /* Find e-type nearest integer to X, as floor (X + 0.5). */
3935 static void
3936 eround (x, y)
3937 unsigned EMUSHORT *x, *y;
3939 eadd (ehalf, x, y);
3940 efloor (y, y);
3943 /* Convert HOST_WIDE_INT LP to e type Y. */
3945 static void
3946 ltoe (lp, y)
3947 HOST_WIDE_INT *lp;
3948 unsigned EMUSHORT *y;
3950 unsigned EMUSHORT yi[NI];
3951 unsigned HOST_WIDE_INT ll;
3952 int k;
3954 ecleaz (yi);
3955 if (*lp < 0)
3957 /* make it positive */
3958 ll = (unsigned HOST_WIDE_INT) (-(*lp));
3959 yi[0] = 0xffff; /* put correct sign in the e type number */
3961 else
3963 ll = (unsigned HOST_WIDE_INT) (*lp);
3965 /* move the long integer to yi significand area */
3966 #if HOST_BITS_PER_WIDE_INT == 64
3967 yi[M] = (unsigned EMUSHORT) (ll >> 48);
3968 yi[M + 1] = (unsigned EMUSHORT) (ll >> 32);
3969 yi[M + 2] = (unsigned EMUSHORT) (ll >> 16);
3970 yi[M + 3] = (unsigned EMUSHORT) ll;
3971 yi[E] = EXONE + 47; /* exponent if normalize shift count were 0 */
3972 #else
3973 yi[M] = (unsigned EMUSHORT) (ll >> 16);
3974 yi[M + 1] = (unsigned EMUSHORT) ll;
3975 yi[E] = EXONE + 15; /* exponent if normalize shift count were 0 */
3976 #endif
3978 if ((k = enormlz (yi)) > NBITS)/* normalize the significand */
3979 ecleaz (yi); /* it was zero */
3980 else
3981 yi[E] -= (unsigned EMUSHORT) k;/* subtract shift count from exponent */
3982 emovo (yi, y); /* output the answer */
3985 /* Convert unsigned HOST_WIDE_INT LP to e type Y. */
3987 static void
3988 ultoe (lp, y)
3989 unsigned HOST_WIDE_INT *lp;
3990 unsigned EMUSHORT *y;
3992 unsigned EMUSHORT yi[NI];
3993 unsigned HOST_WIDE_INT ll;
3994 int k;
3996 ecleaz (yi);
3997 ll = *lp;
3999 /* move the long integer to ayi significand area */
4000 #if HOST_BITS_PER_WIDE_INT == 64
4001 yi[M] = (unsigned EMUSHORT) (ll >> 48);
4002 yi[M + 1] = (unsigned EMUSHORT) (ll >> 32);
4003 yi[M + 2] = (unsigned EMUSHORT) (ll >> 16);
4004 yi[M + 3] = (unsigned EMUSHORT) ll;
4005 yi[E] = EXONE + 47; /* exponent if normalize shift count were 0 */
4006 #else
4007 yi[M] = (unsigned EMUSHORT) (ll >> 16);
4008 yi[M + 1] = (unsigned EMUSHORT) ll;
4009 yi[E] = EXONE + 15; /* exponent if normalize shift count were 0 */
4010 #endif
4012 if ((k = enormlz (yi)) > NBITS)/* normalize the significand */
4013 ecleaz (yi); /* it was zero */
4014 else
4015 yi[E] -= (unsigned EMUSHORT) k; /* subtract shift count from exponent */
4016 emovo (yi, y); /* output the answer */
4020 /* Find signed HOST_WIDE_INT integer I and floating point fractional
4021 part FRAC of e-type (packed internal format) floating point input X.
4022 The integer output I has the sign of the input, except that
4023 positive overflow is permitted if FIXUNS_TRUNC_LIKE_FIX_TRUNC.
4024 The output e-type fraction FRAC is the positive fractional
4025 part of abs (X). */
4027 static void
4028 eifrac (x, i, frac)
4029 unsigned EMUSHORT *x;
4030 HOST_WIDE_INT *i;
4031 unsigned EMUSHORT *frac;
4033 unsigned EMUSHORT xi[NI];
4034 int j, k;
4035 unsigned HOST_WIDE_INT ll;
4037 emovi (x, xi);
4038 k = (int) xi[E] - (EXONE - 1);
4039 if (k <= 0)
4041 /* if exponent <= 0, integer = 0 and real output is fraction */
4042 *i = 0L;
4043 emovo (xi, frac);
4044 return;
4046 if (k > (HOST_BITS_PER_WIDE_INT - 1))
4048 /* long integer overflow: output large integer
4049 and correct fraction */
4050 if (xi[0])
4051 *i = ((unsigned HOST_WIDE_INT) 1) << (HOST_BITS_PER_WIDE_INT - 1);
4052 else
4054 #ifdef FIXUNS_TRUNC_LIKE_FIX_TRUNC
4055 /* In this case, let it overflow and convert as if unsigned. */
4056 euifrac (x, &ll, frac);
4057 *i = (HOST_WIDE_INT) ll;
4058 return;
4059 #else
4060 /* In other cases, return the largest positive integer. */
4061 *i = (((unsigned HOST_WIDE_INT) 1) << (HOST_BITS_PER_WIDE_INT - 1)) - 1;
4062 #endif
4064 eshift (xi, k);
4065 if (extra_warnings)
4066 warning ("overflow on truncation to integer");
4068 else if (k > 16)
4070 /* Shift more than 16 bits: first shift up k-16 mod 16,
4071 then shift up by 16's. */
4072 j = k - ((k >> 4) << 4);
4073 eshift (xi, j);
4074 ll = xi[M];
4075 k -= j;
4078 eshup6 (xi);
4079 ll = (ll << 16) | xi[M];
4081 while ((k -= 16) > 0);
4082 *i = ll;
4083 if (xi[0])
4084 *i = -(*i);
4086 else
4088 /* shift not more than 16 bits */
4089 eshift (xi, k);
4090 *i = (HOST_WIDE_INT) xi[M] & 0xffff;
4091 if (xi[0])
4092 *i = -(*i);
4094 xi[0] = 0;
4095 xi[E] = EXONE - 1;
4096 xi[M] = 0;
4097 if ((k = enormlz (xi)) > NBITS)
4098 ecleaz (xi);
4099 else
4100 xi[E] -= (unsigned EMUSHORT) k;
4102 emovo (xi, frac);
4106 /* Find unsigned HOST_WIDE_INT integer I and floating point fractional part
4107 FRAC of e-type X. A negative input yields integer output = 0 but
4108 correct fraction. */
4110 static void
4111 euifrac (x, i, frac)
4112 unsigned EMUSHORT *x;
4113 unsigned HOST_WIDE_INT *i;
4114 unsigned EMUSHORT *frac;
4116 unsigned HOST_WIDE_INT ll;
4117 unsigned EMUSHORT xi[NI];
4118 int j, k;
4120 emovi (x, xi);
4121 k = (int) xi[E] - (EXONE - 1);
4122 if (k <= 0)
4124 /* if exponent <= 0, integer = 0 and argument is fraction */
4125 *i = 0L;
4126 emovo (xi, frac);
4127 return;
4129 if (k > HOST_BITS_PER_WIDE_INT)
4131 /* Long integer overflow: output large integer
4132 and correct fraction.
4133 Note, the BSD microvax compiler says that ~(0UL)
4134 is a syntax error. */
4135 *i = ~(0L);
4136 eshift (xi, k);
4137 if (extra_warnings)
4138 warning ("overflow on truncation to unsigned integer");
4140 else if (k > 16)
4142 /* Shift more than 16 bits: first shift up k-16 mod 16,
4143 then shift up by 16's. */
4144 j = k - ((k >> 4) << 4);
4145 eshift (xi, j);
4146 ll = xi[M];
4147 k -= j;
4150 eshup6 (xi);
4151 ll = (ll << 16) | xi[M];
4153 while ((k -= 16) > 0);
4154 *i = ll;
4156 else
4158 /* shift not more than 16 bits */
4159 eshift (xi, k);
4160 *i = (HOST_WIDE_INT) xi[M] & 0xffff;
4163 if (xi[0]) /* A negative value yields unsigned integer 0. */
4164 *i = 0L;
4166 xi[0] = 0;
4167 xi[E] = EXONE - 1;
4168 xi[M] = 0;
4169 if ((k = enormlz (xi)) > NBITS)
4170 ecleaz (xi);
4171 else
4172 xi[E] -= (unsigned EMUSHORT) k;
4174 emovo (xi, frac);
4177 /* Shift the significand of exploded e-type X up or down by SC bits. */
4179 static int
4180 eshift (x, sc)
4181 unsigned EMUSHORT *x;
4182 int sc;
4184 unsigned EMUSHORT lost;
4185 unsigned EMUSHORT *p;
4187 if (sc == 0)
4188 return (0);
4190 lost = 0;
4191 p = x + NI - 1;
4193 if (sc < 0)
4195 sc = -sc;
4196 while (sc >= 16)
4198 lost |= *p; /* remember lost bits */
4199 eshdn6 (x);
4200 sc -= 16;
4203 while (sc >= 8)
4205 lost |= *p & 0xff;
4206 eshdn8 (x);
4207 sc -= 8;
4210 while (sc > 0)
4212 lost |= *p & 1;
4213 eshdn1 (x);
4214 sc -= 1;
4217 else
4219 while (sc >= 16)
4221 eshup6 (x);
4222 sc -= 16;
4225 while (sc >= 8)
4227 eshup8 (x);
4228 sc -= 8;
4231 while (sc > 0)
4233 eshup1 (x);
4234 sc -= 1;
4237 if (lost)
4238 lost = 1;
4239 return ((int) lost);
4242 /* Shift normalize the significand area of exploded e-type X.
4243 Return the shift count (up = positive). */
4245 static int
4246 enormlz (x)
4247 unsigned EMUSHORT x[];
4249 register unsigned EMUSHORT *p;
4250 int sc;
4252 sc = 0;
4253 p = &x[M];
4254 if (*p != 0)
4255 goto normdn;
4256 ++p;
4257 if (*p & 0x8000)
4258 return (0); /* already normalized */
4259 while (*p == 0)
4261 eshup6 (x);
4262 sc += 16;
4264 /* With guard word, there are NBITS+16 bits available.
4265 Return true if all are zero. */
4266 if (sc > NBITS)
4267 return (sc);
4269 /* see if high byte is zero */
4270 while ((*p & 0xff00) == 0)
4272 eshup8 (x);
4273 sc += 8;
4275 /* now shift 1 bit at a time */
4276 while ((*p & 0x8000) == 0)
4278 eshup1 (x);
4279 sc += 1;
4280 if (sc > NBITS)
4282 mtherr ("enormlz", UNDERFLOW);
4283 return (sc);
4286 return (sc);
4288 /* Normalize by shifting down out of the high guard word
4289 of the significand */
4290 normdn:
4292 if (*p & 0xff00)
4294 eshdn8 (x);
4295 sc -= 8;
4297 while (*p != 0)
4299 eshdn1 (x);
4300 sc -= 1;
4302 if (sc < -NBITS)
4304 mtherr ("enormlz", OVERFLOW);
4305 return (sc);
4308 return (sc);
4311 /* Powers of ten used in decimal <-> binary conversions. */
4313 #define NTEN 12
4314 #define MAXP 4096
4316 #if LONG_DOUBLE_TYPE_SIZE == 128
4317 static unsigned EMUSHORT etens[NTEN + 1][NE] =
4319 {0x6576, 0x4a92, 0x804a, 0x153f,
4320 0xc94c, 0x979a, 0x8a20, 0x5202, 0xc460, 0x7525,}, /* 10**4096 */
4321 {0x6a32, 0xce52, 0x329a, 0x28ce,
4322 0xa74d, 0x5de4, 0xc53d, 0x3b5d, 0x9e8b, 0x5a92,}, /* 10**2048 */
4323 {0x526c, 0x50ce, 0xf18b, 0x3d28,
4324 0x650d, 0x0c17, 0x8175, 0x7586, 0xc976, 0x4d48,},
4325 {0x9c66, 0x58f8, 0xbc50, 0x5c54,
4326 0xcc65, 0x91c6, 0xa60e, 0xa0ae, 0xe319, 0x46a3,},
4327 {0x851e, 0xeab7, 0x98fe, 0x901b,
4328 0xddbb, 0xde8d, 0x9df9, 0xebfb, 0xaa7e, 0x4351,},
4329 {0x0235, 0x0137, 0x36b1, 0x336c,
4330 0xc66f, 0x8cdf, 0x80e9, 0x47c9, 0x93ba, 0x41a8,},
4331 {0x50f8, 0x25fb, 0xc76b, 0x6b71,
4332 0x3cbf, 0xa6d5, 0xffcf, 0x1f49, 0xc278, 0x40d3,},
4333 {0x0000, 0x0000, 0x0000, 0x0000,
4334 0xf020, 0xb59d, 0x2b70, 0xada8, 0x9dc5, 0x4069,},
4335 {0x0000, 0x0000, 0x0000, 0x0000,
4336 0x0000, 0x0000, 0x0400, 0xc9bf, 0x8e1b, 0x4034,},
4337 {0x0000, 0x0000, 0x0000, 0x0000,
4338 0x0000, 0x0000, 0x0000, 0x2000, 0xbebc, 0x4019,},
4339 {0x0000, 0x0000, 0x0000, 0x0000,
4340 0x0000, 0x0000, 0x0000, 0x0000, 0x9c40, 0x400c,},
4341 {0x0000, 0x0000, 0x0000, 0x0000,
4342 0x0000, 0x0000, 0x0000, 0x0000, 0xc800, 0x4005,},
4343 {0x0000, 0x0000, 0x0000, 0x0000,
4344 0x0000, 0x0000, 0x0000, 0x0000, 0xa000, 0x4002,}, /* 10**1 */
4347 static unsigned EMUSHORT emtens[NTEN + 1][NE] =
4349 {0x2030, 0xcffc, 0xa1c3, 0x8123,
4350 0x2de3, 0x9fde, 0xd2ce, 0x04c8, 0xa6dd, 0x0ad8,}, /* 10**-4096 */
4351 {0x8264, 0xd2cb, 0xf2ea, 0x12d4,
4352 0x4925, 0x2de4, 0x3436, 0x534f, 0xceae, 0x256b,}, /* 10**-2048 */
4353 {0xf53f, 0xf698, 0x6bd3, 0x0158,
4354 0x87a6, 0xc0bd, 0xda57, 0x82a5, 0xa2a6, 0x32b5,},
4355 {0xe731, 0x04d4, 0xe3f2, 0xd332,
4356 0x7132, 0xd21c, 0xdb23, 0xee32, 0x9049, 0x395a,},
4357 {0xa23e, 0x5308, 0xfefb, 0x1155,
4358 0xfa91, 0x1939, 0x637a, 0x4325, 0xc031, 0x3cac,},
4359 {0xe26d, 0xdbde, 0xd05d, 0xb3f6,
4360 0xac7c, 0xe4a0, 0x64bc, 0x467c, 0xddd0, 0x3e55,},
4361 {0x2a20, 0x6224, 0x47b3, 0x98d7,
4362 0x3f23, 0xe9a5, 0xa539, 0xea27, 0xa87f, 0x3f2a,},
4363 {0x0b5b, 0x4af2, 0xa581, 0x18ed,
4364 0x67de, 0x94ba, 0x4539, 0x1ead, 0xcfb1, 0x3f94,},
4365 {0xbf71, 0xa9b3, 0x7989, 0xbe68,
4366 0x4c2e, 0xe15b, 0xc44d, 0x94be, 0xe695, 0x3fc9,},
4367 {0x3d4d, 0x7c3d, 0x36ba, 0x0d2b,
4368 0xfdc2, 0xcefc, 0x8461, 0x7711, 0xabcc, 0x3fe4,},
4369 {0xc155, 0xa4a8, 0x404e, 0x6113,
4370 0xd3c3, 0x652b, 0xe219, 0x1758, 0xd1b7, 0x3ff1,},
4371 {0xd70a, 0x70a3, 0x0a3d, 0xa3d7,
4372 0x3d70, 0xd70a, 0x70a3, 0x0a3d, 0xa3d7, 0x3ff8,},
4373 {0xcccd, 0xcccc, 0xcccc, 0xcccc,
4374 0xcccc, 0xcccc, 0xcccc, 0xcccc, 0xcccc, 0x3ffb,}, /* 10**-1 */
4376 #else
4377 /* LONG_DOUBLE_TYPE_SIZE is other than 128 */
4378 static unsigned EMUSHORT etens[NTEN + 1][NE] =
4380 {0xc94c, 0x979a, 0x8a20, 0x5202, 0xc460, 0x7525,}, /* 10**4096 */
4381 {0xa74d, 0x5de4, 0xc53d, 0x3b5d, 0x9e8b, 0x5a92,}, /* 10**2048 */
4382 {0x650d, 0x0c17, 0x8175, 0x7586, 0xc976, 0x4d48,},
4383 {0xcc65, 0x91c6, 0xa60e, 0xa0ae, 0xe319, 0x46a3,},
4384 {0xddbc, 0xde8d, 0x9df9, 0xebfb, 0xaa7e, 0x4351,},
4385 {0xc66f, 0x8cdf, 0x80e9, 0x47c9, 0x93ba, 0x41a8,},
4386 {0x3cbf, 0xa6d5, 0xffcf, 0x1f49, 0xc278, 0x40d3,},
4387 {0xf020, 0xb59d, 0x2b70, 0xada8, 0x9dc5, 0x4069,},
4388 {0x0000, 0x0000, 0x0400, 0xc9bf, 0x8e1b, 0x4034,},
4389 {0x0000, 0x0000, 0x0000, 0x2000, 0xbebc, 0x4019,},
4390 {0x0000, 0x0000, 0x0000, 0x0000, 0x9c40, 0x400c,},
4391 {0x0000, 0x0000, 0x0000, 0x0000, 0xc800, 0x4005,},
4392 {0x0000, 0x0000, 0x0000, 0x0000, 0xa000, 0x4002,}, /* 10**1 */
4395 static unsigned EMUSHORT emtens[NTEN + 1][NE] =
4397 {0x2de4, 0x9fde, 0xd2ce, 0x04c8, 0xa6dd, 0x0ad8,}, /* 10**-4096 */
4398 {0x4925, 0x2de4, 0x3436, 0x534f, 0xceae, 0x256b,}, /* 10**-2048 */
4399 {0x87a6, 0xc0bd, 0xda57, 0x82a5, 0xa2a6, 0x32b5,},
4400 {0x7133, 0xd21c, 0xdb23, 0xee32, 0x9049, 0x395a,},
4401 {0xfa91, 0x1939, 0x637a, 0x4325, 0xc031, 0x3cac,},
4402 {0xac7d, 0xe4a0, 0x64bc, 0x467c, 0xddd0, 0x3e55,},
4403 {0x3f24, 0xe9a5, 0xa539, 0xea27, 0xa87f, 0x3f2a,},
4404 {0x67de, 0x94ba, 0x4539, 0x1ead, 0xcfb1, 0x3f94,},
4405 {0x4c2f, 0xe15b, 0xc44d, 0x94be, 0xe695, 0x3fc9,},
4406 {0xfdc2, 0xcefc, 0x8461, 0x7711, 0xabcc, 0x3fe4,},
4407 {0xd3c3, 0x652b, 0xe219, 0x1758, 0xd1b7, 0x3ff1,},
4408 {0x3d71, 0xd70a, 0x70a3, 0x0a3d, 0xa3d7, 0x3ff8,},
4409 {0xcccd, 0xcccc, 0xcccc, 0xcccc, 0xcccc, 0x3ffb,}, /* 10**-1 */
4411 #endif
4413 /* Convert float value X to ASCII string STRING with NDIG digits after
4414 the decimal point. */
4416 static void
4417 e24toasc (x, string, ndigs)
4418 unsigned EMUSHORT x[];
4419 char *string;
4420 int ndigs;
4422 unsigned EMUSHORT w[NI];
4424 e24toe (x, w);
4425 etoasc (w, string, ndigs);
4428 /* Convert double value X to ASCII string STRING with NDIG digits after
4429 the decimal point. */
4431 static void
4432 e53toasc (x, string, ndigs)
4433 unsigned EMUSHORT x[];
4434 char *string;
4435 int ndigs;
4437 unsigned EMUSHORT w[NI];
4439 e53toe (x, w);
4440 etoasc (w, string, ndigs);
4443 /* Convert double extended value X to ASCII string STRING with NDIG digits
4444 after the decimal point. */
4446 static void
4447 e64toasc (x, string, ndigs)
4448 unsigned EMUSHORT x[];
4449 char *string;
4450 int ndigs;
4452 unsigned EMUSHORT w[NI];
4454 e64toe (x, w);
4455 etoasc (w, string, ndigs);
4458 /* Convert 128-bit long double value X to ASCII string STRING with NDIG digits
4459 after the decimal point. */
4461 static void
4462 e113toasc (x, string, ndigs)
4463 unsigned EMUSHORT x[];
4464 char *string;
4465 int ndigs;
4467 unsigned EMUSHORT w[NI];
4469 e113toe (x, w);
4470 etoasc (w, string, ndigs);
4473 /* Convert e-type X to ASCII string STRING with NDIGS digits after
4474 the decimal point. */
4476 static char wstring[80]; /* working storage for ASCII output */
4478 static void
4479 etoasc (x, string, ndigs)
4480 unsigned EMUSHORT x[];
4481 char *string;
4482 int ndigs;
4484 EMUSHORT digit;
4485 unsigned EMUSHORT y[NI], t[NI], u[NI], w[NI];
4486 unsigned EMUSHORT *p, *r, *ten;
4487 unsigned EMUSHORT sign;
4488 int i, j, k, expon, rndsav;
4489 char *s, *ss;
4490 unsigned EMUSHORT m;
4493 rndsav = rndprc;
4494 ss = string;
4495 s = wstring;
4496 *ss = '\0';
4497 *s = '\0';
4498 #ifdef NANS
4499 if (eisnan (x))
4501 sprintf (wstring, " NaN ");
4502 goto bxit;
4504 #endif
4505 rndprc = NBITS; /* set to full precision */
4506 emov (x, y); /* retain external format */
4507 if (y[NE - 1] & 0x8000)
4509 sign = 0xffff;
4510 y[NE - 1] &= 0x7fff;
4512 else
4514 sign = 0;
4516 expon = 0;
4517 ten = &etens[NTEN][0];
4518 emov (eone, t);
4519 /* Test for zero exponent */
4520 if (y[NE - 1] == 0)
4522 for (k = 0; k < NE - 1; k++)
4524 if (y[k] != 0)
4525 goto tnzro; /* denormalized number */
4527 goto isone; /* valid all zeros */
4529 tnzro:
4531 /* Test for infinity. */
4532 if (y[NE - 1] == 0x7fff)
4534 if (sign)
4535 sprintf (wstring, " -Infinity ");
4536 else
4537 sprintf (wstring, " Infinity ");
4538 goto bxit;
4541 /* Test for exponent nonzero but significand denormalized.
4542 * This is an error condition.
4544 if ((y[NE - 1] != 0) && ((y[NE - 2] & 0x8000) == 0))
4546 mtherr ("etoasc", DOMAIN);
4547 sprintf (wstring, "NaN");
4548 goto bxit;
4551 /* Compare to 1.0 */
4552 i = ecmp (eone, y);
4553 if (i == 0)
4554 goto isone;
4556 if (i == -2)
4557 abort ();
4559 if (i < 0)
4560 { /* Number is greater than 1 */
4561 /* Convert significand to an integer and strip trailing decimal zeros. */
4562 emov (y, u);
4563 u[NE - 1] = EXONE + NBITS - 1;
4565 p = &etens[NTEN - 4][0];
4566 m = 16;
4569 ediv (p, u, t);
4570 efloor (t, w);
4571 for (j = 0; j < NE - 1; j++)
4573 if (t[j] != w[j])
4574 goto noint;
4576 emov (t, u);
4577 expon += (int) m;
4578 noint:
4579 p += NE;
4580 m >>= 1;
4582 while (m != 0);
4584 /* Rescale from integer significand */
4585 u[NE - 1] += y[NE - 1] - (unsigned int) (EXONE + NBITS - 1);
4586 emov (u, y);
4587 /* Find power of 10 */
4588 emov (eone, t);
4589 m = MAXP;
4590 p = &etens[0][0];
4591 /* An unordered compare result shouldn't happen here. */
4592 while (ecmp (ten, u) <= 0)
4594 if (ecmp (p, u) <= 0)
4596 ediv (p, u, u);
4597 emul (p, t, t);
4598 expon += (int) m;
4600 m >>= 1;
4601 if (m == 0)
4602 break;
4603 p += NE;
4606 else
4607 { /* Number is less than 1.0 */
4608 /* Pad significand with trailing decimal zeros. */
4609 if (y[NE - 1] == 0)
4611 while ((y[NE - 2] & 0x8000) == 0)
4613 emul (ten, y, y);
4614 expon -= 1;
4617 else
4619 emovi (y, w);
4620 for (i = 0; i < NDEC + 1; i++)
4622 if ((w[NI - 1] & 0x7) != 0)
4623 break;
4624 /* multiply by 10 */
4625 emovz (w, u);
4626 eshdn1 (u);
4627 eshdn1 (u);
4628 eaddm (w, u);
4629 u[1] += 3;
4630 while (u[2] != 0)
4632 eshdn1 (u);
4633 u[1] += 1;
4635 if (u[NI - 1] != 0)
4636 break;
4637 if (eone[NE - 1] <= u[1])
4638 break;
4639 emovz (u, w);
4640 expon -= 1;
4642 emovo (w, y);
4644 k = -MAXP;
4645 p = &emtens[0][0];
4646 r = &etens[0][0];
4647 emov (y, w);
4648 emov (eone, t);
4649 while (ecmp (eone, w) > 0)
4651 if (ecmp (p, w) >= 0)
4653 emul (r, w, w);
4654 emul (r, t, t);
4655 expon += k;
4657 k /= 2;
4658 if (k == 0)
4659 break;
4660 p += NE;
4661 r += NE;
4663 ediv (t, eone, t);
4665 isone:
4666 /* Find the first (leading) digit. */
4667 emovi (t, w);
4668 emovz (w, t);
4669 emovi (y, w);
4670 emovz (w, y);
4671 eiremain (t, y);
4672 digit = equot[NI - 1];
4673 while ((digit == 0) && (ecmp (y, ezero) != 0))
4675 eshup1 (y);
4676 emovz (y, u);
4677 eshup1 (u);
4678 eshup1 (u);
4679 eaddm (u, y);
4680 eiremain (t, y);
4681 digit = equot[NI - 1];
4682 expon -= 1;
4684 s = wstring;
4685 if (sign)
4686 *s++ = '-';
4687 else
4688 *s++ = ' ';
4689 /* Examine number of digits requested by caller. */
4690 if (ndigs < 0)
4691 ndigs = 0;
4692 if (ndigs > NDEC)
4693 ndigs = NDEC;
4694 if (digit == 10)
4696 *s++ = '1';
4697 *s++ = '.';
4698 if (ndigs > 0)
4700 *s++ = '0';
4701 ndigs -= 1;
4703 expon += 1;
4705 else
4707 *s++ = (char)digit + '0';
4708 *s++ = '.';
4710 /* Generate digits after the decimal point. */
4711 for (k = 0; k <= ndigs; k++)
4713 /* multiply current number by 10, without normalizing */
4714 eshup1 (y);
4715 emovz (y, u);
4716 eshup1 (u);
4717 eshup1 (u);
4718 eaddm (u, y);
4719 eiremain (t, y);
4720 *s++ = (char) equot[NI - 1] + '0';
4722 digit = equot[NI - 1];
4723 --s;
4724 ss = s;
4725 /* round off the ASCII string */
4726 if (digit > 4)
4728 /* Test for critical rounding case in ASCII output. */
4729 if (digit == 5)
4731 emovo (y, t);
4732 if (ecmp (t, ezero) != 0)
4733 goto roun; /* round to nearest */
4734 if ((*(s - 1) & 1) == 0)
4735 goto doexp; /* round to even */
4737 /* Round up and propagate carry-outs */
4738 roun:
4739 --s;
4740 k = *s & 0x7f;
4741 /* Carry out to most significant digit? */
4742 if (k == '.')
4744 --s;
4745 k = *s;
4746 k += 1;
4747 *s = (char) k;
4748 /* Most significant digit carries to 10? */
4749 if (k > '9')
4751 expon += 1;
4752 *s = '1';
4754 goto doexp;
4756 /* Round up and carry out from less significant digits */
4757 k += 1;
4758 *s = (char) k;
4759 if (k > '9')
4761 *s = '0';
4762 goto roun;
4765 doexp:
4767 if (expon >= 0)
4768 sprintf (ss, "e+%d", expon);
4769 else
4770 sprintf (ss, "e%d", expon);
4772 sprintf (ss, "e%d", expon);
4773 bxit:
4774 rndprc = rndsav;
4775 /* copy out the working string */
4776 s = string;
4777 ss = wstring;
4778 while (*ss == ' ') /* strip possible leading space */
4779 ++ss;
4780 while ((*s++ = *ss++) != '\0')
4785 /* Convert ASCII string to floating point.
4787 Numeric input is a free format decimal number of any length, with
4788 or without decimal point. Entering E after the number followed by an
4789 integer number causes the second number to be interpreted as a power of
4790 10 to be multiplied by the first number (i.e., "scientific" notation). */
4792 /* Convert ASCII string S to single precision float value Y. */
4794 static void
4795 asctoe24 (s, y)
4796 char *s;
4797 unsigned EMUSHORT *y;
4799 asctoeg (s, y, 24);
4803 /* Convert ASCII string S to double precision value Y. */
4805 static void
4806 asctoe53 (s, y)
4807 char *s;
4808 unsigned EMUSHORT *y;
4810 #if defined(DEC) || defined(IBM)
4811 asctoeg (s, y, 56);
4812 #else
4813 asctoeg (s, y, 53);
4814 #endif
4818 /* Convert ASCII string S to double extended value Y. */
4820 static void
4821 asctoe64 (s, y)
4822 char *s;
4823 unsigned EMUSHORT *y;
4825 asctoeg (s, y, 64);
4828 /* Convert ASCII string S to 128-bit long double Y. */
4830 static void
4831 asctoe113 (s, y)
4832 char *s;
4833 unsigned EMUSHORT *y;
4835 asctoeg (s, y, 113);
4838 /* Convert ASCII string S to e type Y. */
4840 static void
4841 asctoe (s, y)
4842 char *s;
4843 unsigned EMUSHORT *y;
4845 asctoeg (s, y, NBITS);
4848 /* Convert ASCII string SS to e type Y, with a specified rounding precision
4849 of OPREC bits. */
4851 static void
4852 asctoeg (ss, y, oprec)
4853 char *ss;
4854 unsigned EMUSHORT *y;
4855 int oprec;
4857 unsigned EMUSHORT yy[NI], xt[NI], tt[NI];
4858 int esign, decflg, sgnflg, nexp, exp, prec, lost;
4859 int k, trail, c, rndsav;
4860 EMULONG lexp;
4861 unsigned EMUSHORT nsign, *p;
4862 char *sp, *s, *lstr;
4864 /* Copy the input string. */
4865 lstr = (char *) alloca (strlen (ss) + 1);
4866 s = ss;
4867 while (*s == ' ') /* skip leading spaces */
4868 ++s;
4869 sp = lstr;
4870 while ((*sp++ = *s++) != '\0')
4872 s = lstr;
4874 rndsav = rndprc;
4875 rndprc = NBITS; /* Set to full precision */
4876 lost = 0;
4877 nsign = 0;
4878 decflg = 0;
4879 sgnflg = 0;
4880 nexp = 0;
4881 exp = 0;
4882 prec = 0;
4883 ecleaz (yy);
4884 trail = 0;
4886 nxtcom:
4887 k = *s - '0';
4888 if ((k >= 0) && (k <= 9))
4890 /* Ignore leading zeros */
4891 if ((prec == 0) && (decflg == 0) && (k == 0))
4892 goto donchr;
4893 /* Identify and strip trailing zeros after the decimal point. */
4894 if ((trail == 0) && (decflg != 0))
4896 sp = s;
4897 while ((*sp >= '0') && (*sp <= '9'))
4898 ++sp;
4899 /* Check for syntax error */
4900 c = *sp & 0x7f;
4901 if ((c != 'e') && (c != 'E') && (c != '\0')
4902 && (c != '\n') && (c != '\r') && (c != ' ')
4903 && (c != ','))
4904 goto error;
4905 --sp;
4906 while (*sp == '0')
4907 *sp-- = 'z';
4908 trail = 1;
4909 if (*s == 'z')
4910 goto donchr;
4913 /* If enough digits were given to more than fill up the yy register,
4914 continuing until overflow into the high guard word yy[2]
4915 guarantees that there will be a roundoff bit at the top
4916 of the low guard word after normalization. */
4918 if (yy[2] == 0)
4920 if (decflg)
4921 nexp += 1; /* count digits after decimal point */
4922 eshup1 (yy); /* multiply current number by 10 */
4923 emovz (yy, xt);
4924 eshup1 (xt);
4925 eshup1 (xt);
4926 eaddm (xt, yy);
4927 ecleaz (xt);
4928 xt[NI - 2] = (unsigned EMUSHORT) k;
4929 eaddm (xt, yy);
4931 else
4933 /* Mark any lost non-zero digit. */
4934 lost |= k;
4935 /* Count lost digits before the decimal point. */
4936 if (decflg == 0)
4937 nexp -= 1;
4939 prec += 1;
4940 goto donchr;
4943 switch (*s)
4945 case 'z':
4946 break;
4947 case 'E':
4948 case 'e':
4949 goto expnt;
4950 case '.': /* decimal point */
4951 if (decflg)
4952 goto error;
4953 ++decflg;
4954 break;
4955 case '-':
4956 nsign = 0xffff;
4957 if (sgnflg)
4958 goto error;
4959 ++sgnflg;
4960 break;
4961 case '+':
4962 if (sgnflg)
4963 goto error;
4964 ++sgnflg;
4965 break;
4966 case ',':
4967 case ' ':
4968 case '\0':
4969 case '\n':
4970 case '\r':
4971 goto daldone;
4972 case 'i':
4973 case 'I':
4974 goto infinite;
4975 default:
4976 error:
4977 #ifdef NANS
4978 einan (yy);
4979 #else
4980 mtherr ("asctoe", DOMAIN);
4981 eclear (yy);
4982 #endif
4983 goto aexit;
4985 donchr:
4986 ++s;
4987 goto nxtcom;
4989 /* Exponent interpretation */
4990 expnt:
4992 esign = 1;
4993 exp = 0;
4994 ++s;
4995 /* check for + or - */
4996 if (*s == '-')
4998 esign = -1;
4999 ++s;
5001 if (*s == '+')
5002 ++s;
5003 while ((*s >= '0') && (*s <= '9'))
5005 exp *= 10;
5006 exp += *s++ - '0';
5007 if (exp > -(MINDECEXP))
5009 if (esign < 0)
5010 goto zero;
5011 else
5012 goto infinite;
5015 if (esign < 0)
5016 exp = -exp;
5017 if (exp > MAXDECEXP)
5019 infinite:
5020 ecleaz (yy);
5021 yy[E] = 0x7fff; /* infinity */
5022 goto aexit;
5024 if (exp < MINDECEXP)
5026 zero:
5027 ecleaz (yy);
5028 goto aexit;
5031 daldone:
5032 nexp = exp - nexp;
5033 /* Pad trailing zeros to minimize power of 10, per IEEE spec. */
5034 while ((nexp > 0) && (yy[2] == 0))
5036 emovz (yy, xt);
5037 eshup1 (xt);
5038 eshup1 (xt);
5039 eaddm (yy, xt);
5040 eshup1 (xt);
5041 if (xt[2] != 0)
5042 break;
5043 nexp -= 1;
5044 emovz (xt, yy);
5046 if ((k = enormlz (yy)) > NBITS)
5048 ecleaz (yy);
5049 goto aexit;
5051 lexp = (EXONE - 1 + NBITS) - k;
5052 emdnorm (yy, lost, 0, lexp, 64);
5054 /* Convert to external format:
5056 Multiply by 10**nexp. If precision is 64 bits,
5057 the maximum relative error incurred in forming 10**n
5058 for 0 <= n <= 324 is 8.2e-20, at 10**180.
5059 For 0 <= n <= 999, the peak relative error is 1.4e-19 at 10**947.
5060 For 0 >= n >= -999, it is -1.55e-19 at 10**-435. */
5062 lexp = yy[E];
5063 if (nexp == 0)
5065 k = 0;
5066 goto expdon;
5068 esign = 1;
5069 if (nexp < 0)
5071 nexp = -nexp;
5072 esign = -1;
5073 if (nexp > 4096)
5075 /* Punt. Can't handle this without 2 divides. */
5076 emovi (etens[0], tt);
5077 lexp -= tt[E];
5078 k = edivm (tt, yy);
5079 lexp += EXONE;
5080 nexp -= 4096;
5083 p = &etens[NTEN][0];
5084 emov (eone, xt);
5085 exp = 1;
5088 if (exp & nexp)
5089 emul (p, xt, xt);
5090 p -= NE;
5091 exp = exp + exp;
5093 while (exp <= MAXP);
5095 emovi (xt, tt);
5096 if (esign < 0)
5098 lexp -= tt[E];
5099 k = edivm (tt, yy);
5100 lexp += EXONE;
5102 else
5104 lexp += tt[E];
5105 k = emulm (tt, yy);
5106 lexp -= EXONE - 1;
5109 expdon:
5111 /* Round and convert directly to the destination type */
5112 if (oprec == 53)
5113 lexp -= EXONE - 0x3ff;
5114 #ifdef IBM
5115 else if (oprec == 24 || oprec == 56)
5116 lexp -= EXONE - (0x41 << 2);
5117 #else
5118 else if (oprec == 24)
5119 lexp -= EXONE - 0177;
5120 #endif
5121 #ifdef DEC
5122 else if (oprec == 56)
5123 lexp -= EXONE - 0201;
5124 #endif
5125 rndprc = oprec;
5126 emdnorm (yy, k, 0, lexp, 64);
5128 aexit:
5130 rndprc = rndsav;
5131 yy[0] = nsign;
5132 switch (oprec)
5134 #ifdef DEC
5135 case 56:
5136 todec (yy, y); /* see etodec.c */
5137 break;
5138 #endif
5139 #ifdef IBM
5140 case 56:
5141 toibm (yy, y, DFmode);
5142 break;
5143 #endif
5144 case 53:
5145 toe53 (yy, y);
5146 break;
5147 case 24:
5148 toe24 (yy, y);
5149 break;
5150 case 64:
5151 toe64 (yy, y);
5152 break;
5153 case 113:
5154 toe113 (yy, y);
5155 break;
5156 case NBITS:
5157 emovo (yy, y);
5158 break;
5164 /* Return Y = largest integer not greater than X (truncated toward minus
5165 infinity). */
5167 static unsigned EMUSHORT bmask[] =
5169 0xffff,
5170 0xfffe,
5171 0xfffc,
5172 0xfff8,
5173 0xfff0,
5174 0xffe0,
5175 0xffc0,
5176 0xff80,
5177 0xff00,
5178 0xfe00,
5179 0xfc00,
5180 0xf800,
5181 0xf000,
5182 0xe000,
5183 0xc000,
5184 0x8000,
5185 0x0000,
5188 static void
5189 efloor (x, y)
5190 unsigned EMUSHORT x[], y[];
5192 register unsigned EMUSHORT *p;
5193 int e, expon, i;
5194 unsigned EMUSHORT f[NE];
5196 emov (x, f); /* leave in external format */
5197 expon = (int) f[NE - 1];
5198 e = (expon & 0x7fff) - (EXONE - 1);
5199 if (e <= 0)
5201 eclear (y);
5202 goto isitneg;
5204 /* number of bits to clear out */
5205 e = NBITS - e;
5206 emov (f, y);
5207 if (e <= 0)
5208 return;
5210 p = &y[0];
5211 while (e >= 16)
5213 *p++ = 0;
5214 e -= 16;
5216 /* clear the remaining bits */
5217 *p &= bmask[e];
5218 /* truncate negatives toward minus infinity */
5219 isitneg:
5221 if ((unsigned EMUSHORT) expon & (unsigned EMUSHORT) 0x8000)
5223 for (i = 0; i < NE - 1; i++)
5225 if (f[i] != y[i])
5227 esub (eone, y, y);
5228 break;
5235 /* Return S and EXP such that S * 2^EXP = X and .5 <= S < 1.
5236 For example, 1.1 = 0.55 * 2^1. */
5238 static void
5239 efrexp (x, exp, s)
5240 unsigned EMUSHORT x[];
5241 int *exp;
5242 unsigned EMUSHORT s[];
5244 unsigned EMUSHORT xi[NI];
5245 EMULONG li;
5247 emovi (x, xi);
5248 /* Handle denormalized numbers properly using long integer exponent. */
5249 li = (EMULONG) ((EMUSHORT) xi[1]);
5251 if (li == 0)
5253 li -= enormlz (xi);
5255 xi[1] = 0x3ffe;
5256 emovo (xi, s);
5257 *exp = (int) (li - 0x3ffe);
5260 /* Return e type Y = X * 2^PWR2. */
5262 static void
5263 eldexp (x, pwr2, y)
5264 unsigned EMUSHORT x[];
5265 int pwr2;
5266 unsigned EMUSHORT y[];
5268 unsigned EMUSHORT xi[NI];
5269 EMULONG li;
5270 int i;
5272 emovi (x, xi);
5273 li = xi[1];
5274 li += pwr2;
5275 i = 0;
5276 emdnorm (xi, i, i, li, 64);
5277 emovo (xi, y);
5281 /* C = remainder after dividing B by A, all e type values.
5282 Least significant integer quotient bits left in EQUOT. */
5284 static void
5285 eremain (a, b, c)
5286 unsigned EMUSHORT a[], b[], c[];
5288 unsigned EMUSHORT den[NI], num[NI];
5290 #ifdef NANS
5291 if (eisinf (b)
5292 || (ecmp (a, ezero) == 0)
5293 || eisnan (a)
5294 || eisnan (b))
5296 enan (c, 0);
5297 return;
5299 #endif
5300 if (ecmp (a, ezero) == 0)
5302 mtherr ("eremain", SING);
5303 eclear (c);
5304 return;
5306 emovi (a, den);
5307 emovi (b, num);
5308 eiremain (den, num);
5309 /* Sign of remainder = sign of quotient */
5310 if (a[0] == b[0])
5311 num[0] = 0;
5312 else
5313 num[0] = 0xffff;
5314 emovo (num, c);
5317 /* Return quotient of exploded e-types NUM / DEN in EQUOT,
5318 remainder in NUM. */
5320 static void
5321 eiremain (den, num)
5322 unsigned EMUSHORT den[], num[];
5324 EMULONG ld, ln;
5325 unsigned EMUSHORT j;
5327 ld = den[E];
5328 ld -= enormlz (den);
5329 ln = num[E];
5330 ln -= enormlz (num);
5331 ecleaz (equot);
5332 while (ln >= ld)
5334 if (ecmpm (den, num) <= 0)
5336 esubm (den, num);
5337 j = 1;
5339 else
5340 j = 0;
5341 eshup1 (equot);
5342 equot[NI - 1] |= j;
5343 eshup1 (num);
5344 ln -= 1;
5346 emdnorm (num, 0, 0, ln, 0);
5349 /* Report an error condition CODE encountered in function NAME.
5350 CODE is one of the following:
5352 Mnemonic Value Significance
5354 DOMAIN 1 argument domain error
5355 SING 2 function singularity
5356 OVERFLOW 3 overflow range error
5357 UNDERFLOW 4 underflow range error
5358 TLOSS 5 total loss of precision
5359 PLOSS 6 partial loss of precision
5360 INVALID 7 NaN - producing operation
5361 EDOM 33 Unix domain error code
5362 ERANGE 34 Unix range error code
5364 The order of appearance of the following messages is bound to the
5365 error codes defined above. */
5367 #define NMSGS 8
5368 static char *ermsg[NMSGS] =
5370 "unknown", /* error code 0 */
5371 "domain", /* error code 1 */
5372 "singularity", /* et seq. */
5373 "overflow",
5374 "underflow",
5375 "total loss of precision",
5376 "partial loss of precision",
5377 "invalid operation"
5380 int merror = 0;
5381 extern int merror;
5383 static void
5384 mtherr (name, code)
5385 char *name;
5386 int code;
5388 char errstr[80];
5390 /* The string passed by the calling program is supposed to be the
5391 name of the function in which the error occurred.
5392 The code argument selects which error message string will be printed. */
5394 if ((code <= 0) || (code >= NMSGS))
5395 code = 0;
5396 sprintf (errstr, " %s %s error", name, ermsg[code]);
5397 if (extra_warnings)
5398 warning (errstr);
5399 /* Set global error message word */
5400 merror = code + 1;
5403 #ifdef DEC
5404 /* Convert DEC double precision D to e type E. */
5406 static void
5407 dectoe (d, e)
5408 unsigned EMUSHORT *d;
5409 unsigned EMUSHORT *e;
5411 unsigned EMUSHORT y[NI];
5412 register unsigned EMUSHORT r, *p;
5414 ecleaz (y); /* start with a zero */
5415 p = y; /* point to our number */
5416 r = *d; /* get DEC exponent word */
5417 if (*d & (unsigned int) 0x8000)
5418 *p = 0xffff; /* fill in our sign */
5419 ++p; /* bump pointer to our exponent word */
5420 r &= 0x7fff; /* strip the sign bit */
5421 if (r == 0) /* answer = 0 if high order DEC word = 0 */
5422 goto done;
5425 r >>= 7; /* shift exponent word down 7 bits */
5426 r += EXONE - 0201; /* subtract DEC exponent offset */
5427 /* add our e type exponent offset */
5428 *p++ = r; /* to form our exponent */
5430 r = *d++; /* now do the high order mantissa */
5431 r &= 0177; /* strip off the DEC exponent and sign bits */
5432 r |= 0200; /* the DEC understood high order mantissa bit */
5433 *p++ = r; /* put result in our high guard word */
5435 *p++ = *d++; /* fill in the rest of our mantissa */
5436 *p++ = *d++;
5437 *p = *d;
5439 eshdn8 (y); /* shift our mantissa down 8 bits */
5440 done:
5441 emovo (y, e);
5444 /* Convert e type X to DEC double precision D. */
5446 static void
5447 etodec (x, d)
5448 unsigned EMUSHORT *x, *d;
5450 unsigned EMUSHORT xi[NI];
5451 EMULONG exp;
5452 int rndsav;
5454 emovi (x, xi);
5455 /* Adjust exponent for offsets. */
5456 exp = (EMULONG) xi[E] - (EXONE - 0201);
5457 /* Round off to nearest or even. */
5458 rndsav = rndprc;
5459 rndprc = 56;
5460 emdnorm (xi, 0, 0, exp, 64);
5461 rndprc = rndsav;
5462 todec (xi, d);
5465 /* Convert exploded e-type X, that has already been rounded to
5466 56-bit precision, to DEC format double Y. */
5468 static void
5469 todec (x, y)
5470 unsigned EMUSHORT *x, *y;
5472 unsigned EMUSHORT i;
5473 unsigned EMUSHORT *p;
5475 p = x;
5476 *y = 0;
5477 if (*p++)
5478 *y = 0100000;
5479 i = *p++;
5480 if (i == 0)
5482 *y++ = 0;
5483 *y++ = 0;
5484 *y++ = 0;
5485 *y++ = 0;
5486 return;
5488 if (i > 0377)
5490 *y++ |= 077777;
5491 *y++ = 0xffff;
5492 *y++ = 0xffff;
5493 *y++ = 0xffff;
5494 #ifdef ERANGE
5495 errno = ERANGE;
5496 #endif
5497 return;
5499 i &= 0377;
5500 i <<= 7;
5501 eshup8 (x);
5502 x[M] &= 0177;
5503 i |= x[M];
5504 *y++ |= i;
5505 *y++ = x[M + 1];
5506 *y++ = x[M + 2];
5507 *y++ = x[M + 3];
5509 #endif /* DEC */
5511 #ifdef IBM
5512 /* Convert IBM single/double precision to e type. */
5514 static void
5515 ibmtoe (d, e, mode)
5516 unsigned EMUSHORT *d;
5517 unsigned EMUSHORT *e;
5518 enum machine_mode mode;
5520 unsigned EMUSHORT y[NI];
5521 register unsigned EMUSHORT r, *p;
5522 int rndsav;
5524 ecleaz (y); /* start with a zero */
5525 p = y; /* point to our number */
5526 r = *d; /* get IBM exponent word */
5527 if (*d & (unsigned int) 0x8000)
5528 *p = 0xffff; /* fill in our sign */
5529 ++p; /* bump pointer to our exponent word */
5530 r &= 0x7f00; /* strip the sign bit */
5531 r >>= 6; /* shift exponent word down 6 bits */
5532 /* in fact shift by 8 right and 2 left */
5533 r += EXONE - (0x41 << 2); /* subtract IBM exponent offset */
5534 /* add our e type exponent offset */
5535 *p++ = r; /* to form our exponent */
5537 *p++ = *d++ & 0xff; /* now do the high order mantissa */
5538 /* strip off the IBM exponent and sign bits */
5539 if (mode != SFmode) /* there are only 2 words in SFmode */
5541 *p++ = *d++; /* fill in the rest of our mantissa */
5542 *p++ = *d++;
5544 *p = *d;
5546 if (y[M] == 0 && y[M+1] == 0 && y[M+2] == 0 && y[M+3] == 0)
5547 y[0] = y[E] = 0;
5548 else
5549 y[E] -= 5 + enormlz (y); /* now normalise the mantissa */
5550 /* handle change in RADIX */
5551 emovo (y, e);
5556 /* Convert e type to IBM single/double precision. */
5558 static void
5559 etoibm (x, d, mode)
5560 unsigned EMUSHORT *x, *d;
5561 enum machine_mode mode;
5563 unsigned EMUSHORT xi[NI];
5564 EMULONG exp;
5565 int rndsav;
5567 emovi (x, xi);
5568 exp = (EMULONG) xi[E] - (EXONE - (0x41 << 2)); /* adjust exponent for offsets */
5569 /* round off to nearest or even */
5570 rndsav = rndprc;
5571 rndprc = 56;
5572 emdnorm (xi, 0, 0, exp, 64);
5573 rndprc = rndsav;
5574 toibm (xi, d, mode);
5577 static void
5578 toibm (x, y, mode)
5579 unsigned EMUSHORT *x, *y;
5580 enum machine_mode mode;
5582 unsigned EMUSHORT i;
5583 unsigned EMUSHORT *p;
5584 int r;
5586 p = x;
5587 *y = 0;
5588 if (*p++)
5589 *y = 0x8000;
5590 i = *p++;
5591 if (i == 0)
5593 *y++ = 0;
5594 *y++ = 0;
5595 if (mode != SFmode)
5597 *y++ = 0;
5598 *y++ = 0;
5600 return;
5602 r = i & 0x3;
5603 i >>= 2;
5604 if (i > 0x7f)
5606 *y++ |= 0x7fff;
5607 *y++ = 0xffff;
5608 if (mode != SFmode)
5610 *y++ = 0xffff;
5611 *y++ = 0xffff;
5613 #ifdef ERANGE
5614 errno = ERANGE;
5615 #endif
5616 return;
5618 i &= 0x7f;
5619 *y |= (i << 8);
5620 eshift (x, r + 5);
5621 *y++ |= x[M];
5622 *y++ = x[M + 1];
5623 if (mode != SFmode)
5625 *y++ = x[M + 2];
5626 *y++ = x[M + 3];
5629 #endif /* IBM */
5631 /* Output a binary NaN bit pattern in the target machine's format. */
5633 /* If special NaN bit patterns are required, define them in tm.h
5634 as arrays of unsigned 16-bit shorts. Otherwise, use the default
5635 patterns here. */
5636 #ifdef TFMODE_NAN
5637 TFMODE_NAN;
5638 #else
5639 #ifdef IEEE
5640 unsigned EMUSHORT TFbignan[8] =
5641 {0x7fff, 0xffff, 0xffff, 0xffff, 0xffff, 0xffff, 0xffff, 0xffff};
5642 unsigned EMUSHORT TFlittlenan[8] = {0, 0, 0, 0, 0, 0, 0x8000, 0xffff};
5643 #endif
5644 #endif
5646 #ifdef XFMODE_NAN
5647 XFMODE_NAN;
5648 #else
5649 #ifdef IEEE
5650 unsigned EMUSHORT XFbignan[6] =
5651 {0x7fff, 0xffff, 0xffff, 0xffff, 0xffff, 0xffff};
5652 unsigned EMUSHORT XFlittlenan[6] = {0, 0, 0, 0xc000, 0xffff, 0};
5653 #endif
5654 #endif
5656 #ifdef DFMODE_NAN
5657 DFMODE_NAN;
5658 #else
5659 #ifdef IEEE
5660 unsigned EMUSHORT DFbignan[4] = {0x7fff, 0xffff, 0xffff, 0xffff};
5661 unsigned EMUSHORT DFlittlenan[4] = {0, 0, 0, 0xfff8};
5662 #endif
5663 #endif
5665 #ifdef SFMODE_NAN
5666 SFMODE_NAN;
5667 #else
5668 #ifdef IEEE
5669 unsigned EMUSHORT SFbignan[2] = {0x7fff, 0xffff};
5670 unsigned EMUSHORT SFlittlenan[2] = {0, 0xffc0};
5671 #endif
5672 #endif
5675 static void
5676 make_nan (nan, sign, mode)
5677 unsigned EMUSHORT *nan;
5678 int sign;
5679 enum machine_mode mode;
5681 int n;
5682 unsigned EMUSHORT *p;
5684 switch (mode)
5686 /* Possibly the `reserved operand' patterns on a VAX can be
5687 used like NaN's, but probably not in the same way as IEEE. */
5688 #if !defined(DEC) && !defined(IBM)
5689 case TFmode:
5690 n = 8;
5691 if (REAL_WORDS_BIG_ENDIAN)
5692 p = TFbignan;
5693 else
5694 p = TFlittlenan;
5695 break;
5696 case XFmode:
5697 n = 6;
5698 if (REAL_WORDS_BIG_ENDIAN)
5699 p = XFbignan;
5700 else
5701 p = XFlittlenan;
5702 break;
5703 case DFmode:
5704 n = 4;
5705 if (REAL_WORDS_BIG_ENDIAN)
5706 p = DFbignan;
5707 else
5708 p = DFlittlenan;
5709 break;
5710 case HFmode:
5711 case SFmode:
5712 n = 2;
5713 if (REAL_WORDS_BIG_ENDIAN)
5714 p = SFbignan;
5715 else
5716 p = SFlittlenan;
5717 break;
5718 #endif
5719 default:
5720 abort ();
5722 if (REAL_WORDS_BIG_ENDIAN)
5723 *nan++ = (sign << 15) | *p++;
5724 while (--n != 0)
5725 *nan++ = *p++;
5726 if (! REAL_WORDS_BIG_ENDIAN)
5727 *nan = (sign << 15) | *p;
5730 /* Convert an SFmode target `float' value to a REAL_VALUE_TYPE.
5731 This is the inverse of the function `etarsingle' invoked by
5732 REAL_VALUE_TO_TARGET_SINGLE. */
5734 REAL_VALUE_TYPE
5735 ereal_from_float (f)
5736 HOST_WIDE_INT f;
5738 REAL_VALUE_TYPE r;
5739 unsigned EMUSHORT s[2];
5740 unsigned EMUSHORT e[NE];
5742 /* Convert 32 bit integer to array of 16 bit pieces in target machine order.
5743 This is the inverse operation to what the function `endian' does. */
5744 if (REAL_WORDS_BIG_ENDIAN)
5746 s[0] = (unsigned EMUSHORT) (f >> 16);
5747 s[1] = (unsigned EMUSHORT) f;
5749 else
5751 s[0] = (unsigned EMUSHORT) f;
5752 s[1] = (unsigned EMUSHORT) (f >> 16);
5754 /* Convert and promote the target float to E-type. */
5755 e24toe (s, e);
5756 /* Output E-type to REAL_VALUE_TYPE. */
5757 PUT_REAL (e, &r);
5758 return r;
5762 /* Convert a DFmode target `double' value to a REAL_VALUE_TYPE.
5763 This is the inverse of the function `etardouble' invoked by
5764 REAL_VALUE_TO_TARGET_DOUBLE.
5766 The DFmode is stored as an array of HOST_WIDE_INT in the target's
5767 data format, with no holes in the bit packing. The first element
5768 of the input array holds the bits that would come first in the
5769 target computer's memory. */
5771 REAL_VALUE_TYPE
5772 ereal_from_double (d)
5773 HOST_WIDE_INT d[];
5775 REAL_VALUE_TYPE r;
5776 unsigned EMUSHORT s[4];
5777 unsigned EMUSHORT e[NE];
5779 /* Convert array of HOST_WIDE_INT to equivalent array of 16-bit pieces. */
5780 if (REAL_WORDS_BIG_ENDIAN)
5782 s[0] = (unsigned EMUSHORT) (d[0] >> 16);
5783 s[1] = (unsigned EMUSHORT) d[0];
5784 #if HOST_BITS_PER_WIDE_INT == 32
5785 s[2] = (unsigned EMUSHORT) (d[1] >> 16);
5786 s[3] = (unsigned EMUSHORT) d[1];
5787 #else
5788 /* In this case the entire target double is contained in the
5789 first array element. The second element of the input is
5790 ignored. */
5791 s[2] = (unsigned EMUSHORT) (d[0] >> 48);
5792 s[3] = (unsigned EMUSHORT) (d[0] >> 32);
5793 #endif
5795 else
5797 /* Target float words are little-endian. */
5798 s[0] = (unsigned EMUSHORT) d[0];
5799 s[1] = (unsigned EMUSHORT) (d[0] >> 16);
5800 #if HOST_BITS_PER_WIDE_INT == 32
5801 s[2] = (unsigned EMUSHORT) d[1];
5802 s[3] = (unsigned EMUSHORT) (d[1] >> 16);
5803 #else
5804 s[2] = (unsigned EMUSHORT) (d[0] >> 32);
5805 s[3] = (unsigned EMUSHORT) (d[0] >> 48);
5806 #endif
5808 /* Convert target double to E-type. */
5809 e53toe (s, e);
5810 /* Output E-type to REAL_VALUE_TYPE. */
5811 PUT_REAL (e, &r);
5812 return r;
5816 /* Convert target computer unsigned 64-bit integer to e-type.
5817 The endian-ness of DImode follows the convention for integers,
5818 so we use WORDS_BIG_ENDIAN here, not REAL_WORDS_BIG_ENDIAN. */
5820 static void
5821 uditoe (di, e)
5822 unsigned EMUSHORT *di; /* Address of the 64-bit int. */
5823 unsigned EMUSHORT *e;
5825 unsigned EMUSHORT yi[NI];
5826 int k;
5828 ecleaz (yi);
5829 if (WORDS_BIG_ENDIAN)
5831 for (k = M; k < M + 4; k++)
5832 yi[k] = *di++;
5834 else
5836 for (k = M + 3; k >= M; k--)
5837 yi[k] = *di++;
5839 yi[E] = EXONE + 47; /* exponent if normalize shift count were 0 */
5840 if ((k = enormlz (yi)) > NBITS)/* normalize the significand */
5841 ecleaz (yi); /* it was zero */
5842 else
5843 yi[E] -= (unsigned EMUSHORT) k;/* subtract shift count from exponent */
5844 emovo (yi, e);
5847 /* Convert target computer signed 64-bit integer to e-type. */
5849 static void
5850 ditoe (di, e)
5851 unsigned EMUSHORT *di; /* Address of the 64-bit int. */
5852 unsigned EMUSHORT *e;
5854 unsigned EMULONG acc;
5855 unsigned EMUSHORT yi[NI];
5856 unsigned EMUSHORT carry;
5857 int k, sign;
5859 ecleaz (yi);
5860 if (WORDS_BIG_ENDIAN)
5862 for (k = M; k < M + 4; k++)
5863 yi[k] = *di++;
5865 else
5867 for (k = M + 3; k >= M; k--)
5868 yi[k] = *di++;
5870 /* Take absolute value */
5871 sign = 0;
5872 if (yi[M] & 0x8000)
5874 sign = 1;
5875 carry = 0;
5876 for (k = M + 3; k >= M; k--)
5878 acc = (unsigned EMULONG) (~yi[k] & 0xffff) + carry;
5879 yi[k] = acc;
5880 carry = 0;
5881 if (acc & 0x10000)
5882 carry = 1;
5885 yi[E] = EXONE + 47; /* exponent if normalize shift count were 0 */
5886 if ((k = enormlz (yi)) > NBITS)/* normalize the significand */
5887 ecleaz (yi); /* it was zero */
5888 else
5889 yi[E] -= (unsigned EMUSHORT) k;/* subtract shift count from exponent */
5890 emovo (yi, e);
5891 if (sign)
5892 eneg (e);
5896 /* Convert e-type to unsigned 64-bit int. */
5898 static void
5899 etoudi (x, i)
5900 unsigned EMUSHORT *x;
5901 unsigned EMUSHORT *i;
5903 unsigned EMUSHORT xi[NI];
5904 int j, k;
5906 emovi (x, xi);
5907 if (xi[0])
5909 xi[M] = 0;
5910 goto noshift;
5912 k = (int) xi[E] - (EXONE - 1);
5913 if (k <= 0)
5915 for (j = 0; j < 4; j++)
5916 *i++ = 0;
5917 return;
5919 if (k > 64)
5921 for (j = 0; j < 4; j++)
5922 *i++ = 0xffff;
5923 if (extra_warnings)
5924 warning ("overflow on truncation to integer");
5925 return;
5927 if (k > 16)
5929 /* Shift more than 16 bits: first shift up k-16 mod 16,
5930 then shift up by 16's. */
5931 j = k - ((k >> 4) << 4);
5932 if (j == 0)
5933 j = 16;
5934 eshift (xi, j);
5935 if (WORDS_BIG_ENDIAN)
5936 *i++ = xi[M];
5937 else
5939 i += 3;
5940 *i-- = xi[M];
5942 k -= j;
5945 eshup6 (xi);
5946 if (WORDS_BIG_ENDIAN)
5947 *i++ = xi[M];
5948 else
5949 *i-- = xi[M];
5951 while ((k -= 16) > 0);
5953 else
5955 /* shift not more than 16 bits */
5956 eshift (xi, k);
5958 noshift:
5960 if (WORDS_BIG_ENDIAN)
5962 i += 3;
5963 *i-- = xi[M];
5964 *i-- = 0;
5965 *i-- = 0;
5966 *i = 0;
5968 else
5970 *i++ = xi[M];
5971 *i++ = 0;
5972 *i++ = 0;
5973 *i = 0;
5979 /* Convert e-type to signed 64-bit int. */
5981 static void
5982 etodi (x, i)
5983 unsigned EMUSHORT *x;
5984 unsigned EMUSHORT *i;
5986 unsigned EMULONG acc;
5987 unsigned EMUSHORT xi[NI];
5988 unsigned EMUSHORT carry;
5989 unsigned EMUSHORT *isave;
5990 int j, k;
5992 emovi (x, xi);
5993 k = (int) xi[E] - (EXONE - 1);
5994 if (k <= 0)
5996 for (j = 0; j < 4; j++)
5997 *i++ = 0;
5998 return;
6000 if (k > 64)
6002 for (j = 0; j < 4; j++)
6003 *i++ = 0xffff;
6004 if (extra_warnings)
6005 warning ("overflow on truncation to integer");
6006 return;
6008 isave = i;
6009 if (k > 16)
6011 /* Shift more than 16 bits: first shift up k-16 mod 16,
6012 then shift up by 16's. */
6013 j = k - ((k >> 4) << 4);
6014 if (j == 0)
6015 j = 16;
6016 eshift (xi, j);
6017 if (WORDS_BIG_ENDIAN)
6018 *i++ = xi[M];
6019 else
6021 i += 3;
6022 *i-- = xi[M];
6024 k -= j;
6027 eshup6 (xi);
6028 if (WORDS_BIG_ENDIAN)
6029 *i++ = xi[M];
6030 else
6031 *i-- = xi[M];
6033 while ((k -= 16) > 0);
6035 else
6037 /* shift not more than 16 bits */
6038 eshift (xi, k);
6040 if (WORDS_BIG_ENDIAN)
6042 i += 3;
6043 *i = xi[M];
6044 *i-- = 0;
6045 *i-- = 0;
6046 *i = 0;
6048 else
6050 *i++ = xi[M];
6051 *i++ = 0;
6052 *i++ = 0;
6053 *i = 0;
6056 /* Negate if negative */
6057 if (xi[0])
6059 carry = 0;
6060 if (WORDS_BIG_ENDIAN)
6061 isave += 3;
6062 for (k = 0; k < 4; k++)
6064 acc = (unsigned EMULONG) (~(*isave) & 0xffff) + carry;
6065 if (WORDS_BIG_ENDIAN)
6066 *isave-- = acc;
6067 else
6068 *isave++ = acc;
6069 carry = 0;
6070 if (acc & 0x10000)
6071 carry = 1;
6077 /* Longhand square root routine. */
6080 static int esqinited = 0;
6081 static unsigned short sqrndbit[NI];
6083 static void
6084 esqrt (x, y)
6085 unsigned EMUSHORT *x, *y;
6087 unsigned EMUSHORT temp[NI], num[NI], sq[NI], xx[NI];
6088 EMULONG m, exp;
6089 int i, j, k, n, nlups;
6091 if (esqinited == 0)
6093 ecleaz (sqrndbit);
6094 sqrndbit[NI - 2] = 1;
6095 esqinited = 1;
6097 /* Check for arg <= 0 */
6098 i = ecmp (x, ezero);
6099 if (i <= 0)
6101 if (i == -1)
6103 mtherr ("esqrt", DOMAIN);
6104 eclear (y);
6106 else
6107 emov (x, y);
6108 return;
6111 #ifdef INFINITY
6112 if (eisinf (x))
6114 eclear (y);
6115 einfin (y);
6116 return;
6118 #endif
6119 /* Bring in the arg and renormalize if it is denormal. */
6120 emovi (x, xx);
6121 m = (EMULONG) xx[1]; /* local long word exponent */
6122 if (m == 0)
6123 m -= enormlz (xx);
6125 /* Divide exponent by 2 */
6126 m -= 0x3ffe;
6127 exp = (unsigned short) ((m / 2) + 0x3ffe);
6129 /* Adjust if exponent odd */
6130 if ((m & 1) != 0)
6132 if (m > 0)
6133 exp += 1;
6134 eshdn1 (xx);
6137 ecleaz (sq);
6138 ecleaz (num);
6139 n = 8; /* get 8 bits of result per inner loop */
6140 nlups = rndprc;
6141 j = 0;
6143 while (nlups > 0)
6145 /* bring in next word of arg */
6146 if (j < NE)
6147 num[NI - 1] = xx[j + 3];
6148 /* Do additional bit on last outer loop, for roundoff. */
6149 if (nlups <= 8)
6150 n = nlups + 1;
6151 for (i = 0; i < n; i++)
6153 /* Next 2 bits of arg */
6154 eshup1 (num);
6155 eshup1 (num);
6156 /* Shift up answer */
6157 eshup1 (sq);
6158 /* Make trial divisor */
6159 for (k = 0; k < NI; k++)
6160 temp[k] = sq[k];
6161 eshup1 (temp);
6162 eaddm (sqrndbit, temp);
6163 /* Subtract and insert answer bit if it goes in */
6164 if (ecmpm (temp, num) <= 0)
6166 esubm (temp, num);
6167 sq[NI - 2] |= 1;
6170 nlups -= n;
6171 j += 1;
6174 /* Adjust for extra, roundoff loop done. */
6175 exp += (NBITS - 1) - rndprc;
6177 /* Sticky bit = 1 if the remainder is nonzero. */
6178 k = 0;
6179 for (i = 3; i < NI; i++)
6180 k |= (int) num[i];
6182 /* Renormalize and round off. */
6183 emdnorm (sq, k, 0, exp, 64);
6184 emovo (sq, y);
6186 #endif /* EMU_NON_COMPILE not defined */
6188 /* Return the binary precision of the significand for a given
6189 floating point mode. The mode can hold an integer value
6190 that many bits wide, without losing any bits. */
6193 significand_size (mode)
6194 enum machine_mode mode;
6197 /* Don't test the modes, but their sizes, lest this
6198 code won't work for BITS_PER_UNIT != 8 . */
6200 switch (GET_MODE_BITSIZE (mode))
6202 case 32:
6203 return 24;
6205 case 64:
6206 #if TARGET_FLOAT_FORMAT == IEEE_FLOAT_FORMAT
6207 return 53;
6208 #else
6209 #if TARGET_FLOAT_FORMAT == IBM_FLOAT_FORMAT
6210 return 56;
6211 #else
6212 #if TARGET_FLOAT_FORMAT == VAX_FLOAT_FORMAT
6213 return 56;
6214 #else
6215 abort ();
6216 #endif
6217 #endif
6218 #endif
6220 case 96:
6221 return 64;
6222 case 128:
6223 return 113;
6225 default:
6226 abort ();