OSDN Git Service

* real.c (struct real_format): Move to real.h.
[pf3gnuchains/gcc-fork.git] / gcc / real.c
1 /* real.c - software floating point emulation.
2    Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998,
3    1999, 2000, 2002 Free Software Foundation, Inc.
4    Contributed by Stephen L. Moshier (moshier@world.std.com).
5    Re-written by Richard Henderson  <rth@redhat.com>
6
7    This file is part of GCC.
8
9    GCC is free software; you can redistribute it and/or modify it under
10    the terms of the GNU General Public License as published by the Free
11    Software Foundation; either version 2, or (at your option) any later
12    version.
13
14    GCC is distributed in the hope that it will be useful, but WITHOUT ANY
15    WARRANTY; without even the implied warranty of MERCHANTABILITY or
16    FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
17    for more details.
18
19    You should have received a copy of the GNU General Public License
20    along with GCC; see the file COPYING.  If not, write to the Free
21    Software Foundation, 59 Temple Place - Suite 330, Boston, MA
22    02111-1307, USA.  */
23
24 #include "config.h"
25 #include "system.h"
26 #include "tree.h"
27 #include "toplev.h"
28 #include "real.h"
29 #include "tm_p.h"
30
31 /* The floating point model used internally is not exactly IEEE 754
32    compliant, and close to the description in the ISO C standard,
33    section 5.2.4.2.2 Characteristics of floating types.
34
35    Specifically
36
37         x = s * b^e * \sum_{k=1}^p f_k * b^{-k}
38
39         where
40                 s = sign (+- 1)
41                 b = base or radix, here always 2
42                 e = exponent
43                 p = precision (the number of base-b digits in the significand)
44                 f_k = the digits of the significand.
45
46    We differ from typical IEEE 754 encodings in that the entire
47    significand is fractional.  Normalized significands are in the
48    range [0.5, 1.0).
49
50    A requirement of the model is that P be larger than than the 
51    largest supported target floating-point type by at least 2 bits.
52    This gives us proper rounding when we truncate to the target type.
53    In addition, E must be large enough to hold the smallest supported
54    denormal number in a normalized form.
55
56    Both of these requirements are easily satisfied.  The largest
57    target significand is 113 bits; we store 128.  The smallest
58    denormal number fits in 17 exponent bits; we store 29.
59
60    Target floating point models that use base 16 instead of base 2
61    (i.e. IBM 370), are handled during round_for_format, in which we
62    canonicalize the exponent to be a multiple of 4 (log2(16)), and
63    adjust the significand to match.  */
64
65
66 /* Used to classify two numbers simultaneously.  */
67 #define CLASS2(A, B)  ((A) << 2 | (B))
68
69 #if HOST_BITS_PER_LONG != 64 && HOST_BITS_PER_LONG != 32
70  #error "Some constant folding done by hand to avoid shift count warnings"
71 #endif
72
73 static void get_zero PARAMS ((REAL_VALUE_TYPE *, int));
74 static void get_canonical_qnan PARAMS ((REAL_VALUE_TYPE *, int));
75 static void get_canonical_snan PARAMS ((REAL_VALUE_TYPE *, int));
76 static void get_inf PARAMS ((REAL_VALUE_TYPE *, int));
77 static void sticky_rshift_significand PARAMS ((REAL_VALUE_TYPE *,
78                                                const REAL_VALUE_TYPE *,
79                                                unsigned int));
80 static void rshift_significand PARAMS ((REAL_VALUE_TYPE *,
81                                         const REAL_VALUE_TYPE *,
82                                         unsigned int));
83 static void lshift_significand PARAMS ((REAL_VALUE_TYPE *,
84                                         const REAL_VALUE_TYPE *,
85                                         unsigned int));
86 static void lshift_significand_1 PARAMS ((REAL_VALUE_TYPE *,
87                                           const REAL_VALUE_TYPE *));
88 static bool add_significands PARAMS ((REAL_VALUE_TYPE *r,
89                                       const REAL_VALUE_TYPE *,
90                                       const REAL_VALUE_TYPE *));
91 static bool sub_significands PARAMS ((REAL_VALUE_TYPE *,
92                                       const REAL_VALUE_TYPE *,
93                                       const REAL_VALUE_TYPE *));
94 static void neg_significand PARAMS ((REAL_VALUE_TYPE *,
95                                      const REAL_VALUE_TYPE *));
96 static int cmp_significands PARAMS ((const REAL_VALUE_TYPE *,
97                                      const REAL_VALUE_TYPE *));
98 static void set_significand_bit PARAMS ((REAL_VALUE_TYPE *, unsigned int));
99 static void clear_significand_bit PARAMS ((REAL_VALUE_TYPE *, unsigned int));
100 static bool test_significand_bit PARAMS ((REAL_VALUE_TYPE *, unsigned int));
101 static void clear_significand_below PARAMS ((REAL_VALUE_TYPE *,
102                                              unsigned int));
103 static bool div_significands PARAMS ((REAL_VALUE_TYPE *,
104                                       const REAL_VALUE_TYPE *,
105                                       const REAL_VALUE_TYPE *));
106 static void normalize PARAMS ((REAL_VALUE_TYPE *));
107
108 static void do_add PARAMS ((REAL_VALUE_TYPE *, const REAL_VALUE_TYPE *,
109                             const REAL_VALUE_TYPE *, int));
110 static void do_multiply PARAMS ((REAL_VALUE_TYPE *,
111                                  const REAL_VALUE_TYPE *,
112                                  const REAL_VALUE_TYPE *));
113 static void do_divide PARAMS ((REAL_VALUE_TYPE *, const REAL_VALUE_TYPE *,
114                                const REAL_VALUE_TYPE *));
115 static int do_compare PARAMS ((const REAL_VALUE_TYPE *,
116                                const REAL_VALUE_TYPE *, int));
117 static void do_fix_trunc PARAMS ((REAL_VALUE_TYPE *,
118                                   const REAL_VALUE_TYPE *));
119
120 static const REAL_VALUE_TYPE * ten_to_ptwo PARAMS ((int));
121 static const REAL_VALUE_TYPE * real_digit PARAMS ((int));
122
123 static void round_for_format PARAMS ((const struct real_format *,
124                                       REAL_VALUE_TYPE *));
125 \f
126 /* Initialize R with a positive zero.  */
127
128 static inline void
129 get_zero (r, sign)
130      REAL_VALUE_TYPE *r;
131      int sign;
132 {
133   memset (r, 0, sizeof (*r));
134   r->sign = sign;
135 }
136
137 /* Initialize R with the canonical quiet NaN.  */
138
139 static inline void
140 get_canonical_qnan (r, sign)
141      REAL_VALUE_TYPE *r;
142      int sign;
143 {
144   memset (r, 0, sizeof (*r));
145   r->class = rvc_nan;
146   r->sign = sign;
147   r->sig[SIGSZ-1] = SIG_MSB >> 1;
148 }
149
150 static inline void
151 get_canonical_snan (r, sign)
152      REAL_VALUE_TYPE *r;
153      int sign;
154 {
155   memset (r, 0, sizeof (*r));
156   r->class = rvc_nan;
157   r->sign = sign;
158   r->sig[SIGSZ-1] = SIG_MSB >> 2;
159 }
160
161 static inline void
162 get_inf (r, sign)
163      REAL_VALUE_TYPE *r;
164      int sign;
165 {
166   memset (r, 0, sizeof (*r));
167   r->class = rvc_inf;
168   r->sign = sign;
169 }
170
171 \f
172 /* Right-shift the significand of A by N bits; put the result in the
173    significand of R.  If any one bits are shifted out, set the least
174    significant bit of R.  */
175
176 static void
177 sticky_rshift_significand (r, a, n)
178      REAL_VALUE_TYPE *r;
179      const REAL_VALUE_TYPE *a;
180      unsigned int n;
181 {
182   unsigned long sticky = 0;
183   unsigned int i, ofs = 0;
184
185   if (n >= HOST_BITS_PER_LONG)
186     {
187       for (i = 0, ofs = n / HOST_BITS_PER_LONG; i < ofs; ++i)
188         sticky |= a->sig[i];
189       n -= ofs * HOST_BITS_PER_LONG;
190     }
191
192   if (n != 0)
193     {
194       sticky |= a->sig[ofs] & (((unsigned long)1 << n) - 1);
195       for (i = 0; i < SIGSZ; ++i)
196         {
197           r->sig[i]
198             = (((ofs + i >= SIGSZ ? 0 : a->sig[ofs + i]) >> n)
199                | ((ofs + i + 1 >= SIGSZ ? 0 : a->sig[ofs + i + 1])
200                   << (HOST_BITS_PER_LONG - n)));
201         }
202     }
203   else
204     {
205       for (i = 0; ofs + i < SIGSZ; ++i)
206         r->sig[i] = a->sig[ofs + i];
207       for (; i < SIGSZ; ++i)
208         r->sig[i] = 0;
209     }
210
211   r->sig[0] |= (sticky != 0);
212 }
213
214 /* Right-shift the significand of A by N bits; put the result in the
215    significand of R.  */
216
217 static void
218 rshift_significand (r, a, n)
219      REAL_VALUE_TYPE *r;
220      const REAL_VALUE_TYPE *a;
221      unsigned int n;
222 {
223   unsigned int i, ofs = n / HOST_BITS_PER_LONG;
224
225   n -= ofs * HOST_BITS_PER_LONG;
226   if (n != 0)
227     {
228       for (i = 0; i < SIGSZ; ++i)
229         {
230           r->sig[i]
231             = (((ofs + i >= SIGSZ ? 0 : a->sig[ofs + i]) >> n)
232                | ((ofs + i + 1 >= SIGSZ ? 0 : a->sig[ofs + i + 1])
233                   << (HOST_BITS_PER_LONG - n)));
234         }
235     }
236   else
237     {
238       for (i = 0; ofs + i < SIGSZ; ++i)
239         r->sig[i] = a->sig[ofs + i];
240       for (; i < SIGSZ; ++i)
241         r->sig[i] = 0;
242     }
243 }
244
245 /* Left-shift the significand of A by N bits; put the result in the
246    significand of R.  */
247
248 static void
249 lshift_significand (r, a, n)
250      REAL_VALUE_TYPE *r;
251      const REAL_VALUE_TYPE *a;
252      unsigned int n;
253 {
254   unsigned int i, ofs = n / HOST_BITS_PER_LONG;
255
256   n -= ofs * HOST_BITS_PER_LONG;
257   if (n == 0)
258     {
259       for (i = 0; ofs + i < SIGSZ; ++i)
260         r->sig[SIGSZ-1-i] = a->sig[SIGSZ-1-i-ofs];
261       for (; i < SIGSZ; ++i)
262         r->sig[SIGSZ-1-i] = 0;
263     }
264   else
265     for (i = 0; i < SIGSZ; ++i)
266       {
267         r->sig[SIGSZ-1-i]
268           = (((ofs + i >= SIGSZ ? 0 : a->sig[SIGSZ-1-i-ofs]) << n)
269              | ((ofs + i + 1 >= SIGSZ ? 0 : a->sig[SIGSZ-1-i-ofs-1])
270                 >> (HOST_BITS_PER_LONG - n)));
271       }
272 }
273
274 /* Likewise, but N is specialized to 1.  */
275
276 static inline void
277 lshift_significand_1 (r, a)
278      REAL_VALUE_TYPE *r;
279      const REAL_VALUE_TYPE *a;
280 {
281   unsigned int i;
282
283   for (i = SIGSZ - 1; i > 0; --i)
284     r->sig[i] = (a->sig[i] << 1) | (a->sig[i-1] >> (HOST_BITS_PER_LONG - 1));
285   r->sig[0] = a->sig[0] << 1;
286 }
287
288 /* Add the significands of A and B, placing the result in R.  Return
289    true if there was carry out of the most significant word.  */
290
291 static inline bool
292 add_significands (r, a, b)
293      REAL_VALUE_TYPE *r;
294      const REAL_VALUE_TYPE *a, *b;
295 {
296   bool carry = false;
297   int i;
298
299   for (i = 0; i < SIGSZ; ++i)
300     {
301       unsigned long ai = a->sig[i];
302       unsigned long ri = ai + b->sig[i];
303
304       if (carry)
305         {
306           carry = ri < ai;
307           carry |= ++ri == 0;
308         }
309       else
310         carry = ri < ai;
311
312       r->sig[i] = ri;
313     }
314
315   return carry;
316 }
317
318 /* Subtract the significands of A and B, placing the result in R.
319    Return true if there was carry out of the most significant word.  */
320
321 static inline bool
322 sub_significands (r, a, b)
323      REAL_VALUE_TYPE *r;
324      const REAL_VALUE_TYPE *a, *b;
325 {
326   bool carry = false;
327   int i;
328
329   for (i = 0; i < SIGSZ; ++i)
330     {
331       unsigned long ai = a->sig[i];
332       unsigned long ri = ai - b->sig[i];
333
334       if (carry)
335         {
336           carry = ri > ai;
337           carry |= ~--ri == 0;
338         }
339       else
340         carry = ri > ai;
341
342       r->sig[i] = ri;
343     }
344
345   return carry;
346 }  
347
348 /* Negate the significand A, placing the result in R.  */
349
350 static inline void
351 neg_significand (r, a)
352      REAL_VALUE_TYPE *r;
353      const REAL_VALUE_TYPE *a;
354 {
355   bool carry = true;
356   int i;
357
358   for (i = 0; i < SIGSZ; ++i)
359     {
360       unsigned long ri, ai = a->sig[i];
361
362       if (carry)
363         {
364           if (ai)
365             {
366               ri = -ai;
367               carry = false;
368             }
369           else
370             ri = ai;
371         }
372       else
373         ri = ~ai;
374
375       r->sig[i] = ri;
376     }
377 }  
378
379 /* Compare significands.  Return tri-state vs zero.  */
380
381 static inline int 
382 cmp_significands (a, b)
383      const REAL_VALUE_TYPE *a, *b;
384 {
385   int i;
386
387   for (i = SIGSZ - 1; i >= 0; --i)
388     {
389       unsigned long ai = a->sig[i];
390       unsigned long bi = b->sig[i];
391
392       if (ai > bi)
393         return 1;
394       if (ai < bi)
395         return -1;
396     }
397
398   return 0;
399 }
400
401 /* Set bit N of the significand of R.  */
402
403 static inline void
404 set_significand_bit (r, n)
405      REAL_VALUE_TYPE *r;
406      unsigned int n;
407 {
408   r->sig[n / HOST_BITS_PER_LONG]
409     |= (unsigned long)1 << (n % HOST_BITS_PER_LONG);
410 }
411
412 /* Clear bit N of the significand of R.  */
413
414 static inline void
415 clear_significand_bit (r, n)
416      REAL_VALUE_TYPE *r;
417      unsigned int n;
418 {
419   r->sig[n / HOST_BITS_PER_LONG]
420     &= ~((unsigned long)1 << (n % HOST_BITS_PER_LONG));
421 }
422
423 /* Test bit N of the significand of R.  */
424
425 static inline bool
426 test_significand_bit (r, n)
427      REAL_VALUE_TYPE *r;
428      unsigned int n;
429 {
430   /* ??? Compiler bug here if we return this expression directly.
431      The conversion to bool strips the "&1" and we wind up testing
432      e.g. 2 != 0 -> true.  Seen in gcc version 3.2 20020520.  */
433   int t = (r->sig[n / HOST_BITS_PER_LONG] >> (n % HOST_BITS_PER_LONG)) & 1;
434   return t;
435 }
436
437 /* Clear bits 0..N-1 of the significand of R.  */
438
439 static void
440 clear_significand_below (r, n)
441      REAL_VALUE_TYPE *r;
442      unsigned int n;
443 {
444   int i, w = n / HOST_BITS_PER_LONG;
445
446   for (i = 0; i < w; ++i)
447     r->sig[i] = 0;
448
449   r->sig[w] &= ~(((unsigned long)1 << (n % HOST_BITS_PER_LONG)) - 1);
450 }
451
452 /* Divide the significands of A and B, placing the result in R.  Return
453    true if the division was inexact.  */
454
455 static inline bool
456 div_significands (r, a, b)
457      REAL_VALUE_TYPE *r;
458      const REAL_VALUE_TYPE *a, *b;
459 {
460   REAL_VALUE_TYPE u;
461   int bit = SIGNIFICAND_BITS - 1;
462   int i;
463   long inexact;
464
465   u = *a;
466   memset (r->sig, 0, sizeof (r->sig));
467
468   goto start;
469   do
470     {
471       if ((u.sig[SIGSZ-1] & SIG_MSB) == 0)
472         {
473           lshift_significand_1 (&u, &u);
474         start:
475           if (cmp_significands (&u, b) >= 0)
476             {
477               sub_significands (&u, &u, b);
478               set_significand_bit (r, bit);
479             }
480         }
481       else
482         {
483           /* We lose a bit here, and thus know the next quotient bit
484              will be one.  */
485           lshift_significand_1 (&u, &u);
486           sub_significands (&u, &u, b);
487           set_significand_bit (r, bit);
488         }
489     }
490   while (--bit >= 0);
491
492   for (i = 0, inexact = 0; i < SIGSZ; i++)
493     inexact |= u.sig[i];
494
495   return inexact != 0;
496 }
497
498 /* Adjust the exponent and significand of R such that the most
499    significant bit is set.  We underflow to zero and overflow to
500    infinity here, without denormals.  (The intermediate representation
501    exponent is large enough to handle target denormals normalized.)  */
502
503 static void
504 normalize (r)
505      REAL_VALUE_TYPE *r;
506 {
507   int shift = 0, exp;
508   int i, j;
509
510   /* Find the first word that is non-zero.  */
511   for (i = SIGSZ - 1; i >= 0; i--)
512     if (r->sig[i] == 0)
513       shift += HOST_BITS_PER_LONG;
514     else
515       break;
516
517   /* Zero significand flushes to zero.  */
518   if (i < 0)
519     {
520       r->class = rvc_zero;
521       r->exp = 0;
522       return;
523     }
524
525   /* Find the first bit that is non-zero.  */
526   for (j = 0; ; j++)
527     if (r->sig[i] & ((unsigned long)1 << (HOST_BITS_PER_LONG - 1 - j)))
528       break;
529   shift += j;
530
531   if (shift > 0)
532     {
533       exp = r->exp - shift;
534       if (exp > MAX_EXP)
535         get_inf (r, r->sign);
536       else if (exp < -MAX_EXP)
537         get_zero (r, r->sign);
538       else
539         {
540           r->exp = exp;
541           lshift_significand (r, r, shift);
542         }
543     }
544 }
545 \f
546 /* Return R = A + (SUBTRACT_P ? -B : B).  */
547
548 static void
549 do_add (r, a, b, subtract_p)
550      REAL_VALUE_TYPE *r;
551      const REAL_VALUE_TYPE *a, *b;
552      int subtract_p;
553 {
554   int dexp, sign, exp;
555   REAL_VALUE_TYPE t;
556
557   /* Determine if we need to add or subtract.  */
558   sign = a->sign;
559   subtract_p = (sign ^ b->sign) ^ subtract_p;
560
561   switch (CLASS2 (a->class, b->class))
562     {
563     case CLASS2 (rvc_zero, rvc_zero):
564       /* +-0 +/- +-0 = +0.  */
565       get_zero (r, 0);
566       return;
567
568     case CLASS2 (rvc_zero, rvc_normal):
569     case CLASS2 (rvc_zero, rvc_inf):
570     case CLASS2 (rvc_zero, rvc_nan):
571       /* 0 + ANY = ANY.  */
572     case CLASS2 (rvc_normal, rvc_nan):
573     case CLASS2 (rvc_inf, rvc_nan):
574     case CLASS2 (rvc_nan, rvc_nan):
575       /* ANY + NaN = NaN.  */
576     case CLASS2 (rvc_normal, rvc_inf):
577       /* R + Inf = Inf.  */
578       *r = *b;
579       r->sign = sign ^ subtract_p;
580       return;
581
582     case CLASS2 (rvc_normal, rvc_zero):
583     case CLASS2 (rvc_inf, rvc_zero):
584     case CLASS2 (rvc_nan, rvc_zero):
585       /* ANY + 0 = ANY.  */
586     case CLASS2 (rvc_nan, rvc_normal):
587     case CLASS2 (rvc_nan, rvc_inf):
588       /* NaN + ANY = NaN.  */
589     case CLASS2 (rvc_inf, rvc_normal):
590       /* Inf + R = Inf.  */
591       *r = *a;
592       return;
593
594     case CLASS2 (rvc_inf, rvc_inf):
595       if (subtract_p)
596         /* Inf - Inf = NaN.  */
597         get_canonical_qnan (r, 0);
598       else
599         /* Inf + Inf = Inf.  */
600         *r = *a;
601       return;
602
603     case CLASS2 (rvc_normal, rvc_normal):
604       break;
605
606     default:
607       abort ();
608     }
609
610   /* Swap the arguments such that A has the larger exponent.  */
611   dexp = a->exp - b->exp;
612   if (dexp < 0)
613     {
614       const REAL_VALUE_TYPE *t;
615       t = a, a = b, b = t;
616       dexp = -dexp;
617       sign ^= subtract_p;
618     }
619   exp = a->exp;
620
621   /* If the exponents are not identical, we need to shift the
622      significand of B down.  */
623   if (dexp > 0)
624     {
625       /* If the exponents are too far apart, the significands
626          do not overlap, which makes the subtraction a noop.  */
627       if (dexp >= SIGNIFICAND_BITS)
628         {
629           *r = *a;
630           r->sign = sign;
631           return;
632         }
633
634       sticky_rshift_significand (&t, b, dexp);
635       b = &t;
636     }
637
638   if (subtract_p)
639     {
640       if (sub_significands (r, a, b))
641         {
642           /* We got a borrow out of the subtraction.  That means that
643              A and B had the same exponent, and B had the larger
644              significand.  We need to swap the sign and negate the
645              significand.  */
646           sign ^= 1;
647           neg_significand (r, r);
648         }
649     }
650   else
651     {
652       if (add_significands (r, a, b))
653         {
654           /* We got carry out of the addition.  This means we need to
655              shift the significand back down one bit and increase the
656              exponent.  */
657           sticky_rshift_significand (r, r, 1);
658           r->sig[SIGSZ-1] |= SIG_MSB;
659           if (++exp > MAX_EXP)
660             {
661               get_inf (r, sign);
662               return;
663             }
664         }
665     }
666
667   r->class = rvc_normal;
668   r->sign = sign;
669   r->exp = exp;
670
671   /* Re-normalize the result.  */
672   normalize (r);
673
674   /* Special case: if the subtraction results in zero, the result
675      is positive.  */
676   if (r->class == rvc_zero)
677     r->sign = 0;
678 }
679
680 /* Return R = A * B.  */
681
682 static void
683 do_multiply (r, a, b)
684      REAL_VALUE_TYPE *r;
685      const REAL_VALUE_TYPE *a, *b;
686 {
687   REAL_VALUE_TYPE u, t, *rr;
688   unsigned int i, j, k;
689   int sign = a->sign ^ b->sign;
690
691   switch (CLASS2 (a->class, b->class))
692     {
693     case CLASS2 (rvc_zero, rvc_zero):
694     case CLASS2 (rvc_zero, rvc_normal):
695     case CLASS2 (rvc_normal, rvc_zero):
696       /* +-0 * ANY = 0 with appropriate sign.  */
697       get_zero (r, sign);
698       return;
699
700     case CLASS2 (rvc_zero, rvc_nan):
701     case CLASS2 (rvc_normal, rvc_nan):
702     case CLASS2 (rvc_inf, rvc_nan):
703     case CLASS2 (rvc_nan, rvc_nan):
704       /* ANY * NaN = NaN.  */
705       *r = *b;
706       r->sign = sign;
707       return;
708
709     case CLASS2 (rvc_nan, rvc_zero):
710     case CLASS2 (rvc_nan, rvc_normal):
711     case CLASS2 (rvc_nan, rvc_inf):
712       /* NaN * ANY = NaN.  */
713       *r = *a;
714       r->sign = sign;
715       return;
716
717     case CLASS2 (rvc_zero, rvc_inf):
718     case CLASS2 (rvc_inf, rvc_zero):
719       /* 0 * Inf = NaN */
720       get_canonical_qnan (r, sign);
721       return;
722
723     case CLASS2 (rvc_inf, rvc_inf):
724     case CLASS2 (rvc_normal, rvc_inf):
725     case CLASS2 (rvc_inf, rvc_normal):
726       /* Inf * Inf = Inf, R * Inf = Inf */
727     overflow:
728       get_inf (r, sign);
729       return;
730
731     case CLASS2 (rvc_normal, rvc_normal):
732       break;
733
734     default:
735       abort ();
736     }
737
738   if (r == a || r == b)
739     rr = &t;
740   else
741     rr = r;
742   get_zero (rr, 0);
743
744   u.class = rvc_normal;
745   u.sign = 0;
746
747   /* Collect all the partial products.  Since we don't have sure access
748      to a widening multiply, we split each long into two half-words.
749
750      Consider the long-hand form of a four half-word multiplication:
751
752                  A  B  C  D
753               *  E  F  G  H
754              --------------
755                 DE DF DG DH
756              CE CF CG CH
757           BE BF BG BH
758        AE AF AG AH
759
760      We construct partial products of the widened half-word products
761      that are known to not overlap, e.g. DF+DH.  Each such partial
762      product is given its proper exponent, which allows us to sum them
763      and obtain the finished product.  */
764
765   for (i = 0; i < SIGSZ * 2; ++i)
766     {
767       unsigned long ai = a->sig[i / 2];
768       if (i & 1)
769         ai >>= HOST_BITS_PER_LONG / 2;
770       else
771         ai &= ((unsigned long)1 << (HOST_BITS_PER_LONG / 2)) - 1;
772
773       if (ai == 0)
774         continue;
775
776       for (j = 0; j < 2; ++j)
777         {
778           int exp = (a->exp - (2*SIGSZ-1-i)*(HOST_BITS_PER_LONG/2)
779                      + (b->exp - (1-j)*(HOST_BITS_PER_LONG/2)));
780
781           if (exp > MAX_EXP)
782             goto overflow;
783           if (exp < -MAX_EXP)
784             /* Would underflow to zero, which we shouldn't bother adding.  */
785             continue;
786
787           u.exp = exp;
788
789           for (k = j; k < SIGSZ * 2; k += 2)
790             {
791               unsigned long bi = b->sig[k / 2];
792               if (k & 1)
793                 bi >>= HOST_BITS_PER_LONG / 2;
794               else
795                 bi &= ((unsigned long)1 << (HOST_BITS_PER_LONG / 2)) - 1;
796
797               u.sig[k / 2] = ai * bi;
798             }
799
800           do_add (rr, rr, &u, 0);
801         }
802     }
803
804   rr->sign = sign;
805   if (rr != r)
806     *r = t;
807 }
808
809 /* Return R = A / B.  */
810
811 static void
812 do_divide (r, a, b)
813      REAL_VALUE_TYPE *r;
814      const REAL_VALUE_TYPE *a, *b;
815 {
816   int exp, sign = a->sign ^ b->sign;
817   REAL_VALUE_TYPE t, *rr;
818   bool inexact;
819
820   switch (CLASS2 (a->class, b->class))
821     {
822     case CLASS2 (rvc_zero, rvc_zero):
823       /* 0 / 0 = NaN.  */
824     case CLASS2 (rvc_inf, rvc_zero):
825       /* Inf / 0 = NaN.  */
826     case CLASS2 (rvc_inf, rvc_inf):
827       /* Inf / Inf = NaN.  */
828       get_canonical_qnan (r, sign);
829       return;
830
831     case CLASS2 (rvc_zero, rvc_normal):
832     case CLASS2 (rvc_zero, rvc_inf):
833       /* 0 / ANY = 0.  */
834     case CLASS2 (rvc_normal, rvc_inf):
835       /* R / Inf = 0.  */
836     underflow:
837       get_zero (r, sign);
838       return;
839
840     case CLASS2 (rvc_normal, rvc_zero):
841       /* R / 0 = Inf.  */
842       get_inf (r, sign);
843       return;
844
845     case CLASS2 (rvc_zero, rvc_nan):
846     case CLASS2 (rvc_normal, rvc_nan):
847     case CLASS2 (rvc_inf, rvc_nan):
848     case CLASS2 (rvc_nan, rvc_nan):
849       /* ANY / NaN = NaN.  */
850       *r = *b;
851       r->sign = sign;
852       return;
853
854     case CLASS2 (rvc_nan, rvc_zero):
855     case CLASS2 (rvc_nan, rvc_normal):
856     case CLASS2 (rvc_nan, rvc_inf):
857       /* NaN / ANY = NaN.  */
858       *r = *a;
859       r->sign = sign;
860       return;
861
862     case CLASS2 (rvc_inf, rvc_normal):
863       /* Inf / R = Inf.  */
864     overflow:
865       get_inf (r, sign);
866       return;
867
868     case CLASS2 (rvc_normal, rvc_normal):
869       break;
870
871     default:
872       abort ();
873     }
874
875   if (r == a || r == b)
876     rr = &t;
877   else
878     rr = r;
879
880   rr->class = rvc_normal;
881   rr->sign = sign;
882
883   exp = a->exp - b->exp + 1;
884   if (exp > MAX_EXP)
885     goto overflow;
886   if (exp < -MAX_EXP)
887     goto underflow;
888   rr->exp = exp;
889
890   inexact = div_significands (rr, a, b);
891   rr->sig[0] |= inexact;
892
893   /* Re-normalize the result.  */
894   normalize (rr);
895
896   if (rr != r)
897     *r = t;
898 }
899
900 /* Return a tri-state comparison of A vs B.  Return NAN_RESULT if
901    one of the two operands is a NaN.  */
902
903 static int
904 do_compare (a, b, nan_result)
905      const REAL_VALUE_TYPE *a, *b;
906      int nan_result;
907 {
908   int ret;
909
910   switch (CLASS2 (a->class, b->class))
911     {
912     case CLASS2 (rvc_zero, rvc_zero):
913       /* Sign of zero doesn't matter for compares.  */
914       return 0;
915
916     case CLASS2 (rvc_inf, rvc_zero):
917     case CLASS2 (rvc_inf, rvc_normal):
918     case CLASS2 (rvc_normal, rvc_zero):
919       return (a->sign ? -1 : 1);
920
921     case CLASS2 (rvc_inf, rvc_inf):
922       return -a->sign - -b->sign;
923
924     case CLASS2 (rvc_zero, rvc_normal):
925     case CLASS2 (rvc_zero, rvc_inf):
926     case CLASS2 (rvc_normal, rvc_inf):
927       return (b->sign ? 1 : -1);
928
929     case CLASS2 (rvc_zero, rvc_nan):
930     case CLASS2 (rvc_normal, rvc_nan):
931     case CLASS2 (rvc_inf, rvc_nan):
932     case CLASS2 (rvc_nan, rvc_nan):
933     case CLASS2 (rvc_nan, rvc_zero):
934     case CLASS2 (rvc_nan, rvc_normal):
935     case CLASS2 (rvc_nan, rvc_inf):
936       return nan_result;
937
938     case CLASS2 (rvc_normal, rvc_normal):
939       break;
940
941     default:
942       abort ();
943     }
944
945   if (a->sign != b->sign)
946     return -a->sign - -b->sign;
947
948   if (a->exp > b->exp)
949     ret = 1;
950   else if (a->exp < b->exp)
951     ret = -1;
952   else
953     ret = cmp_significands (a, b);
954
955   return (a->sign ? -ret : ret);
956 }
957
958 /* Return A truncated to an integral value toward zero.  */
959
960 static void
961 do_fix_trunc (r, a)
962      REAL_VALUE_TYPE *r;
963      const REAL_VALUE_TYPE *a;
964 {
965   *r = *a;
966
967   switch (a->class)
968     {
969     case rvc_zero:
970     case rvc_inf:
971     case rvc_nan:
972       break;
973
974     case rvc_normal:
975       if (r->exp <= 0)
976         get_zero (r, r->sign);
977       else if (r->exp < SIGNIFICAND_BITS)
978         clear_significand_below (r, SIGNIFICAND_BITS - r->exp);
979       break;
980
981     default:
982       abort ();
983     }
984 }
985
986 /* Perform the binary or unary operation described by CODE.
987    For a unary operation, leave OP1 NULL.  */
988
989 void
990 real_arithmetic (r, icode, op0, op1)
991      REAL_VALUE_TYPE *r;
992      int icode;
993      const REAL_VALUE_TYPE *op0, *op1;
994 {
995   enum tree_code code = icode;
996
997   switch (code)
998     {
999     case PLUS_EXPR:
1000       do_add (r, op0, op1, 0);
1001       break;
1002
1003     case MINUS_EXPR:
1004       do_add (r, op0, op1, 1);
1005       break;
1006
1007     case MULT_EXPR:
1008       do_multiply (r, op0, op1);
1009       break;
1010
1011     case RDIV_EXPR:
1012       do_divide (r, op0, op1);
1013       break;
1014
1015     case MIN_EXPR:
1016       if (op1->class == rvc_nan)
1017         *r = *op1;
1018       else if (do_compare (op0, op1, -1) < 0)
1019         *r = *op0;
1020       else
1021         *r = *op1;
1022       break;
1023
1024     case MAX_EXPR:
1025       if (op1->class == rvc_nan)
1026         *r = *op1;
1027       else if (do_compare (op0, op1, 1) < 0)
1028         *r = *op1;
1029       else
1030         *r = *op0;
1031       break;
1032
1033     case NEGATE_EXPR:
1034       *r = *op0;
1035       r->sign ^= 1;
1036       break;
1037
1038     case ABS_EXPR:
1039       *r = *op0;
1040       r->sign = 0;
1041       break;
1042
1043     case FIX_TRUNC_EXPR:
1044       do_fix_trunc (r, op0);
1045       break;
1046
1047     default:
1048       abort ();
1049     }
1050 }
1051
1052 /* Legacy.  Similar, but return the result directly.  */
1053
1054 REAL_VALUE_TYPE
1055 real_arithmetic2 (icode, op0, op1)
1056      int icode;
1057      const REAL_VALUE_TYPE *op0, *op1;
1058 {
1059   REAL_VALUE_TYPE r;
1060   real_arithmetic (&r, icode, op0, op1);
1061   return r;
1062 }
1063
1064 bool
1065 real_compare (icode, op0, op1)
1066      int icode;
1067      const REAL_VALUE_TYPE *op0, *op1;
1068 {
1069   enum tree_code code = icode;
1070
1071   switch (code)
1072     {
1073     case LT_EXPR:
1074       return do_compare (op0, op1, 1) < 0;
1075     case LE_EXPR:
1076       return do_compare (op0, op1, 1) <= 0;
1077     case GT_EXPR:
1078       return do_compare (op0, op1, -1) > 0;
1079     case GE_EXPR:
1080       return do_compare (op0, op1, -1) >= 0;
1081     case EQ_EXPR:
1082       return do_compare (op0, op1, -1) == 0;
1083     case NE_EXPR:
1084       return do_compare (op0, op1, -1) != 0;
1085     case UNORDERED_EXPR:
1086       return op0->class == rvc_nan || op1->class == rvc_nan;
1087     case ORDERED_EXPR:
1088       return op0->class != rvc_nan && op1->class != rvc_nan;
1089     case UNLT_EXPR:
1090       return do_compare (op0, op1, -1) < 0;
1091     case UNLE_EXPR:
1092       return do_compare (op0, op1, -1) <= 0;
1093     case UNGT_EXPR:
1094       return do_compare (op0, op1, 1) > 0;
1095     case UNGE_EXPR:
1096       return do_compare (op0, op1, 1) >= 0;
1097     case UNEQ_EXPR:
1098       return do_compare (op0, op1, 0) == 0;
1099
1100     default:
1101       abort ();
1102     }
1103 }
1104
1105 /* Return floor log2(R).  */
1106
1107 int
1108 real_exponent (r)
1109      const REAL_VALUE_TYPE *r;
1110 {
1111   switch (r->class)
1112     {
1113     case rvc_zero:
1114       return 0;
1115     case rvc_inf:
1116     case rvc_nan:
1117       return (unsigned int)-1 >> 1;
1118     case rvc_normal:
1119       return r->exp;
1120     default:
1121       abort ();
1122     }
1123 }
1124
1125 /* R = OP0 * 2**EXP.  */
1126
1127 void
1128 real_ldexp (r, op0, exp)
1129      REAL_VALUE_TYPE *r;
1130      const REAL_VALUE_TYPE *op0;
1131      int exp;
1132 {
1133   *r = *op0;
1134   switch (r->class)
1135     {
1136     case rvc_zero:
1137     case rvc_inf:
1138     case rvc_nan:
1139       break;
1140
1141     case rvc_normal:
1142       exp += op0->exp;
1143       if (exp > MAX_EXP)
1144         get_inf (r, r->sign);
1145       else if (exp < -MAX_EXP)
1146         get_zero (r, r->sign);
1147       else
1148         r->exp = exp;
1149       break;
1150
1151     default:
1152       abort ();
1153     }
1154 }
1155
1156 /* Determine whether a floating-point value X is infinite.  */
1157
1158 bool
1159 real_isinf (r)
1160      const REAL_VALUE_TYPE *r;
1161 {
1162   return (r->class == rvc_inf);
1163 }
1164
1165 /* Determine whether a floating-point value X is a NaN.  */
1166
1167 bool
1168 real_isnan (r)
1169      const REAL_VALUE_TYPE *r;
1170 {
1171   return (r->class == rvc_nan);
1172 }
1173
1174 /* Determine whether a floating-point value X is negative.  */
1175
1176 bool
1177 real_isneg (r)
1178      const REAL_VALUE_TYPE *r;
1179 {
1180   return r->sign;
1181 }
1182
1183 /* Determine whether a floating-point value X is minus zero.  */
1184
1185 bool
1186 real_isnegzero (r)
1187      const REAL_VALUE_TYPE *r;
1188 {
1189   return r->sign && r->class == rvc_zero;
1190 }
1191
1192 /* Compare two floating-point objects for bitwise identity.  */
1193
1194 extern bool
1195 real_identical (a, b)
1196      const REAL_VALUE_TYPE *a, *b;
1197 {
1198   int i;
1199
1200   if (a->class != b->class)
1201     return false;
1202   if (a->sign != b->sign)
1203     return false;
1204
1205   switch (a->class)
1206     {
1207     case rvc_zero:
1208     case rvc_inf:
1209       break;
1210
1211     case rvc_normal:
1212       if (a->exp != b->exp)
1213         return false;
1214       /* FALLTHRU */
1215     case rvc_nan:
1216       for (i = 0; i < SIGSZ; ++i)
1217         if (a->sig[i] != b->sig[i])
1218           return false;
1219       break;
1220
1221     default:
1222       abort ();
1223     }
1224
1225   return true;
1226 }
1227
1228 /* Try to change R into its exact multiplicative inverse in machine
1229    mode MODE.  Return true if successful.  */
1230
1231 bool
1232 exact_real_inverse (mode, r)
1233      enum machine_mode mode;
1234      REAL_VALUE_TYPE *r;
1235 {
1236   const REAL_VALUE_TYPE *one = real_digit (1);
1237   REAL_VALUE_TYPE u;
1238   int i;
1239   
1240   if (r->class != rvc_normal)
1241     return false;
1242
1243   /* Check for a power of two: all significand bits zero except the MSB.  */
1244   for (i = 0; i < SIGSZ-1; ++i)
1245     if (r->sig[i] != 0)
1246       return false;
1247   if (r->sig[SIGSZ-1] != SIG_MSB)
1248     return false;
1249
1250   /* Find the inverse and truncate to the required mode.  */
1251   do_divide (&u, one, r);
1252   real_convert (&u, mode, &u);
1253   
1254   /* The rounding may have overflowed.  */
1255   if (u.class != rvc_normal)
1256     return false;
1257   for (i = 0; i < SIGSZ-1; ++i)
1258     if (u.sig[i] != 0)
1259       return false;
1260   if (u.sig[SIGSZ-1] != SIG_MSB)
1261     return false;
1262
1263   *r = u;
1264   return true;
1265 }
1266 \f
1267 /* Render R as an integer.  */
1268
1269 HOST_WIDE_INT
1270 real_to_integer (r)
1271      const REAL_VALUE_TYPE *r;
1272 {
1273   unsigned HOST_WIDE_INT i;
1274
1275   switch (r->class)
1276     {
1277     case rvc_zero:
1278     underflow:
1279       return 0;
1280
1281     case rvc_inf:
1282     case rvc_nan:
1283     overflow:
1284       i = (unsigned HOST_WIDE_INT) 1 << (HOST_BITS_PER_WIDE_INT - 1);
1285       if (!r->sign)
1286         i--;
1287       return i;
1288
1289     case rvc_normal:
1290       if (r->exp <= 0)
1291         goto underflow;
1292       if (r->exp > HOST_BITS_PER_WIDE_INT)
1293         goto overflow;
1294
1295       if (HOST_BITS_PER_WIDE_INT == HOST_BITS_PER_LONG)
1296         i = r->sig[SIGSZ-1];
1297       else if (HOST_BITS_PER_WIDE_INT == 2*HOST_BITS_PER_LONG)
1298         {
1299           i = r->sig[SIGSZ-1];
1300           i = i << (HOST_BITS_PER_LONG - 1) << 1;
1301           i |= r->sig[SIGSZ-2];
1302         }
1303       else
1304         abort ();
1305
1306       i >>= HOST_BITS_PER_WIDE_INT - r->exp;
1307
1308       if (r->sign)
1309         i = -i;
1310       return i;
1311
1312     default:
1313       abort ();
1314     }
1315 }
1316
1317 /* Likewise, but to an integer pair, HI+LOW.  */
1318
1319 void
1320 real_to_integer2 (plow, phigh, r)
1321      HOST_WIDE_INT *plow, *phigh;
1322      const REAL_VALUE_TYPE *r;
1323 {
1324   REAL_VALUE_TYPE t;
1325   HOST_WIDE_INT low, high;
1326   int exp;
1327
1328   switch (r->class)
1329     {
1330     case rvc_zero:
1331     underflow:
1332       low = high = 0;
1333       break;
1334
1335     case rvc_inf:
1336     case rvc_nan:
1337     overflow:
1338       high = (unsigned HOST_WIDE_INT) 1 << (HOST_BITS_PER_WIDE_INT - 1);
1339       if (r->sign)
1340         low = 0;
1341       else
1342         {
1343           high--;
1344           low = -1;
1345         }
1346       break;
1347
1348     case rvc_normal:
1349       exp = r->exp;
1350       if (exp <= 0)
1351         goto underflow;
1352       if (exp >= 2*HOST_BITS_PER_WIDE_INT)
1353         goto overflow;
1354
1355       rshift_significand (&t, r, 2*HOST_BITS_PER_WIDE_INT - exp);
1356       if (HOST_BITS_PER_WIDE_INT == HOST_BITS_PER_LONG)
1357         {
1358           high = t.sig[SIGSZ-1];
1359           low = t.sig[SIGSZ-2];
1360         }
1361       else if (HOST_BITS_PER_WIDE_INT == 2*HOST_BITS_PER_LONG)
1362         {
1363           high = t.sig[SIGSZ-1];
1364           high = high << (HOST_BITS_PER_LONG - 1) << 1;
1365           high |= t.sig[SIGSZ-2];
1366
1367           low = t.sig[SIGSZ-3];
1368           low = low << (HOST_BITS_PER_LONG - 1) << 1;
1369           low |= t.sig[SIGSZ-4];
1370         }
1371       else
1372         abort ();
1373
1374       if (r->sign)
1375         {
1376           if (low == 0)
1377             high = -high;
1378           else
1379             low = -low, high = ~high;
1380         }
1381       break;
1382
1383     default:
1384       abort ();
1385     }
1386
1387   *plow = low;
1388   *phigh = high;
1389 }
1390
1391 /* Render R as a decimal floating point constant.  Emit DIGITS
1392    significant digits in the result.  If DIGITS <= 0, choose the
1393    maximum for the representation.  */
1394
1395 #define M_LOG10_2       0.30102999566398119521
1396
1397 void
1398 real_to_decimal (str, r_orig, digits)
1399      char *str;
1400      const REAL_VALUE_TYPE *r_orig;
1401      int digits;
1402 {
1403   REAL_VALUE_TYPE r;
1404   const REAL_VALUE_TYPE *one, *ten;
1405   int dec_exp, max_digits, d, cmp_half;
1406   char *p, *first, *last;
1407   bool sign;
1408
1409   r = *r_orig;
1410   switch (r.class)
1411     {
1412     case rvc_zero:
1413       strcpy (str, (r.sign ? "-0.0" : "0.0"));
1414       return;
1415     case rvc_normal:
1416       break;
1417     case rvc_inf:
1418       strcpy (str, (r.sign ? "+Inf" : "-Inf"));
1419       return;
1420     case rvc_nan:
1421       /* ??? Print the significand as well, if not canonical?  */
1422       strcpy (str, (r.sign ? "+NaN" : "-NaN"));
1423       return;
1424     default:
1425       abort ();
1426     }
1427
1428   max_digits = SIGNIFICAND_BITS * M_LOG10_2;
1429   if (digits <= 0 || digits > max_digits)
1430     digits = max_digits;
1431
1432   one = real_digit (1);
1433   ten = ten_to_ptwo (0);
1434
1435   sign = r.sign;
1436   r.sign = 0;
1437
1438   /* Estimate the decimal exponent.  */
1439   dec_exp = r.exp * M_LOG10_2;
1440   
1441   /* Scale the number such that it is in [1, 10).  */
1442   if (dec_exp > 0)
1443     {
1444       int i;
1445       for (i = EXP_BITS - 1; i >= 0; --i)
1446         if (dec_exp & (1 << i))
1447           do_divide (&r, &r, ten_to_ptwo (i));
1448     }
1449   else if (dec_exp < 0)
1450     {
1451       int i, pos_exp = -(--dec_exp);
1452
1453       for (i = EXP_BITS - 1; i >= 0; --i)
1454         if (pos_exp & (1 << i))
1455           do_multiply (&r, &r, ten_to_ptwo (i));
1456     }
1457
1458   /* Assert that the number is in the proper range.  Round-off can
1459      prevent the above from working exactly.  */
1460   if (do_compare (&r, one, -1) < 0)
1461     {
1462       do_multiply (&r, &r, ten);
1463       dec_exp--;
1464     }
1465   else if (do_compare (&r, ten, 1) >= 0)
1466     {
1467       do_divide (&r, &r, ten);
1468       dec_exp++;
1469     }
1470
1471   p = str;
1472   if (sign)
1473     *p++ = '-';
1474   first = p++;
1475   while (1)
1476     {
1477       d = real_to_integer ((const REAL_VALUE_TYPE *) &r);
1478       do_add (&r, &r, real_digit (d), 1);
1479
1480       *p++ = d + '0';
1481       if (--digits == 0)
1482         break;
1483       do_multiply (&r, &r, ten);
1484     }
1485   last = p;
1486
1487   /* Round the result.  Compare R vs 0.5 by doing R*2 vs 1.0.  */
1488   r.exp += 1;
1489   cmp_half = do_compare (&r, one, -1);
1490   if (cmp_half == 0)
1491     /* Round to even.  */
1492     cmp_half += d & 1;
1493   if (cmp_half > 0)
1494     {
1495       while (p > first)
1496         {
1497           d = *--p;
1498           if (d == '9')
1499             *p = '0';
1500           else
1501             {
1502               *p = d + 1;
1503               break;
1504             }
1505         }
1506
1507       if (p == first)
1508         {
1509           first[1] = '1';
1510           dec_exp++;
1511         }
1512     }
1513   
1514   first[0] = first[1];
1515   first[1] = '.';
1516
1517   sprintf (last, "e%+d", dec_exp);
1518 }
1519
1520 /* Render R as a hexadecimal floating point constant.  Emit DIGITS
1521    significant digits in the result.  If DIGITS <= 0, choose the maximum
1522    for the representation.  */
1523
1524 void
1525 real_to_hexadecimal (str, r, digits)
1526      char *str;
1527      const REAL_VALUE_TYPE *r;
1528      int digits;
1529 {
1530   int i, j, exp = r->exp;
1531   char *p;
1532
1533   switch (r->class)
1534     {
1535     case rvc_zero:
1536       exp = 0;
1537       break;
1538     case rvc_normal:
1539       break;
1540     case rvc_inf:
1541       strcpy (str, (r->sign ? "+Inf" : "-Inf"));
1542       return;
1543     case rvc_nan:
1544       /* ??? Print the significand as well, if not canonical?  */
1545       strcpy (str, (r->sign ? "+NaN" : "-NaN"));
1546       return;
1547     default:
1548       abort ();
1549     }
1550
1551   if (digits <= 0)
1552     digits = SIGNIFICAND_BITS / 4;
1553
1554   p = str;
1555   if (r->sign)
1556     *p++ = '-';
1557   *p++ = '0';
1558   *p++ = 'x';
1559   *p++ = '0';
1560   *p++ = '.';
1561
1562   for (i = SIGSZ - 1; i >= 0; --i)
1563     for (j = HOST_BITS_PER_LONG - 4; j >= 0; j -= 4)
1564       {
1565         *p++ = "0123456789abcdef"[(r->sig[i] >> j) & 15];
1566         if (--digits == 0)
1567           goto out;
1568       }
1569  out:
1570   sprintf (p, "p%+d", exp);
1571 }
1572
1573 /* Initialize R from a decimal or hexadecimal string.  The string is
1574    assumed to have been syntax checked already.  */
1575
1576 void
1577 real_from_string (r, str)
1578      REAL_VALUE_TYPE *r;
1579      const char *str;
1580 {
1581   int exp = 0;
1582
1583   get_zero (r, 0);
1584
1585   if (*str == '-')
1586     {
1587       r->sign = 1;
1588       str++;
1589     }
1590   else if (*str == '+')
1591     str++;
1592
1593   if (str[0] == '0' && str[1] == 'x')
1594     {
1595       /* Hexadecimal floating point.  */
1596       int pos = SIGNIFICAND_BITS - 4, d;
1597
1598       str += 2;
1599
1600       while (*str == '0')
1601         str++;
1602       while (1)
1603         {
1604           d = hex_value (*str);
1605           if (d == _hex_bad)
1606             break;
1607           if (pos >= 0)
1608             {
1609               r->sig[pos / HOST_BITS_PER_LONG]
1610                 |= (unsigned long) d << (pos % HOST_BITS_PER_LONG);
1611               pos -= 4;
1612             }
1613           exp += 4;
1614           str++;
1615         }
1616       if (*str == '.')
1617         {
1618           str++;
1619           while (1)
1620             {
1621               d = hex_value (*str);
1622               if (d == _hex_bad)
1623                 break;
1624               if (pos >= 0)
1625                 {
1626                   r->sig[pos / HOST_BITS_PER_LONG]
1627                     |= (unsigned long) d << (pos % HOST_BITS_PER_LONG);
1628                   pos -= 4;
1629                 }
1630               str++;
1631             }
1632         }
1633       if (*str == 'p' || *str == 'P')
1634         {
1635           int exp_neg = 0;
1636
1637           str++;
1638           if (*str == '-')
1639             {
1640               exp_neg = 1;
1641               str++;
1642             }
1643           else if (*str == '+')
1644             str++;
1645
1646           d = 0;
1647           while (ISDIGIT (*str))
1648             {
1649               int t = d;
1650               d *= 10;
1651               d += *str - '0';
1652               if (d < t)
1653                 {
1654                   /* Overflowed the exponent.  */
1655                   if (exp_neg)
1656                     goto underflow;
1657                   else
1658                     goto overflow;
1659                 }
1660               str++;
1661             }
1662           if (exp_neg)
1663             d = -d;
1664
1665           exp += d;
1666         }
1667
1668       r->class = rvc_normal;
1669       r->exp = exp;
1670       if (r->exp != exp)
1671         {
1672           if (exp < 0)
1673             goto underflow;
1674           else
1675             goto overflow;
1676         }
1677
1678       normalize (r);
1679     }
1680   else
1681     {
1682       /* Decimal floating point.  */
1683       const REAL_VALUE_TYPE *ten = ten_to_ptwo (0);
1684       int d;
1685
1686       while (*str == '0')
1687         str++;
1688       while (ISDIGIT (*str))
1689         {
1690           d = *str++ - '0';
1691           do_multiply (r, r, ten);
1692           if (d)
1693             do_add (r, r, real_digit (d), 0);
1694         }
1695       if (*str == '.')
1696         {
1697           str++;
1698           while (ISDIGIT (*str))
1699             {
1700               d = *str++ - '0';
1701               do_multiply (r, r, ten);
1702               if (d)
1703                 do_add (r, r, real_digit (d), 0);
1704               exp--;
1705             }
1706         }
1707
1708       if (*str == 'e' || *str == 'E')
1709         {
1710           int exp_neg = 0;
1711
1712           str++;
1713           if (*str == '-')
1714             {
1715               exp_neg = 1;
1716               str++;
1717             }
1718           else if (*str == '+')
1719             str++;
1720
1721           d = 0;
1722           while (ISDIGIT (*str))
1723             {
1724               int t = d;
1725               d *= 10;
1726               d += *str - '0';
1727               if (d < t)
1728                 {
1729                   /* Overflowed the exponent.  */
1730                   if (exp_neg)
1731                     goto underflow;
1732                   else
1733                     goto overflow;
1734                 }
1735               str++;
1736             }
1737           if (exp_neg)
1738             d = -d;
1739           exp += d;
1740         }
1741
1742       if (exp < 0)
1743         {
1744           exp = -exp;
1745           for (d = 0; d < EXP_BITS; ++d)
1746             if (exp & (1 << d))
1747               do_divide (r, r, ten_to_ptwo (d));
1748         }
1749       else if (exp > 0)
1750         {
1751           for (d = 0; d < EXP_BITS; ++d)
1752             if (exp & (1 << d))
1753               do_multiply (r, r, ten_to_ptwo (d));
1754         }
1755     }
1756
1757   return;
1758
1759  underflow:
1760   get_zero (r, r->sign);
1761   return;
1762
1763  overflow:
1764   get_inf (r, r->sign);
1765   return;
1766 }
1767
1768 /* Legacy.  Similar, but return the result directly.  */
1769
1770 REAL_VALUE_TYPE
1771 real_from_string2 (s, mode)
1772      const char *s;
1773      enum machine_mode mode;
1774 {
1775   REAL_VALUE_TYPE r;
1776
1777   real_from_string (&r, s);
1778   if (mode != VOIDmode)
1779     real_convert (&r, mode, &r);
1780
1781   return r;
1782 }
1783
1784 /* Initialize R from the integer pair HIGH+LOW.  */
1785
1786 void
1787 real_from_integer (r, mode, low, high, unsigned_p)
1788      REAL_VALUE_TYPE *r;
1789      enum machine_mode mode;
1790      unsigned HOST_WIDE_INT low;
1791      HOST_WIDE_INT high;
1792      int unsigned_p;
1793 {
1794   if (low == 0 && high == 0)
1795     get_zero (r, 0);
1796   else
1797     {
1798       r->class = rvc_normal;
1799       r->sign = high < 0 && !unsigned_p;
1800       r->exp = 2 * HOST_BITS_PER_WIDE_INT;
1801
1802       if (r->sign)
1803         {
1804           high = ~high;
1805           if (low == 0)
1806             high += 1;
1807           else
1808             low = -low;
1809         }
1810
1811       if (HOST_BITS_PER_LONG == HOST_BITS_PER_WIDE_INT)
1812         {
1813           r->sig[SIGSZ-1] = high;
1814           r->sig[SIGSZ-2] = low;
1815           memset (r->sig, 0, sizeof(long)*(SIGSZ-2));
1816         }
1817       else if (HOST_BITS_PER_LONG*2 == HOST_BITS_PER_WIDE_INT)
1818         {
1819           r->sig[SIGSZ-1] = high >> (HOST_BITS_PER_LONG - 1) >> 1;
1820           r->sig[SIGSZ-2] = high;
1821           r->sig[SIGSZ-3] = low >> (HOST_BITS_PER_LONG - 1) >> 1;
1822           r->sig[SIGSZ-4] = low;
1823           if (SIGSZ > 4)
1824             memset (r->sig, 0, sizeof(long)*(SIGSZ-4));
1825         }
1826       else
1827         abort ();
1828
1829       normalize (r);
1830     }
1831
1832   if (mode != VOIDmode)
1833     real_convert (r, mode, r);
1834 }
1835
1836 /* Returns 10**2**n.  */
1837
1838 static const REAL_VALUE_TYPE *
1839 ten_to_ptwo (n)
1840      int n;
1841 {
1842   static REAL_VALUE_TYPE tens[EXP_BITS];
1843
1844   if (n < 0 || n >= EXP_BITS)
1845     abort ();
1846
1847   if (tens[n].class == rvc_zero)
1848     {
1849       if (n < (HOST_BITS_PER_WIDE_INT == 64 ? 5 : 4))
1850         {
1851           HOST_WIDE_INT t = 10;
1852           int i;
1853
1854           for (i = 0; i < n; ++i)
1855             t *= t;
1856
1857           real_from_integer (&tens[n], VOIDmode, t, 0, 1);
1858         }
1859       else
1860         {
1861           const REAL_VALUE_TYPE *t = ten_to_ptwo (n - 1);
1862           do_multiply (&tens[n], t, t);
1863         }
1864     }
1865
1866   return &tens[n];
1867 }
1868
1869 /* Returns N.  */
1870
1871 static const REAL_VALUE_TYPE *
1872 real_digit (n)
1873      int n;
1874 {
1875   static REAL_VALUE_TYPE num[10];
1876
1877   if (n < 0 || n > 9)
1878     abort ();
1879
1880   if (n > 0 && num[n].class == rvc_zero)
1881     real_from_integer (&num[n], VOIDmode, n, 0, 1);
1882
1883   return &num[n];
1884 }
1885
1886 /* Fills R with +Inf.  */
1887
1888 void
1889 real_inf (r)
1890      REAL_VALUE_TYPE *r;
1891 {
1892   get_inf (r, 0);
1893 }
1894
1895 /* Fills R with a NaN whose significand is described by STR.  If QUIET,
1896    we force a QNaN, else we force an SNaN.  The string, if not empty,
1897    is parsed as a number and placed in the significand.  Return true
1898    if the string was successfully parsed.  */
1899
1900 bool
1901 real_nan (r, str, quiet, mode)
1902      REAL_VALUE_TYPE *r;
1903      const char *str;
1904      int quiet;
1905      enum machine_mode mode;
1906 {
1907   const struct real_format *fmt;
1908
1909   fmt = real_format_for_mode[mode - QFmode];
1910   if (fmt == NULL)
1911     abort ();
1912
1913   if (*str == 0)
1914     {
1915       if (quiet)
1916         get_canonical_qnan (r, 0);
1917       else
1918         get_canonical_snan (r, 0);
1919     }
1920   else
1921     {
1922       int base = 10, d;
1923       bool neg = false;
1924
1925       memset (r, 0, sizeof (*r));
1926       r->class = rvc_nan;
1927
1928       /* Parse akin to strtol into the significand of R.  */
1929
1930       while (ISSPACE (*str))
1931         str++;
1932       if (*str == '-')
1933         str++, neg = true;
1934       else if (*str == '+')
1935         str++;
1936       if (*str == '0')
1937         {
1938           if (*++str == 'x')
1939             str++, base = 16;
1940           else
1941             base = 8;
1942         }
1943
1944       while ((d = hex_value (*str)) < base)
1945         {
1946           REAL_VALUE_TYPE u;
1947
1948           switch (base)
1949             {
1950             case 8:
1951               lshift_significand (r, r, 3);
1952               break;
1953             case 16:
1954               lshift_significand (r, r, 4);
1955               break;
1956             case 10:
1957               lshift_significand_1 (&u, r);
1958               lshift_significand (r, r, 3);
1959               add_significands (r, r, &u);
1960               break;
1961             default:
1962               abort ();
1963             }
1964
1965           get_zero (&u, 0);
1966           u.sig[0] = d;
1967           add_significands (r, r, &u);
1968
1969           str++;
1970         }
1971
1972       /* Must have consumed the entire string for success.  */
1973       if (*str != 0)
1974         return false;
1975
1976       /* Shift the significand into place such that the bits
1977          are in the most significant bits for the format.  */
1978       lshift_significand (r, r, SIGNIFICAND_BITS - fmt->p);
1979
1980       /* Our MSB is always unset for NaNs.  */
1981       r->sig[SIGSZ-1] &= ~SIG_MSB;
1982
1983       /* Force quiet or signalling NaN.  */
1984       if (quiet)
1985         r->sig[SIGSZ-1] |= SIG_MSB >> 1;
1986       else
1987         r->sig[SIGSZ-1] &= ~(SIG_MSB >> 1);
1988
1989       /* Force at least one bit of the significand set.  */
1990       for (d = 0; d < SIGSZ; ++d)
1991         if (r->sig[d])
1992           break;
1993       if (d == SIGSZ)
1994         r->sig[SIGSZ-1] |= SIG_MSB >> 2;
1995
1996       /* Our intermediate format forces QNaNs to have MSB-1 set.
1997          If the target format has QNaNs with the top bit unset,
1998          mirror the output routines and invert the top two bits.  */
1999       if (!fmt->qnan_msb_set)
2000         r->sig[SIGSZ-1] ^= (SIG_MSB >> 1) | (SIG_MSB >> 2);
2001     }
2002
2003   return true;
2004 }
2005
2006 /* Fills R with 2**N.  */
2007
2008 void
2009 real_2expN (r, n)
2010      REAL_VALUE_TYPE *r;
2011      int n;
2012 {
2013   memset (r, 0, sizeof (*r));
2014
2015   n++;
2016   if (n > MAX_EXP)
2017     r->class = rvc_inf;
2018   else if (n < -MAX_EXP)
2019     ;
2020   else
2021     {
2022       r->class = rvc_normal;
2023       r->exp = n;
2024       r->sig[SIGSZ-1] = SIG_MSB;
2025     }
2026 }
2027
2028 \f
2029 static void
2030 round_for_format (fmt, r)
2031      const struct real_format *fmt;
2032      REAL_VALUE_TYPE *r;
2033 {
2034   int p2, np2, i, w;
2035   unsigned long sticky;
2036   bool guard, lsb;
2037   int emin2m1, emax2;
2038
2039   p2 = fmt->p * fmt->log2_b;
2040   emin2m1 = (fmt->emin - 1) * fmt->log2_b;
2041   emax2 = fmt->emax * fmt->log2_b;
2042
2043   np2 = SIGNIFICAND_BITS - p2;
2044   switch (r->class)
2045     {
2046     underflow:
2047       get_zero (r, r->sign);
2048     case rvc_zero:
2049       if (!fmt->has_signed_zero)
2050         r->sign = 0;
2051       return;
2052
2053     overflow:
2054       get_inf (r, r->sign);
2055     case rvc_inf:
2056       return;
2057
2058     case rvc_nan:
2059       clear_significand_below (r, np2);
2060
2061       /* If we've cleared the entire significand, we need one bit
2062          set for this to continue to be a NaN.  */
2063       for (i = 0; i < SIGSZ; ++i)
2064         if (r->sig[i])
2065           break;
2066       if (i == SIGSZ)
2067         r->sig[SIGSZ-1] = SIG_MSB >> 2;
2068       return;
2069
2070     case rvc_normal:
2071       break;
2072
2073     default:
2074       abort ();
2075     }
2076
2077   /* If we're not base2, normalize the exponent to a multiple of
2078      the true base.  */
2079   if (fmt->log2_b != 1)
2080     {
2081       int shift = r->exp & (fmt->log2_b - 1);
2082       if (shift)
2083         {
2084           shift = fmt->log2_b - shift;
2085           sticky_rshift_significand (r, r, shift);
2086           r->exp += shift;
2087         }
2088     }
2089
2090   /* Check the range of the exponent.  If we're out of range,
2091      either underflow or overflow.  */
2092   if (r->exp > emax2)
2093     goto overflow;
2094   else if (r->exp <= emin2m1)
2095     {
2096       int diff;
2097
2098       if (!fmt->has_denorm)
2099         {
2100           /* Don't underflow completely until we've had a chance to round.  */
2101           if (r->exp < emin2m1)
2102             goto underflow;
2103         }
2104       else
2105         {
2106           diff = emin2m1 - r->exp + 1;
2107           if (diff > p2)
2108             goto underflow;
2109
2110           /* De-normalize the significand.  */
2111           sticky_rshift_significand (r, r, diff);
2112           r->exp += diff;
2113         }
2114     }
2115
2116   /* There are P2 true significand bits, followed by one guard bit,
2117      followed by one sticky bit, followed by stuff.  Fold non-zero
2118      stuff into the sticky bit.  */
2119
2120   sticky = 0;
2121   for (i = 0, w = (np2 - 1) / HOST_BITS_PER_LONG; i < w; ++i)
2122     sticky |= r->sig[i];
2123   sticky |=
2124     r->sig[w] & (((unsigned long)1 << ((np2 - 1) % HOST_BITS_PER_LONG)) - 1);
2125
2126   guard = test_significand_bit (r, np2 - 1);
2127   lsb = test_significand_bit (r, np2);
2128
2129   /* Round to even.  */
2130   if (guard && (sticky || lsb))
2131     {
2132       REAL_VALUE_TYPE u;
2133       get_zero (&u, 0);
2134       set_significand_bit (&u, np2);
2135
2136       if (add_significands (r, r, &u))
2137         {
2138           /* Overflow.  Means the significand had been all ones, and
2139              is now all zeros.  Need to increase the exponent, and
2140              possibly re-normalize it.  */
2141           if (++r->exp > emax2)
2142             goto overflow;
2143           r->sig[SIGSZ-1] = SIG_MSB;
2144
2145           if (fmt->log2_b != 1)
2146             {
2147               int shift = r->exp & (fmt->log2_b - 1);
2148               if (shift)
2149                 {
2150                   shift = fmt->log2_b - shift;
2151                   sticky_rshift_significand (r, r, shift);
2152                   r->exp += shift;
2153                   if (r->exp > emax2)
2154                     goto overflow;
2155                 }
2156             }
2157         }
2158     }
2159
2160   /* Catch underflow that we deferred until after rounding.  */
2161   if (r->exp <= emin2m1)
2162     goto underflow;
2163
2164   /* Clear out trailing garbage.  */
2165   clear_significand_below (r, np2);
2166 }
2167
2168 /* Extend or truncate to a new mode.  */
2169
2170 void
2171 real_convert (r, mode, a)
2172      REAL_VALUE_TYPE *r;
2173      enum machine_mode mode;
2174      const REAL_VALUE_TYPE *a;
2175 {
2176   const struct real_format *fmt;
2177
2178   fmt = real_format_for_mode[mode - QFmode];
2179   if (fmt == NULL)
2180     abort ();
2181
2182   *r = *a;
2183   round_for_format (fmt, r);
2184
2185   /* round_for_format de-normalizes denormals.  Undo just that part.  */
2186   if (r->class == rvc_normal)
2187     normalize (r);
2188 }
2189
2190 /* Legacy.  Likewise, except return the struct directly.  */
2191
2192 REAL_VALUE_TYPE
2193 real_value_truncate (mode, a)
2194      enum machine_mode mode;
2195      REAL_VALUE_TYPE a;
2196 {
2197   REAL_VALUE_TYPE r;
2198   real_convert (&r, mode, &a);
2199   return r;
2200 }
2201
2202 /* Return true if truncating to MODE is exact.  */
2203
2204 bool
2205 exact_real_truncate (mode, a)
2206      enum machine_mode mode;
2207      const REAL_VALUE_TYPE *a;
2208 {
2209   REAL_VALUE_TYPE t;
2210   real_convert (&t, mode, a);
2211   return real_identical (&t, a);
2212 }
2213
2214 /* Write R to the given target format.  Place the words of the result
2215    in target word order in BUF.  There are always 32 bits in each
2216    long, no matter the size of the host long.
2217
2218    Legacy: return word 0 for implementing REAL_VALUE_TO_TARGET_SINGLE.  */
2219
2220 long
2221 real_to_target_fmt (buf, r_orig, fmt)
2222      long *buf;
2223      const REAL_VALUE_TYPE *r_orig;
2224      const struct real_format *fmt;
2225 {
2226   REAL_VALUE_TYPE r;
2227   long buf1;
2228
2229   r = *r_orig;
2230   round_for_format (fmt, &r);
2231
2232   if (!buf)
2233     buf = &buf1;
2234   (*fmt->encode) (fmt, buf, &r);
2235
2236   return *buf;
2237 }
2238
2239 /* Similar, but look up the format from MODE.  */
2240
2241 long
2242 real_to_target (buf, r, mode)
2243      long *buf;
2244      const REAL_VALUE_TYPE *r;
2245      enum machine_mode mode;
2246 {
2247   const struct real_format *fmt;
2248
2249   fmt = real_format_for_mode[mode - QFmode];
2250   if (fmt == NULL)
2251     abort ();
2252
2253   return real_to_target_fmt (buf, r, fmt);
2254 }
2255
2256 /* Read R from the given target format.  Read the words of the result
2257    in target word order in BUF.  There are always 32 bits in each
2258    long, no matter the size of the host long.  */
2259
2260 void
2261 real_from_target_fmt (r, buf, fmt)
2262      REAL_VALUE_TYPE *r;
2263      const long *buf;
2264      const struct real_format *fmt;
2265 {
2266   (*fmt->decode) (fmt, r, buf);
2267 }     
2268
2269 /* Similar, but look up the format from MODE.  */
2270
2271 void
2272 real_from_target (r, buf, mode)
2273      REAL_VALUE_TYPE *r;
2274      const long *buf;
2275      enum machine_mode mode;
2276 {
2277   const struct real_format *fmt;
2278
2279   fmt = real_format_for_mode[mode - QFmode];
2280   if (fmt == NULL)
2281     abort ();
2282
2283   (*fmt->decode) (fmt, r, buf);
2284 }     
2285
2286 /* Return the number of bits in the significand for MODE.  */
2287 /* ??? Legacy.  Should get access to real_format directly.  */
2288
2289 int
2290 significand_size (mode)
2291      enum machine_mode mode;
2292 {
2293   const struct real_format *fmt;
2294
2295   fmt = real_format_for_mode[mode - QFmode];
2296   if (fmt == NULL)
2297     return 0;
2298
2299   return fmt->p * fmt->log2_b;
2300 }
2301
2302 /* Return a hash value for the given real value.  */
2303 /* ??? The "unsigned int" return value is intended to be hashval_t,
2304    but I didn't want to pull hashtab.h into real.h.  */
2305
2306 unsigned int
2307 real_hash (r)
2308      const REAL_VALUE_TYPE *r;
2309 {
2310   unsigned int h;
2311   size_t i;
2312
2313   h = r->class | (r->sign << 2);
2314   switch (r->class)
2315     {
2316     case rvc_zero:
2317     case rvc_inf:
2318       break;
2319
2320     case rvc_normal:
2321       h |= r->exp << 3;
2322       /* FALLTHRU */
2323
2324     case rvc_nan:
2325       if (sizeof(unsigned long) > sizeof(unsigned int))
2326         for (i = 0; i < SIGSZ; ++i)
2327           {
2328             unsigned long s = r->sig[i];
2329             h ^= s ^ (s >> (HOST_BITS_PER_LONG / 2));
2330           }
2331       else
2332         for (i = 0; i < SIGSZ; ++i)
2333           h ^= r->sig[i];
2334       break;
2335
2336     default:
2337       abort ();
2338     }
2339
2340   return h;
2341 }
2342 \f
2343 /* IEEE single-precision format.  */
2344
2345 static void encode_ieee_single PARAMS ((const struct real_format *fmt,
2346                                         long *, const REAL_VALUE_TYPE *));
2347 static void decode_ieee_single PARAMS ((const struct real_format *,
2348                                         REAL_VALUE_TYPE *, const long *));
2349
2350 static void
2351 encode_ieee_single (fmt, buf, r)
2352      const struct real_format *fmt;
2353      long *buf;
2354      const REAL_VALUE_TYPE *r;
2355 {
2356   unsigned long image, sig, exp;
2357   bool denormal = (r->sig[SIGSZ-1] & SIG_MSB) == 0;
2358
2359   image = r->sign << 31;
2360   sig = (r->sig[SIGSZ-1] >> (HOST_BITS_PER_LONG - 24)) & 0x7fffff;
2361
2362   switch (r->class)
2363     {
2364     case rvc_zero:
2365       break;
2366
2367     case rvc_inf:
2368       if (fmt->has_inf)
2369         image |= 255 << 23;
2370       else
2371         image |= 0x7fffffff;
2372       break;
2373
2374     case rvc_nan:
2375       if (fmt->has_nans)
2376         {
2377           image |= 255 << 23;
2378           image |= sig;
2379           if (!fmt->qnan_msb_set)
2380             image ^= 1 << 23 | 1 << 22;
2381         }
2382       else
2383         image |= 0x7fffffff;
2384       break;
2385
2386     case rvc_normal:
2387       /* Recall that IEEE numbers are interpreted as 1.F x 2**exp,
2388          whereas the intermediate representation is 0.F x 2**exp.
2389          Which means we're off by one.  */
2390       if (denormal)
2391         exp = 0;
2392       else
2393       exp = r->exp + 127 - 1;
2394       image |= exp << 23;
2395       image |= sig;
2396       break;
2397
2398     default:
2399       abort ();
2400     }
2401
2402   buf[0] = image;
2403 }
2404
2405 static void
2406 decode_ieee_single (fmt, r, buf)
2407      const struct real_format *fmt;
2408      REAL_VALUE_TYPE *r;
2409      const long *buf;
2410 {
2411   unsigned long image = buf[0] & 0xffffffff;
2412   bool sign = (image >> 31) & 1;
2413   int exp = (image >> 23) & 0xff;
2414
2415   memset (r, 0, sizeof (*r));
2416   image <<= HOST_BITS_PER_LONG - 24;
2417   image &= ~SIG_MSB;
2418
2419   if (exp == 0)
2420     {
2421       if (image && fmt->has_denorm)
2422         {
2423           r->class = rvc_normal;
2424           r->sign = sign;
2425           r->exp = -126;
2426           r->sig[SIGSZ-1] = image << 1;
2427           normalize (r);
2428         }
2429       else if (fmt->has_signed_zero)
2430         r->sign = sign;
2431     }
2432   else if (exp == 255 && (fmt->has_nans || fmt->has_inf))
2433     {
2434       if (image)
2435         {
2436           r->class = rvc_nan;
2437           r->sign = sign;
2438           if (!fmt->qnan_msb_set)
2439             image ^= (SIG_MSB >> 1 | SIG_MSB >> 2);
2440           r->sig[SIGSZ-1] = image;
2441         }
2442       else
2443         {
2444           r->class = rvc_inf;
2445           r->sign = sign;
2446         }
2447     }
2448   else
2449     {
2450       r->class = rvc_normal;
2451       r->sign = sign;
2452       r->exp = exp - 127 + 1;
2453       r->sig[SIGSZ-1] = image | SIG_MSB;
2454     }
2455 }
2456
2457 const struct real_format ieee_single_format = 
2458   {
2459     encode_ieee_single,
2460     decode_ieee_single,
2461     2,
2462     1,
2463     24,
2464     -125,
2465     128,
2466     true,
2467     true,
2468     true,
2469     true,
2470     true
2471   };
2472
2473 \f
2474 /* IEEE double-precision format.  */
2475
2476 static void encode_ieee_double PARAMS ((const struct real_format *fmt,
2477                                         long *, const REAL_VALUE_TYPE *));
2478 static void decode_ieee_double PARAMS ((const struct real_format *,
2479                                         REAL_VALUE_TYPE *, const long *));
2480
2481 static void
2482 encode_ieee_double (fmt, buf, r)
2483      const struct real_format *fmt;
2484      long *buf;
2485      const REAL_VALUE_TYPE *r;
2486 {
2487   unsigned long image_lo, image_hi, sig_lo, sig_hi, exp;
2488   bool denormal = (r->sig[SIGSZ-1] & SIG_MSB) == 0;
2489
2490   image_hi = r->sign << 31;
2491   image_lo = 0;
2492
2493   if (HOST_BITS_PER_LONG == 64)
2494     {
2495       sig_hi = r->sig[SIGSZ-1];
2496       sig_lo = (sig_hi >> (64 - 53)) & 0xffffffff;
2497       sig_hi = (sig_hi >> (64 - 53 + 1) >> 31) & 0xfffff;
2498     }
2499   else
2500     {
2501       sig_hi = r->sig[SIGSZ-1];
2502       sig_lo = r->sig[SIGSZ-2];
2503       sig_lo = (sig_hi << 21) | (sig_lo >> 11);
2504       sig_hi = (sig_hi >> 11) & 0xfffff;
2505     }
2506
2507   switch (r->class)
2508     {
2509     case rvc_zero:
2510       break;
2511
2512     case rvc_inf:
2513       if (fmt->has_inf)
2514         image_hi |= 2047 << 20;
2515       else
2516         {
2517           image_hi |= 0x7fffffff;
2518           image_lo = 0xffffffff;
2519         }
2520       break;
2521
2522     case rvc_nan:
2523       if (fmt->has_nans)
2524         {
2525           image_hi |= 2047 << 20;
2526           image_hi |= sig_hi;
2527           if (!fmt->qnan_msb_set)
2528             image_hi ^= 1 << 19 | 1 << 18;
2529           image_lo = sig_lo;
2530         }
2531       else
2532         {
2533           image_hi |= 0x7fffffff;
2534           image_lo = 0xffffffff;
2535         }
2536       break;
2537
2538     case rvc_normal:
2539       /* Recall that IEEE numbers are interpreted as 1.F x 2**exp,
2540          whereas the intermediate representation is 0.F x 2**exp.
2541          Which means we're off by one.  */
2542       if (denormal)
2543         exp = 0;
2544       else
2545         exp = r->exp + 1023 - 1;
2546       image_hi |= exp << 20;
2547       image_hi |= sig_hi;
2548       image_lo = sig_lo;
2549       break;
2550
2551     default:
2552       abort ();
2553     }
2554
2555   if (FLOAT_WORDS_BIG_ENDIAN)
2556     buf[0] = image_hi, buf[1] = image_lo;
2557   else
2558     buf[0] = image_lo, buf[1] = image_hi;
2559 }
2560
2561 static void
2562 decode_ieee_double (fmt, r, buf)
2563      const struct real_format *fmt;
2564      REAL_VALUE_TYPE *r;
2565      const long *buf;
2566 {
2567   unsigned long image_hi, image_lo;
2568   bool sign;
2569   int exp;
2570
2571   if (FLOAT_WORDS_BIG_ENDIAN)
2572     image_hi = buf[0], image_lo = buf[1];
2573   else
2574     image_lo = buf[0], image_hi = buf[1];
2575   image_lo &= 0xffffffff;
2576   image_hi &= 0xffffffff;
2577
2578   sign = (image_hi >> 31) & 1;
2579   exp = (image_hi >> 20) & 0x7ff;
2580
2581   memset (r, 0, sizeof (*r));
2582
2583   image_hi <<= 32 - 21;
2584   image_hi |= image_lo >> 21;
2585   image_hi &= 0x7fffffff;
2586   image_lo <<= 32 - 21;
2587
2588   if (exp == 0)
2589     {
2590       if ((image_hi || image_lo) && fmt->has_denorm)
2591         {
2592           r->class = rvc_normal;
2593           r->sign = sign;
2594           r->exp = -1022;
2595           if (HOST_BITS_PER_LONG == 32)
2596             {
2597               image_hi = (image_hi << 1) | (image_lo >> 31);
2598               image_lo <<= 1;
2599               r->sig[SIGSZ-1] = image_hi;
2600               r->sig[SIGSZ-2] = image_lo;
2601             }
2602           else
2603             {
2604               image_hi = (image_hi << 31 << 2) | (image_lo << 1);
2605               r->sig[SIGSZ-1] = image_hi;
2606             }
2607           normalize (r);
2608         }
2609       else if (fmt->has_signed_zero)
2610         r->sign = sign;
2611     }
2612   else if (exp == 2047 && (fmt->has_nans || fmt->has_inf))
2613     {
2614       if (image_hi || image_lo)
2615         {
2616           r->class = rvc_nan;
2617           r->sign = sign;
2618           if (HOST_BITS_PER_LONG == 32)
2619             {
2620               r->sig[SIGSZ-1] = image_hi;
2621               r->sig[SIGSZ-2] = image_lo;
2622             }
2623           else
2624             r->sig[SIGSZ-1] = (image_hi << 31 << 1) | image_lo;
2625
2626           if (!fmt->qnan_msb_set)
2627             r->sig[SIGSZ-1] ^= (SIG_MSB >> 1 | SIG_MSB >> 2);
2628         }
2629       else
2630         {
2631           r->class = rvc_inf;
2632           r->sign = sign;
2633         }
2634     }
2635   else
2636     {
2637       r->class = rvc_normal;
2638       r->sign = sign;
2639       r->exp = exp - 1023 + 1;
2640       if (HOST_BITS_PER_LONG == 32)
2641         {
2642           r->sig[SIGSZ-1] = image_hi | SIG_MSB;
2643           r->sig[SIGSZ-2] = image_lo;
2644         }
2645       else
2646         r->sig[SIGSZ-1] = (image_hi << 31 << 1) | image_lo | SIG_MSB;
2647     }
2648 }
2649
2650 const struct real_format ieee_double_format = 
2651   {
2652     encode_ieee_double,
2653     decode_ieee_double,
2654     2,
2655     1,
2656     53,
2657     -1021,
2658     1024,
2659     true,
2660     true,
2661     true,
2662     true,
2663     true
2664   };
2665
2666 \f
2667 /* IEEE extended double precision format.  This comes in three
2668    flavours: Intel's as a 12 byte image, Intel's as a 16 byte image,
2669    and Motorola's.  */
2670
2671 static void encode_ieee_extended PARAMS ((const struct real_format *fmt,
2672                                           long *, const REAL_VALUE_TYPE *));
2673 static void decode_ieee_extended PARAMS ((const struct real_format *,
2674                                           REAL_VALUE_TYPE *, const long *));
2675
2676 static void encode_ieee_extended_128 PARAMS ((const struct real_format *fmt,
2677                                               long *,
2678                                               const REAL_VALUE_TYPE *));
2679 static void decode_ieee_extended_128 PARAMS ((const struct real_format *,
2680                                               REAL_VALUE_TYPE *,
2681                                               const long *));
2682
2683 static void
2684 encode_ieee_extended (fmt, buf, r)
2685      const struct real_format *fmt;
2686      long *buf;
2687      const REAL_VALUE_TYPE *r;
2688 {
2689   unsigned long image_hi, sig_hi, sig_lo;
2690   bool denormal = (r->sig[SIGSZ-1] & SIG_MSB) == 0;
2691
2692   image_hi = r->sign << 15;
2693   sig_hi = sig_lo = 0;
2694
2695   switch (r->class)
2696     {
2697     case rvc_zero:
2698       break;
2699
2700     case rvc_inf:
2701       if (fmt->has_inf)
2702         {
2703           image_hi |= 32767;
2704
2705           /* Intel requires the explicit integer bit to be set, otherwise
2706              it considers the value a "pseudo-infinity".  Motorola docs
2707              say it doesn't care.  */
2708           sig_hi = 0x80000000;
2709         }
2710       else
2711         {
2712           image_hi |= 32767;
2713           sig_lo = sig_hi = 0xffffffff;
2714         }
2715       break;
2716
2717     case rvc_nan:
2718       if (fmt->has_nans)
2719         {
2720           image_hi |= 32767;
2721           if (HOST_BITS_PER_LONG == 32)
2722             {
2723               sig_hi = r->sig[SIGSZ-1];
2724               sig_lo = r->sig[SIGSZ-2];
2725             }
2726           else
2727             {
2728               sig_lo = r->sig[SIGSZ-1];
2729               sig_hi = sig_lo >> 31 >> 1;
2730               sig_lo &= 0xffffffff;
2731             }
2732           if (!fmt->qnan_msb_set)
2733             sig_hi ^= 1 << 30 | 1 << 29;
2734
2735           /* Intel requires the explicit integer bit to be set, otherwise
2736              it considers the value a "pseudo-nan".  Motorola docs say it
2737              doesn't care.  */
2738           sig_hi |= 0x80000000;
2739         }
2740       else
2741         {
2742           image_hi |= 32767;
2743           sig_lo = sig_hi = 0xffffffff;
2744         }
2745       break;
2746
2747     case rvc_normal:
2748       {
2749         int exp = r->exp;
2750
2751         /* Recall that IEEE numbers are interpreted as 1.F x 2**exp,
2752            whereas the intermediate representation is 0.F x 2**exp.
2753            Which means we're off by one. 
2754
2755            Except for Motorola, which consider exp=0 and explicit
2756            integer bit set to continue to be normalized.  In theory
2757            this descrepency has been taken care of by the difference
2758            in fmt->emin in round_for_format.  */
2759
2760         if (denormal)
2761           exp = 0;
2762         else
2763           {
2764             exp += 16383 - 1;
2765             if (exp < 0)
2766               abort ();
2767           }
2768         image_hi |= exp;
2769
2770         if (HOST_BITS_PER_LONG == 32)
2771           {
2772             sig_hi = r->sig[SIGSZ-1];
2773             sig_lo = r->sig[SIGSZ-2];
2774           }
2775         else
2776           {
2777             sig_lo = r->sig[SIGSZ-1];
2778             sig_hi = sig_lo >> 31 >> 1;
2779             sig_lo &= 0xffffffff;
2780           }
2781       }
2782       break;
2783
2784     default:
2785       abort ();
2786     }
2787
2788   if (FLOAT_WORDS_BIG_ENDIAN)
2789     buf[0] = image_hi << 16, buf[1] = sig_hi, buf[2] = sig_lo;
2790   else
2791     buf[0] = sig_lo, buf[1] = sig_hi, buf[2] = image_hi;
2792 }
2793
2794 static void
2795 encode_ieee_extended_128 (fmt, buf, r)
2796      const struct real_format *fmt;
2797      long *buf;
2798      const REAL_VALUE_TYPE *r;
2799 {
2800   buf[3 * !FLOAT_WORDS_BIG_ENDIAN] = 0;
2801   encode_ieee_extended (fmt, buf+!!FLOAT_WORDS_BIG_ENDIAN, r);
2802 }
2803
2804 static void
2805 decode_ieee_extended (fmt, r, buf)
2806      const struct real_format *fmt;
2807      REAL_VALUE_TYPE *r;
2808      const long *buf;
2809 {
2810   unsigned long image_hi, sig_hi, sig_lo;
2811   bool sign;
2812   int exp;
2813
2814   if (FLOAT_WORDS_BIG_ENDIAN)
2815     image_hi = buf[0] >> 16, sig_hi = buf[1], sig_lo = buf[2];
2816   else
2817     sig_lo = buf[0], sig_hi = buf[1], image_hi = buf[2];
2818   sig_lo &= 0xffffffff;
2819   sig_hi &= 0xffffffff;
2820   image_hi &= 0xffffffff;
2821
2822   sign = (image_hi >> 15) & 1;
2823   exp = image_hi & 0x7fff;
2824
2825   memset (r, 0, sizeof (*r));
2826
2827   if (exp == 0)
2828     {
2829       if ((sig_hi || sig_lo) && fmt->has_denorm)
2830         {
2831           r->class = rvc_normal;
2832           r->sign = sign;
2833
2834           /* When the IEEE format contains a hidden bit, we know that
2835              it's zero at this point, and so shift up the significand
2836              and decrease the exponent to match.  In this case, Motorola
2837              defines the explicit integer bit to be valid, so we don't
2838              know whether the msb is set or not.  */
2839           r->exp = fmt->emin;
2840           if (HOST_BITS_PER_LONG == 32)
2841             {
2842               r->sig[SIGSZ-1] = sig_hi;
2843               r->sig[SIGSZ-2] = sig_lo;
2844             }
2845           else
2846             r->sig[SIGSZ-1] = (sig_hi << 31 << 1) | sig_lo;
2847
2848           normalize (r);
2849         }
2850       else if (fmt->has_signed_zero)
2851         r->sign = sign;
2852     }
2853   else if (exp == 32767 && (fmt->has_nans || fmt->has_inf))
2854     {
2855       /* See above re "pseudo-infinities" and "pseudo-nans".
2856          Short summary is that the MSB will likely always be
2857          set, and that we don't care about it.  */
2858       sig_hi &= 0x7fffffff;
2859
2860       if (sig_hi || sig_lo)
2861         {
2862           r->class = rvc_nan;
2863           r->sign = sign;
2864           if (HOST_BITS_PER_LONG == 32)
2865             {
2866               r->sig[SIGSZ-1] = sig_hi;
2867               r->sig[SIGSZ-2] = sig_lo;
2868             }
2869           else
2870             r->sig[SIGSZ-1] = (sig_hi << 31 << 1) | sig_lo;
2871
2872           if (!fmt->qnan_msb_set)
2873             r->sig[SIGSZ-1] ^= (SIG_MSB >> 1 | SIG_MSB >> 2);
2874         }
2875       else
2876         {
2877           r->class = rvc_inf;
2878           r->sign = sign;
2879         }
2880     }
2881   else
2882     {
2883       r->class = rvc_normal;
2884       r->sign = sign;
2885       r->exp = exp - 16383 + 1;
2886       if (HOST_BITS_PER_LONG == 32)
2887         {
2888           r->sig[SIGSZ-1] = sig_hi;
2889           r->sig[SIGSZ-2] = sig_lo;
2890         }
2891       else
2892         r->sig[SIGSZ-1] = (sig_hi << 31 << 1) | sig_lo;
2893     }
2894 }
2895
2896 static void
2897 decode_ieee_extended_128 (fmt, r, buf)
2898      const struct real_format *fmt;
2899      REAL_VALUE_TYPE *r;
2900      const long *buf;
2901 {
2902   decode_ieee_extended (fmt, r, buf+!!FLOAT_WORDS_BIG_ENDIAN);
2903 }
2904
2905 const struct real_format ieee_extended_motorola_format = 
2906   {
2907     encode_ieee_extended,
2908     decode_ieee_extended,
2909     2,
2910     1,
2911     64,
2912     -16382,
2913     16384,
2914     true,
2915     true,
2916     true,
2917     true,
2918     true
2919   };
2920
2921 const struct real_format ieee_extended_intel_96_format = 
2922   {
2923     encode_ieee_extended,
2924     decode_ieee_extended,
2925     2,
2926     1,
2927     64,
2928     -16381,
2929     16384,
2930     true,
2931     true,
2932     true,
2933     true,
2934     true
2935   };
2936
2937 const struct real_format ieee_extended_intel_128_format = 
2938   {
2939     encode_ieee_extended_128,
2940     decode_ieee_extended_128,
2941     2,
2942     1,
2943     64,
2944     -16381,
2945     16384,
2946     true,
2947     true,
2948     true,
2949     true,
2950     true
2951   };
2952
2953 \f
2954 /* IEEE quad precision format.  */
2955
2956 static void encode_ieee_quad PARAMS ((const struct real_format *fmt,
2957                                       long *, const REAL_VALUE_TYPE *));
2958 static void decode_ieee_quad PARAMS ((const struct real_format *,
2959                                       REAL_VALUE_TYPE *, const long *));
2960
2961 static void
2962 encode_ieee_quad (fmt, buf, r)
2963      const struct real_format *fmt;
2964      long *buf;
2965      const REAL_VALUE_TYPE *r;
2966 {
2967   unsigned long image3, image2, image1, image0, exp;
2968   bool denormal = (r->sig[SIGSZ-1] & SIG_MSB) == 0;
2969   REAL_VALUE_TYPE u;
2970
2971   image3 = r->sign << 31;
2972   image2 = 0;
2973   image1 = 0;
2974   image0 = 0;
2975
2976   rshift_significand (&u, r, SIGNIFICAND_BITS - 113);
2977
2978   switch (r->class)
2979     {
2980     case rvc_zero:
2981       break;
2982
2983     case rvc_inf:
2984       if (fmt->has_inf)
2985         image3 |= 32767 << 16;
2986       else
2987         {
2988           image3 |= 0x7fffffff;
2989           image2 = 0xffffffff;
2990           image1 = 0xffffffff;
2991           image0 = 0xffffffff;
2992         }
2993       break;
2994
2995     case rvc_nan:
2996       if (fmt->has_nans)
2997         {
2998           image3 |= 32767 << 16;
2999
3000           if (HOST_BITS_PER_LONG == 32)
3001             {
3002               image0 = u.sig[0];
3003               image1 = u.sig[1];
3004               image2 = u.sig[2];
3005               image3 |= u.sig[3] & 0xffff;
3006             }
3007           else
3008             {
3009               image0 = u.sig[0];
3010               image1 = image0 >> 31 >> 1;
3011               image2 = u.sig[1];
3012               image3 |= (image2 >> 31 >> 1) & 0xffff;
3013               image0 &= 0xffffffff;
3014               image2 &= 0xffffffff;
3015             }
3016
3017           if (!fmt->qnan_msb_set)
3018             image3 ^= 1 << 15 | 1 << 14;
3019         }
3020       else
3021         {
3022           image3 |= 0x7fffffff;
3023           image2 = 0xffffffff;
3024           image1 = 0xffffffff;
3025           image0 = 0xffffffff;
3026         }
3027       break;
3028
3029     case rvc_normal:
3030       /* Recall that IEEE numbers are interpreted as 1.F x 2**exp,
3031          whereas the intermediate representation is 0.F x 2**exp.
3032          Which means we're off by one.  */
3033       if (denormal)
3034         exp = 0;
3035       else
3036         exp = r->exp + 16383 - 1;
3037       image3 |= exp << 16;
3038
3039       if (HOST_BITS_PER_LONG == 32)
3040         {
3041           image0 = u.sig[0];
3042           image1 = u.sig[1];
3043           image2 = u.sig[2];
3044           image3 |= u.sig[3] & 0xffff;
3045         }
3046       else
3047         {
3048           image0 = u.sig[0];
3049           image1 = image0 >> 31 >> 1;
3050           image2 = u.sig[1];
3051           image3 |= (image2 >> 31 >> 1) & 0xffff;
3052           image0 &= 0xffffffff;
3053           image2 &= 0xffffffff;
3054         }
3055       break;
3056
3057     default:
3058       abort ();
3059     }
3060
3061   if (FLOAT_WORDS_BIG_ENDIAN)
3062     {
3063       buf[0] = image3;
3064       buf[1] = image2;
3065       buf[2] = image1;
3066       buf[3] = image0;
3067     }
3068   else
3069     {
3070       buf[0] = image0;
3071       buf[1] = image1;
3072       buf[2] = image2;
3073       buf[3] = image3;
3074     }
3075 }
3076
3077 static void
3078 decode_ieee_quad (fmt, r, buf)
3079      const struct real_format *fmt;
3080      REAL_VALUE_TYPE *r;
3081      const long *buf;
3082 {
3083   unsigned long image3, image2, image1, image0;
3084   bool sign;
3085   int exp;
3086
3087   if (FLOAT_WORDS_BIG_ENDIAN)
3088     {
3089       image3 = buf[0];
3090       image2 = buf[1];
3091       image1 = buf[2];
3092       image0 = buf[3];
3093     }
3094   else
3095     {
3096       image0 = buf[0];
3097       image1 = buf[1];
3098       image2 = buf[2];
3099       image3 = buf[3];
3100     }
3101   image0 &= 0xffffffff;
3102   image1 &= 0xffffffff;
3103   image2 &= 0xffffffff;
3104
3105   sign = (image3 >> 31) & 1;
3106   exp = (image3 >> 16) & 0x7fff;
3107   image3 &= 0xffff;
3108
3109   memset (r, 0, sizeof (*r));
3110
3111   if (exp == 0)
3112     {
3113       if ((image3 | image2 | image1 | image0) && fmt->has_denorm)
3114         {
3115           r->class = rvc_normal;
3116           r->sign = sign;
3117
3118           r->exp = -16382 + (SIGNIFICAND_BITS - 112);
3119           if (HOST_BITS_PER_LONG == 32)
3120             {
3121               r->sig[0] = image0;
3122               r->sig[1] = image1;
3123               r->sig[2] = image2;
3124               r->sig[3] = image3;
3125             }
3126           else
3127             {
3128               r->sig[0] = (image1 << 31 << 1) | image0;
3129               r->sig[1] = (image3 << 31 << 1) | image2;
3130             }
3131
3132           normalize (r);
3133         }
3134       else if (fmt->has_signed_zero)
3135         r->sign = sign;
3136     }
3137   else if (exp == 32767 && (fmt->has_nans || fmt->has_inf))
3138     {
3139       if (image3 | image2 | image1 | image0)
3140         {
3141           r->class = rvc_nan;
3142           r->sign = sign;
3143
3144           if (HOST_BITS_PER_LONG == 32)
3145             {
3146               r->sig[0] = image0;
3147               r->sig[1] = image1;
3148               r->sig[2] = image2;
3149               r->sig[3] = image3;
3150             }
3151           else
3152             {
3153               r->sig[0] = (image1 << 31 << 1) | image0;
3154               r->sig[1] = (image3 << 31 << 1) | image2;
3155             }
3156           lshift_significand (r, r, SIGNIFICAND_BITS - 113);
3157
3158           if (!fmt->qnan_msb_set)
3159             r->sig[SIGSZ-1] ^= (SIG_MSB >> 1 | SIG_MSB >> 2);
3160         }
3161       else
3162         {
3163           r->class = rvc_inf;
3164           r->sign = sign;
3165         }
3166     }
3167   else
3168     {
3169       r->class = rvc_normal;
3170       r->sign = sign;
3171       r->exp = exp - 16383 + 1;
3172
3173       if (HOST_BITS_PER_LONG == 32)
3174         {
3175           r->sig[0] = image0;
3176           r->sig[1] = image1;
3177           r->sig[2] = image2;
3178           r->sig[3] = image3;
3179         }
3180       else
3181         {
3182           r->sig[0] = (image1 << 31 << 1) | image0;
3183           r->sig[1] = (image3 << 31 << 1) | image2;
3184         }
3185       lshift_significand (r, r, SIGNIFICAND_BITS - 113);
3186       r->sig[SIGSZ-1] |= SIG_MSB;
3187     }
3188 }
3189
3190 const struct real_format ieee_quad_format = 
3191   {
3192     encode_ieee_quad,
3193     decode_ieee_quad,
3194     2,
3195     1,
3196     113,
3197     -16381,
3198     16384,
3199     true,
3200     true,
3201     true,
3202     true,
3203     true
3204   };
3205 \f
3206 /* Descriptions of VAX floating point formats can be found beginning at
3207
3208    http://www.openvms.compaq.com:8000/73final/4515/4515pro_013.html#f_floating_point_format
3209
3210    The thing to remember is that they're almost IEEE, except for word
3211    order, exponent bias, and the lack of infinities, nans, and denormals.
3212
3213    We don't implement the H_floating format here, simply because neither
3214    the VAX or Alpha ports use it.  */
3215    
3216 static void encode_vax_f PARAMS ((const struct real_format *fmt,
3217                                   long *, const REAL_VALUE_TYPE *));
3218 static void decode_vax_f PARAMS ((const struct real_format *,
3219                                   REAL_VALUE_TYPE *, const long *));
3220 static void encode_vax_d PARAMS ((const struct real_format *fmt,
3221                                   long *, const REAL_VALUE_TYPE *));
3222 static void decode_vax_d PARAMS ((const struct real_format *,
3223                                   REAL_VALUE_TYPE *, const long *));
3224 static void encode_vax_g PARAMS ((const struct real_format *fmt,
3225                                   long *, const REAL_VALUE_TYPE *));
3226 static void decode_vax_g PARAMS ((const struct real_format *,
3227                                   REAL_VALUE_TYPE *, const long *));
3228
3229 static void
3230 encode_vax_f (fmt, buf, r)
3231      const struct real_format *fmt ATTRIBUTE_UNUSED;
3232      long *buf;
3233      const REAL_VALUE_TYPE *r;
3234 {
3235   unsigned long sign, exp, sig, image;
3236
3237   sign = r->sign << 15;
3238
3239   switch (r->class)
3240     {
3241     case rvc_zero:
3242       image = 0;
3243       break;
3244
3245     case rvc_inf:
3246     case rvc_nan:
3247       image = 0xffff7fff | sign;
3248       break;
3249
3250     case rvc_normal:
3251       sig = (r->sig[SIGSZ-1] >> (HOST_BITS_PER_LONG - 24)) & 0x7fffff;
3252       exp = r->exp + 128;
3253
3254       image = (sig << 16) & 0xffff0000;
3255       image |= sign;
3256       image |= exp << 7;
3257       image |= sig >> 16;
3258       break;
3259
3260     default:
3261       abort ();
3262     }
3263
3264   buf[0] = image;
3265 }
3266
3267 static void
3268 decode_vax_f (fmt, r, buf)
3269      const struct real_format *fmt ATTRIBUTE_UNUSED;
3270      REAL_VALUE_TYPE *r;
3271      const long *buf;
3272 {
3273   unsigned long image = buf[0] & 0xffffffff;
3274   int exp = (image >> 7) & 0xff;
3275
3276   memset (r, 0, sizeof (*r));
3277
3278   if (exp != 0)
3279     {
3280       r->class = rvc_normal;
3281       r->sign = (image >> 15) & 1;
3282       r->exp = exp - 128;
3283
3284       image = ((image & 0x7f) << 16) | ((image >> 16) & 0xffff);
3285       r->sig[SIGSZ-1] = (image << (HOST_BITS_PER_LONG - 24)) | SIG_MSB;
3286     }
3287 }
3288
3289 static void
3290 encode_vax_d (fmt, buf, r)
3291      const struct real_format *fmt ATTRIBUTE_UNUSED;
3292      long *buf;
3293      const REAL_VALUE_TYPE *r;
3294 {
3295   unsigned long image0, image1, sign = r->sign << 15;
3296
3297   switch (r->class)
3298     {
3299     case rvc_zero:
3300       image0 = image1 = 0;
3301       break;
3302
3303     case rvc_inf:
3304     case rvc_nan:
3305       image0 = 0xffff7fff | sign;
3306       image1 = 0xffffffff;
3307       break;
3308
3309     case rvc_normal:
3310       /* Extract the significand into straight hi:lo.  */
3311       if (HOST_BITS_PER_LONG == 64)
3312         {
3313           image0 = r->sig[SIGSZ-1];
3314           image1 = (image0 >> (64 - 56)) & 0xffffffff;
3315           image0 = (image0 >> (64 - 56 + 1) >> 31) & 0x7fffff;
3316         }
3317       else
3318         {
3319           image0 = r->sig[SIGSZ-1];
3320           image1 = r->sig[SIGSZ-2];
3321           image1 = (image0 << 24) | (image1 >> 8);
3322           image0 = (image0 >> 8) & 0xffffff;
3323         }
3324
3325       /* Rearrange the half-words of the significand to match the
3326          external format.  */
3327       image0 = ((image0 << 16) | (image0 >> 16)) & 0xffff007f;
3328       image1 = ((image1 << 16) | (image1 >> 16)) & 0xffffffff;
3329
3330       /* Add the sign and exponent.  */
3331       image0 |= sign;
3332       image0 |= (r->exp + 128) << 7;
3333       break;
3334
3335     default:
3336       abort ();
3337     }
3338
3339   if (FLOAT_WORDS_BIG_ENDIAN)
3340     buf[0] = image1, buf[1] = image0;
3341   else
3342     buf[0] = image0, buf[1] = image1;
3343 }
3344
3345 static void
3346 decode_vax_d (fmt, r, buf)
3347      const struct real_format *fmt ATTRIBUTE_UNUSED;
3348      REAL_VALUE_TYPE *r;
3349      const long *buf;
3350 {
3351   unsigned long image0, image1;
3352   int exp;
3353
3354   if (FLOAT_WORDS_BIG_ENDIAN)
3355     image1 = buf[0], image0 = buf[1];
3356   else
3357     image0 = buf[0], image1 = buf[1];
3358   image0 &= 0xffffffff;
3359   image1 &= 0xffffffff;
3360
3361   exp = (image0 >> 7) & 0x7f;
3362
3363   memset (r, 0, sizeof (*r));
3364
3365   if (exp != 0)
3366     {
3367       r->class = rvc_normal;
3368       r->sign = (image0 >> 15) & 1;
3369       r->exp = exp - 128;
3370
3371       /* Rearrange the half-words of the external format into
3372          proper ascending order.  */
3373       image0 = ((image0 & 0x7f) << 16) | ((image0 >> 16) & 0xffff);
3374       image1 = ((image1 & 0xffff) << 16) | ((image1 >> 16) & 0xffff);
3375
3376       if (HOST_BITS_PER_LONG == 64)
3377         {
3378           image0 = (image0 << 31 << 1) | image1;
3379           image0 <<= 64 - 56;
3380           image0 |= SIG_MSB;
3381           r->sig[SIGSZ-1] = image0;
3382         }
3383       else
3384         {
3385           r->sig[SIGSZ-1] = image0;
3386           r->sig[SIGSZ-2] = image1;
3387           lshift_significand (r, r, 2*HOST_BITS_PER_LONG - 56);
3388           r->sig[SIGSZ-1] |= SIG_MSB;
3389         }
3390     }
3391 }
3392
3393 static void
3394 encode_vax_g (fmt, buf, r)
3395      const struct real_format *fmt ATTRIBUTE_UNUSED;
3396      long *buf;
3397      const REAL_VALUE_TYPE *r;
3398 {
3399   unsigned long image0, image1, sign = r->sign << 15;
3400
3401   switch (r->class)
3402     {
3403     case rvc_zero:
3404       image0 = image1 = 0;
3405       break;
3406
3407     case rvc_inf:
3408     case rvc_nan:
3409       image0 = 0xffff7fff | sign;
3410       image1 = 0xffffffff;
3411       break;
3412
3413     case rvc_normal:
3414       /* Extract the significand into straight hi:lo.  */
3415       if (HOST_BITS_PER_LONG == 64)
3416         {
3417           image0 = r->sig[SIGSZ-1];
3418           image1 = (image0 >> (64 - 53)) & 0xffffffff;
3419           image0 = (image0 >> (64 - 53 + 1) >> 31) & 0xfffff;
3420         }
3421       else
3422         {
3423           image0 = r->sig[SIGSZ-1];
3424           image1 = r->sig[SIGSZ-2];
3425           image1 = (image0 << 21) | (image1 >> 11);
3426           image0 = (image0 >> 11) & 0xfffff;
3427         }
3428
3429       /* Rearrange the half-words of the significand to match the
3430          external format.  */
3431       image0 = ((image0 << 16) | (image0 >> 16)) & 0xffff000f;
3432       image1 = ((image1 << 16) | (image1 >> 16)) & 0xffffffff;
3433
3434       /* Add the sign and exponent.  */
3435       image0 |= sign;
3436       image0 |= (r->exp + 1024) << 4;
3437       break;
3438
3439     default:
3440       abort ();
3441     }
3442
3443   if (FLOAT_WORDS_BIG_ENDIAN)
3444     buf[0] = image1, buf[1] = image0;
3445   else
3446     buf[0] = image0, buf[1] = image1;
3447 }
3448
3449 static void
3450 decode_vax_g (fmt, r, buf)
3451      const struct real_format *fmt ATTRIBUTE_UNUSED;
3452      REAL_VALUE_TYPE *r;
3453      const long *buf;
3454 {
3455   unsigned long image0, image1;
3456   int exp;
3457
3458   if (FLOAT_WORDS_BIG_ENDIAN)
3459     image1 = buf[0], image0 = buf[1];
3460   else
3461     image0 = buf[0], image1 = buf[1];
3462   image0 &= 0xffffffff;
3463   image1 &= 0xffffffff;
3464
3465   exp = (image0 >> 4) & 0x7ff;
3466
3467   memset (r, 0, sizeof (*r));
3468
3469   if (exp != 0)
3470     {
3471       r->class = rvc_normal;
3472       r->sign = (image0 >> 15) & 1;
3473       r->exp = exp - 1024;
3474
3475       /* Rearrange the half-words of the external format into
3476          proper ascending order.  */
3477       image0 = ((image0 & 0xf) << 16) | ((image0 >> 16) & 0xffff);
3478       image1 = ((image1 & 0xffff) << 16) | ((image1 >> 16) & 0xffff);
3479
3480       if (HOST_BITS_PER_LONG == 64)
3481         {
3482           image0 = (image0 << 31 << 1) | image1;
3483           image0 <<= 64 - 53;
3484           image0 |= SIG_MSB;
3485           r->sig[SIGSZ-1] = image0;
3486         }
3487       else
3488         {
3489           r->sig[SIGSZ-1] = image0;
3490           r->sig[SIGSZ-2] = image1;
3491           lshift_significand (r, r, 64 - 53);
3492           r->sig[SIGSZ-1] |= SIG_MSB;
3493         }
3494     }
3495 }
3496
3497 const struct real_format vax_f_format = 
3498   {
3499     encode_vax_f,
3500     decode_vax_f,
3501     2,
3502     1,
3503     24,
3504     -127,
3505     127,
3506     false,
3507     false,
3508     false,
3509     false,
3510     false
3511   };
3512
3513 const struct real_format vax_d_format = 
3514   {
3515     encode_vax_d,
3516     decode_vax_d,
3517     2,
3518     1,
3519     56,
3520     -127,
3521     127,
3522     false,
3523     false,
3524     false,
3525     false,
3526     false
3527   };
3528
3529 const struct real_format vax_g_format = 
3530   {
3531     encode_vax_g,
3532     decode_vax_g,
3533     2,
3534     1,
3535     53,
3536     -1023,
3537     1023,
3538     false,
3539     false,
3540     false,
3541     false,
3542     false
3543   };
3544 \f
3545 /* A good reference for these can be found in chapter 9 of
3546    "ESA/390 Principles of Operation", IBM document number SA22-7201-01.
3547    An on-line version can be found here:
3548
3549    http://publibz.boulder.ibm.com/cgi-bin/bookmgr_OS390/BOOKS/DZ9AR001/9.1?DT=19930923083613
3550 */
3551
3552 static void encode_i370_single PARAMS ((const struct real_format *fmt,
3553                                         long *, const REAL_VALUE_TYPE *));
3554 static void decode_i370_single PARAMS ((const struct real_format *,
3555                                         REAL_VALUE_TYPE *, const long *));
3556 static void encode_i370_double PARAMS ((const struct real_format *fmt,
3557                                         long *, const REAL_VALUE_TYPE *));
3558 static void decode_i370_double PARAMS ((const struct real_format *,
3559                                         REAL_VALUE_TYPE *, const long *));
3560
3561 static void
3562 encode_i370_single (fmt, buf, r)
3563      const struct real_format *fmt ATTRIBUTE_UNUSED;
3564      long *buf;
3565      const REAL_VALUE_TYPE *r;
3566 {
3567   unsigned long sign, exp, sig, image;
3568
3569   sign = r->sign << 31;
3570
3571   switch (r->class)
3572     {
3573     case rvc_zero:
3574       image = 0;
3575       break;
3576
3577     case rvc_inf:
3578     case rvc_nan:
3579       image = 0x7fffffff | sign;
3580       break;
3581
3582     case rvc_normal:
3583       sig = (r->sig[SIGSZ-1] >> (HOST_BITS_PER_LONG - 24)) & 0xffffff;
3584       exp = ((r->exp / 4) + 64) << 24;
3585       image = sign | exp | sig;
3586       break;
3587
3588     default:
3589       abort ();
3590     }
3591
3592   buf[0] = image;
3593 }
3594
3595 static void
3596 decode_i370_single (fmt, r, buf)
3597      const struct real_format *fmt ATTRIBUTE_UNUSED;
3598      REAL_VALUE_TYPE *r;
3599      const long *buf;
3600 {
3601   unsigned long sign, sig, image = buf[0];
3602   int exp;
3603
3604   sign = (image >> 31) & 1;
3605   exp = (image >> 24) & 0x7f;
3606   sig = image & 0xffffff;
3607
3608   memset (r, 0, sizeof (*r));
3609
3610   if (exp || sig)
3611     {
3612       r->class = rvc_normal;
3613       r->sign = sign;
3614       r->exp = (exp - 64) * 4;
3615       r->sig[SIGSZ-1] = sig << (HOST_BITS_PER_LONG - 24);
3616       normalize (r);
3617     }
3618 }
3619
3620 static void
3621 encode_i370_double (fmt, buf, r)
3622      const struct real_format *fmt ATTRIBUTE_UNUSED;
3623      long *buf;
3624      const REAL_VALUE_TYPE *r;
3625 {
3626   unsigned long sign, exp, image_hi, image_lo;
3627
3628   sign = r->sign << 31;
3629
3630   switch (r->class)
3631     {
3632     case rvc_zero:
3633       image_hi = image_lo = 0;
3634       break;
3635
3636     case rvc_inf:
3637     case rvc_nan:
3638       image_hi = 0x7fffffff | sign;
3639       image_lo = 0xffffffff;
3640       break;
3641
3642     case rvc_normal:
3643       if (HOST_BITS_PER_LONG == 64)
3644         {
3645           image_hi = r->sig[SIGSZ-1];
3646           image_lo = (image_hi >> (64 - 56)) & 0xffffffff;
3647           image_hi = (image_hi >> (64 - 56 + 1) >> 31) & 0xffffff;
3648         }
3649       else
3650         {
3651           image_hi = r->sig[SIGSZ-1];
3652           image_lo = r->sig[SIGSZ-2];
3653           image_lo = (image_lo >> 8) | (image_hi << 24);
3654           image_hi >>= 8;
3655         }
3656
3657       exp = ((r->exp / 4) + 64) << 24;
3658       image_hi |= sign | exp;
3659       break;
3660
3661     default:
3662       abort ();
3663     }
3664
3665   if (FLOAT_WORDS_BIG_ENDIAN)
3666     buf[0] = image_hi, buf[1] = image_lo;
3667   else
3668     buf[0] = image_lo, buf[1] = image_hi;
3669 }
3670
3671 static void
3672 decode_i370_double (fmt, r, buf)
3673      const struct real_format *fmt ATTRIBUTE_UNUSED;
3674      REAL_VALUE_TYPE *r;
3675      const long *buf;
3676 {
3677   unsigned long sign, image_hi, image_lo;
3678   int exp;
3679
3680   if (FLOAT_WORDS_BIG_ENDIAN)
3681     image_hi = buf[0], image_lo = buf[1];
3682   else
3683     image_lo = buf[0], image_hi = buf[1];
3684
3685   sign = (image_hi >> 31) & 1;
3686   exp = (image_hi >> 24) & 0x7f;
3687   image_hi &= 0xffffff;
3688   image_lo &= 0xffffffff;
3689
3690   memset (r, 0, sizeof (*r));
3691
3692   if (exp || image_hi || image_lo)
3693     {
3694       r->class = rvc_normal;
3695       r->sign = sign;
3696       r->exp = (exp - 64) * 4 + (SIGNIFICAND_BITS - 56);
3697
3698       if (HOST_BITS_PER_LONG == 32)
3699         {
3700           r->sig[0] = image_lo;
3701           r->sig[1] = image_hi;
3702         }
3703       else
3704         r->sig[0] = image_lo | (image_hi << 31 << 1);
3705
3706       normalize (r);
3707     }
3708 }
3709
3710 const struct real_format i370_single_format =
3711   {
3712     encode_i370_single,
3713     decode_i370_single,
3714     16,
3715     4,
3716     6,
3717     -64,
3718     63,
3719     false,
3720     false,
3721     false, /* ??? The encoding does allow for "unnormals".  */
3722     false, /* ??? The encoding does allow for "unnormals".  */
3723     false
3724   };
3725
3726 const struct real_format i370_double_format =
3727   {
3728     encode_i370_double,
3729     decode_i370_double,
3730     16,
3731     4,
3732     14,
3733     -64,
3734     63,
3735     false,
3736     false,
3737     false, /* ??? The encoding does allow for "unnormals".  */
3738     false, /* ??? The encoding does allow for "unnormals".  */
3739     false
3740   };
3741 \f
3742 /* The "twos-compliment" c4x format is officially defined as
3743
3744         x = s(~s).f * 2**e
3745
3746    This is rather misleading.  One must remember that F is signed.
3747    A better description would be
3748
3749         x = -1**s * ((s + 1 + .f) * 2**e
3750
3751    So if we have a (4 bit) fraction of .1000 with a sign bit of 1,
3752    that's -1 * (1+1+(-.5)) == -1.5.  I think.
3753
3754    The constructions here are taken from Tables 5-1 and 5-2 of the
3755    TMS320C4x User's Guide wherein step-by-step instructions for
3756    conversion from IEEE are presented.  That's close enough to our
3757    internal representation so as to make things easy.
3758
3759    See http://www-s.ti.com/sc/psheets/spru063c/spru063c.pdf  */
3760
3761 static void encode_c4x_single PARAMS ((const struct real_format *fmt,
3762                                        long *, const REAL_VALUE_TYPE *));
3763 static void decode_c4x_single PARAMS ((const struct real_format *,
3764                                        REAL_VALUE_TYPE *, const long *));
3765 static void encode_c4x_extended PARAMS ((const struct real_format *fmt,
3766                                          long *, const REAL_VALUE_TYPE *));
3767 static void decode_c4x_extended PARAMS ((const struct real_format *,
3768                                          REAL_VALUE_TYPE *, const long *));
3769
3770 static void
3771 encode_c4x_single (fmt, buf, r)
3772      const struct real_format *fmt ATTRIBUTE_UNUSED;
3773      long *buf;
3774      const REAL_VALUE_TYPE *r;
3775 {
3776   unsigned long image, exp, sig;
3777   
3778   switch (r->class)
3779     {
3780     case rvc_zero:
3781       exp = -128;
3782       sig = 0;
3783       break;
3784
3785     case rvc_inf:
3786     case rvc_nan:
3787       exp = 127;
3788       sig = 0x800000 - r->sign;
3789       break;
3790
3791     case rvc_normal:
3792       exp = r->exp - 1;
3793       sig = (r->sig[SIGSZ-1] >> (HOST_BITS_PER_LONG - 24)) & 0x7fffff;
3794       if (r->sign)
3795         {
3796           if (sig)
3797             sig = -sig;
3798           else
3799             exp--;
3800           sig |= 0x800000;
3801         }
3802       break;
3803