--- /dev/null
+/* A C version of Kahan's Floating Point Test "Paranoia"
+
+Thos Sumner, UCSF, Feb. 1985
+David Gay, BTL, Jan. 1986
+
+This is a rewrite from the Pascal version by
+
+B. A. Wichmann, 18 Jan. 1985
+
+(and does NOT exhibit good C programming style).
+
+Adjusted to use Standard C headers 19 Jan. 1992 (dmg);
+
+(C) Apr 19 1983 in BASIC version by:
+Professor W. M. Kahan,
+567 Evans Hall
+Electrical Engineering & Computer Science Dept.
+University of California
+Berkeley, California 94720
+USA
+
+converted to Pascal by:
+B. A. Wichmann
+National Physical Laboratory
+Teddington Middx
+TW11 OLW
+UK
+
+converted to C by:
+
+David M. Gay and Thos Sumner
+AT&T Bell Labs Computer Center, Rm. U-76
+600 Mountain Avenue University of California
+Murray Hill, NJ 07974 San Francisco, CA 94143
+USA USA
+
+with simultaneous corrections to the Pascal source (reflected
+in the Pascal source available over netlib).
+[A couple of bug fixes from dgh = sun!dhough incorporated 31 July 1986.]
+
+Reports of results on various systems from all the versions
+of Paranoia are being collected by Richard Karpinski at the
+same address as Thos Sumner. This includes sample outputs,
+bug reports, and criticisms.
+
+You may copy this program freely if you acknowledge its source.
+Comments on the Pascal version to NPL, please.
+
+The following is from the introductory commentary from Wichmann's work:
+
+The BASIC program of Kahan is written in Microsoft BASIC using many
+facilities which have no exact analogy in Pascal. The Pascal
+version below cannot therefore be exactly the same. Rather than be
+a minimal transcription of the BASIC program, the Pascal coding
+follows the conventional style of block-structured languages. Hence
+the Pascal version could be useful in producing versions in other
+structured languages.
+
+Rather than use identifiers of minimal length (which therefore have
+little mnemonic significance), the Pascal version uses meaningful
+identifiers as follows [Note: A few changes have been made for C]:
+
+
+BASIC C BASIC C BASIC C
+
+A J S StickyBit
+A1 AInverse J0 NoErrors T
+B Radix [Failure] T0 Underflow
+B1 BInverse J1 NoErrors T2 ThirtyTwo
+B2 RadixD2 [SeriousDefect] T5 OneAndHalf
+B9 BMinusU2 J2 NoErrors T7 TwentySeven
+C [Defect] T8 TwoForty
+C1 CInverse J3 NoErrors U OneUlp
+D [Flaw] U0 UnderflowThreshold
+D4 FourD K PageNo U1
+E0 L Milestone U2
+E1 M V
+E2 Exp2 N V0
+E3 N1 V8
+E5 MinSqEr O Zero V9
+E6 SqEr O1 One W
+E7 MaxSqEr O2 Two X
+E8 O3 Three X1
+E9 O4 Four X8
+F1 MinusOne O5 Five X9 Random1
+F2 Half O8 Eight Y
+F3 Third O9 Nine Y1
+F6 P Precision Y2
+F9 Q Y9 Random2
+G1 GMult Q8 Z
+G2 GDiv Q9 Z0 PseudoZero
+G3 GAddSub R Z1
+H R1 RMult Z2
+H1 HInverse R2 RDiv Z9
+I R3 RAddSub
+IO NoTrials R4 RSqrt
+I3 IEEE R9 Random9
+
+SqRWrng
+
+All the variables in BASIC are true variables and in consequence,
+the program is more difficult to follow since the "constants" must
+be determined (the glossary is very helpful). The Pascal version
+uses Real constants, but checks are added to ensure that the values
+are correctly converted by the compiler.
+
+The major textual change to the Pascal version apart from the
+identifiersis that named procedures are used, inserting parameters
+wherehelpful. New procedures are also introduced. The
+correspondence is as follows:
+
+
+BASIC Pascal
+lines
+
+90- 140 Pause
+170- 250 Instructions
+380- 460 Heading
+480- 670 Characteristics
+690- 870 History
+2940-2950 Random
+3710-3740 NewD
+4040-4080 DoesYequalX
+4090-4110 PrintIfNPositive
+4640-4850 TestPartialUnderflow
+
+*/
+
+ /* This version of paranoia has been modified to work with GCC's internal
+ software floating point emulation library, as a sanity check of same.
+
+ I'm doing this in C++ so that I can do operator overloading and not
+ have to modify so damned much of the existing code. */
+
+ extern "C" {
+#include <stdio.h>
+#include <stddef.h>
+#include <limits.h>
+#include <string.h>
+#include <stdlib.h>
+#include <math.h>
+#include <unistd.h>
+#include <float.h>
+
+ /* This part is made all the more awful because many gcc headers are
+ not prepared at all to be parsed as C++. The biggest stickler
+ here is const structure members. So we include exactly the pieces
+ that we need. */
+
+#define GTY(x)
+
+#include "ansidecl.h"
+#include "auto-host.h"
+#include "hwint.h"
+
+#undef EXTRA_MODES_FILE
+
+ struct rtx_def;
+ typedef struct rtx_def *rtx;
+ struct rtvec_def;
+ typedef struct rtvec_def *rtvec;
+ union tree_node;
+ typedef union tree_node *tree;
+
+#define DEFTREECODE(SYM, STRING, TYPE, NARGS) SYM,
+ enum tree_code {
+#include "tree.def"
+ LAST_AND_UNUSED_TREE_CODE
+ };
+#undef DEFTREECODE
+
+#include "real.h"
+ }
+
+/* We never produce signals from the library. Thus setjmp need do nothing. */
+#undef setjmp
+#define setjmp(x) (0)
+
+static bool verbose = false;
+static int verbose_index = 0;
+
+/* ====================================================================== */
+/* The implementation of the abstract floating point class based on gcc's
+ real.c. I.e. the object of this excersize. Templated so that we can
+ all fp sizes. */
+
+template<int SIZE, enum machine_mode MODE>
+class real_c_float
+{
+ private:
+ long image[SIZE / 32];
+
+ void from_long(long);
+ void from_str(const char *);
+ void binop(int code, const real_c_float&);
+ void unop(int code);
+ bool cmp(int code, const real_c_float&) const;
+
+ public:
+ real_c_float()
+ { }
+ real_c_float(long l)
+ { from_long(l); }
+ real_c_float(const char *s)
+ { from_str(s); }
+ real_c_float(const real_c_float &b)
+ { memcpy(image, b.image, sizeof(image)); }
+
+ const real_c_float& operator= (long l)
+ { from_long(l); return *this; }
+ const real_c_float& operator= (const char *s)
+ { from_str(s); return *this; }
+ const real_c_float& operator= (const real_c_float &b)
+ { memcpy(image, b.image, sizeof(image)); return *this; }
+
+ const real_c_float& operator+= (const real_c_float &b)
+ { binop(PLUS_EXPR, b); return *this; }
+ const real_c_float& operator-= (const real_c_float &b)
+ { binop(MINUS_EXPR, b); return *this; }
+ const real_c_float& operator*= (const real_c_float &b)
+ { binop(MULT_EXPR, b); return *this; }
+ const real_c_float& operator/= (const real_c_float &b)
+ { binop(RDIV_EXPR, b); return *this; }
+
+ real_c_float operator- () const
+ { real_c_float r(*this); r.unop(NEGATE_EXPR); return r; }
+ real_c_float abs () const
+ { real_c_float r(*this); r.unop(ABS_EXPR); return r; }
+
+ bool operator < (const real_c_float &b) const { return cmp(LT_EXPR, b); }
+ bool operator <= (const real_c_float &b) const { return cmp(LE_EXPR, b); }
+ bool operator == (const real_c_float &b) const { return cmp(EQ_EXPR, b); }
+ bool operator != (const real_c_float &b) const { return cmp(NE_EXPR, b); }
+ bool operator >= (const real_c_float &b) const { return cmp(GE_EXPR, b); }
+ bool operator > (const real_c_float &b) const { return cmp(GT_EXPR, b); }
+
+ const char * str () const;
+ const char * hex () const;
+ long integer () const;
+ int exp () const;
+ void ldexp (int);
+};
+
+template<int SIZE, enum machine_mode MODE>
+void
+real_c_float<SIZE, MODE>::from_long (long l)
+{
+ REAL_VALUE_TYPE f;
+
+ real_from_integer (&f, MODE, l, l < 0 ? -1 : 0, 0);
+ real_to_target (image, &f, MODE);
+}
+
+template<int SIZE, enum machine_mode MODE>
+void
+real_c_float<SIZE, MODE>::from_str (const char *s)
+{
+ REAL_VALUE_TYPE f;
+ char *p = s;
+
+ if (*p == '-' || *p == '+')
+ p++;
+ if (strcasecmp(p, "inf") == 0)
+ {
+ real_inf (&f);
+ if (*s == '-')
+ real_arithmetic (&f, NEGATE_EXPR, &f, NULL);
+ }
+ else if (strcasecmp(p, "nan") == 0)
+ real_nan (&f, "", 1, MODE);
+ else
+ real_from_string (&f, s);
+
+ real_to_target (image, &f, MODE);
+}
+
+template<int SIZE, enum machine_mode MODE>
+void
+real_c_float<SIZE, MODE>::binop (int code, const real_c_float &b)
+{
+ REAL_VALUE_TYPE ai, bi, ri;
+
+ real_from_target (&ai, image, MODE);
+ real_from_target (&bi, b.image, MODE);
+ real_arithmetic (&ri, code, &ai, &bi);
+ real_to_target (image, &ri, MODE);
+
+ if (verbose)
+ {
+ char ab[64], bb[64], rb[64];
+ const int digits = int(SIZE / 4);
+ char symbol_for_code;
+
+ real_from_target (&ri, image, MODE);
+ real_to_hexadecimal (ab, &ai, digits);
+ real_to_hexadecimal (bb, &bi, digits);
+ real_to_hexadecimal (rb, &ri, digits);
+
+ switch (code)
+ {
+ case PLUS_EXPR:
+ symbol_for_code = '+';
+ break;
+ case MINUS_EXPR:
+ symbol_for_code = '-';
+ break;
+ case MULT_EXPR:
+ symbol_for_code = '*';
+ break;
+ case RDIV_EXPR:
+ symbol_for_code = '/';
+ break;
+ default:
+ abort ();
+ }
+
+ fprintf (stderr, "%6d: %s %c %s = %s\n", verbose_index++,
+ ab, symbol_for_code, bb, rb);
+ }
+}
+
+template<int SIZE, enum machine_mode MODE>
+void
+real_c_float<SIZE, MODE>::unop (int code)
+{
+ REAL_VALUE_TYPE ai, ri;
+
+ real_from_target (&ai, image, MODE);
+ real_arithmetic (&ri, code, &ai, NULL);
+ real_to_target (image, &ri, MODE);
+
+ if (verbose)
+ {
+ char ab[64], rb[64];
+ const int digits = int(SIZE / 4);
+ const char *symbol_for_code;
+
+ real_from_target (&ri, image, MODE);
+ real_to_hexadecimal (ab, &ai, digits);
+ real_to_hexadecimal (rb, &ri, digits);
+
+ switch (code)
+ {
+ case NEGATE_EXPR:
+ symbol_for_code = "-";
+ break;
+ case ABS_EXPR:
+ symbol_for_code = "abs ";
+ break;
+ default:
+ abort ();
+ }
+
+ fprintf (stderr, "%6d: %s%s = %s\n", verbose_index++,
+ symbol_for_code, ab, rb);
+ }
+}
+
+template<int SIZE, enum machine_mode MODE>
+bool
+real_c_float<SIZE, MODE>::cmp (int code, const real_c_float &b) const
+{
+ REAL_VALUE_TYPE ai, bi;
+ bool ret;
+
+ real_from_target (&ai, image, MODE);
+ real_from_target (&bi, b.image, MODE);
+ ret = real_compare (code, &ai, &bi);
+
+ if (verbose)
+ {
+ char ab[64], bb[64];
+ const int digits = int(SIZE / 4);
+ const char *symbol_for_code;
+
+ real_to_hexadecimal (ab, &ai, digits);
+ real_to_hexadecimal (bb, &bi, digits);
+
+ switch (code)
+ {
+ case LT_EXPR:
+ symbol_for_code = "<";
+ break;
+ case LE_EXPR:
+ symbol_for_code = "<=";
+ break;
+ case EQ_EXPR:
+ symbol_for_code = "==";
+ break;
+ case NE_EXPR:
+ symbol_for_code = "!=";
+ break;
+ case GE_EXPR:
+ symbol_for_code = ">=";
+ break;
+ case GT_EXPR:
+ symbol_for_code = ">";
+ break;
+ default:
+ abort ();
+ }
+
+ fprintf (stderr, "%6d: %s %s %s = %s\n", verbose_index++,
+ ab, symbol_for_code, bb, (ret ? "true" : "false"));
+ }
+
+ return ret;
+}
+
+template<int SIZE, enum machine_mode MODE>
+const char *
+real_c_float<SIZE, MODE>::str() const
+{
+ REAL_VALUE_TYPE f;
+ const int digits = int(SIZE * .30102999566398119521 + 1);
+
+ real_from_target (&f, image, MODE);
+ char *buf = new char[digits + 10];
+ real_to_decimal (buf, &f, digits);
+
+ return buf;
+}
+
+template<int SIZE, enum machine_mode MODE>
+const char *
+real_c_float<SIZE, MODE>::hex() const
+{
+ REAL_VALUE_TYPE f;
+ const int digits = int(SIZE / 4);
+
+ real_from_target (&f, image, MODE);
+ char *buf = new char[digits + 10];
+ real_to_hexadecimal (buf, &f, digits);
+
+ return buf;
+}
+
+template<int SIZE, enum machine_mode MODE>
+long
+real_c_float<SIZE, MODE>::integer() const
+{
+ REAL_VALUE_TYPE f;
+ real_from_target (&f, image, MODE);
+ return real_to_integer (&f);
+}
+
+template<int SIZE, enum machine_mode MODE>
+int
+real_c_float<SIZE, MODE>::exp() const
+{
+ REAL_VALUE_TYPE f;
+ real_from_target (&f, image, MODE);
+ return real_exponent (&f);
+}
+
+template<int SIZE, enum machine_mode MODE>
+void
+real_c_float<SIZE, MODE>::ldexp (int exp)
+{
+ REAL_VALUE_TYPE ai;
+
+ real_from_target (&ai, image, MODE);
+ real_ldexp (&ai, &ai, exp);
+ real_to_target (image, &ai, MODE);
+}
+
+/* ====================================================================== */
+/* An implementation of the abstract floating point class that uses native
+ arithmetic. Exists for reference and debugging. */
+
+template<typename T>
+class native_float
+{
+ private:
+ // Force intermediate results back to memory.
+ volatile T image;
+
+ static T from_str (const char *);
+ static T do_abs (T);
+ static T verbose_binop (T, char, T, T);
+ static T verbose_unop (const char *, T, T);
+ static bool verbose_cmp (T, const char *, T, bool);
+
+ public:
+ native_float()
+ { }
+ native_float(long l)
+ { image = l; }
+ native_float(const char *s)
+ { image = from_str(s); }
+ native_float(const native_float &b)
+ { image = b.image; }
+
+ const native_float& operator= (long l)
+ { image = l; return *this; }
+ const native_float& operator= (const char *s)
+ { image = from_str(s); return *this; }
+ const native_float& operator= (const native_float &b)
+ { image = b.image; return *this; }
+
+ const native_float& operator+= (const native_float &b)
+ {
+ image = verbose_binop(image, '+', b.image, image + b.image);
+ return *this;
+ }
+ const native_float& operator-= (const native_float &b)
+ {
+ image = verbose_binop(image, '-', b.image, image - b.image);
+ return *this;
+ }
+ const native_float& operator*= (const native_float &b)
+ {
+ image = verbose_binop(image, '*', b.image, image * b.image);
+ return *this;
+ }
+ const native_float& operator/= (const native_float &b)
+ {
+ image = verbose_binop(image, '/', b.image, image / b.image);
+ return *this;
+ }
+
+ native_float operator- () const
+ {
+ native_float r;
+ r.image = verbose_unop("-", image, -image);
+ return r;
+ }
+ native_float abs () const
+ {
+ native_float r;
+ r.image = verbose_unop("abs ", image, do_abs(image));
+ return r;
+ }
+
+ bool operator < (const native_float &b) const
+ { return verbose_cmp(image, "<", b.image, image < b.image); }
+ bool operator <= (const native_float &b) const
+ { return verbose_cmp(image, "<=", b.image, image <= b.image); }
+ bool operator == (const native_float &b) const
+ { return verbose_cmp(image, "==", b.image, image == b.image); }
+ bool operator != (const native_float &b) const
+ { return verbose_cmp(image, "!=", b.image, image != b.image); }
+ bool operator >= (const native_float &b) const
+ { return verbose_cmp(image, ">=", b.image, image >= b.image); }
+ bool operator > (const native_float &b) const
+ { return verbose_cmp(image, ">", b.image, image > b.image); }
+
+ const char * str () const;
+ const char * hex () const;
+ long integer () const
+ { return long(image); }
+ int exp () const;
+ void ldexp (int);
+};
+
+template<typename T>
+inline T
+native_float<T>::from_str (const char *s)
+{
+ return strtold (s, NULL);
+}
+
+template<>
+inline float
+native_float<float>::from_str (const char *s)
+{
+ return strtof (s, NULL);
+}
+
+template<>
+inline double
+native_float<double>::from_str (const char *s)
+{
+ return strtod (s, NULL);
+}
+
+template<typename T>
+inline T
+native_float<T>::do_abs (T image)
+{
+ return fabsl (image);
+}
+
+template<>
+inline float
+native_float<float>::do_abs (float image)
+{
+ return fabsf (image);
+}
+
+template<>
+inline double
+native_float<double>::do_abs (double image)
+{
+ return fabs (image);
+}
+
+template<typename T>
+T
+native_float<T>::verbose_binop (T a, char symbol, T b, T r)
+{
+ if (verbose)
+ {
+ const int digits = int(sizeof(T) * CHAR_BIT / 4) - 1;
+#ifdef NO_LONG_DOUBLE
+ fprintf (stderr, "%6d: %.*a %c %.*a = %.*a\n", verbose_index++,
+ digits, (double)a, symbol,
+ digits, (double)b, digits, (double)r);
+#else
+ fprintf (stderr, "%6d: %.*La %c %.*La = %.*La\n", verbose_index++,
+ digits, (long double)a, symbol,
+ digits, (long double)b, digits, (long double)r);
+#endif
+ }
+ return r;
+}
+
+template<typename T>
+T
+native_float<T>::verbose_unop (const char *symbol, T a, T r)
+{
+ if (verbose)
+ {
+ const int digits = int(sizeof(T) * CHAR_BIT / 4) - 1;
+#ifdef NO_LONG_DOUBLE
+ fprintf (stderr, "%6d: %s%.*a = %.*a\n", verbose_index++,
+ symbol, digits, (double)a, digits, (double)r);
+#else
+ fprintf (stderr, "%6d: %s%.*La = %.*La\n", verbose_index++,
+ symbol, digits, (long double)a, digits, (long double)r);
+#endif
+ }
+ return r;
+}
+
+template<typename T>
+bool
+native_float<T>::verbose_cmp (T a, const char *symbol, T b, bool r)
+{
+ if (verbose)
+ {
+ const int digits = int(sizeof(T) * CHAR_BIT / 4) - 1;
+#ifndef NO_LONG_DOUBLE
+ fprintf (stderr, "%6d: %.*a %s %.*a = %s\n", verbose_index++,
+ digits, (double)a, symbol,
+ digits, (double)b, (r ? "true" : "false"));
+#else
+ fprintf (stderr, "%6d: %.*La %s %.*La = %s\n", verbose_index++,
+ digits, (long double)a, symbol,
+ digits, (long double)b, (r ? "true" : "false"));
+#endif
+ }
+ return r;
+}
+
+template<typename T>
+const char *
+native_float<T>::str() const
+{
+ char *buf = new char[50];
+ const int digits = int(sizeof(T) * CHAR_BIT * .30102999566398119521 + 1);
+#ifndef NO_LONG_DOUBLE
+ sprintf (buf, "%.*e", digits - 1, (double) image);
+#else
+ sprintf (buf, "%.*Le", digits - 1, (long double) image);
+#endif
+ return buf;
+}
+
+template<typename T>
+const char *
+native_float<T>::hex() const
+{
+ char *buf = new char[50];
+ const int digits = int(sizeof(T) * CHAR_BIT / 4);
+#ifndef NO_LONG_DOUBLE
+ sprintf (buf, "%.*a", digits - 1, (double) image);
+#else
+ sprintf (buf, "%.*La", digits - 1, (long double) image);
+#endif
+ return buf;
+}
+
+template<typename T>
+int
+native_float<T>::exp() const
+{
+ int e;
+ frexp (image, &e);
+ return e;
+}
+
+template<typename T>
+void
+native_float<T>::ldexp (int exp)
+{
+ image = ldexpl (image, exp);
+}
+
+template<>
+void
+native_float<float>::ldexp (int exp)
+{
+ image = ldexpf (image, exp);
+}
+
+template<>
+void
+native_float<double>::ldexp (int exp)
+{
+ image = ::ldexp (image, exp);
+}
+
+/* ====================================================================== */
+/* Some libm routines that Paranoia expects to be available. */
+
+template<typename FLOAT>
+inline FLOAT
+FABS (const FLOAT &f)
+{
+ return f.abs();
+}
+
+template<typename FLOAT, typename RHS>
+inline FLOAT
+operator+ (const FLOAT &a, const RHS &b)
+{
+ return FLOAT(a) += FLOAT(b);
+}
+
+template<typename FLOAT, typename RHS>
+inline FLOAT
+operator- (const FLOAT &a, const RHS &b)
+{
+ return FLOAT(a) -= FLOAT(b);
+}
+
+template<typename FLOAT, typename RHS>
+inline FLOAT
+operator* (const FLOAT &a, const RHS &b)
+{
+ return FLOAT(a) *= FLOAT(b);
+}
+
+template<typename FLOAT, typename RHS>
+inline FLOAT
+operator/ (const FLOAT &a, const RHS &b)
+{
+ return FLOAT(a) /= FLOAT(b);
+}
+
+template<typename FLOAT>
+FLOAT
+FLOOR (const FLOAT &f)
+{
+ /* ??? This is only correct when F is representable as an integer. */
+ long i = f.integer();
+ FLOAT r;
+
+ r = i;
+ if (i < 0 && f != r)
+ r = i - 1;
+
+ return r;
+}
+
+template<typename FLOAT>
+FLOAT
+SQRT (const FLOAT &f)
+{
+#if 0
+ FLOAT zero = long(0);
+ FLOAT two = 2;
+ FLOAT one = 1;
+ FLOAT diff, diff2;
+ FLOAT z, t;
+
+ if (f == zero)
+ return zero;
+ if (f < zero)
+ return zero / zero;
+ if (f == one)
+ return f;
+
+ z = f;
+ z.ldexp (-f.exp() / 2);
+
+ diff2 = FABS (z * z - f);
+ if (diff2 > zero)
+ while (1)
+ {
+ t = (f / (two * z)) + (z / two);
+ diff = FABS (t * t - f);
+ if (diff >= diff2)
+ break;
+ z = t;
+ diff2 = diff;
+ }
+
+ return z;
+#elif defined(NO_LONG_DOUBLE)
+ double d;
+ char buf[64];
+
+ d = strtod (f.hex(), NULL);
+ d = sqrt (d);
+ sprintf(buf, "%.35a", d);
+
+ return FLOAT(buf);
+#else
+ long double ld;
+ char buf[64];
+
+ ld = strtold (f.hex(), NULL);
+ ld = sqrtl (ld);
+ sprintf(buf, "%.35La", ld);
+
+ return FLOAT(buf);
+#endif
+}
+
+template<typename FLOAT>
+FLOAT
+LOG (FLOAT x)
+{
+#if 0
+ FLOAT zero = long(0);
+ FLOAT one = 1;
+
+ if (x <= zero)
+ return zero / zero;
+ if (x == one)
+ return zero;
+
+ int exp = x.exp() - 1;
+ x.ldexp(-exp);
+
+ FLOAT xm1 = x - one;
+ FLOAT y = xm1;
+ long n = 2;
+
+ FLOAT sum = xm1;
+ while (1)
+ {
+ y *= xm1;
+ FLOAT term = y / FLOAT (n);
+ FLOAT next = sum + term;
+ if (next == sum)
+ break;
+ sum = next;
+ if (++n == 1000)
+ break;
+ }
+
+ if (exp)
+ sum += FLOAT (exp) * FLOAT(".69314718055994530941");
+
+ return sum;
+#elif defined (NO_LONG_DOUBLE)
+ double d;
+ char buf[64];
+
+ d = strtod (x.hex(), NULL);
+ d = log (d);
+ sprintf(buf, "%.35a", d);
+
+ return FLOAT(buf);
+#else
+ long double ld;
+ char buf[64];
+
+ ld = strtold (x.hex(), NULL);
+ ld = logl (ld);
+ sprintf(buf, "%.35La", ld);
+
+ return FLOAT(buf);
+#endif
+}
+
+template<typename FLOAT>
+FLOAT
+EXP (const FLOAT &x)
+{
+ /* Cheat. */
+#ifdef NO_LONG_DOUBLE
+ double d;
+ char buf[64];
+
+ d = strtod (x.hex(), NULL);
+ d = exp (d);
+ sprintf(buf, "%.35a", d);
+
+ return FLOAT(buf);
+#else
+ long double ld;
+ char buf[64];
+
+ ld = strtold (x.hex(), NULL);
+ ld = expl (ld);
+ sprintf(buf, "%.35La", ld);
+
+ return FLOAT(buf);
+#endif
+}
+
+template<typename FLOAT>
+FLOAT
+POW (const FLOAT &base, const FLOAT &exp)
+{
+ /* Cheat. */
+#ifdef NO_LONG_DOUBLE
+ double d1, d2;
+ char buf[64];
+
+ d1 = strtod (base.hex(), NULL);
+ d2 = strtod (exp.hex(), NULL);
+ d1 = pow (d1, d2);
+ sprintf(buf, "%.35a", d1);
+
+ return FLOAT(buf);
+#else
+ long double ld1, ld2;
+ char buf[64];
+
+ ld1 = strtold (base.hex(), NULL);
+ ld2 = strtold (exp.hex(), NULL);
+ ld1 = powl (ld1, ld2);
+ sprintf(buf, "%.35La", ld1);
+
+ return FLOAT(buf);
+#endif
+}
+
+/* ====================================================================== */
+/* Real Paranoia begins again here. We wrap the thing in a template so
+ that we can instantiate it for each floating point type we care for. */
+
+int NoTrials = 20; /*Number of tests for commutativity. */
+bool do_pause = false;
+
+enum Guard { No, Yes };
+enum Rounding { Other, Rounded, Chopped };
+enum Class { Failure, Serious, Defect, Flaw };
+
+template<typename FLOAT>
+struct Paranoia
+{
+ FLOAT Radix, BInvrse, RadixD2, BMinusU2;
+
+ /* Small floating point constants. */
+ FLOAT Zero;
+ FLOAT Half;
+ FLOAT One;
+ FLOAT Two;
+ FLOAT Three;
+ FLOAT Four;
+ FLOAT Five;
+ FLOAT Eight;
+ FLOAT Nine;
+ FLOAT TwentySeven;
+ FLOAT ThirtyTwo;
+ FLOAT TwoForty;
+ FLOAT MinusOne;
+ FLOAT OneAndHalf;
+
+ /* Declarations of Variables. */
+ int Indx;
+ char ch[8];
+ FLOAT AInvrse, A1;
+ FLOAT C, CInvrse;
+ FLOAT D, FourD;
+ FLOAT E0, E1, Exp2, E3, MinSqEr;
+ FLOAT SqEr, MaxSqEr, E9;
+ FLOAT Third;
+ FLOAT F6, F9;
+ FLOAT H, HInvrse;
+ int I;
+ FLOAT StickyBit, J;
+ FLOAT MyZero;
+ FLOAT Precision;
+ FLOAT Q, Q9;
+ FLOAT R, Random9;
+ FLOAT T, Underflow, S;
+ FLOAT OneUlp, UfThold, U1, U2;
+ FLOAT V, V0, V9;
+ FLOAT W;
+ FLOAT X, X1, X2, X8, Random1;
+ FLOAT Y, Y1, Y2, Random2;
+ FLOAT Z, PseudoZero, Z1, Z2, Z9;
+ int ErrCnt[4];
+ int Milestone;
+ int PageNo;
+ int M, N, N1;
+ Guard GMult, GDiv, GAddSub;
+ Rounding RMult, RDiv, RAddSub, RSqrt;
+ int Break, Done, NotMonot, Monot, Anomaly, IEEE, SqRWrng, UfNGrad;
+
+ /* Computed constants. */
+ /*U1 gap below 1.0, i.e, 1.0-U1 is next number below 1.0 */
+ /*U2 gap above 1.0, i.e, 1.0+U2 is next number above 1.0 */
+
+ int main ();
+
+ FLOAT Sign (FLOAT);
+ FLOAT Random ();
+ void Pause ();
+ void BadCond (int, const char *);
+ void SqXMinX (int);
+ void TstCond (int, int, const char *);
+ void notify (const char *);
+ void IsYeqX ();
+ void NewD ();
+ void PrintIfNPositive ();
+ void SR3750 ();
+ void TstPtUf ();
+
+ // Pretend we're bss.
+ Paranoia() { memset(this, 0, sizeof (*this)); }
+};
+
+template<typename FLOAT>
+int
+Paranoia<FLOAT>::main()
+{
+ /* First two assignments use integer right-hand sides. */
+ Zero = long(0);
+ One = long(1);
+ Two = long(2);
+ Three = long(3);
+ Four = long(4);
+ Five = long(5);
+ Eight = long(8);
+ Nine = long(9);
+ TwentySeven = long(27);
+ ThirtyTwo = long(32);
+ TwoForty = long(240);
+ MinusOne = long(-1);
+ Half = "0x1p-1";
+ OneAndHalf = "0x3p-1";
+ ErrCnt[Failure] = 0;
+ ErrCnt[Serious] = 0;
+ ErrCnt[Defect] = 0;
+ ErrCnt[Flaw] = 0;
+ PageNo = 1;
+ /*=============================================*/
+ Milestone = 7;
+ /*=============================================*/
+ printf ("Program is now RUNNING tests on small integers:\n");
+
+ TstCond (Failure, (Zero + Zero == Zero), "0+0 != 0");
+ TstCond (Failure, (One - One == Zero), "1-1 != 0");
+ TstCond (Failure, (One > Zero), "1 <= 0");
+ TstCond (Failure, (One + One == Two), "1+1 != 2");
+
+ Z = -Zero;
+ if (Z != Zero)
+ {
+ ErrCnt[Failure] = ErrCnt[Failure] + 1;
+ printf ("Comparison alleges that -0.0 is Non-zero!\n");
+ U2 = "0.001";
+ Radix = 1;
+ TstPtUf ();
+ }
+
+ TstCond (Failure, (Three == Two + One), "3 != 2+1");
+ TstCond (Failure, (Four == Three + One), "4 != 3+1");
+ TstCond (Failure, (Four + Two * (-Two) == Zero), "4 + 2*(-2) != 0");
+ TstCond (Failure, (Four - Three - One == Zero), "4-3-1 != 0");
+
+ TstCond (Failure, (MinusOne == (Zero - One)), "-1 != 0-1");
+ TstCond (Failure, (MinusOne + One == Zero), "-1+1 != 0");
+ TstCond (Failure, (One + MinusOne == Zero), "1+(-1) != 0");
+ TstCond (Failure, (MinusOne + FABS (One) == Zero), "-1+abs(1) != 0");
+ TstCond (Failure, (MinusOne + MinusOne * MinusOne == Zero),
+ "-1+(-1)*(-1) != 0");
+
+ TstCond (Failure, Half + MinusOne + Half == Zero, "1/2 + (-1) + 1/2 != 0");
+
+ /*=============================================*/
+ Milestone = 10;
+ /*=============================================*/
+
+ TstCond (Failure, (Nine == Three * Three), "9 != 3*3");
+ TstCond (Failure, (TwentySeven == Nine * Three), "27 != 9*3");
+ TstCond (Failure, (Eight == Four + Four), "8 != 4+4");
+ TstCond (Failure, (ThirtyTwo == Eight * Four), "32 != 8*4");
+ TstCond (Failure, (ThirtyTwo - TwentySeven - Four - One == Zero),
+ "32-27-4-1 != 0");
+
+ TstCond (Failure, Five == Four + One, "5 != 4+1");
+ TstCond (Failure, TwoForty == Four * Five * Three * Four, "240 != 4*5*3*4");
+ TstCond (Failure, TwoForty / Three - Four * Four * Five == Zero,
+ "240/3 - 4*4*5 != 0");
+ TstCond (Failure, TwoForty / Four - Five * Three * Four == Zero,
+ "240/4 - 5*3*4 != 0");
+ TstCond (Failure, TwoForty / Five - Four * Three * Four == Zero,
+ "240/5 - 4*3*4 != 0");
+
+ if (ErrCnt[Failure] == 0)
+ {
+ printf ("-1, 0, 1/2, 1, 2, 3, 4, 5, 9, 27, 32 & 240 are O.K.\n");
+ printf ("\n");
+ }
+ printf ("Searching for Radix and Precision.\n");
+ W = One;
+ do
+ {
+ W = W + W;
+ Y = W + One;
+ Z = Y - W;
+ Y = Z - One;
+ }
+ while (MinusOne + FABS (Y) < Zero);
+ /*.. now W is just big enough that |((W+1)-W)-1| >= 1 ... */
+ Precision = Zero;
+ Y = One;
+ do
+ {
+ Radix = W + Y;
+ Y = Y + Y;
+ Radix = Radix - W;
+ }
+ while (Radix == Zero);
+ if (Radix < Two)
+ Radix = One;
+ printf ("Radix = %s .\n", Radix.str());
+ if (Radix != One)
+ {
+ W = One;
+ do
+ {
+ Precision = Precision + One;
+ W = W * Radix;
+ Y = W + One;
+ }
+ while ((Y - W) == One);
+ }
+ /*... now W == Radix^Precision is barely too big to satisfy (W+1)-W == 1
+ ... */
+ U1 = One / W;
+ U2 = Radix * U1;
+ printf ("Closest relative separation found is U1 = %s .\n\n", U1.str());
+ printf ("Recalculating radix and precision\n ");
+
+ /*save old values */
+ E0 = Radix;
+ E1 = U1;
+ E9 = U2;
+ E3 = Precision;
+
+ X = Four / Three;
+ Third = X - One;
+ F6 = Half - Third;
+ X = F6 + F6;
+ X = FABS (X - Third);
+ if (X < U2)
+ X = U2;
+
+ /*... now X = (unknown no.) ulps of 1+... */
+ do
+ {
+ U2 = X;
+ Y = Half * U2 + ThirtyTwo * U2 * U2;
+ Y = One + Y;
+ X = Y - One;
+ }
+ while (!((U2 <= X) || (X <= Zero)));
+
+ /*... now U2 == 1 ulp of 1 + ... */
+ X = Two / Three;
+ F6 = X - Half;
+ Third = F6 + F6;
+ X = Third - Half;
+ X = FABS (X + F6);
+ if (X < U1)
+ X = U1;
+
+ /*... now X == (unknown no.) ulps of 1 -... */
+ do
+ {
+ U1 = X;
+ Y = Half * U1 + ThirtyTwo * U1 * U1;
+ Y = Half - Y;
+ X = Half + Y;
+ Y = Half - X;
+ X = Half + Y;
+ }
+ while (!((U1 <= X) || (X <= Zero)));
+ /*... now U1 == 1 ulp of 1 - ... */
+ if (U1 == E1)
+ printf ("confirms closest relative separation U1 .\n");
+ else
+ printf ("gets better closest relative separation U1 = %s .\n", U1.str());
+ W = One / U1;
+ F9 = (Half - U1) + Half;
+
+ Radix = FLOOR (FLOAT ("0.01") + U2 / U1);
+ if (Radix == E0)
+ printf ("Radix confirmed.\n");
+ else
+ printf ("MYSTERY: recalculated Radix = %s .\n", Radix.str());
+ TstCond (Defect, Radix <= Eight + Eight,
+ "Radix is too big: roundoff problems");
+ TstCond (Flaw, (Radix == Two) || (Radix == 10)
+ || (Radix == One), "Radix is not as good as 2 or 10");
+ /*=============================================*/
+ Milestone = 20;
+ /*=============================================*/
+ TstCond (Failure, F9 - Half < Half,
+ "(1-U1)-1/2 < 1/2 is FALSE, prog. fails?");
+ X = F9;
+ I = 1;
+ Y = X - Half;
+ Z = Y - Half;
+ TstCond (Failure, (X != One)
+ || (Z == Zero), "Comparison is fuzzy,X=1 but X-1/2-1/2 != 0");
+ X = One + U2;
+ I = 0;
+ /*=============================================*/
+ Milestone = 25;
+ /*=============================================*/
+ /*... BMinusU2 = nextafter(Radix, 0) */
+ BMinusU2 = Radix - One;
+ BMinusU2 = (BMinusU2 - U2) + One;
+ /* Purify Integers */
+ if (Radix != One)
+ {
+ X = -TwoForty * LOG (U1) / LOG (Radix);
+ Y = FLOOR (Half + X);
+ if (FABS (X - Y) * Four < One)
+ X = Y;
+ Precision = X / TwoForty;
+ Y = FLOOR (Half + Precision);
+ if (FABS (Precision - Y) * TwoForty < Half)
+ Precision = Y;
+ }
+ if ((Precision != FLOOR (Precision)) || (Radix == One))
+ {
+ printf ("Precision cannot be characterized by an Integer number\n");
+ printf
+ ("of significant digits but, by itself, this is a minor flaw.\n");
+ }
+ if (Radix == One)
+ printf
+ ("logarithmic encoding has precision characterized solely by U1.\n");
+ else
+ printf ("The number of significant digits of the Radix is %s .\n",
+ Precision.str());
+ TstCond (Serious, U2 * Nine * Nine * TwoForty < One,
+ "Precision worse than 5 decimal figures ");
+ /*=============================================*/
+ Milestone = 30;
+ /*=============================================*/
+ /* Test for extra-precise subexpressions */
+ X = FABS (((Four / Three - One) - One / Four) * Three - One / Four);
+ do
+ {
+ Z2 = X;
+ X = (One + (Half * Z2 + ThirtyTwo * Z2 * Z2)) - One;
+ }
+ while (!((Z2 <= X) || (X <= Zero)));
+ X = Y = Z = FABS ((Three / Four - Two / Three) * Three - One / Four);
+ do
+ {
+ Z1 = Z;
+ Z = (One / Two - ((One / Two - (Half * Z1 + ThirtyTwo * Z1 * Z1))
+ + One / Two)) + One / Two;
+ }
+ while (!((Z1 <= Z) || (Z <= Zero)));
+ do
+ {
+ do
+ {
+ Y1 = Y;
+ Y =
+ (Half - ((Half - (Half * Y1 + ThirtyTwo * Y1 * Y1)) + Half)) +
+ Half;
+ }
+ while (!((Y1 <= Y) || (Y <= Zero)));
+ X1 = X;
+ X = ((Half * X1 + ThirtyTwo * X1 * X1) - F9) + F9;
+ }
+ while (!((X1 <= X) || (X <= Zero)));
+ if ((X1 != Y1) || (X1 != Z1))
+ {
+ BadCond (Serious, "Disagreements among the values X1, Y1, Z1,\n");
+ printf ("respectively %s, %s, %s,\n", X1.str(), Y1.str(), Z1.str());
+ printf ("are symptoms of inconsistencies introduced\n");
+ printf ("by extra-precise evaluation of arithmetic subexpressions.\n");
+ notify ("Possibly some part of this");
+ if ((X1 == U1) || (Y1 == U1) || (Z1 == U1))
+ printf ("That feature is not tested further by this program.\n");
+ }
+ else
+ {
+ if ((Z1 != U1) || (Z2 != U2))
+ {
+ if ((Z1 >= U1) || (Z2 >= U2))
+ {
+ BadCond (Failure, "");
+ notify ("Precision");
+ printf ("\tU1 = %s, Z1 - U1 = %s\n", U1.str(), (Z1 - U1).str());
+ printf ("\tU2 = %s, Z2 - U2 = %s\n", U2.str(), (Z2 - U2).str());
+ }
+ else
+ {
+ if ((Z1 <= Zero) || (Z2 <= Zero))
+ {
+ printf ("Because of unusual Radix = %s", Radix.str());
+ printf (", or exact rational arithmetic a result\n");
+ printf ("Z1 = %s, or Z2 = %s ", Z1.str(), Z2.str());
+ notify ("of an\nextra-precision");
+ }
+ if (Z1 != Z2 || Z1 > Zero)
+ {
+ X = Z1 / U1;
+ Y = Z2 / U2;
+ if (Y > X)
+ X = Y;
+ Q = -LOG (X);
+ printf ("Some subexpressions appear to be calculated "
+ "extra precisely\n");
+ printf ("with about %s extra B-digits, i.e.\n",
+ (Q / LOG (Radix)).str());
+ printf ("roughly %s extra significant decimals.\n",
+ (Q / LOG (FLOAT (10))).str());
+ }
+ printf
+ ("That feature is not tested further by this program.\n");
+ }
+ }
+ }
+ Pause ();
+ /*=============================================*/
+ Milestone = 35;
+ /*=============================================*/
+ if (Radix >= Two)
+ {
+ X = W / (Radix * Radix);
+ Y = X + One;
+ Z = Y - X;
+ T = Z + U2;
+ X = T - Z;
+ TstCond (Failure, X == U2,
+ "Subtraction is not normalized X=Y,X+Z != Y+Z!");
+ if (X == U2)
+ printf ("Subtraction appears to be normalized, as it should be.");
+ }
+ printf ("\nChecking for guard digit in *, /, and -.\n");
+ Y = F9 * One;
+ Z = One * F9;
+ X = F9 - Half;
+ Y = (Y - Half) - X;
+ Z = (Z - Half) - X;
+ X = One + U2;
+ T = X * Radix;
+ R = Radix * X;
+ X = T - Radix;
+ X = X - Radix * U2;
+ T = R - Radix;
+ T = T - Radix * U2;
+ X = X * (Radix - One);
+ T = T * (Radix - One);
+ if ((X == Zero) && (Y == Zero) && (Z == Zero) && (T == Zero))
+ GMult = Yes;
+ else
+ {
+ GMult = No;
+ TstCond (Serious, false, "* lacks a Guard Digit, so 1*X != X");
+ }
+ Z = Radix * U2;
+ X = One + Z;
+ Y = FABS ((X + Z) - X * X) - U2;
+ X = One - U2;
+ Z = FABS ((X - U2) - X * X) - U1;
+ TstCond (Failure, (Y <= Zero)
+ && (Z <= Zero), "* gets too many final digits wrong.\n");
+ Y = One - U2;
+ X = One + U2;
+ Z = One / Y;
+ Y = Z - X;
+ X = One / Three;
+ Z = Three / Nine;
+ X = X - Z;
+ T = Nine / TwentySeven;
+ Z = Z - T;
+ TstCond (Defect, X == Zero && Y == Zero && Z == Zero,
+ "Division lacks a Guard Digit, so error can exceed 1 ulp\n"
+ "or 1/3 and 3/9 and 9/27 may disagree");
+ Y = F9 / One;
+ X = F9 - Half;
+ Y = (Y - Half) - X;
+ X = One + U2;
+ T = X / One;
+ X = T - X;
+ if ((X == Zero) && (Y == Zero) && (Z == Zero))
+ GDiv = Yes;
+ else
+ {
+ GDiv = No;
+ TstCond (Serious, false, "Division lacks a Guard Digit, so X/1 != X");
+ }
+ X = One / (One + U2);
+ Y = X - Half - Half;
+ TstCond (Serious, Y < Zero, "Computed value of 1/1.000..1 >= 1");
+ X = One - U2;
+ Y = One + Radix * U2;
+ Z = X * Radix;
+ T = Y * Radix;
+ R = Z / Radix;
+ StickyBit = T / Radix;
+ X = R - X;
+ Y = StickyBit - Y;
+ TstCond (Failure, X == Zero && Y == Zero,
+ "* and/or / gets too many last digits wrong");
+ Y = One - U1;
+ X = One - F9;
+ Y = One - Y;
+ T = Radix - U2;
+ Z = Radix - BMinusU2;
+ T = Radix - T;
+ if ((X == U1) && (Y == U1) && (Z == U2) && (T == U2))
+ GAddSub = Yes;
+ else
+ {
+ GAddSub = No;
+ TstCond (Serious, false,
+ "- lacks Guard Digit, so cancellation is obscured");
+ }
+ if (F9 != One && F9 - One >= Zero)
+ {
+ BadCond (Serious, "comparison alleges (1-U1) < 1 although\n");
+ printf (" subtraction yields (1-U1) - 1 = 0 , thereby vitiating\n");
+ printf (" such precautions against division by zero as\n");
+ printf (" ... if (X == 1.0) {.....} else {.../(X-1.0)...}\n");
+ }
+ if (GMult == Yes && GDiv == Yes && GAddSub == Yes)
+ printf
+ (" *, /, and - appear to have guard digits, as they should.\n");
+ /*=============================================*/
+ Milestone = 40;
+ /*=============================================*/
+ Pause ();
+ printf ("Checking rounding on multiply, divide and add/subtract.\n");
+ RMult = Other;
+ RDiv = Other;
+ RAddSub = Other;
+ RadixD2 = Radix / Two;
+ A1 = Two;
+ Done = false;
+ do
+ {
+ AInvrse = Radix;
+ do
+ {
+ X = AInvrse;
+ AInvrse = AInvrse / A1;
+ }
+ while (!(FLOOR (AInvrse) != AInvrse));
+ Done = (X == One) || (A1 > Three);
+ if (!Done)
+ A1 = Nine + One;
+ }
+ while (!(Done));
+ if (X == One)
+ A1 = Radix;
+ AInvrse = One / A1;
+ X = A1;
+ Y = AInvrse;
+ Done = false;
+ do
+ {
+ Z = X * Y - Half;
+ TstCond (Failure, Z == Half, "X * (1/X) differs from 1");
+ Done = X == Radix;
+ X = Radix;
+ Y = One / X;
+ }
+ while (!(Done));
+ Y2 = One + U2;
+ Y1 = One - U2;
+ X = OneAndHalf - U2;
+ Y = OneAndHalf + U2;
+ Z = (X - U2) * Y2;
+ T = Y * Y1;
+ Z = Z - X;
+ T = T - X;
+ X = X * Y2;
+ Y = (Y + U2) * Y1;
+ X = X - OneAndHalf;
+ Y = Y - OneAndHalf;
+ if ((X == Zero) && (Y == Zero) && (Z == Zero) && (T <= Zero))
+ {
+ X = (OneAndHalf + U2) * Y2;
+ Y = OneAndHalf - U2 - U2;
+ Z = OneAndHalf + U2 + U2;
+ T = (OneAndHalf - U2) * Y1;
+ X = X - (Z + U2);
+ StickyBit = Y * Y1;
+ S = Z * Y2;
+ T = T - Y;
+ Y = (U2 - Y) + StickyBit;
+ Z = S - (Z + U2 + U2);
+ StickyBit = (Y2 + U2) * Y1;
+ Y1 = Y2 * Y1;
+ StickyBit = StickyBit - Y2;
+ Y1 = Y1 - Half;
+ if ((X == Zero) && (Y == Zero) && (Z == Zero) && (T == Zero)
+ && (StickyBit == Zero) && (Y1 == Half))
+ {
+ RMult = Rounded;
+ printf ("Multiplication appears to round correctly.\n");
+ }
+ else if ((X + U2 == Zero) && (Y < Zero) && (Z + U2 == Zero)
+ && (T < Zero) && (StickyBit + U2 == Zero) && (Y1 < Half))
+ {
+ RMult = Chopped;
+ printf ("Multiplication appears to chop.\n");
+ }
+ else
+ printf ("* is neither chopped nor correctly rounded.\n");
+ if ((RMult == Rounded) && (GMult == No))
+ notify ("Multiplication");
+ }
+ else
+ printf ("* is neither chopped nor correctly rounded.\n");
+ /*=============================================*/
+ Milestone = 45;
+ /*=============================================*/
+ Y2 = One + U2;
+ Y1 = One - U2;
+ Z = OneAndHalf + U2 + U2;
+ X = Z / Y2;
+ T = OneAndHalf - U2 - U2;
+ Y = (T - U2) / Y1;
+ Z = (Z + U2) / Y2;
+ X = X - OneAndHalf;
+ Y = Y - T;
+ T = T / Y1;
+ Z = Z - (OneAndHalf + U2);
+ T = (U2 - OneAndHalf) + T;
+ if (!((X > Zero) || (Y > Zero) || (Z > Zero) || (T > Zero)))
+ {
+ X = OneAndHalf / Y2;
+ Y = OneAndHalf - U2;
+ Z = OneAndHalf + U2;
+ X = X - Y;
+ T = OneAndHalf / Y1;
+ Y = Y / Y1;
+ T = T - (Z + U2);
+ Y = Y - Z;
+ Z = Z / Y2;
+ Y1 = (Y2 + U2) / Y2;
+ Z = Z - OneAndHalf;
+ Y2 = Y1 - Y2;
+ Y1 = (F9 - U1) / F9;
+ if ((X == Zero) && (Y == Zero) && (Z == Zero) && (T == Zero)
+ && (Y2 == Zero) && (Y2 == Zero) && (Y1 - Half == F9 - Half))
+ {
+ RDiv = Rounded;
+ printf ("Division appears to round correctly.\n");
+ if (GDiv == No)
+ notify ("Division");
+ }
+ else if ((X < Zero) && (Y < Zero) && (Z < Zero) && (T < Zero)
+ && (Y2 < Zero) && (Y1 - Half < F9 - Half))
+ {
+ RDiv = Chopped;
+ printf ("Division appears to chop.\n");
+ }
+ }
+ if (RDiv == Other)
+ printf ("/ is neither chopped nor correctly rounded.\n");
+ BInvrse = One / Radix;
+ TstCond (Failure, (BInvrse * Radix - Half == Half),
+ "Radix * ( 1 / Radix ) differs from 1");
+ /*=============================================*/
+ Milestone = 50;
+ /*=============================================*/
+ TstCond (Failure, ((F9 + U1) - Half == Half)
+ && ((BMinusU2 + U2) - One == Radix - One),
+ "Incomplete carry-propagation in Addition");
+ X = One - U1 * U1;
+ Y = One + U2 * (One - U2);
+ Z = F9 - Half;
+ X = (X - Half) - Z;
+ Y = Y - One;
+ if ((X == Zero) && (Y == Zero))
+ {
+ RAddSub = Chopped;
+ printf ("Add/Subtract appears to be chopped.\n");
+ }
+ if (GAddSub == Yes)
+ {
+ X = (Half + U2) * U2;
+ Y = (Half - U2) * U2;
+ X = One + X;
+ Y = One + Y;
+ X = (One + U2) - X;
+ Y = One - Y;
+ if ((X == Zero) && (Y == Zero))
+ {
+ X = (Half + U2) * U1;
+ Y = (Half - U2) * U1;
+ X = One - X;
+ Y = One - Y;
+ X = F9 - X;
+ Y = One - Y;
+ if ((X == Zero) && (Y == Zero))
+ {
+ RAddSub = Rounded;
+ printf ("Addition/Subtraction appears to round correctly.\n");
+ if (GAddSub == No)
+ notify ("Add/Subtract");
+ }
+ else
+ printf ("Addition/Subtraction neither rounds nor chops.\n");
+ }
+ else
+ printf ("Addition/Subtraction neither rounds nor chops.\n");
+ }
+ else
+ printf ("Addition/Subtraction neither rounds nor chops.\n");
+ S = One;
+ X = One + Half * (One + Half);
+ Y = (One + U2) * Half;
+ Z = X - Y;
+ T = Y - X;
+ StickyBit = Z + T;
+ if (StickyBit != Zero)
+ {
+ S = Zero;
+ BadCond (Flaw, "(X - Y) + (Y - X) is non zero!\n");
+ }
+ StickyBit = Zero;
+ if ((GMult == Yes) && (GDiv == Yes) && (GAddSub == Yes)
+ && (RMult == Rounded) && (RDiv == Rounded)
+ && (RAddSub == Rounded) && (FLOOR (RadixD2) == RadixD2))
+ {
+ printf ("Checking for sticky bit.\n");
+ X = (Half + U1) * U2;
+ Y = Half * U2;
+ Z = One + Y;
+ T = One + X;
+ if ((Z - One <= Zero) && (T - One >= U2))
+ {
+ Z = T + Y;
+ Y = Z - X;
+ if ((Z - T >= U2) && (Y - T == Zero))
+ {
+ X = (Half + U1) * U1;
+ Y = Half * U1;
+ Z = One - Y;
+ T = One - X;
+ if ((Z - One == Zero) && (T - F9 == Zero))
+ {
+ Z = (Half - U1) * U1;
+ T = F9 - Z;
+ Q = F9 - Y;
+ if ((T - F9 == Zero) && (F9 - U1 - Q == Zero))
+ {
+ Z = (One + U2) * OneAndHalf;
+ T = (OneAndHalf + U2) - Z + U2;
+ X = One + Half / Radix;
+ Y = One + Radix * U2;
+ Z = X * Y;
+ if (T == Zero && X + Radix * U2 - Z == Zero)
+ {
+ if (Radix != Two)
+ {
+ X = Two + U2;
+ Y = X / Two;
+ if ((Y - One == Zero))
+ StickyBit = S;
+ }
+ else
+ StickyBit = S;
+ }
+ }
+ }
+ }
+ }
+ }
+ if (StickyBit == One)
+ printf ("Sticky bit apparently used correctly.\n");
+ else
+ printf ("Sticky bit used incorrectly or not at all.\n");
+ TstCond (Flaw, !(GMult == No || GDiv == No || GAddSub == No ||
+ RMult == Other || RDiv == Other || RAddSub == Other),
+ "lack(s) of guard digits or failure(s) to correctly round or chop\n\
+(noted above) count as one flaw in the final tally below");
+ /*=============================================*/
+ Milestone = 60;
+ /*=============================================*/
+ printf ("\n");
+ printf ("Does Multiplication commute? ");
+ printf ("Testing on %d random pairs.\n", NoTrials);
+ Random9 = SQRT (FLOAT (3));
+ Random1 = Third;
+ I = 1;
+ do
+ {
+ X = Random ();
+ Y = Random ();
+ Z9 = Y * X;
+ Z = X * Y;
+ Z9 = Z - Z9;
+ I = I + 1;
+ }
+ while (!((I > NoTrials) || (Z9 != Zero)));
+ if (I == NoTrials)
+ {
+ Random1 = One + Half / Three;
+ Random2 = (U2 + U1) + One;
+ Z = Random1 * Random2;
+ Y = Random2 * Random1;
+ Z9 = (One + Half / Three) * ((U2 + U1) + One) - (One + Half /
+ Three) * ((U2 + U1) +
+ One);
+ }
+ if (!((I == NoTrials) || (Z9 == Zero)))
+ BadCond (Defect, "X * Y == Y * X trial fails.\n");
+ else
+ printf (" No failures found in %d integer pairs.\n", NoTrials);
+ /*=============================================*/
+ Milestone = 70;
+ /*=============================================*/
+ printf ("\nRunning test of square root(x).\n");
+ TstCond (Failure, (Zero == SQRT (Zero))
+ && (-Zero == SQRT (-Zero))
+ && (One == SQRT (One)), "Square root of 0.0, -0.0 or 1.0 wrong");
+ MinSqEr = Zero;
+ MaxSqEr = Zero;
+ J = Zero;
+ X = Radix;
+ OneUlp = U2;
+ SqXMinX (Serious);
+ X = BInvrse;
+ OneUlp = BInvrse * U1;
+ SqXMinX (Serious);
+ X = U1;
+ OneUlp = U1 * U1;
+ SqXMinX (Serious);
+ if (J != Zero)
+ Pause ();
+ printf ("Testing if sqrt(X * X) == X for %d Integers X.\n", NoTrials);
+ J = Zero;
+ X = Two;
+ Y = Radix;
+ if ((Radix != One))
+ do
+ {
+ X = Y;
+ Y = Radix * Y;
+ }
+ while (!((Y - X >= NoTrials)));
+ OneUlp = X * U2;
+ I = 1;
+ while (I <= NoTrials)
+ {
+ X = X + One;
+ SqXMinX (Defect);
+ if (J > Zero)
+ break;
+ I = I + 1;
+ }
+ printf ("Test for sqrt monotonicity.\n");
+ I = -1;
+ X = BMinusU2;
+ Y = Radix;
+ Z = Radix + Radix * U2;
+ NotMonot = false;
+ Monot = false;
+ while (!(NotMonot || Monot))
+ {
+ I = I + 1;
+ X = SQRT (X);
+ Q = SQRT (Y);
+ Z = SQRT (Z);
+ if ((X > Q) || (Q > Z))
+ NotMonot = true;
+ else
+ {
+ Q = FLOOR (Q + Half);
+ if (!(I > 0 || Radix == Q * Q))
+ Monot = true;
+ else if (I > 0)
+ {
+ if (I > 1)
+ Monot = true;
+ else
+ {
+ Y = Y * BInvrse;
+ X = Y - U1;
+ Z = Y + U1;
+ }
+ }
+ else
+ {
+ Y = Q;
+ X = Y - U2;
+ Z = Y + U2;
+ }
+ }
+ }
+ if (Monot)
+ printf ("sqrt has passed a test for Monotonicity.\n");
+ else
+ {
+ BadCond (Defect, "");
+ printf ("sqrt(X) is non-monotonic for X near %s .\n", Y.str());
+ }
+ /*=============================================*/
+ Milestone = 110;
+ /*=============================================*/
+ printf ("Seeking Underflow thresholds UfThold and E0.\n");
+ D = U1;
+ if (Precision != FLOOR (Precision))
+ {
+ D = BInvrse;
+ X = Precision;
+ do
+ {
+ D = D * BInvrse;
+ X = X - One;
+ }
+ while (X > Zero);
+ }
+ Y = One;
+ Z = D;
+ /* ... D is power of 1/Radix < 1. */
+ do
+ {
+ C = Y;
+ Y = Z;
+ Z = Y * Y;
+ }
+ while ((Y > Z) && (Z + Z > Z));
+ Y = C;
+ Z = Y * D;
+ do
+ {
+ C = Y;
+ Y = Z;
+ Z = Y * D;
+ }
+ while ((Y > Z) && (Z + Z > Z));
+ if (Radix < Two)
+ HInvrse = Two;
+ else
+ HInvrse = Radix;
+ H = One / HInvrse;
+ /* ... 1/HInvrse == H == Min(1/Radix, 1/2) */
+ CInvrse = One / C;
+ E0 = C;
+ Z = E0 * H;
+ /* ...1/Radix^(BIG Integer) << 1 << CInvrse == 1/C */
+ do
+ {
+ Y = E0;
+ E0 = Z;
+ Z = E0 * H;
+ }
+ while ((E0 > Z) && (Z + Z > Z));
+ UfThold = E0;
+ E1 = Zero;
+ Q = Zero;
+ E9 = U2;
+ S = One + E9;
+ D = C * S;
+ if (D <= C)
+ {
+ E9 = Radix * U2;
+ S = One + E9;
+ D = C * S;
+ if (D <= C)
+ {
+ BadCond (Failure,
+ "multiplication gets too many last digits wrong.\n");
+ Underflow = E0;
+ Y1 = Zero;
+ PseudoZero = Z;
+ Pause ();
+ }
+ }
+ else
+ {
+ Underflow = D;
+ PseudoZero = Underflow * H;
+ UfThold = Zero;
+ do
+ {
+ Y1 = Underflow;
+ Underflow = PseudoZero;
+ if (E1 + E1 <= E1)
+ {
+ Y2 = Underflow * HInvrse;
+ E1 = FABS (Y1 - Y2);
+ Q = Y1;
+ if ((UfThold == Zero) && (Y1 != Y2))
+ UfThold = Y1;
+ }
+ PseudoZero = PseudoZero * H;
+ }
+ while ((Underflow > PseudoZero)
+ && (PseudoZero + PseudoZero > PseudoZero));
+ }
+ /* Comment line 4530 .. 4560 */
+ if (PseudoZero != Zero)
+ {
+ printf ("\n");
+ Z = PseudoZero;
+ /* ... Test PseudoZero for "phoney- zero" violates */
+ /* ... PseudoZero < Underflow or PseudoZero < PseudoZero + PseudoZero
+ ... */
+ if (PseudoZero <= Zero)
+ {
+ BadCond (Failure, "Positive expressions can underflow to an\n");
+ printf ("allegedly negative value\n");
+ printf ("PseudoZero that prints out as: %s .\n", PseudoZero.str());
+ X = -PseudoZero;
+ if (X <= Zero)
+ {
+ printf ("But -PseudoZero, which should be\n");
+ printf ("positive, isn't; it prints out as %s .\n", X.str());
+ }
+ }
+ else
+ {
+ BadCond (Flaw, "Underflow can stick at an allegedly positive\n");
+ printf ("value PseudoZero that prints out as %s .\n",
+ PseudoZero.str());
+ }
+ TstPtUf ();
+ }
+ /*=============================================*/
+ Milestone = 120;
+ /*=============================================*/
+ if (CInvrse * Y > CInvrse * Y1)
+ {
+ S = H * S;
+ E0 = Underflow;
+ }
+ if (!((E1 == Zero) || (E1 == E0)))
+ {
+ BadCond (Defect, "");
+ if (E1 < E0)
+ {
+ printf ("Products underflow at a higher");
+ printf (" threshold than differences.\n");
+ if (PseudoZero == Zero)
+ E0 = E1;
+ }
+ else
+ {
+ printf ("Difference underflows at a higher");
+ printf (" threshold than products.\n");
+ }
+ }
+ printf ("Smallest strictly positive number found is E0 = %s .\n", E0.str());
+ Z = E0;
+ TstPtUf ();
+ Underflow = E0;
+ if (N == 1)
+ Underflow = Y;
+ I = 4;
+ if (E1 == Zero)
+ I = 3;
+ if (UfThold == Zero)
+ I = I - 2;
+ UfNGrad = true;
+ switch (I)
+ {
+ case 1:
+ UfThold = Underflow;
+ if ((CInvrse * Q) != ((CInvrse * Y) * S))
+ {
+ UfThold = Y;
+ BadCond (Failure, "Either accuracy deteriorates as numbers\n");
+ printf ("approach a threshold = %s\n", UfThold.str());
+ printf (" coming down from %s\n", C.str());
+ printf
+ (" or else multiplication gets too many last digits wrong.\n");
+ }
+ Pause ();
+ break;
+
+ case 2:
+ BadCond (Failure,
+ "Underflow confuses Comparison, which alleges that\n");
+ printf ("Q == Y while denying that |Q - Y| == 0; these values\n");
+ printf ("print out as Q = %s, Y = %s .\n", Q.str(), Y2.str());
+ printf ("|Q - Y| = %s .\n", FABS (Q - Y2).str());
+ UfThold = Q;
+ break;
+
+ case 3:
+ X = X;
+ break;
+
+ case 4:
+ if ((Q == UfThold) && (E1 == E0) && (FABS (UfThold - E1 / E9) <= E1))
+ {
+ UfNGrad = false;
+ printf ("Underflow is gradual; it incurs Absolute Error =\n");
+ printf ("(roundoff in UfThold) < E0.\n");
+ Y = E0 * CInvrse;
+ Y = Y * (OneAndHalf + U2);
+ X = CInvrse * (One + U2);
+ Y = Y / X;
+ IEEE = (Y == E0);
+ }
+ }
+ if (UfNGrad)
+ {
+ printf ("\n");
+ if (setjmp (ovfl_buf))
+ {
+ printf ("Underflow / UfThold failed!\n");
+ R = H + H;
+ }
+ else
+ R = SQRT (Underflow / UfThold);
+ if (R <= H)
+ {
+ Z = R * UfThold;
+ X = Z * (One + R * H * (One + H));
+ }
+ else
+ {
+ Z = UfThold;
+ X = Z * (One + H * H * (One + H));
+ }
+ if (!((X == Z) || (X - Z != Zero)))
+ {
+ BadCond (Flaw, "");
+ printf ("X = %s\n\tis not equal to Z = %s .\n", X.str(), Z.str());
+ Z9 = X - Z;
+ printf ("yet X - Z yields %s .\n", Z9.str());
+ printf (" Should this NOT signal Underflow, ");
+ printf ("this is a SERIOUS DEFECT\nthat causes ");
+ printf ("confusion when innocent statements like\n");;
+ printf (" if (X == Z) ... else");
+ printf (" ... (f(X) - f(Z)) / (X - Z) ...\n");
+ printf ("encounter Division by Zero although actually\n");
+ if (setjmp (ovfl_buf))
+ printf ("X / Z fails!\n");
+ else
+ printf ("X / Z = 1 + %s .\n", ((X / Z - Half) - Half).str());
+ }
+ }
+ printf ("The Underflow threshold is %s, below which\n", UfThold.str());
+ printf ("calculation may suffer larger Relative error than ");
+ printf ("merely roundoff.\n");
+ Y2 = U1 * U1;
+ Y = Y2 * Y2;
+ Y2 = Y * U1;
+ if (Y2 <= UfThold)
+ {
+ if (Y > E0)
+ {
+ BadCond (Defect, "");
+ I = 5;
+ }
+ else
+ {
+ BadCond (Serious, "");
+ I = 4;
+ }
+ printf ("Range is too narrow; U1^%d Underflows.\n", I);
+ }
+ /*=============================================*/
+ Milestone = 130;
+ /*=============================================*/
+ Y = -FLOOR (Half - TwoForty * LOG (UfThold) / LOG (HInvrse)) / TwoForty;
+ Y2 = Y + Y;
+ printf ("Since underflow occurs below the threshold\n");
+ printf ("UfThold = (%s) ^ (%s)\nonly underflow ", HInvrse.str(), Y.str());
+ printf ("should afflict the expression\n\t(%s) ^ (%s);\n",
+ HInvrse.str(), Y2.str());
+ printf ("actually calculating yields:");
+ if (setjmp (ovfl_buf))
+ {
+ BadCond (Serious, "trap on underflow.\n");
+ }
+ else
+ {
+ V9 = POW (HInvrse, Y2);
+ printf (" %s .\n", V9.str());
+ if (!((V9 >= Zero) && (V9 <= (Radix + Radix + E9) * UfThold)))
+ {
+ BadCond (Serious, "this is not between 0 and underflow\n");
+ printf (" threshold = %s .\n", UfThold.str());
+ }
+ else if (!(V9 > UfThold * (One + E9)))
+ printf ("This computed value is O.K.\n");
+ else
+ {
+ BadCond (Defect, "this is not between 0 and underflow\n");
+ printf (" threshold = %s .\n", UfThold.str());
+ }
+ }
+ /*=============================================*/
+ Milestone = 160;
+ /*=============================================*/
+ Pause ();
+ printf ("Searching for Overflow threshold:\n");
+ printf ("This may generate an error.\n");
+ Y = -CInvrse;
+ V9 = HInvrse * Y;
+ if (setjmp (ovfl_buf))
+ {
+ I = 0;
+ V9 = Y;
+ goto overflow;
+ }
+ do
+ {
+ V = Y;
+ Y = V9;
+ V9 = HInvrse * Y;
+ }
+ while (V9 < Y);
+ I = 1;
+overflow:
+ Z = V9;
+ printf ("Can `Z = -Y' overflow?\n");
+ printf ("Trying it on Y = %s .\n", Y.str());
+ V9 = -Y;
+ V0 = V9;
+ if (V - Y == V + V0)
+ printf ("Seems O.K.\n");
+ else
+ {
+ printf ("finds a ");
+ BadCond (Flaw, "-(-Y) differs from Y.\n");
+ }
+ if (Z != Y)
+ {
+ BadCond (Serious, "");
+ printf ("overflow past %s\n\tshrinks to %s .\n", Y.str(), Z.str());
+ }
+ if (I)
+ {
+ Y = V * (HInvrse * U2 - HInvrse);
+ Z = Y + ((One - HInvrse) * U2) * V;
+ if (Z < V0)
+ Y = Z;
+ if (Y < V0)
+ V = Y;
+ if (V0 - V < V0)
+ V = V0;
+ }
+ else
+ {
+ V = Y * (HInvrse * U2 - HInvrse);
+ V = V + ((One - HInvrse) * U2) * Y;
+ }
+ printf ("Overflow threshold is V = %s .\n", V.str());
+ if (I)
+ printf ("Overflow saturates at V0 = %s .\n", V0.str());
+ else
+ printf ("There is no saturation value because "
+ "the system traps on overflow.\n");
+ V9 = V * One;
+ printf ("No Overflow should be signaled for V * 1 = %s\n", V9.str());
+ V9 = V / One;
+ printf (" nor for V / 1 = %s.\n", V9.str());
+ printf ("Any overflow signal separating this * from the one\n");
+ printf ("above is a DEFECT.\n");
+ /*=============================================*/
+ Milestone = 170;
+ /*=============================================*/
+ if (!(-V < V && -V0 < V0 && -UfThold < V && UfThold < V))
+ {
+ BadCond (Failure, "Comparisons involving ");
+ printf ("+-%s, +-%s\nand +-%s are confused by Overflow.",
+ V.str(), V0.str(), UfThold.str());
+ }
+ /*=============================================*/
+ Milestone = 175;
+ /*=============================================*/
+ printf ("\n");
+ for (Indx = 1; Indx <= 3; ++Indx)
+ {
+ switch (Indx)
+ {
+ case 1:
+ Z = UfThold;
+ break;
+ case 2:
+ Z = E0;
+ break;
+ case 3:
+ Z = PseudoZero;
+ break;
+ }
+ if (Z != Zero)
+ {
+ V9 = SQRT (Z);
+ Y = V9 * V9;
+ if (Y / (One - Radix * E9) < Z || Y > (One + Radix * E9) * Z)
+ { /* dgh: + E9 --> * E9 */
+ if (V9 > U1)
+ BadCond (Serious, "");
+ else
+ BadCond (Defect, "");
+ printf ("Comparison alleges that what prints as Z = %s\n",
+ Z.str());
+ printf (" is too far from sqrt(Z) ^ 2 = %s .\n", Y.str());
+ }
+ }
+ }
+ /*=============================================*/
+ Milestone = 180;
+ /*=============================================*/
+ for (Indx = 1; Indx <= 2; ++Indx)
+ {
+ if (Indx == 1)
+ Z = V;
+ else
+ Z = V0;
+ V9 = SQRT (Z);
+ X = (One - Radix * E9) * V9;
+ V9 = V9 * X;
+ if (((V9 < (One - Two * Radix * E9) * Z) || (V9 > Z)))
+ {
+ Y = V9;
+ if (X < W)
+ BadCond (Serious, "");
+ else
+ BadCond (Defect, "");
+ printf ("Comparison alleges that Z = %s\n", Z.str());
+ printf (" is too far from sqrt(Z) ^ 2 (%s) .\n", Y.str());
+ }
+ }
+ /*=============================================*/
+ Milestone = 190;
+ /*=============================================*/
+ Pause ();
+ X = UfThold * V;
+ Y = Radix * Radix;
+ if (X * Y < One || X > Y)
+ {
+ if (X * Y < U1 || X > Y / U1)
+ BadCond (Defect, "Badly");
+ else
+ BadCond (Flaw, "");
+
+ printf (" unbalanced range; UfThold * V = %s\n\t%s\n",
+ X.str(), "is too far from 1.\n");
+ }
+ /*=============================================*/
+ Milestone = 200;
+ /*=============================================*/
+ for (Indx = 1; Indx <= 5; ++Indx)
+ {
+ X = F9;
+ switch (Indx)
+ {
+ case 2:
+ X = One + U2;
+ break;
+ case 3:
+ X = V;
+ break;
+ case 4:
+ X = UfThold;
+ break;
+ case 5:
+ X = Radix;
+ }
+ Y = X;
+ if (setjmp (ovfl_buf))
+ printf (" X / X traps when X = %s\n", X.str());
+ else
+ {
+ V9 = (Y / X - Half) - Half;
+ if (V9 == Zero)
+ continue;
+ if (V9 == -U1 && Indx < 5)
+ BadCond (Flaw, "");
+ else
+ BadCond (Serious, "");
+ printf (" X / X differs from 1 when X = %s\n", X.str());
+ printf (" instead, X / X - 1/2 - 1/2 = %s .\n", V9.str());
+ }
+ }
+ /*=============================================*/
+ Milestone = 210;
+ /*=============================================*/
+ MyZero = Zero;
+ printf ("\n");
+ printf ("What message and/or values does Division by Zero produce?\n");
+ printf (" Trying to compute 1 / 0 produces ...");
+ if (!setjmp (ovfl_buf))
+ printf (" %s .\n", (One / MyZero).str());
+ printf ("\n Trying to compute 0 / 0 produces ...");
+ if (!setjmp (ovfl_buf))
+ printf (" %s .\n", (Zero / MyZero).str());
+ /*=============================================*/
+ Milestone = 220;
+ /*=============================================*/
+ Pause ();
+ printf ("\n");
+ {
+ static const char *msg[] = {
+ "FAILUREs encountered =",
+ "SERIOUS DEFECTs discovered =",
+ "DEFECTs discovered =",
+ "FLAWs discovered ="
+ };
+ int i;
+ for (i = 0; i < 4; i++)
+ if (ErrCnt[i])
+ printf ("The number of %-29s %d.\n", msg[i], ErrCnt[i]);
+ }
+ printf ("\n");
+ if ((ErrCnt[Failure] + ErrCnt[Serious] + ErrCnt[Defect] + ErrCnt[Flaw]) > 0)
+ {
+ if ((ErrCnt[Failure] + ErrCnt[Serious] + ErrCnt[Defect] == 0)
+ && (ErrCnt[Flaw] > 0))
+ {
+ printf ("The arithmetic diagnosed seems ");
+ printf ("Satisfactory though flawed.\n");
+ }
+ if ((ErrCnt[Failure] + ErrCnt[Serious] == 0) && (ErrCnt[Defect] > 0))
+ {
+ printf ("The arithmetic diagnosed may be Acceptable\n");
+ printf ("despite inconvenient Defects.\n");
+ }
+ if ((ErrCnt[Failure] + ErrCnt[Serious]) > 0)
+ {
+ printf ("The arithmetic diagnosed has ");
+ printf ("unacceptable Serious Defects.\n");
+ }
+ if (ErrCnt[Failure] > 0)
+ {
+ printf ("Potentially fatal FAILURE may have spoiled this");
+ printf (" program's subsequent diagnoses.\n");
+ }
+ }
+ else
+ {
+ printf ("No failures, defects nor flaws have been discovered.\n");
+ if (!((RMult == Rounded) && (RDiv == Rounded)
+ && (RAddSub == Rounded) && (RSqrt == Rounded)))
+ printf ("The arithmetic diagnosed seems Satisfactory.\n");
+ else
+ {
+ if (StickyBit >= One &&
+ (Radix - Two) * (Radix - Nine - One) == Zero)
+ {
+ printf ("Rounding appears to conform to ");
+ printf ("the proposed IEEE standard P");
+ if ((Radix == Two) &&
+ ((Precision - Four * Three * Two) *
+ (Precision - TwentySeven - TwentySeven + One) == Zero))
+ printf ("754");
+ else
+ printf ("854");
+ if (IEEE)
+ printf (".\n");
+ else
+ {
+ printf (",\nexcept for possibly Double Rounding");
+ printf (" during Gradual Underflow.\n");
+ }
+ }
+ printf ("The arithmetic diagnosed appears to be Excellent!\n");
+ }
+ }
+ printf ("END OF TEST.\n");
+ return 0;
+}
+
+template<typename FLOAT>
+FLOAT
+Paranoia<FLOAT>::Sign (FLOAT X)
+{
+ return X >= FLOAT (long (0)) ? 1 : -1;
+}
+
+template<typename FLOAT>
+void
+Paranoia<FLOAT>::Pause ()
+{
+ if (do_pause)
+ {
+ fputs ("Press return...", stdout);
+ fflush (stdout);
+ getchar();
+ }
+ printf ("\nDiagnosis resumes after milestone Number %d", Milestone);
+ printf (" Page: %d\n\n", PageNo);
+ ++Milestone;
+ ++PageNo;
+}
+
+template<typename FLOAT>
+void
+Paranoia<FLOAT>::TstCond (int K, int Valid, const char *T)
+{
+ if (!Valid)
+ {
+ BadCond (K, T);
+ printf (".\n");
+ }
+}
+
+template<typename FLOAT>
+void
+Paranoia<FLOAT>::BadCond (int K, const char *T)
+{
+ static const char *msg[] = { "FAILURE", "SERIOUS DEFECT", "DEFECT", "FLAW" };
+
+ ErrCnt[K] = ErrCnt[K] + 1;
+ printf ("%s: %s", msg[K], T);
+}
+
+/* Random computes
+ X = (Random1 + Random9)^5
+ Random1 = X - FLOOR(X) + 0.000005 * X;
+ and returns the new value of Random1. */
+
+template<typename FLOAT>
+FLOAT
+Paranoia<FLOAT>::Random ()
+{
+ FLOAT X, Y;
+
+ X = Random1 + Random9;
+ Y = X * X;
+ Y = Y * Y;
+ X = X * Y;
+ Y = X - FLOOR (X);
+ Random1 = Y + X * FLOAT ("0.000005");
+ return (Random1);
+}
+
+template<typename FLOAT>
+void
+Paranoia<FLOAT>::SqXMinX (int ErrKind)
+{
+ FLOAT XA, XB;
+
+ XB = X * BInvrse;
+ XA = X - XB;
+ SqEr = ((SQRT (X * X) - XB) - XA) / OneUlp;
+ if (SqEr != Zero)
+ {
+ if (SqEr < MinSqEr)
+ MinSqEr = SqEr;
+ if (SqEr > MaxSqEr)
+ MaxSqEr = SqEr;
+ J = J + 1;
+ BadCond (ErrKind, "\n");
+ printf ("sqrt(%s) - %s = %s\n", (X * X).str(), X.str(),
+ (OneUlp * SqEr).str());
+ printf ("\tinstead of correct value 0 .\n");
+ }
+}
+
+template<typename FLOAT>
+void
+Paranoia<FLOAT>::NewD ()
+{
+ X = Z1 * Q;
+ X = FLOOR (Half - X / Radix) * Radix + X;
+ Q = (Q - X * Z) / Radix + X * X * (D / Radix);
+ Z = Z - Two * X * D;
+ if (Z <= Zero)
+ {
+ Z = -Z;
+ Z1 = -Z1;
+ }
+ D = Radix * D;
+}
+
+template<typename FLOAT>
+void
+Paranoia<FLOAT>::SR3750 ()
+{
+ if (!((X - Radix < Z2 - Radix) || (X - Z2 > W - Z2)))
+ {
+ I = I + 1;
+ X2 = SQRT (X * D);
+ Y2 = (X2 - Z2) - (Y - Z2);
+ X2 = X8 / (Y - Half);
+ X2 = X2 - Half * X2 * X2;
+ SqEr = (Y2 + Half) + (Half - X2);
+ if (SqEr < MinSqEr)
+ MinSqEr = SqEr;
+ SqEr = Y2 - X2;
+ if (SqEr > MaxSqEr)
+ MaxSqEr = SqEr;
+ }
+}
+
+template<typename FLOAT>
+void
+Paranoia<FLOAT>::IsYeqX ()
+{
+ if (Y != X)
+ {
+ if (N <= 0)
+ {
+ if (Z == Zero && Q <= Zero)
+ printf ("WARNING: computing\n");
+ else
+ BadCond (Defect, "computing\n");
+ printf ("\t(%s) ^ (%s)\n", Z.str(), Q.str());
+ printf ("\tyielded %s;\n", Y.str());
+ printf ("\twhich compared unequal to correct %s ;\n", X.str());
+ printf ("\t\tthey differ by %s .\n", (Y - X).str());
+ }
+ N = N + 1; /* ... count discrepancies. */
+ }
+}
+
+template<typename FLOAT>
+void
+Paranoia<FLOAT>::PrintIfNPositive ()
+{
+ if (N > 0)
+ printf ("Similar discrepancies have occurred %d times.\n", N);
+}
+
+template<typename FLOAT>
+void
+Paranoia<FLOAT>::TstPtUf ()
+{
+ N = 0;
+ if (Z != Zero)
+ {
+ printf ("Since comparison denies Z = 0, evaluating ");
+ printf ("(Z + Z) / Z should be safe.\n");
+ if (setjmp (ovfl_buf))
+ goto very_serious;
+ Q9 = (Z + Z) / Z;
+ printf ("What the machine gets for (Z + Z) / Z is %s .\n", Q9.str());
+ if (FABS (Q9 - Two) < Radix * U2)
+ {
+ printf ("This is O.K., provided Over/Underflow");
+ printf (" has NOT just been signaled.\n");
+ }
+ else
+ {
+ if ((Q9 < One) || (Q9 > Two))
+ {
+ very_serious:
+ N = 1;
+ ErrCnt[Serious] = ErrCnt[Serious] + 1;
+ printf ("This is a VERY SERIOUS DEFECT!\n");
+ }
+ else
+ {
+ N = 1;
+ ErrCnt[Defect] = ErrCnt[Defect] + 1;
+ printf ("This is a DEFECT!\n");
+ }
+ }
+ V9 = Z * One;
+ Random1 = V9;
+ V9 = One * Z;
+ Random2 = V9;
+ V9 = Z / One;
+ if ((Z == Random1) && (Z == Random2) && (Z == V9))
+ {
+ if (N > 0)
+ Pause ();
+ }
+ else
+ {
+ N = 1;
+ BadCond (Defect, "What prints as Z = ");
+ printf ("%s\n\tcompares different from ", Z.str());
+ if (Z != Random1)
+ printf ("Z * 1 = %s ", Random1.str());
+ if (!((Z == Random2) || (Random2 == Random1)))
+ printf ("1 * Z == %s\n", Random2.str());
+ if (!(Z == V9))
+ printf ("Z / 1 = %s\n", V9.str());
+ if (Random2 != Random1)
+ {
+ ErrCnt[Defect] = ErrCnt[Defect] + 1;
+ BadCond (Defect, "Multiplication does not commute!\n");
+ printf ("\tComparison alleges that 1 * Z = %s\n", Random2.str());
+ printf ("\tdiffers from Z * 1 = %s\n", Random1.str());
+ }
+ Pause ();
+ }
+ }
+}
+
+template<typename FLOAT>
+void
+Paranoia<FLOAT>::notify (const char *s)
+{
+ printf ("%s test appears to be inconsistent...\n", s);
+ printf (" PLEASE NOTIFY KARPINKSI!\n");
+}
+
+/* ====================================================================== */
+
+int main(int ac, char **av)
+{
+ init_real_once ();
+
+ while (1)
+ switch (getopt (ac, av, "pvg:fdl"))
+ {
+ case -1:
+ return 0;
+ case 'p':
+ do_pause = true;
+ break;
+ case 'v':
+ verbose = true;
+ break;
+ case 'g':
+ {
+ int size = strtol (optarg, 0, 0);
+
+ switch (size)
+ {
+ case 32:
+ Paranoia< real_c_float<32, SFmode> >().main();
+ break;
+
+ case 64:
+ Paranoia< real_c_float<64, DFmode> >().main();
+ break;
+
+ case 96:
+ Paranoia< real_c_float<96, XFmode> >().main();
+ break;
+
+ case 128:
+ Paranoia< real_c_float<128, TFmode> >().main();
+ break;
+
+ default:
+ puts ("Invalid gcc implementation size.");
+ return 1;
+ }
+ break;
+ }
+
+ case 'f':
+ Paranoia < native_float<float> >().main();
+ break;
+ case 'd':
+ Paranoia < native_float<double> >().main();
+ break;
+ case 'l':
+#ifndef NO_LONG_DOUBLE
+ Paranoia < native_float<long double> >().main();
+#endif
+ break;
+
+ case '?':
+ puts ("-p\tpause between pages");
+ puts ("-g<N>\treal.c implementation size N");
+ puts ("-f\tnative float");
+ puts ("-d\tnative double");
+ puts ("-l\tnative long double");
+ return 0;
+ }
+}
+
+/* GCC stuff referenced by real.o. */
+
+extern "C" void
+fancy_abort ()
+{
+ abort ();
+}
+
+int target_flags = 0;
+
+extern "C"
+enum machine_mode
+mode_for_size (unsigned int size, enum mode_class, int)
+{
+ switch (size)
+ {
+ case 32:
+ return SFmode;
+ case 64:
+ return DFmode;
+ case 96:
+ return XFmode;
+ case 128:
+ return TFmode;
+ }
+ abort ();
+}
-/* real.c - implementation of REAL_ARITHMETIC, REAL_VALUE_ATOF,
- and support for XFmode IEEE extended real floating point arithmetic.
+/* real.c - software floating point emulation.
Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998,
1999, 2000, 2002 Free Software Foundation, Inc.
Contributed by Stephen L. Moshier (moshier@world.std.com).
+ Re-written by Richard Henderson <rth@redhat.com>
-This file is part of GCC.
+ This file is part of GCC.
-GCC is free software; you can redistribute it and/or modify it under
-the terms of the GNU General Public License as published by the Free
-Software Foundation; either version 2, or (at your option) any later
-version.
+ GCC is free software; you can redistribute it and/or modify it under
+ the terms of the GNU General Public License as published by the Free
+ Software Foundation; either version 2, or (at your option) any later
+ version.
-GCC is distributed in the hope that it will be useful, but WITHOUT ANY
-WARRANTY; without even the implied warranty of MERCHANTABILITY or
-FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-for more details.
+ GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+ WARRANTY; without even the implied warranty of MERCHANTABILITY or
+ FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+ for more details.
-You should have received a copy of the GNU General Public License
-along with GCC; see the file COPYING. If not, write to the Free
-Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-02111-1307, USA. */
+ You should have received a copy of the GNU General Public License
+ along with GCC; see the file COPYING. If not, write to the Free
+ Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+ 02111-1307, USA. */
#include "config.h"
#include "system.h"
-#include "real.h"
#include "tree.h"
#include "toplev.h"
+#include "real.h"
#include "tm_p.h"
-/* To enable support of XFmode extended real floating point, define
-LONG_DOUBLE_TYPE_SIZE 96 in the tm.h file (m68k.h or i386.h).
-
-Machine files (tm.h etc) must not contain any code
-that tries to use host floating point arithmetic to convert
-REAL_VALUE_TYPEs from `double' to `float', pass them to fprintf,
-etc. In cross-compile situations a REAL_VALUE_TYPE may not
-be intelligible to the host computer's native arithmetic.
-
-The first part of this file interfaces gcc to a floating point
-arithmetic suite that was not written with gcc in mind. Avoid
-changing the low-level arithmetic routines unless you have suitable
-test programs available. A special version of the PARANOIA floating
-point arithmetic tester, modified for this purpose, can be found on
-usc.edu: /pub/C-numanal/ieeetest.zoo. Other tests, and libraries of
-XFmode and TFmode transcendental functions, can be obtained by ftp from
-netlib.att.com: netlib/cephes. */
-\f
-/* Type of computer arithmetic.
- Only one of DEC, IBM, IEEE, C4X, or UNK should get defined.
-
- `IEEE', when REAL_WORDS_BIG_ENDIAN is non-zero, refers generically
- to big-endian IEEE floating-point data structure. This definition
- should work in SFmode `float' type and DFmode `double' type on
- virtually all big-endian IEEE machines. If LONG_DOUBLE_TYPE_SIZE
- has been defined to be 96, then IEEE also invokes the particular
- XFmode (`long double' type) data structure used by the Motorola
- 680x0 series processors.
-
- `IEEE', when REAL_WORDS_BIG_ENDIAN is zero, refers generally to
- little-endian IEEE machines. In this case, if LONG_DOUBLE_TYPE_SIZE
- has been defined to be 96, then IEEE also invokes the particular
- XFmode `long double' data structure used by the Intel 80x86 series
- processors.
-
- `DEC' refers specifically to the Digital Equipment Corp PDP-11
- and VAX floating point data structure. This model currently
- supports no type wider than DFmode.
-
- `IBM' refers specifically to the IBM System/370 and compatible
- floating point data structure. This model currently supports
- no type wider than DFmode. The IBM conversions were contributed by
- frank@atom.ansto.gov.au (Frank Crawford).
-
- `C4X' refers specifically to the floating point format used on
- Texas Instruments TMS320C3x and TMS320C4x digital signal
- processors. This supports QFmode (32-bit float, double) and HFmode
- (40-bit long double) where BITS_PER_BYTE is 32. Unlike IEEE
- floats, C4x floats are not rounded to be even. The C4x conversions
- were contributed by m.hayes@elec.canterbury.ac.nz (Michael Hayes) and
- Haj.Ten.Brugge@net.HCC.nl (Herman ten Brugge).
-
- If LONG_DOUBLE_TYPE_SIZE = 64 (the default, unless tm.h defines it)
- then `long double' and `double' are both implemented, but they
- both mean DFmode.
-
- The case LONG_DOUBLE_TYPE_SIZE = 128 activates TFmode support
- and may deactivate XFmode since `long double' is used to refer
- to both modes. Defining INTEL_EXTENDED_IEEE_FORMAT to non-zero
- at the same time enables 80387-style 80-bit floats in a 128-bit
- padded image, as seen on IA-64.
-
- The macros FLOAT_WORDS_BIG_ENDIAN, HOST_FLOAT_WORDS_BIG_ENDIAN,
- contributed by Richard Earnshaw <Richard.Earnshaw@cl.cam.ac.uk>,
- separate the floating point unit's endian-ness from that of
- the integer addressing. This permits one to define a big-endian
- FPU on a little-endian machine (e.g., ARM). An extension to
- BYTES_BIG_ENDIAN may be required for some machines in the future.
- These optional macros may be defined in tm.h. In real.h, they
- default to WORDS_BIG_ENDIAN, etc., so there is no need to define
- them for any normal host or target machine on which the floats
- and the integers have the same endian-ness. */
-
-
-/* The following converts gcc macros into the ones used by this file. */
-
-#if TARGET_FLOAT_FORMAT == VAX_FLOAT_FORMAT
-/* PDP-11, Pro350, VAX: */
-#define DEC 1
-#else /* it's not VAX */
-#if TARGET_FLOAT_FORMAT == IBM_FLOAT_FORMAT
-/* IBM System/370 style */
-#define IBM 1
-#else /* it's also not an IBM */
-#if TARGET_FLOAT_FORMAT == C4X_FLOAT_FORMAT
-/* TMS320C3x/C4x style */
-#define C4X 1
-#else /* it's also not a C4X */
-#if TARGET_FLOAT_FORMAT == IEEE_FLOAT_FORMAT
-#define IEEE
-#else /* it's not IEEE either */
-/* UNKnown arithmetic. We don't support this and can't go on. */
-unknown arithmetic type
-#define UNK 1
-#endif /* not IEEE */
-#endif /* not C4X */
-#endif /* not IBM */
-#endif /* not VAX */
-
-#define REAL_WORDS_BIG_ENDIAN FLOAT_WORDS_BIG_ENDIAN
-
-/* Make sure that the endianness is correct for IBM and DEC. */
-#if defined(DEC)
-#undef LARGEST_EXPONENT_IS_NORMAL
-#define LARGEST_EXPONENT_IS_NORMAL(x) 1
-#undef REAL_WORDS_BIG_ENDIAN
-/* Strangely enough, DEC float most closely resembles big endian IEEE */
-#define REAL_WORDS_BIG_ENDIAN 1
-/* ... but the halfwords are reversed from IEEE big endian. */
-#ifndef VAX_HALFWORD_ORDER
-#define VAX_HALFWORD_ORDER 1
-#endif
-#else
-#if defined(IBM)
-#if !REAL_WORDS_BIG_ENDIAN
- #error "Little-endian representations are not supported for IBM."
-#endif
-#endif
-#endif
+/* The floating point model used internally is not exactly IEEE 754
+ compliant, and close to the description in the ISO C standard,
+ section 5.2.4.2.2 Characteristics of floating types.
-#if defined(DEC) && !defined (TARGET_G_FLOAT)
-#define TARGET_G_FLOAT 0
-#endif
+ Specifically
-#ifndef VAX_HALFWORD_ORDER
-#define VAX_HALFWORD_ORDER 0
-#endif
+ x = s * b^e * \sum_{k=1}^p f_k * b^{-k}
-/* Define INFINITY for support of infinity.
- Define NANS for support of Not-a-Number's (NaN's). */
-#if !defined(DEC) && !defined(IBM) && !defined(C4X)
-#define INFINITY
-#define NANS
-#endif
+ where
+ s = sign (+- 1)
+ b = base or radix, here always 2
+ e = exponent
+ p = precision (the number of base-b digits in the significand)
+ f_k = the digits of the significand.
-/* Support of NaNs requires support of infinity. */
-#ifdef NANS
-#ifndef INFINITY
-#define INFINITY
-#endif
-#endif
-\f
-/* Find a host integer type that is at least 16 bits wide,
- and another type at least twice whatever that size is. */
-
-#if HOST_BITS_PER_CHAR >= 16
-#define EMUSHORT char
-#define EMUSHORT_SIZE HOST_BITS_PER_CHAR
-#define EMULONG_SIZE (2 * HOST_BITS_PER_CHAR)
-#else
-#if HOST_BITS_PER_SHORT >= 16
-#define EMUSHORT short
-#define EMUSHORT_SIZE HOST_BITS_PER_SHORT
-#define EMULONG_SIZE (2 * HOST_BITS_PER_SHORT)
-#else
-#if HOST_BITS_PER_INT >= 16
-#define EMUSHORT int
-#define EMUSHORT_SIZE HOST_BITS_PER_INT
-#define EMULONG_SIZE (2 * HOST_BITS_PER_INT)
-#else
-#if HOST_BITS_PER_LONG >= 16
-#define EMUSHORT long
-#define EMUSHORT_SIZE HOST_BITS_PER_LONG
-#define EMULONG_SIZE (2 * HOST_BITS_PER_LONG)
-#else
- #error "You will have to modify this program to have a smaller unit size."
-#endif
-#endif
-#endif
-#endif
+ We differ from typical IEEE 754 encodings in that the entire
+ significand is fractional. Normalized significands are in the
+ range [0.5, 1.0).
-/* If no 16-bit type has been found and the compiler is GCC, try HImode. */
-#if defined(__GNUC__) && EMUSHORT_SIZE != 16
-typedef int HItype __attribute__ ((mode (HI)));
-typedef unsigned int UHItype __attribute__ ((mode (HI)));
-#undef EMUSHORT
-#undef EMUSHORT_SIZE
-#undef EMULONG_SIZE
-#define EMUSHORT HItype
-#define UEMUSHORT UHItype
-#define EMUSHORT_SIZE 16
-#define EMULONG_SIZE 32
-#else
-#define UEMUSHORT unsigned EMUSHORT
-#endif
+ A requirement of the model is that P be larger than than the
+ largest supported target floating-point type by at least 2 bits.
+ This gives us proper rounding when we truncate to the target type.
+ In addition, E must be large enough to hold the smallest supported
+ denormal number in a normalized form.
-#if HOST_BITS_PER_SHORT >= EMULONG_SIZE
-#define EMULONG short
-#else
-#if HOST_BITS_PER_INT >= EMULONG_SIZE
-#define EMULONG int
-#else
-#if HOST_BITS_PER_LONG >= EMULONG_SIZE
-#define EMULONG long
-#else
-#if HOST_BITS_PER_LONGLONG >= EMULONG_SIZE
-#define EMULONG long long int
-#else
- #error "You will have to modify this program to have a smaller unit size."
-#endif
-#endif
-#endif
-#endif
+ Both of these requirements are easily satisfied. The largest
+ target significand is 113 bits; we store 128. The smallest
+ denormal number fits in 17 exponent bits; we store 29.
-#if EMUSHORT_SIZE != 16
- #error "The host interface doesn't work if no 16-bit size exists."
-#endif
+ Target floating point models that use base 16 instead of base 2
+ (i.e. IBM 370), are handled during round_for_format, in which we
+ canonicalize the exponent to be a multiple of 4 (log2(16)), and
+ adjust the significand to match. */
-/* Calculate the size of the generic "e" type. This always has
- identical in-memory size to REAL_VALUE_TYPE. The sizes are supposed
- to be the same as well, but when REAL_VALUE_TYPE_SIZE is not evenly
- divisible by HOST_BITS_PER_WIDE_INT we have some padding in
- REAL_VALUE_TYPE.
- There are only two supported sizes: ten and six 16-bit words (160
- or 96 bits). */
-
-#if MAX_LONG_DOUBLE_TYPE_SIZE == 128 && !INTEL_EXTENDED_IEEE_FORMAT
-/* TFmode */
-# define NE 10
-# define MAXDECEXP 4932
-# define MINDECEXP -4977
-#else
-# define NE 6
-# define MAXDECEXP 4932
-# define MINDECEXP -4956
-#endif
-/* Fail compilation if 2*NE is not the appropriate size.
- If HOST_BITS_PER_WIDE_INT is 64, we're going to have padding
- at the end of the array, because neither 96 nor 160 is
- evenly divisible by 64. */
-struct compile_test_dummy {
- char twice_NE_must_equal_sizeof_REAL_VALUE_TYPE
- [(sizeof (REAL_VALUE_TYPE) >= 2*NE) ? 1 : -1];
+/* Enumerate the special cases of numbers that we encounter. */
+enum real_value_class {
+ rvc_zero,
+ rvc_normal,
+ rvc_inf,
+ rvc_nan
};
-/* Construct macros to translate between REAL_VALUE_TYPE and e type.
- In GET_REAL and PUT_REAL, r and e are pointers.
- A REAL_VALUE_TYPE is guaranteed to occupy contiguous locations
- in memory, with no holes. */
-#define GET_REAL(r, e) memcpy ((e), (r), 2*NE)
-#define PUT_REAL(e, r) \
- do { \
- memcpy (r, e, 2*NE); \
- if (2*NE < sizeof (*r)) \
- memset ((char *) (r) + 2*NE, 0, sizeof (*r) - 2*NE); \
- } while (0)
-
-/* Number of 16 bit words in internal format */
-#define NI (NE+3)
-
-/* Array offset to exponent */
-#define E 1
-
-/* Array offset to high guard word */
-#define M 2
-
-/* Number of bits of precision */
-#define NBITS ((NI-4)*16)
-
-/* Maximum number of decimal digits in ASCII conversion
- * = NBITS*log10(2)
- */
-#define NDEC (NBITS*8/27)
-
-/* The exponent of 1.0 */
-#define EXONE (0x3fff)
-
-#if defined(HOST_EBCDIC)
-/* bit 8 is significant in EBCDIC */
-#define CHARMASK 0xff
-#else
-#define CHARMASK 0x7f
+/* Used to classify two numbers simultaneously. */
+#define CLASS2(A, B) ((A) << 2 | (B))
+
+/* An expanded form of the represented number. */
+
+#define SIGNIFICAND_BITS 128
+#define EXP_BITS (32 - 3)
+#define MAX_EXP ((1 << (EXP_BITS - 1)) - 1)
+#define SIGSZ (SIGNIFICAND_BITS / HOST_BITS_PER_LONG)
+#define SIG_MSB ((unsigned long)1 << (HOST_BITS_PER_LONG - 1))
+
+#if HOST_BITS_PER_LONG != 64 && HOST_BITS_PER_LONG != 32
+ #error "Some constant folding done by hand to avoid shift count warnings"
#endif
-/* Information about the various IEEE precisions. At the moment, we only
- support exponents of 15 bits or less. */
-struct ieee_format
+struct real_value
{
- /* Precision. */
- int precision;
+ enum real_value_class class : 2;
+ unsigned int sign : 1;
+ int exp : EXP_BITS;
+ unsigned long sig[SIGSZ];
+};
- /* Size of the exponent in bits. */
- int expbits;
+/* Describes the properties of the specific target format in use. */
+struct real_format
+{
+ /* Move to and from the target bytes. */
+ void (*encode) (const struct real_format *, long *,
+ const struct real_value *);
+ void (*decode) (const struct real_format *, struct real_value *,
+ const long *);
- /* Overall size of the value in bits. */
- int bits;
+ /* The radix of the exponent and digits of the significand. */
+ int b;
- /* Mode used for representing the value. */
- enum machine_mode mode;
+ /* log2(b). */
+ int log2_b;
- /* Exponent adjustment for offsets. */
- EMULONG adjustment;
-};
+ /* Size of the significand in digits of radix B. */
+ int p;
-#ifdef IEEE
-/* IEEE float (24 bits). */
-static const struct ieee_format ieee_24 =
-{
- 24,
- 8,
- 32,
- SFmode,
- EXONE - 0x7f
-};
+ /* The minimum negative integer, x, such that b**(x-1) is normalized. */
+ int emin;
-/* IEEE double (53 bits). */
-static const struct ieee_format ieee_53 =
-{
- 53,
- 11,
- 64,
- DFmode,
- EXONE - 0x3ff
+ /* The maximum integer, x, such that b**(x-1) is representable. */
+ int emax;
+
+ /* Properties of the format. */
+ bool has_nans;
+ bool has_inf;
+ bool has_denorm;
+ bool has_signed_zero;
+ bool qnan_msb_set;
};
-#endif /* IEEE */
-/* IEEE extended double (64 bits). */
-static const struct ieee_format ieee_64 =
-{
- 64,
- 15,
- 80,
- XFmode,
- 0
-};
+static const struct real_format *fmt_for_mode[TFmode - QFmode + 1];
+
+
+static void get_zero PARAMS ((struct real_value *, int));
+static void get_canonical_qnan PARAMS ((struct real_value *, int));
+static void get_canonical_snan PARAMS ((struct real_value *, int));
+static void get_inf PARAMS ((struct real_value *, int));
+static void sticky_rshift_significand PARAMS ((struct real_value *,
+ const struct real_value *,
+ unsigned int));
+static void rshift_significand PARAMS ((struct real_value *,
+ const struct real_value *,
+ unsigned int));
+static void lshift_significand PARAMS ((struct real_value *,
+ const struct real_value *,
+ unsigned int));
+static void lshift_significand_1 PARAMS ((struct real_value *,
+ const struct real_value *));
+static bool add_significands PARAMS ((struct real_value *r,
+ const struct real_value *,
+ const struct real_value *));
+static bool sub_significands PARAMS ((struct real_value *,
+ const struct real_value *,
+ const struct real_value *));
+static void neg_significand PARAMS ((struct real_value *,
+ const struct real_value *));
+static int cmp_significands PARAMS ((const struct real_value *,
+ const struct real_value *));
+static void set_significand_bit PARAMS ((struct real_value *, unsigned int));
+static void clear_significand_bit PARAMS ((struct real_value *, unsigned int));
+static bool test_significand_bit PARAMS ((struct real_value *, unsigned int));
+static void clear_significand_below PARAMS ((struct real_value *,
+ unsigned int));
+static bool div_significands PARAMS ((struct real_value *,
+ const struct real_value *,
+ const struct real_value *));
+static void normalize PARAMS ((struct real_value *));
+
+static void do_add PARAMS ((struct real_value *, const struct real_value *,
+ const struct real_value *, int));
+static void do_multiply PARAMS ((struct real_value *,
+ const struct real_value *,
+ const struct real_value *));
+static void do_divide PARAMS ((struct real_value *, const struct real_value *,
+ const struct real_value *));
+static int do_compare PARAMS ((const struct real_value *,
+ const struct real_value *, int));
+
+static const struct real_value * ten_to_ptwo PARAMS ((int));
+static const struct real_value * real_digit PARAMS ((int));
+
+static void round_for_format PARAMS ((const struct real_format *,
+ struct real_value *));
+\f
+/* Initialize R with a positive zero. */
-#if (INTEL_EXTENDED_IEEE_FORMAT == 0)
-/* IEEE long double (113 bits). */
-static const struct ieee_format ieee_113 =
+static inline void
+get_zero (r, sign)
+ struct real_value *r;
+ int sign;
{
- 113,
- 15,
- 128,
- TFmode,
- 0
-};
-#endif /* INTEL_EXTENDED_IEEE_FORMAT == 0 */
+ memset (r, 0, sizeof (*r));
+ r->sign = sign;
+}
-#ifdef DEC
-/* DEC F float (24 bits). */
-static const struct ieee_format dec_f =
-{
- 24,
- 8,
- 32,
- SFmode,
- EXONE - 0201
-};
+/* Initialize R with the canonical quiet NaN. */
-/* DEC D float (56 bits). */
-static const struct ieee_format dec_d =
+static inline void
+get_canonical_qnan (r, sign)
+ struct real_value *r;
+ int sign;
{
- 56,
- 8,
- 64,
- DFmode,
- EXONE - 0201
-};
+ memset (r, 0, sizeof (*r));
+ r->class = rvc_nan;
+ r->sign = sign;
+ r->sig[SIGSZ-1] = SIG_MSB >> 1;
+}
-/* DEC G float (53 bits). */
-static const struct ieee_format dec_g =
+static inline void
+get_canonical_snan (r, sign)
+ struct real_value *r;
+ int sign;
{
- 53,
- 11,
- 64,
- DFmode,
- EXONE - 1025
-};
+ memset (r, 0, sizeof (*r));
+ r->class = rvc_nan;
+ r->sign = sign;
+ r->sig[SIGSZ-1] = SIG_MSB >> 2;
+}
-#if 0
-/* DEC H float (113 bits). (not yet used) */
-static const struct ieee_format dec_h =
+static inline void
+get_inf (r, sign)
+ struct real_value *r;
+ int sign;
{
- 113,
- 15,
- 128,
- TFmode,
- EXONE - 16385
-};
-#endif
-#endif /* DEC */
-
-extern int extra_warnings;
-extern const UEMUSHORT ezero[NE], ehalf[NE], eone[NE], etwo[NE];
-extern const UEMUSHORT elog2[NE], esqrt2[NE];
-
-static void endian PARAMS ((const UEMUSHORT *, long *,
- enum machine_mode));
-static void eclear PARAMS ((UEMUSHORT *));
-static void emov PARAMS ((const UEMUSHORT *, UEMUSHORT *));
-#if 0
-static void eabs PARAMS ((UEMUSHORT *));
-#endif
-static void eneg PARAMS ((UEMUSHORT *));
-static int eisneg PARAMS ((const UEMUSHORT *));
-static int eisinf PARAMS ((const UEMUSHORT *));
-static int eisnan PARAMS ((const UEMUSHORT *));
-static void einfin PARAMS ((UEMUSHORT *));
-#ifdef NANS
-static void enan PARAMS ((UEMUSHORT *, int));
-static void einan PARAMS ((UEMUSHORT *));
-static int eiisnan PARAMS ((const UEMUSHORT *));
-static void make_nan PARAMS ((UEMUSHORT *, int, enum machine_mode));
-#endif
-static int eiisneg PARAMS ((const UEMUSHORT *));
-static void saturate PARAMS ((UEMUSHORT *, int, int, int));
-static void emovi PARAMS ((const UEMUSHORT *, UEMUSHORT *));
-static void emovo PARAMS ((const UEMUSHORT *, UEMUSHORT *));
-static void ecleaz PARAMS ((UEMUSHORT *));
-static void ecleazs PARAMS ((UEMUSHORT *));
-static void emovz PARAMS ((const UEMUSHORT *, UEMUSHORT *));
-#if 0
-static void eiinfin PARAMS ((UEMUSHORT *));
-#endif
-#ifdef INFINITY
-static int eiisinf PARAMS ((const UEMUSHORT *));
-#endif
-static int ecmpm PARAMS ((const UEMUSHORT *, const UEMUSHORT *));
-static void eshdn1 PARAMS ((UEMUSHORT *));
-static void eshup1 PARAMS ((UEMUSHORT *));
-static void eshdn8 PARAMS ((UEMUSHORT *));
-static void eshup8 PARAMS ((UEMUSHORT *));
-static void eshup6 PARAMS ((UEMUSHORT *));
-static void eshdn6 PARAMS ((UEMUSHORT *));
-static void eaddm PARAMS ((const UEMUSHORT *, UEMUSHORT *));\f
-static void esubm PARAMS ((const UEMUSHORT *, UEMUSHORT *));
-static void m16m PARAMS ((unsigned int, const UEMUSHORT *, UEMUSHORT *));
-static int edivm PARAMS ((const UEMUSHORT *, UEMUSHORT *));
-static int emulm PARAMS ((const UEMUSHORT *, UEMUSHORT *));
-static void emdnorm PARAMS ((UEMUSHORT *, int, int, EMULONG, int));
-static void esub PARAMS ((const UEMUSHORT *, const UEMUSHORT *,
- UEMUSHORT *));
-static void eadd PARAMS ((const UEMUSHORT *, const UEMUSHORT *,
- UEMUSHORT *));
-static void eadd1 PARAMS ((const UEMUSHORT *, const UEMUSHORT *,
- UEMUSHORT *));
-static void ediv PARAMS ((const UEMUSHORT *, const UEMUSHORT *,
- UEMUSHORT *));
-static void emul PARAMS ((const UEMUSHORT *, const UEMUSHORT *,
- UEMUSHORT *));
-static void e53toe PARAMS ((const UEMUSHORT *, UEMUSHORT *));
-static void e64toe PARAMS ((const UEMUSHORT *, UEMUSHORT *));
-#if (INTEL_EXTENDED_IEEE_FORMAT == 0)
-static void e113toe PARAMS ((const UEMUSHORT *, UEMUSHORT *));
-#endif
-static void e24toe PARAMS ((const UEMUSHORT *, UEMUSHORT *));
-#if (INTEL_EXTENDED_IEEE_FORMAT == 0)
-static void etoe113 PARAMS ((const UEMUSHORT *, UEMUSHORT *));
-static void toe113 PARAMS ((UEMUSHORT *, UEMUSHORT *));
-#endif
-static void etoe64 PARAMS ((const UEMUSHORT *, UEMUSHORT *));
-static void toe64 PARAMS ((UEMUSHORT *, UEMUSHORT *));
-static void etoe53 PARAMS ((const UEMUSHORT *, UEMUSHORT *));
-static void toe53 PARAMS ((UEMUSHORT *, UEMUSHORT *));
-static void etoe24 PARAMS ((const UEMUSHORT *, UEMUSHORT *));
-static void toe24 PARAMS ((UEMUSHORT *, UEMUSHORT *));
-static void ieeetoe PARAMS ((const UEMUSHORT *, UEMUSHORT *,
- const struct ieee_format *));
-static void etoieee PARAMS ((const UEMUSHORT *, UEMUSHORT *,
- const struct ieee_format *));
-static void toieee PARAMS ((UEMUSHORT *, UEMUSHORT *,
- const struct ieee_format *));
-static int ecmp PARAMS ((const UEMUSHORT *, const UEMUSHORT *));
-#if 0
-static void eround PARAMS ((const UEMUSHORT *, UEMUSHORT *));
-#endif
-static void ltoe PARAMS ((const HOST_WIDE_INT *, UEMUSHORT *));
-static void ultoe PARAMS ((const unsigned HOST_WIDE_INT *, UEMUSHORT *));
-static void eifrac PARAMS ((const UEMUSHORT *, HOST_WIDE_INT *,
- UEMUSHORT *));
-static void euifrac PARAMS ((const UEMUSHORT *, unsigned HOST_WIDE_INT *,
- UEMUSHORT *));
-static int eshift PARAMS ((UEMUSHORT *, int));
-static int enormlz PARAMS ((UEMUSHORT *));
-#if 0
-static void e24toasc PARAMS ((const UEMUSHORT *, char *, int));
-static void e53toasc PARAMS ((const UEMUSHORT *, char *, int));
-static void e64toasc PARAMS ((const UEMUSHORT *, char *, int));
-static void e113toasc PARAMS ((const UEMUSHORT *, char *, int));
-#endif /* 0 */
-static void etoasc PARAMS ((const UEMUSHORT *, char *, int));
-static void asctoe24 PARAMS ((const char *, UEMUSHORT *));
-static void asctoe53 PARAMS ((const char *, UEMUSHORT *));
-static void asctoe64 PARAMS ((const char *, UEMUSHORT *));
-#if (INTEL_EXTENDED_IEEE_FORMAT == 0)
-static void asctoe113 PARAMS ((const char *, UEMUSHORT *));
-#endif
-static void asctoe PARAMS ((const char *, UEMUSHORT *));
-static void asctoeg PARAMS ((const char *, UEMUSHORT *, int));
-static void efloor PARAMS ((const UEMUSHORT *, UEMUSHORT *));
-#if 0
-static void efrexp PARAMS ((const UEMUSHORT *, int *,
- UEMUSHORT *));
-#endif
-static void eldexp PARAMS ((const UEMUSHORT *, int, UEMUSHORT *));
-#if 0
-static void eremain PARAMS ((const UEMUSHORT *, const UEMUSHORT *,
- UEMUSHORT *));
-#endif
-static void eiremain PARAMS ((UEMUSHORT *, UEMUSHORT *));
-static void mtherr PARAMS ((const char *, int));
-#ifdef DEC
-static void dectoe PARAMS ((const UEMUSHORT *, UEMUSHORT *));
-static void etodec PARAMS ((const UEMUSHORT *, UEMUSHORT *));
-static void todec PARAMS ((UEMUSHORT *, UEMUSHORT *));
-#endif
-#ifdef IBM
-static void ibmtoe PARAMS ((const UEMUSHORT *, UEMUSHORT *,
- enum machine_mode));
-static void etoibm PARAMS ((const UEMUSHORT *, UEMUSHORT *,
- enum machine_mode));
-static void toibm PARAMS ((UEMUSHORT *, UEMUSHORT *,
- enum machine_mode));
-#endif
-#ifdef C4X
-static void c4xtoe PARAMS ((const UEMUSHORT *, UEMUSHORT *,
- enum machine_mode));
-static void etoc4x PARAMS ((const UEMUSHORT *, UEMUSHORT *,
- enum machine_mode));
-static void toc4x PARAMS ((UEMUSHORT *, UEMUSHORT *,
- enum machine_mode));
-#endif
-#if 0
-static void uditoe PARAMS ((const UEMUSHORT *, UEMUSHORT *));
-static void ditoe PARAMS ((const UEMUSHORT *, UEMUSHORT *));
-static void etoudi PARAMS ((const UEMUSHORT *, UEMUSHORT *));
-static void etodi PARAMS ((const UEMUSHORT *, UEMUSHORT *));
-static void esqrt PARAMS ((const UEMUSHORT *, UEMUSHORT *));
-#endif
+ memset (r, 0, sizeof (*r));
+ r->class = rvc_inf;
+ r->sign = sign;
+}
+
\f
-/* Copy 32-bit numbers obtained from array containing 16-bit numbers,
- swapping ends if required, into output array of longs. The
- result is normally passed to fprintf by the ASM_OUTPUT_ macros. */
+/* Right-shift the significand of A by N bits; put the result in the
+ significand of R. If any one bits are shifted out, set the least
+ significant bit of R. */
static void
-endian (e, x, mode)
- const UEMUSHORT e[];
- long x[];
- enum machine_mode mode;
+sticky_rshift_significand (r, a, n)
+ struct real_value *r;
+ const struct real_value *a;
+ unsigned int n;
{
- unsigned long th, t;
+ bool sticky = false;
+ unsigned int i, ofs = 0;
- if (REAL_WORDS_BIG_ENDIAN && !VAX_HALFWORD_ORDER)
+ if (n >= HOST_BITS_PER_LONG)
{
- switch (mode)
- {
- case TFmode:
-#if (INTEL_EXTENDED_IEEE_FORMAT == 0)
- /* Swap halfwords in the fourth long. */
- th = (unsigned long) e[6] & 0xffff;
- t = (unsigned long) e[7] & 0xffff;
- t |= th << 16;
- x[3] = (long) t;
-#else
- x[3] = 0;
-#endif
- /* FALLTHRU */
-
- case XFmode:
- /* Swap halfwords in the third long. */
- th = (unsigned long) e[4] & 0xffff;
- t = (unsigned long) e[5] & 0xffff;
- t |= th << 16;
- x[2] = (long) t;
- /* FALLTHRU */
-
- case DFmode:
- /* Swap halfwords in the second word. */
- th = (unsigned long) e[2] & 0xffff;
- t = (unsigned long) e[3] & 0xffff;
- t |= th << 16;
- x[1] = (long) t;
- /* FALLTHRU */
-
- case SFmode:
- case HFmode:
- /* Swap halfwords in the first word. */
- th = (unsigned long) e[0] & 0xffff;
- t = (unsigned long) e[1] & 0xffff;
- t |= th << 16;
- x[0] = (long) t;
- break;
+ for (i = 0, ofs = n / HOST_BITS_PER_LONG; i < ofs; ++i)
+ sticky |= a->sig[i];
+ n -= ofs * HOST_BITS_PER_LONG;
+ }
- default:
- abort ();
+ if (n != 0)
+ {
+ sticky |= a->sig[ofs] & (((unsigned long)1 << n) - 1);
+ for (i = 0; i < SIGSZ; ++i)
+ {
+ r->sig[i]
+ = (((ofs + i >= SIGSZ ? 0 : a->sig[ofs + i]) >> n)
+ | ((ofs + i + 1 >= SIGSZ ? 0 : a->sig[ofs + i + 1])
+ << (HOST_BITS_PER_LONG - n)));
}
}
else
{
- /* Pack the output array without swapping. */
-
- switch (mode)
- {
- case TFmode:
-#if (INTEL_EXTENDED_IEEE_FORMAT == 0)
- /* Pack the fourth long. */
- th = (unsigned long) e[7] & 0xffff;
- t = (unsigned long) e[6] & 0xffff;
- t |= th << 16;
- x[3] = (long) t;
-#else
- x[3] = 0;
-#endif
- /* FALLTHRU */
-
- case XFmode:
- /* Pack the third long.
- Each element of the input REAL_VALUE_TYPE array has 16 useful bits
- in it. */
- th = (unsigned long) e[5] & 0xffff;
- t = (unsigned long) e[4] & 0xffff;
- t |= th << 16;
- x[2] = (long) t;
- /* FALLTHRU */
-
- case DFmode:
- /* Pack the second long */
- th = (unsigned long) e[3] & 0xffff;
- t = (unsigned long) e[2] & 0xffff;
- t |= th << 16;
- x[1] = (long) t;
- /* FALLTHRU */
-
- case SFmode:
- case HFmode:
- /* Pack the first long */
- th = (unsigned long) e[1] & 0xffff;
- t = (unsigned long) e[0] & 0xffff;
- t |= th << 16;
- x[0] = (long) t;
- break;
-
- default:
- abort ();
- }
+ for (i = 0; ofs + i < SIGSZ; ++i)
+ r->sig[i] = a->sig[ofs + i];
+ for (; i < SIGSZ; ++i)
+ r->sig[i] = 0;
}
-}
+ r->sig[0] |= sticky;
+}
-/* This is the implementation of the REAL_ARITHMETIC macro. */
+/* Right-shift the significand of A by N bits; put the result in the
+ significand of R. */
-void
-earith (value, icode, r1, r2)
- REAL_VALUE_TYPE *value;
- int icode;
- REAL_VALUE_TYPE *r1;
- REAL_VALUE_TYPE *r2;
+static void
+rshift_significand (r, a, n)
+ struct real_value *r;
+ const struct real_value *a;
+ unsigned int n;
{
- UEMUSHORT d1[NE], d2[NE], v[NE];
- enum tree_code code;
-
- GET_REAL (r1, d1);
- GET_REAL (r2, d2);
-#ifdef NANS
-/* Return NaN input back to the caller. */
- if (eisnan (d1))
+ unsigned int i, ofs = n / HOST_BITS_PER_LONG;
+
+ n -= ofs * HOST_BITS_PER_LONG;
+ if (n != 0)
{
- PUT_REAL (d1, value);
- return;
+ for (i = 0; i < SIGSZ; ++i)
+ {
+ r->sig[i]
+ = (((ofs + i >= SIGSZ ? 0 : a->sig[ofs + i]) >> n)
+ | ((ofs + i + 1 >= SIGSZ ? 0 : a->sig[ofs + i + 1])
+ << (HOST_BITS_PER_LONG - n)));
+ }
}
- if (eisnan (d2))
+ else
{
- PUT_REAL (d2, value);
- return;
+ for (i = 0; ofs + i < SIGSZ; ++i)
+ r->sig[i] = a->sig[ofs + i];
+ for (; i < SIGSZ; ++i)
+ r->sig[i] = 0;
}
-#endif
- code = (enum tree_code) icode;
- switch (code)
- {
- case PLUS_EXPR:
- eadd (d2, d1, v);
- break;
-
- case MINUS_EXPR:
- esub (d2, d1, v); /* d1 - d2 */
- break;
-
- case MULT_EXPR:
- emul (d2, d1, v);
- break;
+}
- case RDIV_EXPR:
-#ifndef INFINITY
- if (ecmp (d2, ezero) == 0)
- abort ();
-#endif
- ediv (d2, d1, v); /* d1/d2 */
- break;
+/* Left-shift the significand of A by N bits; put the result in the
+ significand of R. */
- case MIN_EXPR: /* min (d1,d2) */
- if (ecmp (d1, d2) < 0)
- emov (d1, v);
- else
- emov (d2, v);
- break;
+static void
+lshift_significand (r, a, n)
+ struct real_value *r;
+ const struct real_value *a;
+ unsigned int n;
+{
+ unsigned int i, ofs = n / HOST_BITS_PER_LONG;
- case MAX_EXPR: /* max (d1,d2) */
- if (ecmp (d1, d2) > 0)
- emov (d1, v);
- else
- emov (d2, v);
- break;
- default:
- emov (ezero, v);
- break;
+ n -= ofs * HOST_BITS_PER_LONG;
+ if (n == 0)
+ {
+ for (i = 0; ofs + i < SIGSZ; ++i)
+ r->sig[SIGSZ-1-i] = a->sig[SIGSZ-1-i-ofs];
+ for (; i < SIGSZ; ++i)
+ r->sig[SIGSZ-1-i] = 0;
}
-PUT_REAL (v, value);
+ else
+ for (i = 0; i < SIGSZ; ++i)
+ {
+ r->sig[SIGSZ-1-i]
+ = (((ofs + i >= SIGSZ ? 0 : a->sig[SIGSZ-1-i-ofs]) << n)
+ | ((ofs + i + 1 >= SIGSZ ? 0 : a->sig[SIGSZ-1-i-ofs-1])
+ >> (HOST_BITS_PER_LONG - n)));
+ }
}
+/* Likewise, but N is specialized to 1. */
-/* Truncate REAL_VALUE_TYPE toward zero to signed HOST_WIDE_INT.
- implements REAL_VALUE_RNDZINT (x) (etrunci (x)). */
-
-REAL_VALUE_TYPE
-etrunci (x)
- REAL_VALUE_TYPE x;
+static inline void
+lshift_significand_1 (r, a)
+ struct real_value *r;
+ const struct real_value *a;
{
- UEMUSHORT f[NE], g[NE];
- REAL_VALUE_TYPE r;
- HOST_WIDE_INT l;
+ unsigned int i;
- GET_REAL (&x, g);
-#ifdef NANS
- if (eisnan (g))
- return (x);
-#endif
- eifrac (g, &l, f);
- ltoe (&l, g);
- PUT_REAL (g, &r);
- return (r);
+ for (i = SIGSZ - 1; i > 0; --i)
+ r->sig[i] = (a->sig[i] << 1) | (a->sig[i-1] >> (HOST_BITS_PER_LONG - 1));
+ r->sig[0] = a->sig[0] << 1;
}
+/* Add the significands of A and B, placing the result in R. Return
+ true if there was carry out of the most significant word. */
-/* Truncate REAL_VALUE_TYPE toward zero to unsigned HOST_WIDE_INT;
- implements REAL_VALUE_UNSIGNED_RNDZINT (x) (etruncui (x)). */
-
-REAL_VALUE_TYPE
-etruncui (x)
- REAL_VALUE_TYPE x;
+static inline bool
+add_significands (r, a, b)
+ struct real_value *r;
+ const struct real_value *a, *b;
{
- UEMUSHORT f[NE], g[NE];
- REAL_VALUE_TYPE r;
- unsigned HOST_WIDE_INT l;
-
- GET_REAL (&x, g);
-#ifdef NANS
- if (eisnan (g))
- return (x);
-#endif
- euifrac (g, &l, f);
- ultoe (&l, g);
- PUT_REAL (g, &r);
- return (r);
-}
+ bool carry = false;
+ int i;
+ for (i = 0; i < SIGSZ; ++i)
+ {
+ unsigned long ai = a->sig[i];
+ unsigned long ri = ai + b->sig[i];
-/* This is the REAL_VALUE_ATOF function. It converts a decimal or hexadecimal
- string to binary, rounding off as indicated by the machine_mode argument.
- Then it promotes the rounded value to REAL_VALUE_TYPE. */
+ if (carry)
+ {
+ carry = ri < ai;
+ carry |= ++ri == 0;
+ }
+ else
+ carry = ri < ai;
-REAL_VALUE_TYPE
-ereal_atof (s, t)
- const char *s;
- enum machine_mode t;
-{
- UEMUSHORT tem[NE], e[NE];
- REAL_VALUE_TYPE r;
+ r->sig[i] = ri;
+ }
- switch (t)
- {
-#ifdef C4X
- case QFmode:
- case HFmode:
- asctoe53 (s, tem);
- e53toe (tem, e);
- break;
-#else
- case HFmode:
-#endif
+ return carry;
+}
- case SFmode:
- asctoe24 (s, tem);
- e24toe (tem, e);
- break;
+/* Subtract the significands of A and B, placing the result in R.
+ Return true if there was carry out of the most significant word. */
- case DFmode:
- asctoe53 (s, tem);
- e53toe (tem, e);
- break;
+static inline bool
+sub_significands (r, a, b)
+ struct real_value *r;
+ const struct real_value *a, *b;
+{
+ bool carry = false;
+ int i;
- case TFmode:
-#if (INTEL_EXTENDED_IEEE_FORMAT == 0)
- asctoe113 (s, tem);
- e113toe (tem, e);
- break;
-#endif
- /* FALLTHRU */
+ for (i = 0; i < SIGSZ; ++i)
+ {
+ unsigned long ai = a->sig[i];
+ unsigned long ri = ai - b->sig[i];
- case XFmode:
- asctoe64 (s, tem);
- e64toe (tem, e);
- break;
+ if (carry)
+ {
+ carry = ri > ai;
+ carry |= ~--ri == 0;
+ }
+ else
+ carry = ri > ai;
- default:
- asctoe (s, e);
+ r->sig[i] = ri;
}
- PUT_REAL (e, &r);
- return (r);
-}
+ return carry;
+}
-/* Expansion of REAL_NEGATE. */
+/* Negate the significand A, placing the result in R. */
-REAL_VALUE_TYPE
-ereal_negate (x)
- REAL_VALUE_TYPE x;
+static inline void
+neg_significand (r, a)
+ struct real_value *r;
+ const struct real_value *a;
{
- UEMUSHORT e[NE];
- REAL_VALUE_TYPE r;
+ bool carry = true;
+ int i;
- GET_REAL (&x, e);
- eneg (e);
- PUT_REAL (e, &r);
- return (r);
-}
+ for (i = 0; i < SIGSZ; ++i)
+ {
+ unsigned long ri, ai = a->sig[i];
+
+ if (carry)
+ {
+ if (ai)
+ {
+ ri = -ai;
+ carry = false;
+ }
+ else
+ ri = ai;
+ }
+ else
+ ri = ~ai;
+ r->sig[i] = ri;
+ }
+}
-/* Round real toward zero to HOST_WIDE_INT;
- implements REAL_VALUE_FIX (x). */
+/* Compare significands. Return tri-state vs zero. */
-HOST_WIDE_INT
-efixi (x)
- REAL_VALUE_TYPE x;
+static inline int
+cmp_significands (a, b)
+ const struct real_value *a, *b;
{
- UEMUSHORT f[NE], g[NE];
- HOST_WIDE_INT l;
+ int i;
- GET_REAL (&x, f);
-#ifdef NANS
- if (eisnan (f))
+ for (i = SIGSZ - 1; i >= 0; --i)
{
- warning ("conversion from NaN to int");
- return (-1);
+ unsigned long ai = a->sig[i];
+ unsigned long bi = b->sig[i];
+
+ if (ai > bi)
+ return 1;
+ if (ai < bi)
+ return -1;
}
-#endif
- eifrac (f, &l, g);
- return l;
+
+ return 0;
}
-/* Round real toward zero to unsigned HOST_WIDE_INT
- implements REAL_VALUE_UNSIGNED_FIX (x).
- Negative input returns zero. */
+/* Set bit N of the significand of R. */
-unsigned HOST_WIDE_INT
-efixui (x)
- REAL_VALUE_TYPE x;
+static inline void
+set_significand_bit (r, n)
+ struct real_value *r;
+ unsigned int n;
{
- UEMUSHORT f[NE], g[NE];
- unsigned HOST_WIDE_INT l;
-
- GET_REAL (&x, f);
-#ifdef NANS
- if (eisnan (f))
- {
- warning ("conversion from NaN to unsigned int");
- return (-1);
- }
-#endif
- euifrac (f, &l, g);
- return l;
+ r->sig[n / HOST_BITS_PER_LONG]
+ |= (unsigned long)1 << (n % HOST_BITS_PER_LONG);
}
+/* Clear bit N of the significand of R. */
-/* REAL_VALUE_FROM_INT macro. */
-
-void
-ereal_from_int (d, i, j, mode)
- REAL_VALUE_TYPE *d;
- HOST_WIDE_INT i, j;
- enum machine_mode mode;
+static inline void
+clear_significand_bit (r, n)
+ struct real_value *r;
+ unsigned int n;
{
- UEMUSHORT df[NE], dg[NE];
- HOST_WIDE_INT low, high;
- int sign;
-
- if (GET_MODE_CLASS (mode) != MODE_FLOAT)
- abort ();
- sign = 0;
- low = i;
- if ((high = j) < 0)
- {
- sign = 1;
- /* complement and add 1 */
- high = ~high;
- if (low)
- low = -low;
- else
- high += 1;
- }
- eldexp (eone, HOST_BITS_PER_WIDE_INT, df);
- ultoe ((unsigned HOST_WIDE_INT *) &high, dg);
- emul (dg, df, dg);
- ultoe ((unsigned HOST_WIDE_INT *) &low, df);
- eadd (df, dg, dg);
- if (sign)
- eneg (dg);
+ r->sig[n / HOST_BITS_PER_LONG]
+ &= ~((unsigned long)1 << (n % HOST_BITS_PER_LONG));
+}
- /* A REAL_VALUE_TYPE may not be wide enough to hold the two HOST_WIDE_INTS.
- Avoid double-rounding errors later by rounding off now from the
- extra-wide internal format to the requested precision. */
- switch (GET_MODE_BITSIZE (mode))
- {
- case 32:
- etoe24 (dg, df);
- e24toe (df, dg);
- break;
+/* Test bit N of the significand of R. */
- case 64:
- etoe53 (dg, df);
- e53toe (df, dg);
- break;
+static inline bool
+test_significand_bit (r, n)
+ struct real_value *r;
+ unsigned int n;
+{
+ /* ??? Compiler bug here if we return this expression directly.
+ The conversion to bool strips the "&1" and we wind up testing
+ e.g. 2 != 0 -> true. Seen in gcc version 3.2 20020520. */
+ int t = (r->sig[n / HOST_BITS_PER_LONG] >> (n % HOST_BITS_PER_LONG)) & 1;
+ return t;
+}
- case 96:
- etoe64 (dg, df);
- e64toe (df, dg);
- break;
+/* Clear bits 0..N-1 of the significand of R. */
- case 128:
-#if (INTEL_EXTENDED_IEEE_FORMAT == 0)
- etoe113 (dg, df);
- e113toe (df, dg);
-#else
- etoe64 (dg, df);
- e64toe (df, dg);
-#endif
- break;
+static void
+clear_significand_below (r, n)
+ struct real_value *r;
+ unsigned int n;
+{
+ int i, w = n / HOST_BITS_PER_LONG;
- default:
- abort ();
- }
+ for (i = 0; i < w; ++i)
+ r->sig[i] = 0;
- PUT_REAL (dg, d);
+ r->sig[w] &= ~(((unsigned long)1 << (n % HOST_BITS_PER_LONG)) - 1);
}
+/* Divide the significands of A and B, placing the result in R. Return
+ true if the division was inexact. */
-/* REAL_VALUE_FROM_UNSIGNED_INT macro. */
-
-void
-ereal_from_uint (d, i, j, mode)
- REAL_VALUE_TYPE *d;
- unsigned HOST_WIDE_INT i, j;
- enum machine_mode mode;
+static inline bool
+div_significands (r, a, b)
+ struct real_value *r;
+ const struct real_value *a, *b;
{
- UEMUSHORT df[NE], dg[NE];
- unsigned HOST_WIDE_INT low, high;
-
- if (GET_MODE_CLASS (mode) != MODE_FLOAT)
- abort ();
- low = i;
- high = j;
- eldexp (eone, HOST_BITS_PER_WIDE_INT, df);
- ultoe (&high, dg);
- emul (dg, df, dg);
- ultoe (&low, df);
- eadd (df, dg, dg);
-
- /* A REAL_VALUE_TYPE may not be wide enough to hold the two HOST_WIDE_INTS.
- Avoid double-rounding errors later by rounding off now from the
- extra-wide internal format to the requested precision. */
- switch (GET_MODE_BITSIZE (mode))
- {
- case 32:
- etoe24 (dg, df);
- e24toe (df, dg);
- break;
-
- case 64:
- etoe53 (dg, df);
- e53toe (df, dg);
- break;
+ struct real_value u;
+ int bit = SIGNIFICAND_BITS - 1;
+ int i;
+ long inexact;
- case 96:
- etoe64 (dg, df);
- e64toe (df, dg);
- break;
+ u = *a;
+ memset (r->sig, 0, sizeof (r->sig));
- case 128:
-#if (INTEL_EXTENDED_IEEE_FORMAT == 0)
- etoe113 (dg, df);
- e113toe (df, dg);
-#else
- etoe64 (dg, df);
- e64toe (df, dg);
-#endif
- break;
+ goto start;
+ do
+ {
+ if ((u.sig[SIGSZ-1] & SIG_MSB) == 0)
+ {
+ lshift_significand_1 (&u, &u);
+ start:
+ if (cmp_significands (&u, b) >= 0)
+ {
+ sub_significands (&u, &u, b);
+ set_significand_bit (r, bit);
+ }
+ }
+ else
+ {
+ /* We lose a bit here, and thus know the next quotient bit
+ will be one. */
+ lshift_significand_1 (&u, &u);
+ sub_significands (&u, &u, b);
+ set_significand_bit (r, bit);
+ }
+ }
+ while (--bit >= 0);
- default:
- abort ();
- }
+ for (i = 0, inexact = 0; i < SIGSZ; i++)
+ inexact |= u.sig[i];
- PUT_REAL (dg, d);
+ return inexact != 0;
}
+/* Adjust the exponent and significand of R such that the most
+ significant bit is set. We underflow to zero and overflow to
+ infinity here, without denormals. (The intermediate representation
+ exponent is large enough to handle target denormals normalized.) */
-/* REAL_VALUE_TO_INT macro. */
-
-void
-ereal_to_int (low, high, rr)
- HOST_WIDE_INT *low, *high;
- REAL_VALUE_TYPE rr;
+static void
+normalize (r)
+ struct real_value *r;
{
- UEMUSHORT d[NE], df[NE], dg[NE], dh[NE];
- int s;
+ int shift = 0, exp;
+ int i, j;
+
+ /* Find the first word that is non-zero. */
+ for (i = SIGSZ - 1; i >= 0; i--)
+ if (r->sig[i] == 0)
+ shift += HOST_BITS_PER_LONG;
+ else
+ break;
- GET_REAL (&rr, d);
-#ifdef NANS
- if (eisnan (d))
+ /* Zero significand flushes to zero. */
+ if (i < 0)
{
- warning ("conversion from NaN to int");
- *low = -1;
- *high = -1;
+ r->class = rvc_zero;
+ r->exp = 0;
return;
}
-#endif
- /* convert positive value */
- s = 0;
- if (eisneg (d))
- {
- eneg (d);
- s = 1;
- }
- eldexp (eone, HOST_BITS_PER_WIDE_INT, df);
- ediv (df, d, dg); /* dg = d / 2^32 is the high word */
- euifrac (dg, (unsigned HOST_WIDE_INT *) high, dh);
- emul (df, dh, dg); /* fractional part is the low word */
- euifrac (dg, (unsigned HOST_WIDE_INT *) low, dh);
- if (s)
+
+ /* Find the first bit that is non-zero. */
+ for (j = 0; ; j++)
+ if (r->sig[i] & ((unsigned long)1 << (HOST_BITS_PER_LONG - 1 - j)))
+ break;
+ shift += j;
+
+ if (shift > 0)
{
- /* complement and add 1 */
- *high = ~(*high);
- if (*low)
- *low = -(*low);
+ exp = r->exp - shift;
+ if (exp > MAX_EXP)
+ get_inf (r, r->sign);
+ else if (exp < -MAX_EXP)
+ get_zero (r, r->sign);
else
- *high += 1;
+ {
+ r->exp = exp;
+ lshift_significand (r, r, shift);
+ }
}
}
+\f
+/* Return R = A + (SUBTRACT_P ? -B : B). */
-
-/* REAL_VALUE_LDEXP macro. */
-
-REAL_VALUE_TYPE
-ereal_ldexp (x, n)
- REAL_VALUE_TYPE x;
- int n;
+static void
+do_add (r, a, b, subtract_p)
+ struct real_value *r;
+ const struct real_value *a, *b;
+ int subtract_p;
{
- UEMUSHORT e[NE], y[NE];
- REAL_VALUE_TYPE r;
-
- GET_REAL (&x, e);
-#ifdef NANS
- if (eisnan (e))
- return (x);
-#endif
- eldexp (e, n, y);
- PUT_REAL (y, &r);
- return (r);
-}
+ int dexp, sign, exp;
+ struct real_value t;
-/* Check for infinity in a REAL_VALUE_TYPE. */
+ /* Determine if we need to add or subtract. */
+ sign = a->sign;
+ subtract_p = (sign ^ b->sign) ^ subtract_p;
-int
-target_isinf (x)
- REAL_VALUE_TYPE x ATTRIBUTE_UNUSED;
-{
-#ifdef INFINITY
- UEMUSHORT e[NE];
+ switch (CLASS2 (a->class, b->class))
+ {
+ case CLASS2 (rvc_zero, rvc_zero):
+ /* +-0 +/- +-0 = +0. */
+ get_zero (r, 0);
+ return;
- GET_REAL (&x, e);
- return (eisinf (e));
-#else
- return 0;
-#endif
-}
+ case CLASS2 (rvc_zero, rvc_normal):
+ case CLASS2 (rvc_zero, rvc_inf):
+ case CLASS2 (rvc_zero, rvc_nan):
+ /* 0 + ANY = ANY. */
+ case CLASS2 (rvc_normal, rvc_nan):
+ case CLASS2 (rvc_inf, rvc_nan):
+ case CLASS2 (rvc_nan, rvc_nan):
+ /* ANY + NaN = NaN. */
+ case CLASS2 (rvc_normal, rvc_inf):
+ /* R + Inf = Inf. */
+ *r = *b;
+ r->sign = sign ^ subtract_p;
+ return;
-/* Check whether a REAL_VALUE_TYPE item is a NaN. */
+ case CLASS2 (rvc_normal, rvc_zero):
+ case CLASS2 (rvc_inf, rvc_zero):
+ case CLASS2 (rvc_nan, rvc_zero):
+ /* ANY + 0 = ANY. */
+ case CLASS2 (rvc_nan, rvc_normal):
+ case CLASS2 (rvc_nan, rvc_inf):
+ /* NaN + ANY = NaN. */
+ case CLASS2 (rvc_inf, rvc_normal):
+ /* Inf + R = Inf. */
+ *r = *a;
+ return;
-int
-target_isnan (x)
- REAL_VALUE_TYPE x ATTRIBUTE_UNUSED;
-{
-#ifdef NANS
- UEMUSHORT e[NE];
+ case CLASS2 (rvc_inf, rvc_inf):
+ if (subtract_p)
+ /* Inf - Inf = NaN. */
+ get_canonical_qnan (r, 0);
+ else
+ /* Inf + Inf = Inf. */
+ *r = *a;
+ return;
- GET_REAL (&x, e);
- return (eisnan (e));
-#else
- return (0);
-#endif
-}
+ case CLASS2 (rvc_normal, rvc_normal):
+ break;
+ default:
+ abort ();
+ }
-/* Check for a negative REAL_VALUE_TYPE number.
- This just checks the sign bit, so that -0 counts as negative. */
+ /* Swap the arguments such that A has the larger exponent. */
+ dexp = a->exp - b->exp;
+ if (dexp < 0)
+ {
+ const struct real_value *t;
+ t = a, a = b, b = t;
+ dexp = -dexp;
+ sign ^= subtract_p;
+ }
+ exp = a->exp;
-int
-target_negative (x)
- REAL_VALUE_TYPE x;
-{
- return ereal_isneg (x);
+ /* If the exponents are not identical, we need to shift the
+ significand of B down. */
+ if (dexp > 0)
+ {
+ /* If the exponents are too far apart, the significands
+ do not overlap, which makes the subtraction a noop. */
+ if (dexp >= SIGNIFICAND_BITS)
+ {
+ *r = *a;
+ r->sign = sign;
+ return;
+ }
+
+ sticky_rshift_significand (&t, b, dexp);
+ b = &t;
+ }
+
+ if (subtract_p)
+ {
+ if (sub_significands (r, a, b))
+ {
+ /* We got a borrow out of the subtraction. That means that
+ A and B had the same exponent, and B had the larger
+ significand. We need to swap the sign and negate the
+ significand. */
+ sign ^= 1;
+ neg_significand (r, r);
+ }
+ }
+ else
+ {
+ if (add_significands (r, a, b))
+ {
+ /* We got carry out of the addition. This means we need to
+ shift the significand back down one bit and increase the
+ exponent. */
+ sticky_rshift_significand (r, r, 1);
+ r->sig[SIGSZ-1] |= SIG_MSB;
+ if (++exp > MAX_EXP)
+ {
+ get_inf (r, sign);
+ return;
+ }
+ }
+ }
+
+ r->class = rvc_normal;
+ r->sign = sign;
+ r->exp = exp;
+
+ /* Re-normalize the result. */
+ normalize (r);
+
+ /* Special case: if the subtraction results in zero, the result
+ is positive. */
+ if (r->class == rvc_zero)
+ r->sign = 0;
}
-/* Expansion of REAL_VALUE_TRUNCATE.
- The result is in floating point, rounded to nearest or even. */
+/* Return R = A * B. */
-REAL_VALUE_TYPE
-real_value_truncate (mode, arg)
- enum machine_mode mode;
- REAL_VALUE_TYPE arg;
+static void
+do_multiply (r, a, b)
+ struct real_value *r;
+ const struct real_value *a, *b;
{
- UEMUSHORT e[NE], t[NE];
- REAL_VALUE_TYPE r;
+ struct real_value u, t, *rr;
+ unsigned int i, j, k;
+ int sign = a->sign ^ b->sign;
- GET_REAL (&arg, e);
-#ifdef NANS
- if (eisnan (e))
- return (arg);
-#endif
- eclear (t);
- switch (mode)
+ switch (CLASS2 (a->class, b->class))
{
- case TFmode:
-#if (INTEL_EXTENDED_IEEE_FORMAT == 0)
- etoe113 (e, t);
- e113toe (t, t);
- break;
-#endif
- /* FALLTHRU */
-
- case XFmode:
- etoe64 (e, t);
- e64toe (t, t);
- break;
+ case CLASS2 (rvc_zero, rvc_zero):
+ case CLASS2 (rvc_zero, rvc_normal):
+ case CLASS2 (rvc_normal, rvc_zero):
+ /* +-0 * ANY = 0 with appropriate sign. */
+ get_zero (r, sign);
+ return;
- case DFmode:
- etoe53 (e, t);
- e53toe (t, t);
- break;
+ case CLASS2 (rvc_zero, rvc_nan):
+ case CLASS2 (rvc_normal, rvc_nan):
+ case CLASS2 (rvc_inf, rvc_nan):
+ case CLASS2 (rvc_nan, rvc_nan):
+ /* ANY * NaN = NaN. */
+ *r = *b;
+ r->sign = sign;
+ return;
- case SFmode:
-#ifndef C4X
- case HFmode:
-#endif
- etoe24 (e, t);
- e24toe (t, t);
- break;
+ case CLASS2 (rvc_nan, rvc_zero):
+ case CLASS2 (rvc_nan, rvc_normal):
+ case CLASS2 (rvc_nan, rvc_inf):
+ /* NaN * ANY = NaN. */
+ *r = *a;
+ r->sign = sign;
+ return;
-#ifdef C4X
- case HFmode:
- case QFmode:
- etoe53 (e, t);
- e53toe (t, t);
- break;
-#endif
+ case CLASS2 (rvc_zero, rvc_inf):
+ case CLASS2 (rvc_inf, rvc_zero):
+ /* 0 * Inf = NaN */
+ get_canonical_qnan (r, sign);
+ return;
- case SImode:
- r = etrunci (arg);
- return (r);
+ case CLASS2 (rvc_inf, rvc_inf):
+ case CLASS2 (rvc_normal, rvc_inf):
+ case CLASS2 (rvc_inf, rvc_normal):
+ /* Inf * Inf = Inf, R * Inf = Inf */
+ overflow:
+ get_inf (r, sign);
+ return;
- /* If an unsupported type was requested, presume that
- the machine files know something useful to do with
- the unmodified value. */
+ case CLASS2 (rvc_normal, rvc_normal):
+ break;
default:
- return (arg);
+ abort ();
}
- PUT_REAL (t, &r);
- return (r);
-}
-/* Return true if ARG can be represented exactly in MODE. */
+ if (r == a || r == b)
+ rr = &t;
+ else
+ rr = r;
+ get_zero (rr, 0);
-bool
-exact_real_truncate (mode, arg)
- enum machine_mode mode;
- REAL_VALUE_TYPE *arg;
-{
- REAL_VALUE_TYPE trunc;
+ u.class = rvc_normal;
+ u.sign = 0;
- if (target_isnan (*arg))
- return false;
+ /* Collect all the partial products. Since we don't have sure access
+ to a widening multiply, we split each long into two half-words.
- trunc = real_value_truncate (mode, *arg);
- return ereal_cmp (*arg, trunc) == 0;
-}
+ Consider the long-hand form of a four half-word multiplication:
-/* Try to change R into its exact multiplicative inverse in machine mode
- MODE. Return nonzero function value if successful. */
+ A B C D
+ * E F G H
+ --------------
+ DE DF DG DH
+ CE CF CG CH
+ BE BF BG BH
+ AE AF AG AH
-int
-exact_real_inverse (mode, r)
- enum machine_mode mode;
- REAL_VALUE_TYPE *r;
-{
- UEMUSHORT e[NE], einv[NE];
- REAL_VALUE_TYPE rinv;
- int i;
+ We construct partial products of the widened half-word products
+ that are known to not overlap, e.g. DF+DH. Each such partial
+ product is given its proper exponent, which allows us to sum them
+ and obtain the finished product. */
- GET_REAL (r, e);
+ for (i = 0; i < SIGSZ * 2; ++i)
+ {
+ unsigned long ai = a->sig[i / 2];
+ if (i & 1)
+ ai >>= HOST_BITS_PER_LONG / 2;
+ else
+ ai &= ((unsigned long)1 << (HOST_BITS_PER_LONG / 2)) - 1;
- /* Test for input in range. Don't transform IEEE special values. */
- if (eisinf (e) || eisnan (e) || (ecmp (e, ezero) == 0))
- return 0;
+ if (ai == 0)
+ continue;
- /* Test for a power of 2: all significand bits zero except the MSB.
- We are assuming the target has binary (or hex) arithmetic. */
- if (e[NE - 2] != 0x8000)
- return 0;
+ for (j = 0; j < 2; ++j)
+ {
+ int exp = (a->exp - (2*SIGSZ-1-i)*(HOST_BITS_PER_LONG/2)
+ + (b->exp - (1-j)*(HOST_BITS_PER_LONG/2)));
- for (i = 0; i < NE - 2; i++)
- {
- if (e[i] != 0)
- return 0;
- }
+ if (exp > MAX_EXP)
+ goto overflow;
+ if (exp < -MAX_EXP)
+ /* Would underflow to zero, which we shouldn't bother adding. */
+ continue;
- /* Compute the inverse and truncate it to the required mode. */
- ediv (e, eone, einv);
- PUT_REAL (einv, &rinv);
- rinv = real_value_truncate (mode, rinv);
+ u.exp = exp;
-#ifdef CHECK_FLOAT_VALUE
- /* This check is not redundant. It may, for example, flush
- a supposedly IEEE denormal value to zero. */
- i = 0;
- if (CHECK_FLOAT_VALUE (mode, rinv, i))
- return 0;
-#endif
- GET_REAL (&rinv, einv);
+ for (k = j; k < SIGSZ * 2; k += 2)
+ {
+ unsigned long bi = b->sig[k / 2];
+ if (k & 1)
+ bi >>= HOST_BITS_PER_LONG / 2;
+ else
+ bi &= ((unsigned long)1 << (HOST_BITS_PER_LONG / 2)) - 1;
- /* Check the bits again, because the truncation might have
- generated an arbitrary saturation value on overflow. */
- if (einv[NE - 2] != 0x8000)
- return 0;
+ u.sig[k / 2] = ai * bi;
+ }
- for (i = 0; i < NE - 2; i++)
- {
- if (einv[i] != 0)
- return 0;
+ do_add (rr, rr, &u, 0);
+ }
}
- /* Fail if the computed inverse is out of range. */
- if (eisinf (einv) || eisnan (einv) || (ecmp (einv, ezero) == 0))
- return 0;
-
- /* Output the reciprocal and return success flag. */
- PUT_REAL (einv, r);
- return 1;
+ rr->sign = sign;
+ if (rr != r)
+ *r = t;
}
-/* Used for debugging--print the value of R in human-readable format
- on stderr. */
+/* Return R = A / B. */
-void
-debug_real (r)
- REAL_VALUE_TYPE r;
+static void
+do_divide (r, a, b)
+ struct real_value *r;
+ const struct real_value *a, *b;
{
- char dstr[30];
+ int exp, sign = a->sign ^ b->sign;
+ struct real_value t, *rr;
+ bool inexact;
- REAL_VALUE_TO_DECIMAL (r, dstr, -1);
- fprintf (stderr, "%s", dstr);
-}
+ switch (CLASS2 (a->class, b->class))
+ {
+ case CLASS2 (rvc_zero, rvc_zero):
+ /* 0 / 0 = NaN. */
+ case CLASS2 (rvc_inf, rvc_zero):
+ /* Inf / 0 = NaN. */
+ case CLASS2 (rvc_inf, rvc_inf):
+ /* Inf / Inf = NaN. */
+ get_canonical_qnan (r, sign);
+ return;
-\f
-/* The following routines convert REAL_VALUE_TYPE to the various floating
- point formats that are meaningful to supported computers.
+ case CLASS2 (rvc_zero, rvc_normal):
+ case CLASS2 (rvc_zero, rvc_inf):
+ /* 0 / ANY = 0. */
+ case CLASS2 (rvc_normal, rvc_inf):
+ /* R / Inf = 0. */
+ underflow:
+ get_zero (r, sign);
+ return;
- The results are returned in 32-bit pieces, each piece stored in a `long'.
- This is so they can be printed by statements like
+ case CLASS2 (rvc_normal, rvc_zero):
+ /* R / 0 = Inf. */
+ get_inf (r, sign);
+ return;
- fprintf (file, "%lx, %lx", L[0], L[1]);
+ case CLASS2 (rvc_zero, rvc_nan):
+ case CLASS2 (rvc_normal, rvc_nan):
+ case CLASS2 (rvc_inf, rvc_nan):
+ case CLASS2 (rvc_nan, rvc_nan):
+ /* ANY / NaN = NaN. */
+ *r = *b;
+ r->sign = sign;
+ return;
- that will work on both narrow- and wide-word host computers. */
+ case CLASS2 (rvc_nan, rvc_zero):
+ case CLASS2 (rvc_nan, rvc_normal):
+ case CLASS2 (rvc_nan, rvc_inf):
+ /* NaN / ANY = NaN. */
+ *r = *a;
+ r->sign = sign;
+ return;
-/* Convert R to a 128-bit long double precision value. The output array L
- contains four 32-bit pieces of the result, in the order they would appear
- in memory. */
+ case CLASS2 (rvc_inf, rvc_normal):
+ /* Inf / R = Inf. */
+ overflow:
+ get_inf (r, sign);
+ return;
-void
-etartdouble (r, l)
- REAL_VALUE_TYPE r;
- long l[];
-{
- UEMUSHORT e[NE];
+ case CLASS2 (rvc_normal, rvc_normal):
+ break;
- GET_REAL (&r, e);
-#if INTEL_EXTENDED_IEEE_FORMAT == 0
- etoe113 (e, e);
-#else
- etoe64 (e, e);
-#endif
- endian (e, l, TFmode);
-}
+ default:
+ abort ();
+ }
-/* Convert R to a double extended precision value. The output array L
- contains three 32-bit pieces of the result, in the order they would
- appear in memory. */
+ if (r == a || r == b)
+ rr = &t;
+ else
+ rr = r;
-void
-etarldouble (r, l)
- REAL_VALUE_TYPE r;
- long l[];
-{
- UEMUSHORT e[NE];
+ rr->class = rvc_normal;
+ rr->sign = sign;
- GET_REAL (&r, e);
- etoe64 (e, e);
- endian (e, l, XFmode);
-}
+ exp = a->exp - b->exp + 1;
+ if (exp > MAX_EXP)
+ goto overflow;
+ if (exp < -MAX_EXP)
+ goto underflow;
+ rr->exp = exp;
-/* Convert R to a double precision value. The output array L contains two
- 32-bit pieces of the result, in the order they would appear in memory. */
+ inexact = div_significands (rr, a, b);
+ rr->sig[0] |= inexact;
-void
-etardouble (r, l)
- REAL_VALUE_TYPE r;
- long l[];
-{
- UEMUSHORT e[NE];
+ /* Re-normalize the result. */
+ normalize (rr);
- GET_REAL (&r, e);
- etoe53 (e, e);
- endian (e, l, DFmode);
+ if (rr != r)
+ *r = t;
}
-/* Convert R to a single precision float value stored in the least-significant
- bits of a `long'. */
+/* Return a tri-state comparison of A vs B. Return NAN_RESULT if
+ one of the two operands is a NaN. */
-long
-etarsingle (r)
- REAL_VALUE_TYPE r;
+static int
+do_compare (a, b, nan_result)
+ const struct real_value *a, *b;
+ int nan_result;
{
- UEMUSHORT e[NE];
- long l;
+ int ret;
- GET_REAL (&r, e);
- etoe24 (e, e);
- endian (e, &l, SFmode);
- return ((long) l);
-}
+ switch (CLASS2 (a->class, b->class))
+ {
+ case CLASS2 (rvc_zero, rvc_zero):
+ /* Sign of zero doesn't matter for compares. */
+ return 0;
-/* Convert X to a decimal ASCII string S for output to an assembly
- language file. Note, there is no standard way to spell infinity or
- a NaN, so these values may require special treatment in the tm.h
- macros.
+ case CLASS2 (rvc_inf, rvc_zero):
+ case CLASS2 (rvc_inf, rvc_normal):
+ case CLASS2 (rvc_normal, rvc_zero):
+ return (a->sign ? -1 : 1);
- The argument DIGITS is the number of decimal digits to print,
- or -1 to indicate "enough", i.e. DECIMAL_DIG for for the target. */
+ case CLASS2 (rvc_inf, rvc_inf):
+ return -a->sign - -b->sign;
-void
-ereal_to_decimal (x, s, digits)
- REAL_VALUE_TYPE x;
- char *s;
- int digits;
-{
- UEMUSHORT e[NE];
- GET_REAL (&x, e);
+ case CLASS2 (rvc_zero, rvc_normal):
+ case CLASS2 (rvc_zero, rvc_inf):
+ case CLASS2 (rvc_normal, rvc_inf):
+ return (b->sign ? 1 : -1);
- /* Find DECIMAL_DIG for the target. */
- if (digits < 0)
- switch (TARGET_FLOAT_FORMAT)
- {
- case IEEE_FLOAT_FORMAT:
- switch (LONG_DOUBLE_TYPE_SIZE)
- {
- case 32:
- digits = 9;
- break;
- case 64:
- digits = 17;
- break;
- case 128:
- if (!INTEL_EXTENDED_IEEE_FORMAT)
- {
- digits = 36;
- break;
- }
- /* FALLTHRU */
- case 96:
- digits = 21;
- break;
+ case CLASS2 (rvc_zero, rvc_nan):
+ case CLASS2 (rvc_normal, rvc_nan):
+ case CLASS2 (rvc_inf, rvc_nan):
+ case CLASS2 (rvc_nan, rvc_nan):
+ case CLASS2 (rvc_nan, rvc_zero):
+ case CLASS2 (rvc_nan, rvc_normal):
+ case CLASS2 (rvc_nan, rvc_inf):
+ return nan_result;
- default:
- abort ();
- }
- break;
+ case CLASS2 (rvc_normal, rvc_normal):
+ break;
- case VAX_FLOAT_FORMAT:
- digits = 18; /* D_FLOAT */
- break;
+ default:
+ abort ();
+ }
- case IBM_FLOAT_FORMAT:
- digits = 18;
- break;
+ if (a->sign != b->sign)
+ return -a->sign - -b->sign;
- case C4X_FLOAT_FORMAT:
- digits = 11;
- break;
+ if (a->exp > b->exp)
+ ret = 1;
+ else if (a->exp < b->exp)
+ ret = -1;
+ else
+ ret = cmp_significands (a, b);
- default:
- abort ();
- }
-
- /* etoasc interprets digits as places after the decimal point.
- We interpret digits as total decimal digits, which IMO is
- more useful. Since the output will have one digit before
- the point, subtract one. */
- etoasc (e, s, digits - 1);
+ return (a->sign ? -ret : ret);
}
-/* Compare X and Y. Return 1 if X > Y, 0 if X == Y, -1 if X < Y,
- or -2 if either is a NaN. */
+/* Perform the binary or unary operation described by CODE.
+ For a unary operation, leave OP1 NULL. */
-int
-ereal_cmp (x, y)
- REAL_VALUE_TYPE x, y;
+void
+real_arithmetic (tr, icode, top0, top1)
+ REAL_VALUE_TYPE *tr;
+ int icode;
+ const REAL_VALUE_TYPE *top0, *top1;
{
- UEMUSHORT ex[NE], ey[NE];
+ struct real_value *r = (struct real_value *) tr;
+ const struct real_value *op0 = (const struct real_value *) top0;
+ const struct real_value *op1 = (const struct real_value *) top1;
+ enum tree_code code = icode;
- GET_REAL (&x, ex);
- GET_REAL (&y, ey);
- return (ecmp (ex, ey));
-}
+ switch (code)
+ {
+ case PLUS_EXPR:
+ do_add (r, op0, op1, 0);
+ break;
-/* Return 1 if the sign bit of X is set, else return 0. */
+ case MINUS_EXPR:
+ do_add (r, op0, op1, 1);
+ break;
-int
-ereal_isneg (x)
- REAL_VALUE_TYPE x;
-{
- UEMUSHORT ex[NE];
+ case MULT_EXPR:
+ do_multiply (r, op0, op1);
+ break;
- GET_REAL (&x, ex);
- return (eisneg (ex));
-}
+ case RDIV_EXPR:
+ do_divide (r, op0, op1);
+ break;
-\f
-/*
- Extended precision IEEE binary floating point arithmetic routines
+ case MIN_EXPR:
+ if (op1->class == rvc_nan)
+ *r = *op1;
+ else if (do_compare (op0, op1, -1) < 0)
+ *r = *op0;
+ else
+ *r = *op1;
+ break;
- Numbers are stored in C language as arrays of 16-bit unsigned
- short integers. The arguments of the routines are pointers to
- the arrays.
+ case MAX_EXPR:
+ if (op1->class == rvc_nan)
+ *r = *op1;
+ else if (do_compare (op0, op1, 1) < 0)
+ *r = *op1;
+ else
+ *r = *op0;
+ break;
- External e type data structure, similar to Intel 8087 chip
- temporary real format but possibly with a larger significand:
+ case NEGATE_EXPR:
+ *r = *op0;
+ r->sign ^= 1;
+ break;
- NE-1 significand words (least significant word first,
- most significant bit is normally set)
- exponent (value = EXONE for 1.0,
- top bit is the sign)
+ case ABS_EXPR:
+ *r = *op0;
+ r->sign = 0;
+ break;
+ default:
+ abort ();
+ }
+}
- Internal exploded e-type data structure of a number (a "word" is 16 bits):
+/* Legacy. Similar, but return the result directly. */
- ei[0] sign word (0 for positive, 0xffff for negative)
- ei[1] biased exponent (value = EXONE for the number 1.0)
- ei[2] high guard word (always zero after normalization)
- ei[3]
- to ei[NI-2] significand (NI-4 significand words,
- most significant word first,
- most significant bit is set)
- ei[NI-1] low guard word (0x8000 bit is rounding place)
+REAL_VALUE_TYPE
+real_arithmetic2 (icode, top0, top1)
+ int icode;
+ const REAL_VALUE_TYPE *top0, *top1;
+{
+ REAL_VALUE_TYPE r;
+ real_arithmetic (&r, icode, top0, top1);
+ return r;
+}
+bool
+real_compare (icode, top0, top1)
+ int icode;
+ const REAL_VALUE_TYPE *top0, *top1;
+{
+ enum tree_code code = icode;
+ const struct real_value *op0 = (const struct real_value *) top0;
+ const struct real_value *op1 = (const struct real_value *) top1;
+ switch (code)
+ {
+ case LT_EXPR:
+ return do_compare (op0, op1, 1) < 0;
+ case LE_EXPR:
+ return do_compare (op0, op1, 1) <= 0;
+ case GT_EXPR:
+ return do_compare (op0, op1, -1) > 0;
+ case GE_EXPR:
+ return do_compare (op0, op1, -1) >= 0;
+ case EQ_EXPR:
+ return do_compare (op0, op1, -1) == 0;
+ case NE_EXPR:
+ return do_compare (op0, op1, -1) != 0;
+ case UNORDERED_EXPR:
+ return op0->class == rvc_nan || op1->class == rvc_nan;
+ case ORDERED_EXPR:
+ return op0->class != rvc_nan && op1->class != rvc_nan;
+ case UNLT_EXPR:
+ return do_compare (op0, op1, -1) < 0;
+ case UNLE_EXPR:
+ return do_compare (op0, op1, -1) <= 0;
+ case UNGT_EXPR:
+ return do_compare (op0, op1, 1) > 0;
+ case UNGE_EXPR:
+ return do_compare (op0, op1, 1) >= 0;
+ case UNEQ_EXPR:
+ return do_compare (op0, op1, 0) == 0;
- Routines for external format e-type numbers
+ default:
+ abort ();
+ }
+}
- asctoe (string, e) ASCII string to extended double e type
- asctoe64 (string, &d) ASCII string to long double
- asctoe53 (string, &d) ASCII string to double
- asctoe24 (string, &f) ASCII string to single
- asctoeg (string, e, prec) ASCII string to specified precision
- e24toe (&f, e) IEEE single precision to e type
- e53toe (&d, e) IEEE double precision to e type
- e64toe (&d, e) IEEE long double precision to e type
- e113toe (&d, e) 128-bit long double precision to e type
-#if 0
- eabs (e) absolute value
-#endif
- eadd (a, b, c) c = b + a
- eclear (e) e = 0
- ecmp (a, b) Returns 1 if a > b, 0 if a == b,
- -1 if a < b, -2 if either a or b is a NaN.
- ediv (a, b, c) c = b / a
- efloor (a, b) truncate to integer, toward -infinity
- efrexp (a, exp, s) extract exponent and significand
- eifrac (e, &l, frac) e to HOST_WIDE_INT and e type fraction
- euifrac (e, &l, frac) e to unsigned HOST_WIDE_INT and e type fraction
- einfin (e) set e to infinity, leaving its sign alone
- eldexp (a, n, b) multiply by 2**n
- emov (a, b) b = a
- emul (a, b, c) c = b * a
- eneg (e) e = -e
-#if 0
- eround (a, b) b = nearest integer value to a
-#endif
- esub (a, b, c) c = b - a
-#if 0
- e24toasc (&f, str, n) single to ASCII string, n digits after decimal
- e53toasc (&d, str, n) double to ASCII string, n digits after decimal
- e64toasc (&d, str, n) 80-bit long double to ASCII string
- e113toasc (&d, str, n) 128-bit long double to ASCII string
-#endif
- etoasc (e, str, n) e to ASCII string, n digits after decimal
- etoe24 (e, &f) convert e type to IEEE single precision
- etoe53 (e, &d) convert e type to IEEE double precision
- etoe64 (e, &d) convert e type to IEEE long double precision
- ltoe (&l, e) HOST_WIDE_INT to e type
- ultoe (&l, e) unsigned HOST_WIDE_INT to e type
- eisneg (e) 1 if sign bit of e != 0, else 0
- eisinf (e) 1 if e has maximum exponent (non-IEEE)
- or is infinite (IEEE)
- eisnan (e) 1 if e is a NaN
-
-
- Routines for internal format exploded e-type numbers
-
- eaddm (ai, bi) add significands, bi = bi + ai
- ecleaz (ei) ei = 0
- ecleazs (ei) set ei = 0 but leave its sign alone
- ecmpm (ai, bi) compare significands, return 1, 0, or -1
- edivm (ai, bi) divide significands, bi = bi / ai
- emdnorm (ai,l,s,exp) normalize and round off
- emovi (a, ai) convert external a to internal ai
- emovo (ai, a) convert internal ai to external a
- emovz (ai, bi) bi = ai, low guard word of bi = 0
- emulm (ai, bi) multiply significands, bi = bi * ai
- enormlz (ei) left-justify the significand
- eshdn1 (ai) shift significand and guards down 1 bit
- eshdn8 (ai) shift down 8 bits
- eshdn6 (ai) shift down 16 bits
- eshift (ai, n) shift ai n bits up (or down if n < 0)
- eshup1 (ai) shift significand and guards up 1 bit
- eshup8 (ai) shift up 8 bits
- eshup6 (ai) shift up 16 bits
- esubm (ai, bi) subtract significands, bi = bi - ai
- eiisinf (ai) 1 if infinite
- eiisnan (ai) 1 if a NaN
- eiisneg (ai) 1 if sign bit of ai != 0, else 0
- einan (ai) set ai = NaN
-#if 0
- eiinfin (ai) set ai = infinity
-#endif
+/* Return floor log2(R). */
- The result is always normalized and rounded to NI-4 word precision
- after each arithmetic operation.
-
- Exception flags are NOT fully supported.
-
- Signaling NaN's are NOT supported; they are treated the same
- as quiet NaN's.
-
- Define INFINITY for support of infinity; otherwise a
- saturation arithmetic is implemented.
-
- Define NANS for support of Not-a-Number items; otherwise the
- arithmetic will never produce a NaN output, and might be confused
- by a NaN input.
- If NaN's are supported, the output of `ecmp (a,b)' is -2 if
- either a or b is a NaN. This means asking `if (ecmp (a,b) < 0)'
- may not be legitimate. Use `if (ecmp (a,b) == -1)' for `less than'
- if in doubt.
-
- Denormals are always supported here where appropriate (e.g., not
- for conversion to DEC numbers). */
-
-/* Definitions for error codes that are passed to the common error handling
- routine mtherr.
-
- For Digital Equipment PDP-11 and VAX computers, certain
- IBM systems, and others that use numbers with a 56-bit
- significand, the symbol DEC should be defined. In this
- mode, most floating point constants are given as arrays
- of octal integers to eliminate decimal to binary conversion
- errors that might be introduced by the compiler.
-
- For computers, such as IBM PC, that follow the IEEE
- Standard for Binary Floating Point Arithmetic (ANSI/IEEE
- Std 754-1985), the symbol IEEE should be defined.
- These numbers have 53-bit significands. In this mode, constants
- are provided as arrays of hexadecimal 16 bit integers.
- The endian-ness of generated values is controlled by
- REAL_WORDS_BIG_ENDIAN.
-
- To accommodate other types of computer arithmetic, all
- constants are also provided in a normal decimal radix
- which one can hope are correctly converted to a suitable
- format by the available C language compiler. To invoke
- this mode, the symbol UNK is defined.
-
- An important difference among these modes is a predefined
- set of machine arithmetic constants for each. The numbers
- MACHEP (the machine roundoff error), MAXNUM (largest number
- represented), and several other parameters are preset by
- the configuration symbol. Check the file const.c to
- ensure that these values are correct for your computer.
-
- For ANSI C compatibility, define ANSIC equal to 1. Currently
- this affects only the atan2 function and others that use it. */
-
-/* Constant definitions for math error conditions. */
-
-#define DOMAIN 1 /* argument domain error */
-#define SING 2 /* argument singularity */
-#define OVERFLOW 3 /* overflow range error */
-#define UNDERFLOW 4 /* underflow range error */
-#define TLOSS 5 /* total loss of precision */
-#define PLOSS 6 /* partial loss of precision */
-#define INVALID 7 /* NaN-producing operation */
-
-/* e type constants used by high precision check routines */
-
-#if MAX_LONG_DOUBLE_TYPE_SIZE == 128 && (INTEL_EXTENDED_IEEE_FORMAT == 0)
-/* 0.0 */
-const UEMUSHORT ezero[NE] =
- {0x0000, 0x0000, 0x0000, 0x0000,
- 0x0000, 0x0000, 0x0000, 0x0000, 0x0000, 0x0000,};
-
-/* 5.0E-1 */
-const UEMUSHORT ehalf[NE] =
- {0x0000, 0x0000, 0x0000, 0x0000,
- 0x0000, 0x0000, 0x0000, 0x0000, 0x8000, 0x3ffe,};
-
-/* 1.0E0 */
-const UEMUSHORT eone[NE] =
- {0x0000, 0x0000, 0x0000, 0x0000,
- 0x0000, 0x0000, 0x0000, 0x0000, 0x8000, 0x3fff,};
-
-/* 2.0E0 */
-const UEMUSHORT etwo[NE] =
- {0x0000, 0x0000, 0x0000, 0x0000,
- 0x0000, 0x0000, 0x0000, 0x0000, 0x8000, 0x4000,};
-
-/* 3.2E1 */
-const UEMUSHORT e32[NE] =
- {0x0000, 0x0000, 0x0000, 0x0000,
- 0x0000, 0x0000, 0x0000, 0x0000, 0x8000, 0x4004,};
-
-/* 6.93147180559945309417232121458176568075500134360255E-1 */
-const UEMUSHORT elog2[NE] =
- {0x40f3, 0xf6af, 0x03f2, 0xb398,
- 0xc9e3, 0x79ab, 0150717, 0013767, 0130562, 0x3ffe,};
-
-/* 1.41421356237309504880168872420969807856967187537695E0 */
-const UEMUSHORT esqrt2[NE] =
- {0x1d6f, 0xbe9f, 0x754a, 0x89b3,
- 0x597d, 0x6484, 0174736, 0171463, 0132404, 0x3fff,};
-
-/* 3.14159265358979323846264338327950288419716939937511E0 */
-const UEMUSHORT epi[NE] =
- {0x2902, 0x1cd1, 0x80dc, 0x628b,
- 0xc4c6, 0xc234, 0020550, 0155242, 0144417, 0040000,};
-
-#else
-/* LONG_DOUBLE_TYPE_SIZE is other than 128 */
-const UEMUSHORT ezero[NE] =
- {0, 0000000, 0000000, 0000000, 0000000, 0000000,};
-const UEMUSHORT ehalf[NE] =
- {0, 0000000, 0000000, 0000000, 0100000, 0x3ffe,};
-const UEMUSHORT eone[NE] =
- {0, 0000000, 0000000, 0000000, 0100000, 0x3fff,};
-const UEMUSHORT etwo[NE] =
- {0, 0000000, 0000000, 0000000, 0100000, 0040000,};
-const UEMUSHORT e32[NE] =
- {0, 0000000, 0000000, 0000000, 0100000, 0040004,};
-const UEMUSHORT elog2[NE] =
- {0xc9e4, 0x79ab, 0150717, 0013767, 0130562, 0x3ffe,};
-const UEMUSHORT esqrt2[NE] =
- {0x597e, 0x6484, 0174736, 0171463, 0132404, 0x3fff,};
-const UEMUSHORT epi[NE] =
- {0xc4c6, 0xc234, 0020550, 0155242, 0144417, 0040000,};
-#endif
+int
+real_exponent (tr)
+ const REAL_VALUE_TYPE *tr;
+{
+ const struct real_value *r = (const struct real_value *) tr;
-/* Control register for rounding precision.
- This can be set to 113 (if NE=10), 80 (if NE=6), 64, 56, 53, or 24 bits. */
+ switch (r->class)
+ {
+ case rvc_zero:
+ return 0;
+ case rvc_inf:
+ case rvc_nan:
+ return (unsigned int)-1 >> 1;
+ case rvc_normal:
+ return r->exp;
+ default:
+ abort ();
+ }
+}
-int rndprc = NBITS;
-extern int rndprc;
-/* Clear out entire e-type number X. */
+/* R = OP0 * 2**EXP. */
-static void
-eclear (x)
- UEMUSHORT *x;
+void
+real_ldexp (tr, top0, exp)
+ REAL_VALUE_TYPE *tr;
+ const REAL_VALUE_TYPE *top0;
+ int exp;
{
- int i;
-
- for (i = 0; i < NE; i++)
- *x++ = 0;
-}
+ struct real_value *r = (struct real_value *) tr;
+ const struct real_value *op0 = (const struct real_value *) top0;
-/* Move e-type number from A to B. */
+ *r = *op0;
+ switch (r->class)
+ {
+ case rvc_zero:
+ case rvc_inf:
+ case rvc_nan:
+ break;
-static void
-emov (a, b)
- const UEMUSHORT *a;
- UEMUSHORT *b;
-{
- int i;
+ case rvc_normal:
+ exp += op0->exp;
+ if (exp > MAX_EXP)
+ get_inf (r, r->sign);
+ else if (exp < -MAX_EXP)
+ get_zero (r, r->sign);
+ else
+ r->exp = exp;
+ break;
- for (i = 0; i < NE; i++)
- *b++ = *a++;
+ default:
+ abort ();
+ }
}
+/* Determine whether a floating-point value X is infinite. */
-#if 0
-/* Absolute value of e-type X. */
-
-static void
-eabs (x)
- UEMUSHORT x[];
+bool
+real_isinf (tr)
+ const REAL_VALUE_TYPE *tr;
{
- /* sign is top bit of last word of external format */
- x[NE - 1] &= 0x7fff;
+ const struct real_value *r = (const struct real_value *) tr;
+ return (r->class == rvc_inf);
}
-#endif /* 0 */
-/* Negate the e-type number X. */
+/* Determine whether a floating-point value X is a NaN. */
-static void
-eneg (x)
- UEMUSHORT x[];
+bool
+real_isnan (tr)
+ const REAL_VALUE_TYPE *tr;
{
-
- x[NE - 1] ^= 0x8000; /* Toggle the sign bit */
+ const struct real_value *r = (const struct real_value *) tr;
+ return (r->class == rvc_nan);
}
-/* Return 1 if sign bit of e-type number X is nonzero, else zero. */
+/* Determine whether a floating-point value X is negative. */
-static int
-eisneg (x)
- const UEMUSHORT x[];
+bool
+real_isneg (tr)
+ const REAL_VALUE_TYPE *tr;
{
-
- if (x[NE - 1] & 0x8000)
- return (1);
- else
- return (0);
+ const struct real_value *r = (const struct real_value *) tr;
+ return r->sign;
}
-/* Return 1 if e-type number X is infinity, else return zero. */
+/* Determine whether a floating-point value X is minus zero. */
-static int
-eisinf (x)
- const UEMUSHORT x[];
+bool
+real_isnegzero (tr)
+ const REAL_VALUE_TYPE *tr;
{
-
-#ifdef NANS
- if (eisnan (x))
- return (0);
-#endif
- if ((x[NE - 1] & 0x7fff) == 0x7fff)
- return (1);
- else
- return (0);
+ const struct real_value *r = (const struct real_value *) tr;
+ return r->sign && r->class == rvc_zero;
}
-/* Check if e-type number is not a number. The bit pattern is one that we
- defined, so we know for sure how to detect it. */
+/* Compare two floating-point objects for bitwise identity. */
-static int
-eisnan (x)
- const UEMUSHORT x[] ATTRIBUTE_UNUSED;
+extern bool
+real_identical (ta, tb)
+ const REAL_VALUE_TYPE *ta, *tb;
{
-#ifdef NANS
+ const struct real_value *a = (const struct real_value *) ta;
+ const struct real_value *b = (const struct real_value *) tb;
int i;
- /* NaN has maximum exponent */
- if ((x[NE - 1] & 0x7fff) != 0x7fff)
- return (0);
- /* ... and non-zero significand field. */
- for (i = 0; i < NE - 1; i++)
+ if (a->class != b->class)
+ return false;
+ if (a->sign != b->sign)
+ return false;
+
+ switch (a->class)
{
- if (*x++ != 0)
- return (1);
+ case rvc_zero:
+ case rvc_inf:
+ break;
+
+ case rvc_normal:
+ if (a->exp != b->exp)
+ return false;
+ /* FALLTHRU */
+ case rvc_nan:
+ for (i = 0; i < SIGSZ; ++i)
+ if (a->sig[i] != b->sig[i])
+ return false;
+ break;
+
+ default:
+ abort ();
}
-#endif
- return (0);
+ return true;
}
-/* Fill e-type number X with infinity pattern (IEEE)
- or largest possible number (non-IEEE). */
+/* Try to change R into its exact multiplicative inverse in machine
+ mode MODE. Return true if successful. */
-static void
-einfin (x)
- UEMUSHORT *x;
+bool
+exact_real_inverse (mode, tr)
+ enum machine_mode mode;
+ REAL_VALUE_TYPE *tr;
{
+ const struct real_value *one = real_digit (1);
+ struct real_value *r = (struct real_value *) tr;
+ struct real_value u;
int i;
+
+ if (r->class != rvc_normal)
+ return false;
-#ifdef INFINITY
- for (i = 0; i < NE - 1; i++)
- *x++ = 0;
- *x |= 32767;
-#else
- for (i = 0; i < NE - 1; i++)
- *x++ = 0xffff;
- *x |= 32766;
- if (rndprc < NBITS)
- {
- if (rndprc == 113)
- {
- *(x - 9) = 0;
- *(x - 8) = 0;
- }
- if (rndprc == 64)
- {
- *(x - 5) = 0;
- }
- if (rndprc == 53)
- {
- *(x - 4) = 0xf800;
- }
- else
- {
- *(x - 4) = 0;
- *(x - 3) = 0;
- *(x - 2) = 0xff00;
+ /* Check for a power of two: all significand bits zero except the MSB. */
+ for (i = 0; i < SIGSZ-1; ++i)
+ if (r->sig[i] != 0)
+ return false;
+ if (r->sig[SIGSZ-1] != SIG_MSB)
+ return false;
+
+ /* Find the inverse and truncate to the required mode. */
+ do_divide (&u, one, r);
+ real_convert ((REAL_VALUE_TYPE *)&u, mode, (REAL_VALUE_TYPE *)&u);
+
+ /* The rounding may have overflowed. */
+ if (u.class != rvc_normal)
+ return false;
+ for (i = 0; i < SIGSZ-1; ++i)
+ if (u.sig[i] != 0)
+ return false;
+ if (u.sig[SIGSZ-1] != SIG_MSB)
+ return false;
+
+ *r = u;
+ return true;
+}
+\f
+/* Render R as an integer. */
+
+HOST_WIDE_INT
+real_to_integer (tr)
+ const REAL_VALUE_TYPE *tr;
+{
+ const struct real_value *r = (const struct real_value *) tr;
+ unsigned HOST_WIDE_INT i;
+
+ switch (r->class)
+ {
+ case rvc_zero:
+ underflow:
+ return 0;
+
+ case rvc_inf:
+ case rvc_nan:
+ overflow:
+ i = (unsigned HOST_WIDE_INT) 1 << (HOST_BITS_PER_WIDE_INT - 1);
+ if (!r->sign)
+ i--;
+ return i;
+
+ case rvc_normal:
+ if (r->exp <= 0)
+ goto underflow;
+ if (r->exp > HOST_BITS_PER_WIDE_INT)
+ goto overflow;
+
+ if (HOST_BITS_PER_WIDE_INT == HOST_BITS_PER_LONG)
+ i = r->sig[SIGSZ-1];
+ else if (HOST_BITS_PER_WIDE_INT == 2*HOST_BITS_PER_LONG)
+ {
+ i = r->sig[SIGSZ-1];
+ i = i << (HOST_BITS_PER_LONG - 1) << 1;
+ i |= r->sig[SIGSZ-2];
}
+ else
+ abort ();
+
+ i >>= HOST_BITS_PER_WIDE_INT - r->exp;
+
+ if (r->sign)
+ i = -i;
+ return i;
+
+ default:
+ abort ();
}
-#endif
}
-/* Similar, except return it as a REAL_VALUE_TYPE. */
+/* Likewise, but to an integer pair, HI+LOW. */
-REAL_VALUE_TYPE
-ereal_inf (mode)
- enum machine_mode mode;
+void
+real_to_integer2 (plow, phigh, tr)
+ HOST_WIDE_INT *plow, *phigh;
+ const REAL_VALUE_TYPE *tr;
{
- REAL_VALUE_TYPE r;
- UEMUSHORT e[NE];
- int prec, rndsav;
+ struct real_value r;
+ HOST_WIDE_INT low, high;
+ int exp;
- switch (mode)
+ r = *(const struct real_value *) tr;
+ switch (r.class)
{
- case QFmode:
- case SFmode:
- prec = 24;
+ case rvc_zero:
+ underflow:
+ low = high = 0;
break;
- case HFmode:
- case DFmode:
- prec = 53;
+
+ case rvc_inf:
+ case rvc_nan:
+ overflow:
+ high = (unsigned HOST_WIDE_INT) 1 << (HOST_BITS_PER_WIDE_INT - 1);
+ if (r.sign)
+ low = 0;
+ else
+ {
+ high--;
+ low = -1;
+ }
break;
- case TFmode:
- if (!INTEL_EXTENDED_IEEE_FORMAT)
+
+ case rvc_normal:
+ exp = r.exp;
+ if (exp <= 0)
+ goto underflow;
+ if (exp >= 2*HOST_BITS_PER_WIDE_INT)
+ goto overflow;
+
+ rshift_significand (&r, &r, 2*HOST_BITS_PER_WIDE_INT - exp);
+ if (HOST_BITS_PER_WIDE_INT == HOST_BITS_PER_LONG)
{
- prec = 113;
- break;
+ high = r.sig[SIGSZ-1];
+ low = r.sig[SIGSZ-2];
+ }
+ else if (HOST_BITS_PER_WIDE_INT == 2*HOST_BITS_PER_LONG)
+ {
+ high = r.sig[SIGSZ-1];
+ high = high << (HOST_BITS_PER_LONG - 1) << 1;
+ high |= r.sig[SIGSZ-2];
+
+ low = r.sig[SIGSZ-3];
+ low = low << (HOST_BITS_PER_LONG - 1) << 1;
+ low |= r.sig[SIGSZ-4];
+ }
+ else
+ abort ();
+
+ if (r.sign)
+ {
+ if (low == 0)
+ high = -high;
+ else
+ low = -low, high = ~high;
}
- /* FALLTHRU */
- case XFmode:
- prec = 64;
break;
+
default:
abort ();
}
- rndsav = rndprc;
- rndprc = prec;
- eclear (e);
- einfin (e);
- rndprc = rndsav;
-
- PUT_REAL (e, &r);
- return r;
+ *plow = low;
+ *phigh = high;
}
-/* Output an e-type NaN.
- This generates Intel's quiet NaN pattern for extended real.
- The exponent is 7fff, the leading mantissa word is c000. */
+/* Render R as a decimal floating point constant. Emit DIGITS
+ significant digits in the result. If DIGITS <= 0, choose the
+ maximum for the representation. */
-#ifdef NANS
-static void
-enan (x, sign)
- UEMUSHORT *x;
- int sign;
+#define M_LOG10_2 0.30102999566398119521
+
+void
+real_to_decimal (str, r_orig, digits)
+ char *str;
+ const REAL_VALUE_TYPE *r_orig;
+ int digits;
{
- int i;
+ struct real_value r;
+ const struct real_value *one, *ten;
+ int dec_exp, max_digits, d, cmp_half;
+ char *p, *first, *last;
+ bool sign;
- for (i = 0; i < NE - 2; i++)
- *x++ = 0;
- *x++ = 0xc000;
- *x = (sign << 15) | 0x7fff;
-}
-#endif /* NANS */
+ r = *(const struct real_value *)r_orig;
+ switch (r.class)
+ {
+ case rvc_zero:
+ strcpy (str, (r.sign ? "-0.0" : "0.0"));
+ return;
+ case rvc_normal:
+ break;
+ case rvc_inf:
+ strcpy (str, (r.sign ? "+Inf" : "-Inf"));
+ return;
+ case rvc_nan:
+ /* ??? Print the significand as well, if not canonical? */
+ strcpy (str, (r.sign ? "+NaN" : "-NaN"));
+ return;
+ default:
+ abort ();
+ }
-/* Move in an e-type number A, converting it to exploded e-type B. */
+ max_digits = SIGNIFICAND_BITS * M_LOG10_2;
+ if (digits <= 0 || digits > max_digits)
+ digits = max_digits;
-static void
-emovi (a, b)
- const UEMUSHORT *a;
- UEMUSHORT *b;
-{
- const UEMUSHORT *p;
- UEMUSHORT *q;
- int i;
+ one = real_digit (1);
+ ten = ten_to_ptwo (0);
- q = b;
- p = a + (NE - 1); /* point to last word of external number */
- /* get the sign bit */
- if (*p & 0x8000)
- *q++ = 0xffff;
- else
- *q++ = 0;
- /* get the exponent */
- *q = *p--;
- *q++ &= 0x7fff; /* delete the sign bit */
-#ifdef INFINITY
- if ((*(q - 1) & 0x7fff) == 0x7fff)
+ sign = r.sign;
+ r.sign = 0;
+
+ /* Estimate the decimal exponent. */
+ dec_exp = r.exp * M_LOG10_2;
+
+ /* Scale the number such that it is in [1, 10). */
+ if (dec_exp > 0)
{
-#ifdef NANS
- if (eisnan (a))
- {
- *q++ = 0;
- for (i = 3; i < NI; i++)
- *q++ = *p--;
- return;
- }
-#endif
+ int i;
+ for (i = EXP_BITS - 1; i >= 0; --i)
+ if (dec_exp & (1 << i))
+ do_divide (&r, &r, ten_to_ptwo (i));
+ }
+ else if (dec_exp < 0)
+ {
+ int i, pos_exp = -(--dec_exp);
- for (i = 2; i < NI; i++)
- *q++ = 0;
- return;
+ for (i = EXP_BITS - 1; i >= 0; --i)
+ if (pos_exp & (1 << i))
+ do_multiply (&r, &r, ten_to_ptwo (i));
}
-#endif
- /* clear high guard word */
- *q++ = 0;
- /* move in the significand */
- for (i = 0; i < NE - 1; i++)
- *q++ = *p--;
- /* clear low guard word */
- *q = 0;
-}
+ /* Assert that the number is in the proper range. Round-off can
+ prevent the above from working exactly. */
+ if (do_compare (&r, one, -1) < 0)
+ {
+ do_multiply (&r, &r, ten);
+ dec_exp--;
+ }
+ else if (do_compare (&r, ten, 1) >= 0)
+ {
+ do_divide (&r, &r, ten);
+ dec_exp++;
+ }
-/* Move out exploded e-type number A, converting it to e type B. */
+ p = str;
+ if (sign)
+ *p++ = '-';
+ first = p++;
+ while (1)
+ {
+ d = real_to_integer ((const REAL_VALUE_TYPE *) &r);
+ do_add (&r, &r, real_digit (d), 1);
-static void
-emovo (a, b)
- const UEMUSHORT *a;
- UEMUSHORT *b;
-{
- const UEMUSHORT *p;
- UEMUSHORT *q;
- UEMUSHORT i;
- int j;
-
- p = a;
- q = b + (NE - 1); /* point to output exponent */
- /* combine sign and exponent */
- i = *p++;
- if (i)
- *q-- = *p++ | 0x8000;
- else
- *q-- = *p++;
-#ifdef INFINITY
- if (*(p - 1) == 0x7fff)
+ *p++ = d + '0';
+ if (--digits == 0)
+ break;
+ do_multiply (&r, &r, ten);
+ }
+ last = p;
+
+ /* Round the result. Compare R vs 0.5 by doing R*2 vs 1.0. */
+ r.exp += 1;
+ cmp_half = do_compare (&r, one, -1);
+ if (cmp_half == 0)
+ /* Round to even. */
+ cmp_half += d & 1;
+ if (cmp_half > 0)
{
-#ifdef NANS
- if (eiisnan (a))
+ while (p > first)
{
- enan (b, eiisneg (a));
- return;
+ d = *--p;
+ if (d == '9')
+ *p = '0';
+ else
+ {
+ *p = d + 1;
+ break;
+ }
+ }
+
+ if (p == first)
+ {
+ first[1] = '1';
+ dec_exp++;
}
-#endif
- einfin (b);
- return;
}
-#endif
- /* skip over guard word */
- ++p;
- /* move the significand */
- for (j = 0; j < NE - 1; j++)
- *q-- = *p++;
+
+ first[0] = first[1];
+ first[1] = '.';
+
+ sprintf (last, "e%+d", dec_exp);
}
-/* Clear out exploded e-type number XI. */
+/* Render R as a hexadecimal floating point constant. Emit DIGITS
+ significant digits in the result. If DIGITS <= 0, choose the maximum
+ for the representation. */
-static void
-ecleaz (xi)
- UEMUSHORT *xi;
+void
+real_to_hexadecimal (str, tr, digits)
+ char *str;
+ const REAL_VALUE_TYPE *tr;
+ int digits;
{
- int i;
+ struct real_value r;
+ int i, j;
+ char *p;
- for (i = 0; i < NI; i++)
- *xi++ = 0;
-}
+ r = *(const struct real_value *) tr;
+
+ switch (r.class)
+ {
+ case rvc_zero:
+ r.exp = 0;
+ break;
+ case rvc_normal:
+ break;
+ case rvc_inf:
+ strcpy (str, (r.sign ? "+Inf" : "-Inf"));
+ return;
+ case rvc_nan:
+ /* ??? Print the significand as well, if not canonical? */
+ strcpy (str, (r.sign ? "+NaN" : "-NaN"));
+ return;
+ default:
+ abort ();
+ }
-/* Clear out exploded e-type XI, but don't touch the sign. */
+ if (digits <= 0)
+ digits = SIGNIFICAND_BITS / 4;
-static void
-ecleazs (xi)
- UEMUSHORT *xi;
-{
- int i;
+ p = str;
+ if (r.sign)
+ *p++ = '-';
+ *p++ = '0';
+ *p++ = 'x';
+ *p++ = '0';
+ *p++ = '.';
- ++xi;
- for (i = 0; i < NI - 1; i++)
- *xi++ = 0;
+ for (i = SIGSZ - 1; i >= 0; --i)
+ for (j = HOST_BITS_PER_LONG - 4; j >= 0; j -= 4)
+ {
+ *p++ = "0123456789abcdef"[(r.sig[i] >> j) & 15];
+ if (--digits == 0)
+ goto out;
+ }
+ out:
+ sprintf (p, "p%+d", r.exp);
}
-/* Move exploded e-type number from A to B. */
+/* Initialize R from a decimal or hexadecimal string. The string is
+ assumed to have been syntax checked already. */
-static void
-emovz (a, b)
- const UEMUSHORT *a;
- UEMUSHORT *b;
+void
+real_from_string (tr, str)
+ REAL_VALUE_TYPE *tr;
+ const char *str;
{
- int i;
+ struct real_value *r = (struct real_value *) tr;
+ int exp = 0;
- for (i = 0; i < NI - 1; i++)
- *b++ = *a++;
- /* clear low guard word */
- *b = 0;
-}
+ get_zero (r, 0);
-/* Generate exploded e-type NaN.
- The explicit pattern for this is maximum exponent and
- top two significant bits set. */
+ if (*str == '-')
+ {
+ r->sign = 1;
+ str++;
+ }
+ else if (*str == '+')
+ str++;
-#ifdef NANS
-static void
-einan (x)
- UEMUSHORT x[];
-{
+ if (str[0] == '0' && str[1] == 'x')
+ {
+ /* Hexadecimal floating point. */
+ int pos = SIGNIFICAND_BITS - 4, d;
- ecleaz (x);
- x[E] = 0x7fff;
- x[M + 1] = 0xc000;
-}
-#endif /* NANS */
+ str += 2;
+
+ while (*str == '0')
+ str++;
+ while (1)
+ {
+ d = hex_value (*str);
+ if (d == _hex_bad)
+ break;
+ if (pos >= 0)
+ {
+ r->sig[pos / HOST_BITS_PER_LONG]
+ |= (unsigned long) d << (pos % HOST_BITS_PER_LONG);
+ pos -= 4;
+ }
+ exp += 4;
+ str++;
+ }
+ if (*str == '.')
+ {
+ str++;
+ while (1)
+ {
+ d = hex_value (*str);
+ if (d == _hex_bad)
+ break;
+ if (pos >= 0)
+ {
+ r->sig[pos / HOST_BITS_PER_LONG]
+ |= (unsigned long) d << (pos % HOST_BITS_PER_LONG);
+ pos -= 4;
+ }
+ str++;
+ }
+ }
+ if (*str == 'p' || *str == 'P')
+ {
+ int exp_neg = 0;
-/* Return nonzero if exploded e-type X is a NaN. */
+ str++;
+ if (*str == '-')
+ {
+ exp_neg = 1;
+ str++;
+ }
+ else if (*str == '+')
+ str++;
-#ifdef NANS
-static int
-eiisnan (x)
- const UEMUSHORT x[];
-{
- int i;
+ d = 0;
+ while (ISDIGIT (*str))
+ {
+ int t = d;
+ d *= 10;
+ d += *str - '0';
+ if (d < t)
+ {
+ /* Overflowed the exponent. */
+ if (exp_neg)
+ goto underflow;
+ else
+ goto overflow;
+ }
+ str++;
+ }
+ if (exp_neg)
+ d = -d;
- if ((x[E] & 0x7fff) == 0x7fff)
- {
- for (i = M + 1; i < NI; i++)
+ exp += d;
+ }
+
+ r->class = rvc_normal;
+ r->exp = exp;
+ if (r->exp != exp)
{
- if (x[i] != 0)
- return (1);
+ if (exp < 0)
+ goto underflow;
+ else
+ goto overflow;
}
+
+ normalize (r);
}
- return (0);
-}
-#endif /* NANS */
+ else
+ {
+ /* Decimal floating point. */
+ const struct real_value *ten = ten_to_ptwo (0);
+ int d;
-/* Return nonzero if sign of exploded e-type X is nonzero. */
+ while (*str == '0')
+ str++;
+ while (ISDIGIT (*str))
+ {
+ d = *str++ - '0';
+ do_multiply (r, r, ten);
+ if (d)
+ do_add (r, r, real_digit (d), 0);
+ }
+ if (*str == '.')
+ {
+ str++;
+ while (ISDIGIT (*str))
+ {
+ d = *str++ - '0';
+ do_multiply (r, r, ten);
+ if (d)
+ do_add (r, r, real_digit (d), 0);
+ exp--;
+ }
+ }
-static int
-eiisneg (x)
- const UEMUSHORT x[];
-{
+ if (*str == 'e' || *str == 'E')
+ {
+ int exp_neg = 0;
- return x[0] != 0;
-}
+ str++;
+ if (*str == '-')
+ {
+ exp_neg = 1;
+ str++;
+ }
+ else if (*str == '+')
+ str++;
-#if 0
-/* Fill exploded e-type X with infinity pattern.
- This has maximum exponent and significand all zeros. */
+ d = 0;
+ while (ISDIGIT (*str))
+ {
+ int t = d;
+ d *= 10;
+ d += *str - '0';
+ if (d < t)
+ {
+ /* Overflowed the exponent. */
+ if (exp_neg)
+ goto underflow;
+ else
+ goto overflow;
+ }
+ str++;
+ }
+ if (exp_neg)
+ d = -d;
+ exp += d;
+ }
-static void
-eiinfin (x)
- UEMUSHORT x[];
-{
+ if (exp < 0)
+ {
+ exp = -exp;
+ for (d = 0; d < EXP_BITS; ++d)
+ if (exp & (1 << d))
+ do_divide (r, r, ten_to_ptwo (d));
+ }
+ else if (exp > 0)
+ {
+ for (d = 0; d < EXP_BITS; ++d)
+ if (exp & (1 << d))
+ do_multiply (r, r, ten_to_ptwo (d));
+ }
+ }
+
+ return;
- ecleaz (x);
- x[E] = 0x7fff;
+ underflow:
+ get_zero (r, r->sign);
+ return;
+
+ overflow:
+ get_inf (r, r->sign);
+ return;
}
-#endif /* 0 */
-/* Return nonzero if exploded e-type X is infinite. */
+/* Legacy. Similar, but return the result directly. */
-#ifdef INFINITY
-static int
-eiisinf (x)
- const UEMUSHORT x[];
+REAL_VALUE_TYPE
+real_from_string2 (s, mode)
+ const char *s;
+ enum machine_mode mode;
{
+ REAL_VALUE_TYPE r;
-#ifdef NANS
- if (eiisnan (x))
- return (0);
-#endif
- if ((x[E] & 0x7fff) == 0x7fff)
- return (1);
- return (0);
-}
-#endif /* INFINITY */
+ real_from_string (&r, s);
+ if (mode != VOIDmode)
+ real_convert (&r, mode, &r);
-/* Compare significands of numbers in internal exploded e-type format.
- Guard words are included in the comparison.
+ return r;
+}
- Returns +1 if a > b
- 0 if a == b
- -1 if a < b */
+/* Initialize R from the integer pair HIGH+LOW. */
-static int
-ecmpm (a, b)
- const UEMUSHORT *a, *b;
+void
+real_from_integer (tr, mode, low, high, unsigned_p)
+ REAL_VALUE_TYPE *tr;
+ enum machine_mode mode;
+ unsigned HOST_WIDE_INT low;
+ HOST_WIDE_INT high;
+ int unsigned_p;
{
- int i;
+ struct real_value *r = (struct real_value *) tr;
- a += M; /* skip up to significand area */
- b += M;
- for (i = M; i < NI; i++)
+ if (low == 0 && high == 0)
+ get_zero (r, 0);
+ else
{
- if (*a++ != *b++)
- goto difrnt;
+ r->class = rvc_normal;
+ r->sign = high < 0 && !unsigned_p;
+ r->exp = 2 * HOST_BITS_PER_WIDE_INT;
+
+ if (r->sign)
+ {
+ high = ~high;
+ if (low == 0)
+ high += 1;
+ else
+ low = -low;
+ }
+
+ if (HOST_BITS_PER_LONG == HOST_BITS_PER_WIDE_INT)
+ {
+ r->sig[SIGSZ-1] = high;
+ r->sig[SIGSZ-2] = low;
+ memset (r->sig, 0, sizeof(long)*(SIGSZ-2));
+ }
+ else if (HOST_BITS_PER_LONG*2 == HOST_BITS_PER_WIDE_INT)
+ {
+ r->sig[SIGSZ-1] = high >> (HOST_BITS_PER_LONG - 1) >> 1;
+ r->sig[SIGSZ-2] = high;
+ r->sig[SIGSZ-3] = low >> (HOST_BITS_PER_LONG - 1) >> 1;
+ r->sig[SIGSZ-4] = low;
+ if (SIGSZ > 4)
+ memset (r->sig, 0, sizeof(long)*(SIGSZ-4));
+ }
+ else
+ abort ();
+
+ normalize (r);
}
- return (0);
- difrnt:
- if (*(--a) > *(--b))
- return (1);
- else
- return (-1);
+ if (mode != VOIDmode)
+ real_convert (tr, mode, tr);
}
-/* Shift significand of exploded e-type X down by 1 bit. */
+/* Returns 10**2**n. */
-static void
-eshdn1 (x)
- UEMUSHORT *x;
+static const struct real_value *
+ten_to_ptwo (n)
+ int n;
{
- UEMUSHORT bits;
- int i;
+ static struct real_value tens[EXP_BITS];
- x += M; /* point to significand area */
+ if (n < 0 || n >= EXP_BITS)
+ abort ();
- bits = 0;
- for (i = M; i < NI; i++)
+ if (tens[n].class == rvc_zero)
{
- if (*x & 1)
- bits |= 1;
- *x >>= 1;
- if (bits & 2)
- *x |= 0x8000;
- bits <<= 1;
- ++x;
+ if (n < (HOST_BITS_PER_WIDE_INT == 64 ? 5 : 4))
+ {
+ HOST_WIDE_INT t = 10;
+ int i;
+
+ for (i = 0; i < n; ++i)
+ t *= t;
+
+ real_from_integer ((REAL_VALUE_TYPE *) &tens[n], VOIDmode, t, 0, 1);
+ }
+ else
+ {
+ const struct real_value *t = ten_to_ptwo (n - 1);
+ do_multiply (&tens[n], t, t);
+ }
}
+
+ return &tens[n];
}
-/* Shift significand of exploded e-type X up by 1 bit. */
+/* Returns N. */
-static void
-eshup1 (x)
- UEMUSHORT *x;
+static const struct real_value *
+real_digit (n)
+ int n;
{
- UEMUSHORT bits;
- int i;
+ static struct real_value num[10];
- x += NI - 1;
- bits = 0;
+ if (n < 0 || n > 9)
+ abort ();
- for (i = M; i < NI; i++)
- {
- if (*x & 0x8000)
- bits |= 1;
- *x <<= 1;
- if (bits & 2)
- *x |= 1;
- bits <<= 1;
- --x;
- }
+ if (n > 0 && num[n].class == rvc_zero)
+ real_from_integer ((REAL_VALUE_TYPE *) &num[n], VOIDmode, n, 0, 1);
+
+ return &num[n];
}
+/* Fills R with +Inf. */
+
+void
+real_inf (tr)
+ REAL_VALUE_TYPE *tr;
+{
+ get_inf ((struct real_value *)tr, 0);
+}
-/* Shift significand of exploded e-type X down by 8 bits. */
+/* Fills R with a NaN whose significand is described by STR. If QUIET,
+ we force a QNaN, else we force an SNaN. The string, if not empty,
+ is parsed as a number and placed in the significand. */
-static void
-eshdn8 (x)
- UEMUSHORT *x;
+void
+real_nan (tr, str, quiet, mode)
+ REAL_VALUE_TYPE *tr;
+ const char *str;
+ int quiet;
+ enum machine_mode mode ATTRIBUTE_UNUSED;
{
- UEMUSHORT newbyt, oldbyt;
- int i;
+ struct real_value *r = (struct real_value *) tr;
- x += M;
- oldbyt = 0;
- for (i = M; i < NI; i++)
+ if (*str == 0)
{
- newbyt = *x << 8;
- *x >>= 8;
- *x |= oldbyt;
- oldbyt = newbyt;
- ++x;
+ if (quiet)
+ get_canonical_qnan (r, 0);
+ else
+ get_canonical_snan (r, 0);
}
+ else
+ /* FIXME */
+ abort ();
}
-/* Shift significand of exploded e-type X up by 8 bits. */
+/* Fills R with 2**N. */
-static void
-eshup8 (x)
- UEMUSHORT *x;
+void
+real_2expN (tr, n)
+ REAL_VALUE_TYPE *tr;
+ int n;
{
- int i;
- UEMUSHORT newbyt, oldbyt;
+ struct real_value *r = (struct real_value *) tr;
- x += NI - 1;
- oldbyt = 0;
+ memset (r, 0, sizeof (*r));
- for (i = M; i < NI; i++)
+ n++;
+ if (n > MAX_EXP)
+ r->class = rvc_inf;
+ else if (n < -MAX_EXP)
+ ;
+ else
{
- newbyt = *x >> 8;
- *x <<= 8;
- *x |= oldbyt;
- oldbyt = newbyt;
- --x;
+ r->class = rvc_normal;
+ r->exp = n;
+ r->sig[SIGSZ-1] = SIG_MSB;
}
}
-/* Shift significand of exploded e-type X up by 16 bits. */
-
+\f
static void
-eshup6 (x)
- UEMUSHORT *x;
+round_for_format (fmt, r)
+ const struct real_format *fmt;
+ struct real_value *r;
{
- int i;
- UEMUSHORT *p;
+ int p2, np2, i, w;
+ bool sticky, guard, lsb;
+ int emin2m1, emax2;
- p = x + M;
- x += M + 1;
+ p2 = fmt->p * fmt->log2_b;
+ emin2m1 = (fmt->emin - 1) * fmt->log2_b;
+ emax2 = fmt->emax * fmt->log2_b;
- for (i = M; i < NI - 1; i++)
- *p++ = *x++;
-
- *p = 0;
-}
-
-/* Shift significand of exploded e-type X down by 16 bits. */
-
-static void
-eshdn6 (x)
- UEMUSHORT *x;
-{
- int i;
- UEMUSHORT *p;
-
- x += NI - 1;
- p = x + 1;
-
- for (i = M; i < NI - 1; i++)
- *(--p) = *(--x);
-
- *(--p) = 0;
-}
-
-/* Add significands of exploded e-type X and Y. X + Y replaces Y. */
-
-static void
-eaddm (x, y)
- const UEMUSHORT *x;
- UEMUSHORT *y;
-{
- unsigned EMULONG a;
- int i;
- unsigned int carry;
-
- x += NI - 1;
- y += NI - 1;
- carry = 0;
- for (i = M; i < NI; i++)
- {
- a = (unsigned EMULONG) (*x) + (unsigned EMULONG) (*y) + carry;
- if (a & 0x10000)
- carry = 1;
- else
- carry = 0;
- *y = (UEMUSHORT) a;
- --x;
- --y;
- }
-}
-
-/* Subtract significands of exploded e-type X and Y. Y - X replaces Y. */
-
-static void
-esubm (x, y)
- const UEMUSHORT *x;
- UEMUSHORT *y;
-{
- unsigned EMULONG a;
- int i;
- unsigned int carry;
-
- x += NI - 1;
- y += NI - 1;
- carry = 0;
- for (i = M; i < NI; i++)
- {
- a = (unsigned EMULONG) (*y) - (unsigned EMULONG) (*x) - carry;
- if (a & 0x10000)
- carry = 1;
- else
- carry = 0;
- *y = (UEMUSHORT) a;
- --x;
- --y;
- }
-}
-
-
-static UEMUSHORT equot[NI];
-
-
-#if 0
-/* Radix 2 shift-and-add versions of multiply and divide */
-
-
-/* Divide significands */
-
-int
-edivm (den, num)
- UEMUSHORT den[], num[];
-{
- int i;
- UEMUSHORT *p, *q;
- UEMUSHORT j;
-
- p = &equot[0];
- *p++ = num[0];
- *p++ = num[1];
-
- for (i = M; i < NI; i++)
- {
- *p++ = 0;
- }
-
- /* Use faster compare and subtraction if denominator has only 15 bits of
- significance. */
-
- p = &den[M + 2];
- if (*p++ == 0)
- {
- for (i = M + 3; i < NI; i++)
- {
- if (*p++ != 0)
- goto fulldiv;
- }
- if ((den[M + 1] & 1) != 0)
- goto fulldiv;
- eshdn1 (num);
- eshdn1 (den);
-
- p = &den[M + 1];
- q = &num[M + 1];
-
- for (i = 0; i < NBITS + 2; i++)
- {
- if (*p <= *q)
- {
- *q -= *p;
- j = 1;
- }
- else
- {
- j = 0;
- }
- eshup1 (equot);
- equot[NI - 2] |= j;
- eshup1 (num);
- }
- goto divdon;
- }
-
- /* The number of quotient bits to calculate is NBITS + 1 scaling guard
- bit + 1 roundoff bit. */
-
- fulldiv:
-
- p = &equot[NI - 2];
- for (i = 0; i < NBITS + 2; i++)
- {
- if (ecmpm (den, num) <= 0)
- {
- esubm (den, num);
- j = 1; /* quotient bit = 1 */
- }
- else
- j = 0;
- eshup1 (equot);
- *p |= j;
- eshup1 (num);
- }
-
- divdon:
-
- eshdn1 (equot);
- eshdn1 (equot);
-
- /* test for nonzero remainder after roundoff bit */
- p = &num[M];
- j = 0;
- for (i = M; i < NI; i++)
- {
- j |= *p++;
- }
- if (j)
- j = 1;
-
-
- for (i = 0; i < NI; i++)
- num[i] = equot[i];
- return ((int) j);
-}
-
-
-/* Multiply significands */
-
-int
-emulm (a, b)
- UEMUSHORT a[], b[];
-{
- UEMUSHORT *p, *q;
- int i, j, k;
-
- equot[0] = b[0];
- equot[1] = b[1];
- for (i = M; i < NI; i++)
- equot[i] = 0;
-
- p = &a[NI - 2];
- k = NBITS;
- while (*p == 0) /* significand is not supposed to be zero */
- {
- eshdn6 (a);
- k -= 16;
- }
- if ((*p & 0xff) == 0)
- {
- eshdn8 (a);
- k -= 8;
- }
-
- q = &equot[NI - 1];
- j = 0;
- for (i = 0; i < k; i++)
- {
- if (*p & 1)
- eaddm (b, equot);
- /* remember if there were any nonzero bits shifted out */
- if (*q & 1)
- j |= 1;
- eshdn1 (a);
- eshdn1 (equot);
- }
-
- for (i = 0; i < NI; i++)
- b[i] = equot[i];
-
- /* return flag for lost nonzero bits */
- return (j);
-}
-
-#else
-
-/* Radix 65536 versions of multiply and divide. */
-
-/* Multiply significand of e-type number B
- by 16-bit quantity A, return e-type result to C. */
-
-static void
-m16m (a, b, c)
- unsigned int a;
- const UEMUSHORT b[];
- UEMUSHORT c[];
-{
- UEMUSHORT *pp;
- unsigned EMULONG carry;
- const UEMUSHORT *ps;
- UEMUSHORT p[NI];
- unsigned EMULONG aa, m;
- int i;
-
- aa = a;
- pp = &p[NI-2];
- *pp++ = 0;
- *pp = 0;
- ps = &b[NI-1];
-
- for (i=M+1; i<NI; i++)
- {
- if (*ps == 0)
- {
- --ps;
- --pp;
- *(pp-1) = 0;
- }
- else
- {
- m = (unsigned EMULONG) aa * *ps--;
- carry = (m & 0xffff) + *pp;
- *pp-- = (UEMUSHORT) carry;
- carry = (carry >> 16) + (m >> 16) + *pp;
- *pp = (UEMUSHORT) carry;
- *(pp-1) = carry >> 16;
- }
- }
- for (i=M; i<NI; i++)
- c[i] = p[i];
-}
-
-/* Divide significands of exploded e-types NUM / DEN. Neither the
- numerator NUM nor the denominator DEN is permitted to have its high guard
- word nonzero. */
-
-static int
-edivm (den, num)
- const UEMUSHORT den[];
- UEMUSHORT num[];
-{
- int i;
- UEMUSHORT *p;
- unsigned EMULONG tnum;
- UEMUSHORT j, tdenm, tquot;
- UEMUSHORT tprod[NI+1];
-
- p = &equot[0];
- *p++ = num[0];
- *p++ = num[1];
-
- for (i=M; i<NI; i++)
- {
- *p++ = 0;
- }
- eshdn1 (num);
- tdenm = den[M+1];
- for (i=M; i<NI; i++)
- {
- /* Find trial quotient digit (the radix is 65536). */
- tnum = (((unsigned EMULONG) num[M]) << 16) + num[M+1];
-
- /* Do not execute the divide instruction if it will overflow. */
- if ((tdenm * (unsigned long) 0xffff) < tnum)
- tquot = 0xffff;
- else
- tquot = tnum / tdenm;
- /* Multiply denominator by trial quotient digit. */
- m16m ((unsigned int) tquot, den, tprod);
- /* The quotient digit may have been overestimated. */
- if (ecmpm (tprod, num) > 0)
- {
- tquot -= 1;
- esubm (den, tprod);
- if (ecmpm (tprod, num) > 0)
- {
- tquot -= 1;
- esubm (den, tprod);
- }
- }
- esubm (tprod, num);
- equot[i] = tquot;
- eshup6 (num);
- }
- /* test for nonzero remainder after roundoff bit */
- p = &num[M];
- j = 0;
- for (i=M; i<NI; i++)
- {
- j |= *p++;
- }
- if (j)
- j = 1;
-
- for (i=0; i<NI; i++)
- num[i] = equot[i];
-
- return ((int) j);
-}
-
-/* Multiply significands of exploded e-type A and B, result in B. */
-
-static int
-emulm (a, b)
- const UEMUSHORT a[];
- UEMUSHORT b[];
-{
- const UEMUSHORT *p;
- UEMUSHORT *q;
- UEMUSHORT pprod[NI];
- UEMUSHORT j;
- int i;
-
- equot[0] = b[0];
- equot[1] = b[1];
- for (i=M; i<NI; i++)
- equot[i] = 0;
-
- j = 0;
- p = &a[NI-1];
- q = &equot[NI-1];
- for (i=M+1; i<NI; i++)
- {
- if (*p == 0)
- {
- --p;
- }
- else
- {
- m16m ((unsigned int) *p--, b, pprod);
- eaddm (pprod, equot);
- }
- j |= *q;
- eshdn6 (equot);
- }
-
- for (i=0; i<NI; i++)
- b[i] = equot[i];
-
- /* return flag for lost nonzero bits */
- return ((int) j);
-}
-#endif
-
-
-/* Normalize and round off.
-
- The internal format number to be rounded is S.
- Input LOST is 0 if the value is exact. This is the so-called sticky bit.
-
- Input SUBFLG indicates whether the number was obtained
- by a subtraction operation. In that case if LOST is nonzero
- then the number is slightly smaller than indicated.
-
- Input EXP is the biased exponent, which may be negative.
- the exponent field of S is ignored but is replaced by
- EXP as adjusted by normalization and rounding.
-
- Input RCNTRL is the rounding control. If it is nonzero, the
- returned value will be rounded to RNDPRC bits.
-
- For future reference: In order for emdnorm to round off denormal
- significands at the right point, the input exponent must be
- adjusted to be the actual value it would have after conversion to
- the final floating point type. This adjustment has been
- implemented for all type conversions (etoe53, etc.) and decimal
- conversions, but not for the arithmetic functions (eadd, etc.).
- Data types having standard 15-bit exponents are not affected by
- this, but SFmode and DFmode are affected. For example, ediv with
- rndprc = 24 will not round correctly to 24-bit precision if the
- result is denormal. */
-
-static int rlast = -1;
-static int rw = 0;
-static UEMUSHORT rmsk = 0;
-static UEMUSHORT rmbit = 0;
-static UEMUSHORT rebit = 0;
-static int re = 0;
-static UEMUSHORT rbit[NI];
-
-static void
-emdnorm (s, lost, subflg, exp, rcntrl)
- UEMUSHORT s[];
- int lost;
- int subflg ATTRIBUTE_UNUSED;
- EMULONG exp;
- int rcntrl;
-{
- int i, j;
- UEMUSHORT r;
-
- /* Normalize */
- j = enormlz (s);
-
- /* a blank significand could mean either zero or infinity. */
-#ifndef INFINITY
- if (j > NBITS)
- {
- ecleazs (s);
- return;
- }
-#endif
- exp -= j;
-#ifndef INFINITY
- if (exp >= 32767L)
- goto overf;
-#else
- if ((j > NBITS) && (exp < 32767))
- {
- ecleazs (s);
- return;
- }
-#endif
- if (exp < 0L)
- {
- if (exp > (EMULONG) (-NBITS - 1))
- {
- j = (int) exp;
- i = eshift (s, j);
- if (i)
- lost = 1;
- }
- else
- {
- ecleazs (s);
- return;
- }
- }
- /* Round off, unless told not to by rcntrl. */
- if (rcntrl == 0)
- goto mdfin;
- /* Set up rounding parameters if the control register changed. */
- if (rndprc != rlast)
- {
- ecleaz (rbit);
- switch (rndprc)
- {
- default:
- case NBITS:
- rw = NI - 1; /* low guard word */
- rmsk = 0xffff;
- rmbit = 0x8000;
- re = rw - 1;
- rebit = 1;
- break;
-
- case 113:
- rw = 10;
- rmsk = 0x7fff;
- rmbit = 0x4000;
- rebit = 0x8000;
- re = rw;
- break;
-
- case 64:
- rw = 7;
- rmsk = 0xffff;
- rmbit = 0x8000;
- re = rw - 1;
- rebit = 1;
- break;
-
- /* For DEC or IBM arithmetic */
- case 56:
- rw = 6;
- rmsk = 0xff;
- rmbit = 0x80;
- rebit = 0x100;
- re = rw;
- break;
-
- case 53:
- rw = 6;
- rmsk = 0x7ff;
- rmbit = 0x0400;
- rebit = 0x800;
- re = rw;
- break;
-
- /* For C4x arithmetic */
- case 32:
- rw = 5;
- rmsk = 0xffff;
- rmbit = 0x8000;
- rebit = 1;
- re = rw - 1;
- break;
-
- case 24:
- rw = 4;
- rmsk = 0xff;
- rmbit = 0x80;
- rebit = 0x100;
- re = rw;
- break;
- }
- rbit[re] = rebit;
- rlast = rndprc;
- }
-
- /* Shift down 1 temporarily if the data structure has an implied
- most significant bit and the number is denormal.
- Intel long double denormals also lose one bit of precision. */
- if ((exp <= 0) && (rndprc != NBITS)
- && ((rndprc != 64) || ((rndprc == 64) && ! REAL_WORDS_BIG_ENDIAN)))
- {
- lost |= s[NI - 1] & 1;
- eshdn1 (s);
- }
- /* Clear out all bits below the rounding bit,
- remembering in r if any were nonzero. */
- r = s[rw] & rmsk;
- if (rndprc < NBITS)
- {
- i = rw + 1;
- while (i < NI)
- {
- if (s[i])
- r |= 1;
- s[i] = 0;
- ++i;
- }
- }
- s[rw] &= ~rmsk;
- if ((r & rmbit) != 0)
- {
-#ifndef C4X
- if (r == rmbit)
- {
- if (lost == 0)
- { /* round to even */
- if ((s[re] & rebit) == 0)
- goto mddone;
- }
- else
- {
- if (subflg != 0)
- goto mddone;
- }
- }
-#endif
- eaddm (rbit, s);
- }
-#ifndef C4X
- mddone:
-#endif
-/* Undo the temporary shift for denormal values. */
- if ((exp <= 0) && (rndprc != NBITS)
- && ((rndprc != 64) || ((rndprc == 64) && ! REAL_WORDS_BIG_ENDIAN)))
- {
- eshup1 (s);
- }
- if (s[2] != 0)
- { /* overflow on roundoff */
- eshdn1 (s);
- exp += 1;
- }
- mdfin:
- s[NI - 1] = 0;
- if (exp >= 32767L)
- {
-#ifndef INFINITY
- overf:
-#endif
-#ifdef INFINITY
- s[1] = 32767;
- for (i = 2; i < NI - 1; i++)
- s[i] = 0;
- if (extra_warnings)
- warning ("floating point overflow");
-#else
- s[1] = 32766;
- s[2] = 0;
- for (i = M + 1; i < NI - 1; i++)
- s[i] = 0xffff;
- s[NI - 1] = 0;
- if ((rndprc < 64) || (rndprc == 113))
- {
- s[rw] &= ~rmsk;
- if (rndprc == 24)
- {
- s[5] = 0;
- s[6] = 0;
- }
- }
-#endif
- return;
- }
- if (exp < 0)
- s[1] = 0;
- else
- s[1] = (UEMUSHORT) exp;
-}
-
-/* Subtract. C = B - A, all e type numbers. */
-
-static int subflg = 0;
-
-static void
-esub (a, b, c)
- const UEMUSHORT *a, *b;
- UEMUSHORT *c;
-{
-
-#ifdef NANS
- if (eisnan (a))
- {
- emov (a, c);
- return;
- }
- if (eisnan (b))
- {
- emov (b, c);
- return;
- }
-/* Infinity minus infinity is a NaN.
- Test for subtracting infinities of the same sign. */
- if (eisinf (a) && eisinf (b)
- && ((eisneg (a) ^ eisneg (b)) == 0))
- {
- mtherr ("esub", INVALID);
- enan (c, 0);
- return;
- }
-#endif
- subflg = 1;
- eadd1 (a, b, c);
-}
-
-/* Add. C = A + B, all e type. */
-
-static void
-eadd (a, b, c)
- const UEMUSHORT *a, *b;
- UEMUSHORT *c;
-{
-
-#ifdef NANS
-/* NaN plus anything is a NaN. */
- if (eisnan (a))
- {
- emov (a, c);
- return;
- }
- if (eisnan (b))
- {
- emov (b, c);
- return;
- }
-/* Infinity minus infinity is a NaN.
- Test for adding infinities of opposite signs. */
- if (eisinf (a) && eisinf (b)
- && ((eisneg (a) ^ eisneg (b)) != 0))
- {
- mtherr ("esub", INVALID);
- enan (c, 0);
- return;
- }
-#endif
- subflg = 0;
- eadd1 (a, b, c);
-}
-
-/* Arithmetic common to both addition and subtraction. */
-
-static void
-eadd1 (a, b, c)
- const UEMUSHORT *a, *b;
- UEMUSHORT *c;
-{
- UEMUSHORT ai[NI], bi[NI], ci[NI];
- int i, lost, j, k;
- EMULONG lt, lta, ltb;
-
-#ifdef INFINITY
- if (eisinf (a))
- {
- emov (a, c);
- if (subflg)
- eneg (c);
- return;
- }
- if (eisinf (b))
- {
- emov (b, c);
- return;
- }
-#endif
- emovi (a, ai);
- emovi (b, bi);
- if (subflg)
- ai[0] = ~ai[0];
-
- /* compare exponents */
- lta = ai[E];
- ltb = bi[E];
- lt = lta - ltb;
- if (lt > 0L)
- { /* put the larger number in bi */
- emovz (bi, ci);
- emovz (ai, bi);
- emovz (ci, ai);
- ltb = bi[E];
- lt = -lt;
- }
- lost = 0;
- if (lt != 0L)
- {
- if (lt < (EMULONG) (-NBITS - 1))
- goto done; /* answer same as larger addend */
- k = (int) lt;
- lost = eshift (ai, k); /* shift the smaller number down */
- }
- else
- {
- /* exponents were the same, so must compare significands */
- i = ecmpm (ai, bi);
- if (i == 0)
- { /* the numbers are identical in magnitude */
- /* if different signs, result is zero */
- if (ai[0] != bi[0])
- {
- eclear (c);
- return;
- }
- /* if same sign, result is double */
- /* double denormalized tiny number */
- if ((bi[E] == 0) && ((bi[3] & 0x8000) == 0))
- {
- eshup1 (bi);
- goto done;
- }
- /* add 1 to exponent unless both are zero! */
- for (j = 1; j < NI - 1; j++)
- {
- if (bi[j] != 0)
- {
- ltb += 1;
- if (ltb >= 0x7fff)
- {
- eclear (c);
- if (ai[0] != 0)
- eneg (c);
- einfin (c);
- return;
- }
- break;
- }
- }
- bi[E] = (UEMUSHORT) ltb;
- goto done;
- }
- if (i > 0)
- { /* put the larger number in bi */
- emovz (bi, ci);
- emovz (ai, bi);
- emovz (ci, ai);
- }
- }
- if (ai[0] == bi[0])
- {
- eaddm (ai, bi);
- subflg = 0;
- }
- else
- {
- esubm (ai, bi);
- subflg = 1;
- }
- emdnorm (bi, lost, subflg, ltb, !ROUND_TOWARDS_ZERO);
-
- done:
- emovo (bi, c);
-}
-
-/* Divide: C = B/A, all e type. */
-
-static void
-ediv (a, b, c)
- const UEMUSHORT *a, *b;
- UEMUSHORT *c;
-{
- UEMUSHORT ai[NI], bi[NI];
- int i, sign;
- EMULONG lt, lta, ltb;
-
-/* IEEE says if result is not a NaN, the sign is "-" if and only if
- operands have opposite signs -- but flush -0 to 0 later if not IEEE. */
- sign = eisneg (a) ^ eisneg (b);
-
-#ifdef NANS
-/* Return any NaN input. */
- if (eisnan (a))
- {
- emov (a, c);
- return;
- }
- if (eisnan (b))
- {
- emov (b, c);
- return;
- }
-/* Zero over zero, or infinity over infinity, is a NaN. */
- if (((ecmp (a, ezero) == 0) && (ecmp (b, ezero) == 0))
- || (eisinf (a) && eisinf (b)))
- {
- mtherr ("ediv", INVALID);
- enan (c, sign);
- return;
- }
-#endif
-/* Infinity over anything else is infinity. */
-#ifdef INFINITY
- if (eisinf (b))
- {
- einfin (c);
- goto divsign;
- }
-/* Anything else over infinity is zero. */
- if (eisinf (a))
- {
- eclear (c);
- goto divsign;
- }
-#endif
- emovi (a, ai);
- emovi (b, bi);
- lta = ai[E];
- ltb = bi[E];
- if (bi[E] == 0)
- { /* See if numerator is zero. */
- for (i = 1; i < NI - 1; i++)
- {
- if (bi[i] != 0)
- {
- ltb -= enormlz (bi);
- goto dnzro1;
- }
- }
- eclear (c);
- goto divsign;
- }
- dnzro1:
-
- if (ai[E] == 0)
- { /* possible divide by zero */
- for (i = 1; i < NI - 1; i++)
- {
- if (ai[i] != 0)
- {
- lta -= enormlz (ai);
- goto dnzro2;
- }
- }
-/* Divide by zero is not an invalid operation.
- It is a divide-by-zero operation! */
- einfin (c);
- mtherr ("ediv", SING);
- goto divsign;
- }
- dnzro2:
-
- i = edivm (ai, bi);
- /* calculate exponent */
- lt = ltb - lta + EXONE;
- emdnorm (bi, i, 0, lt, !ROUND_TOWARDS_ZERO);
- emovo (bi, c);
-
- divsign:
-
- if (sign
-#ifndef IEEE
- && (ecmp (c, ezero) != 0)
-#endif
- )
- *(c+(NE-1)) |= 0x8000;
- else
- *(c+(NE-1)) &= ~0x8000;
-}
-
-/* Multiply e-types A and B, return e-type product C. */
-
-static void
-emul (a, b, c)
- const UEMUSHORT *a, *b;
- UEMUSHORT *c;
-{
- UEMUSHORT ai[NI], bi[NI];
- int i, j, sign;
- EMULONG lt, lta, ltb;
-
-/* IEEE says if result is not a NaN, the sign is "-" if and only if
- operands have opposite signs -- but flush -0 to 0 later if not IEEE. */
- sign = eisneg (a) ^ eisneg (b);
-
-#ifdef NANS
-/* NaN times anything is the same NaN. */
- if (eisnan (a))
- {
- emov (a, c);
- return;
- }
- if (eisnan (b))
- {
- emov (b, c);
- return;
- }
-/* Zero times infinity is a NaN. */
- if ((eisinf (a) && (ecmp (b, ezero) == 0))
- || (eisinf (b) && (ecmp (a, ezero) == 0)))
- {
- mtherr ("emul", INVALID);
- enan (c, sign);
- return;
- }
-#endif
-/* Infinity times anything else is infinity. */
-#ifdef INFINITY
- if (eisinf (a) || eisinf (b))
- {
- einfin (c);
- goto mulsign;
- }
-#endif
- emovi (a, ai);
- emovi (b, bi);
- lta = ai[E];
- ltb = bi[E];
- if (ai[E] == 0)
- {
- for (i = 1; i < NI - 1; i++)
- {
- if (ai[i] != 0)
- {
- lta -= enormlz (ai);
- goto mnzer1;
- }
- }
- eclear (c);
- goto mulsign;
- }
- mnzer1:
-
- if (bi[E] == 0)
- {
- for (i = 1; i < NI - 1; i++)
- {
- if (bi[i] != 0)
- {
- ltb -= enormlz (bi);
- goto mnzer2;
- }
- }
- eclear (c);
- goto mulsign;
- }
- mnzer2:
-
- /* Multiply significands */
- j = emulm (ai, bi);
- /* calculate exponent */
- lt = lta + ltb - (EXONE - 1);
- emdnorm (bi, j, 0, lt, !ROUND_TOWARDS_ZERO);
- emovo (bi, c);
-
- mulsign:
-
- if (sign
-#ifndef IEEE
- && (ecmp (c, ezero) != 0)
-#endif
- )
- *(c+(NE-1)) |= 0x8000;
- else
- *(c+(NE-1)) &= ~0x8000;
-}
-
-/* Convert double precision PE to e-type Y. */
-
-static void
-e53toe (pe, y)
- const UEMUSHORT *pe;
- UEMUSHORT *y;
-{
-#ifdef DEC
-
- dectoe (pe, y);
-
-#else
-#ifdef IBM
-
- ibmtoe (pe, y, DFmode);
-
-#else
-#ifdef C4X
-
- c4xtoe (pe, y, HFmode);
-
-#else
-
- ieeetoe (pe, y, &ieee_53);
-
-#endif /* not C4X */
-#endif /* not IBM */
-#endif /* not DEC */
-}
-
-/* Convert double extended precision float PE to e type Y. */
-
-static void
-e64toe (pe, y)
- const UEMUSHORT *pe;
- UEMUSHORT *y;
-{
- UEMUSHORT yy[NI];
- const UEMUSHORT *e;
- UEMUSHORT *p, *q;
- int i;
-
- e = pe;
- p = yy;
- for (i = 0; i < NE - 5; i++)
- *p++ = 0;
-#ifndef C4X
- /* REAL_WORDS_BIG_ENDIAN is always 0 for DEC and 1 for IBM.
- This precision is not ordinarily supported on DEC or IBM. */
- if (! REAL_WORDS_BIG_ENDIAN)
- {
- for (i = 0; i < 5; i++)
- *p++ = *e++;
-
-#ifdef IEEE
- /* For denormal long double Intel format, shift significand up one
- -- but only if the top significand bit is zero. A top bit of 1
- is "pseudodenormal" when the exponent is zero. */
- if ((yy[NE-1] & 0x7fff) == 0 && (yy[NE-2] & 0x8000) == 0)
- {
- UEMUSHORT temp[NI];
-
- emovi (yy, temp);
- eshup1 (temp);
- emovo (temp,y);
- return;
- }
-#endif /* IEEE */
- }
- else
- {
- p = &yy[0] + (NE - 1);
- *p-- = *e++;
- ++e;
- for (i = 0; i < 4; i++)
- *p-- = *e++;
- }
-#endif /* not C4X */
-#ifdef INFINITY
- /* Point to the exponent field and check max exponent cases. */
- p = &yy[NE - 1];
- if ((*p & 0x7fff) == 0x7fff)
- {
-#ifdef NANS
- if (! REAL_WORDS_BIG_ENDIAN)
- {
- for (i = 0; i < 4; i++)
- {
- if ((i != 3 && pe[i] != 0)
- /* Anything but 0x8000 here, including 0, is a NaN. */
- || (i == 3 && pe[i] != 0x8000))
- {
- enan (y, (*p & 0x8000) != 0);
- return;
- }
- }
- }
- else
- {
- /* In Motorola extended precision format, the most significant
- bit of an infinity mantissa could be either 1 or 0. It is
- the lower order bits that tell whether the value is a NaN. */
- if ((pe[2] & 0x7fff) != 0)
- goto bigend_nan;
-
- for (i = 3; i <= 5; i++)
- {
- if (pe[i] != 0)
- {
-bigend_nan:
- enan (y, (*p & 0x8000) != 0);
- return;
- }
- }
- }
-#endif /* NANS */
- eclear (y);
- einfin (y);
- if (*p & 0x8000)
- eneg (y);
- return;
- }
-#endif /* INFINITY */
- p = yy;
- q = y;
- for (i = 0; i < NE; i++)
- *q++ = *p++;
-}
-
-#if (INTEL_EXTENDED_IEEE_FORMAT == 0)
-/* Convert 128-bit long double precision float PE to e type Y. */
-
-static void
-e113toe (pe, y)
- const UEMUSHORT *pe;
- UEMUSHORT *y;
-{
- ieeetoe (pe, y, &ieee_113);
-}
-#endif /* INTEL_EXTENDED_IEEE_FORMAT == 0 */
-
-/* Convert single precision float PE to e type Y. */
-
-static void
-e24toe (pe, y)
- const UEMUSHORT *pe;
- UEMUSHORT *y;
-{
-#ifdef IBM
-
- ibmtoe (pe, y, SFmode);
-
-#else
-
-#ifdef C4X
-
- c4xtoe (pe, y, QFmode);
-
-#else
-#ifdef DEC
-
- ieeetoe (pe, y, &dec_f);
-
-#else
-
- ieeetoe (pe, y, &ieee_24);
-
-#endif /* not DEC */
-#endif /* not C4X */
-#endif /* not IBM */
-}
-
-/* Convert machine format float of specified format PE to e type Y. */
-
-static void
-ieeetoe (pe, y, fmt)
- const UEMUSHORT *pe;
- UEMUSHORT *y;
- const struct ieee_format *fmt;
-{
- UEMUSHORT r;
- const UEMUSHORT *e;
- UEMUSHORT *p;
- UEMUSHORT yy[NI];
- int denorm, i, k;
- int shortsm1 = fmt->bits / 16 - 1;
-#ifdef INFINITY
- int expmask = (1 << fmt->expbits) - 1;
-#endif
-int expshift = (fmt->precision - 1) & 0x0f;
- int highbit = 1 << expshift;
-
- e = pe;
- denorm = 0;
- ecleaz (yy);
- if (! REAL_WORDS_BIG_ENDIAN)
- e += shortsm1;
- r = *e;
- yy[0] = 0;
- if (r & 0x8000)
- yy[0] = 0xffff;
- yy[M] = (r & (highbit - 1)) | highbit;
- r = (r & 0x7fff) >> expshift;
-#ifdef INFINITY
- if (!LARGEST_EXPONENT_IS_NORMAL (fmt->precision) && r == expmask)
- {
-#ifdef NANS
- /* First check the word where high order mantissa and exponent live */
- if ((*e & (highbit - 1)) != 0)
- {
- enan (y, yy[0] != 0);
- return;
- }
- if (! REAL_WORDS_BIG_ENDIAN)
- {
- for (i = 0; i < shortsm1; i++)
- {
- if (pe[i] != 0)
- {
- enan (y, yy[0] != 0);
- return;
- }
- }
- }
- else
- {
- for (i = 1; i < shortsm1 + 1; i++)
- {
- if (pe[i] != 0)
- {
- enan (y, yy[0] != 0);
- return;
- }
- }
- }
-#endif /* NANS */
- eclear (y);
- einfin (y);
- if (yy[0])
- eneg (y);
- return;
- }
-#endif /* INFINITY */
- /* If zero exponent, then the significand is denormalized.
- So take back the understood high significand bit. */
- if (r == 0)
- {
- denorm = 1;
- yy[M] &= ~highbit;
- }
- r += fmt->adjustment;
- yy[E] = r;
- p = &yy[M + 1];
- if (! REAL_WORDS_BIG_ENDIAN)
- {
- for (i = 0; i < shortsm1; i++)
- *p++ = *(--e);
- }
- else
- {
- ++e;
- for (i = 0; i < shortsm1; i++)
- *p++ = *e++;
- }
- if (fmt->precision == 113)
- {
- /* denorm is left alone in 113 bit format */
- if (!denorm)
- eshift (yy, -1);
- }
- else
- {
- eshift (yy, -(expshift + 1));
- if (denorm)
- { /* if zero exponent, then normalize the significand */
- if ((k = enormlz (yy)) > NBITS)
- ecleazs (yy);
- else
- yy[E] -= (UEMUSHORT) (k - 1);
- }
- }
- emovo (yy, y);
-}
-
-#if (INTEL_EXTENDED_IEEE_FORMAT == 0)
-/* Convert e-type X to IEEE 128-bit long double format E. */
-
-static void
-etoe113 (x, e)
- const UEMUSHORT *x;
- UEMUSHORT *e;
-{
- etoieee (x, e, &ieee_113);
-}
-
-/* Convert exploded e-type X, that has already been rounded to
- 113-bit precision, to IEEE 128-bit long double format Y. */
-
-static void
-toe113 (x, y)
- UEMUSHORT *x, *y;
-{
- toieee (x, y, &ieee_113);
-}
-
-#endif /* INTEL_EXTENDED_IEEE_FORMAT == 0 */
-
-/* Convert e-type X to IEEE double extended format E. */
-
-static void
-etoe64 (x, e)
- const UEMUSHORT *x;
- UEMUSHORT *e;
-{
- etoieee (x, e, &ieee_64);
-}
-
-/* Convert exploded e-type X, that has already been rounded to
- 64-bit precision, to IEEE double extended format Y. */
-
-static void
-toe64 (x, y)
- UEMUSHORT *x, *y;
-{
- toieee (x, y, &ieee_64);
-}
-
-/* e type to double precision. */
-
-#ifdef DEC
-/* Convert e-type X to DEC-format double E. */
-
-static void
-etoe53 (x, e)
- const UEMUSHORT *x;
- UEMUSHORT *e;
-{
- etodec (x, e);
-}
-
-/* Convert exploded e-type X, that has already been rounded to
- 56-bit double precision, to DEC double Y. */
-
-static void
-toe53 (x, y)
- UEMUSHORT *x, *y;
-{
- todec (x, y);
-}
-
-#else
-#ifdef IBM
-/* Convert e-type X to IBM 370-format double E. */
-
-static void
-etoe53 (x, e)
- const UEMUSHORT *x;
- UEMUSHORT *e;
-{
- etoibm (x, e, DFmode);
-}
-
-/* Convert exploded e-type X, that has already been rounded to
- 56-bit precision, to IBM 370 double Y. */
-
-static void
-toe53 (x, y)
- UEMUSHORT *x, *y;
-{
- toibm (x, y, DFmode);
-}
-
-#else /* it's neither DEC nor IBM */
-#ifdef C4X
-/* Convert e-type X to C4X-format long double E. */
-
-static void
-etoe53 (x, e)
- const UEMUSHORT *x;
- UEMUSHORT *e;
-{
- etoc4x (x, e, HFmode);
-}
-
-/* Convert exploded e-type X, that has already been rounded to
- 56-bit precision, to IBM 370 double Y. */
-
-static void
-toe53 (x, y)
- UEMUSHORT *x, *y;
-{
- toc4x (x, y, HFmode);
-}
-
-#else /* it's neither DEC nor IBM nor C4X */
-
-/* Convert e-type X to IEEE double E. */
-
-static void
-etoe53 (x, e)
- const UEMUSHORT *x;
- UEMUSHORT *e;
-{
- etoieee (x, e, &ieee_53);
-}
-
-/* Convert exploded e-type X, that has already been rounded to
- 53-bit precision, to IEEE double Y. */
-
-static void
-toe53 (x, y)
- UEMUSHORT *x, *y;
-{
- toieee (x, y, &ieee_53);
-}
-
-#endif /* not C4X */
-#endif /* not IBM */
-#endif /* not DEC */
-
-
-
-/* e type to single precision. */
-
-#ifdef IBM
-/* Convert e-type X to IBM 370 float E. */
-
-static void
-etoe24 (x, e)
- const UEMUSHORT *x;
- UEMUSHORT *e;
-{
- etoibm (x, e, SFmode);
-}
-
-/* Convert exploded e-type X, that has already been rounded to
- float precision, to IBM 370 float Y. */
-
-static void
-toe24 (x, y)
- UEMUSHORT *x, *y;
-{
- toibm (x, y, SFmode);
-}
-
-#else /* it's not IBM */
-
-#ifdef C4X
-/* Convert e-type X to C4X float E. */
-
-static void
-etoe24 (x, e)
- const UEMUSHORT *x;
- UEMUSHORT *e;
-{
- etoc4x (x, e, QFmode);
-}
-
-/* Convert exploded e-type X, that has already been rounded to
- float precision, to IBM 370 float Y. */
-
-static void
-toe24 (x, y)
- UEMUSHORT *x, *y;
-{
- toc4x (x, y, QFmode);
-}
-
-#else /* it's neither IBM nor C4X */
-
-#ifdef DEC
-
-/* Convert e-type X to DEC F-float E. */
-
-static void
-etoe24 (x, e)
- const UEMUSHORT *x;
- UEMUSHORT *e;
-{
- etoieee (x, e, &dec_f);
-}
-
-/* Convert exploded e-type X, that has already been rounded to
- float precision, to DEC F-float Y. */
-
-static void
-toe24 (x, y)
- UEMUSHORT *x, *y;
-{
- toieee (x, y, &dec_f);
-}
-
-#else
-
-/* Convert e-type X to IEEE float E. */
-
-static void
-etoe24 (x, e)
- const UEMUSHORT *x;
- UEMUSHORT *e;
-{
- etoieee (x, e, &ieee_24);
-}
-
-/* Convert exploded e-type X, that has already been rounded to
- float precision, to IEEE float Y. */
-
-static void
-toe24 (x, y)
- UEMUSHORT *x, *y;
-{
- toieee (x, y, &ieee_24);
-}
-
-#endif /* not DEC */
-#endif /* not C4X */
-#endif /* not IBM */
-
-
-/* Convert e-type X to the IEEE format described by FMT. */
-
-static void
-etoieee (x, e, fmt)
- const UEMUSHORT *x;
- UEMUSHORT *e;
- const struct ieee_format *fmt;
-{
- UEMUSHORT xi[NI];
- EMULONG exp;
- int rndsav;
-
-#ifdef NANS
- if (eisnan (x))
- {
- make_nan (e, eisneg (x), fmt->mode);
- return;
- }
-#endif
-
- emovi (x, xi);
-
-#ifdef INFINITY
- if (eisinf (x))
- goto nonorm;
-#endif
- /* Adjust exponent for offset. */
- exp = (EMULONG) xi[E] - fmt->adjustment;
-
- /* Round off to nearest or even. */
- rndsav = rndprc;
- rndprc = fmt->precision;
- emdnorm (xi, 0, 0, exp, !ROUND_TOWARDS_ZERO);
- rndprc = rndsav;
-#ifdef INFINITY
- nonorm:
-#endif
- toieee (xi, e, fmt);
-}
-
-/* Convert exploded e-type X, that has already been rounded to
- the necessary precision, to the IEEE format described by FMT. */
-
-static void
-toieee (x, y, fmt)
- UEMUSHORT *x, *y;
- const struct ieee_format *fmt;
-{
- UEMUSHORT maxexp;
- UEMUSHORT *q;
- int words;
- int i;
-
- maxexp = (1 << fmt->expbits) - 1;
- words = (fmt->bits - fmt->expbits) / EMUSHORT_SIZE;
-
-#ifdef NANS
- if (eiisnan (x))
- {
- make_nan (y, eiisneg (x), fmt->mode);
- return;
- }
-#endif
-
- if (fmt->expbits < 15
- && LARGEST_EXPONENT_IS_NORMAL (fmt->bits)
- && x[E] > maxexp)
- {
- saturate (y, eiisneg (x), fmt->bits, 1);
- return;
- }
-
- /* Point to the exponent. */
- if (REAL_WORDS_BIG_ENDIAN)
- q = y;
- else
- q = y + words;
-
- /* Copy the sign. */
- if (x[0])
- *q = 0x8000;
- else
- *q = 0;
-
- if (fmt->expbits < 15
- && !LARGEST_EXPONENT_IS_NORMAL (fmt->bits)
- && x[E] >= maxexp)
- {
- /* Saturate at largest number less that infinity. */
- UEMUSHORT fill;
-#ifdef INFINITY
- *q |= maxexp << (15 - fmt->expbits);
- fill = 0;
-#else
- *q |= (maxexp << (15 - fmt->expbits)) - 1;
- fill = 0xffff;
-#endif
-
- if (!REAL_WORDS_BIG_ENDIAN)
- {
- for (i = 0; i < words; i++)
- *(--q) = fill;
- }
- else
- {
- for (i = 0; i < words; i++)
- *(++q) = fill;
- }
-#if defined(INFINITY) && defined(ERANGE)
- errno = ERANGE;
-#endif
- return;
- }
-
- /* If denormal and DEC float, return zero (DEC has no denormals) */
-#ifdef DEC
- if (x[E] == 0)
- {
- for (i = 0; i < fmt->bits / EMUSHORT_SIZE ; i++)
- q[i] = 0;
- return;
- }
-#endif /* DEC */
-
- /* Delete the implied bit unless denormal, except for
- 64-bit precision. */
- if (fmt->precision != 64 && x[E] != 0)
- {
- eshup1 (x);
- }
-
- /* Shift denormal double extended Intel format significand down
- one bit. */
- if (fmt->precision == 64 && x[E] == 0 && ! REAL_WORDS_BIG_ENDIAN)
- eshdn1 (x);
-
- if (fmt->expbits < 15)
- {
- /* Shift the significand. */
- eshift (x, 15 - fmt->expbits);
-
- /* Combine the exponent and upper bits of the significand. */
- *q |= x[E] << (15 - fmt->expbits);
- *q |= x[M] & (UEMUSHORT) ~((maxexp << (15 - fmt->expbits)) | 0x8000);
- }
- else
- {
- /* Copy the exponent. */
- *q |= x[E];
- }
-
- /* Add padding after the exponent. At the moment, this is only necessary for
- 64-bit precision; in this case, the padding is 16 bits. */
- if (fmt->precision == 64)
- {
- *(q + 1) = 0;
-
- /* Skip padding. */
- if (REAL_WORDS_BIG_ENDIAN)
- ++q;
- }
-
- /* Copy the significand. */
- if (REAL_WORDS_BIG_ENDIAN)
- {
- for (i = 0; i < words; i++)
- *(++q) = x[i + M + 1];
- }
-#ifdef INFINITY
- else if (fmt->precision == 64 && eiisinf (x))
- {
- /* Intel double extended infinity significand. */
- *(--q) = 0x8000;
- *(--q) = 0;
- *(--q) = 0;
- *(--q) = 0;
- }
-#endif
- else
+ np2 = SIGNIFICAND_BITS - p2;
+ switch (r->class)
{
- for (i = 0; i < words; i++)
- *(--q) = x[i + M + 1];
- }
-}
-
-
-/* Compare two e type numbers.
- Return +1 if a > b
- 0 if a == b
- -1 if a < b
- -2 if either a or b is a NaN. */
-
-static int
-ecmp (a, b)
- const UEMUSHORT *a, *b;
-{
- UEMUSHORT ai[NI], bi[NI];
- UEMUSHORT *p, *q;
- int i;
- int msign;
-
-#ifdef NANS
- if (eisnan (a) || eisnan (b))
- return (-2);
-#endif
- emovi (a, ai);
- p = ai;
- emovi (b, bi);
- q = bi;
-
- if (*p != *q)
- { /* the signs are different */
- /* -0 equals + 0 */
- for (i = 1; i < NI - 1; i++)
- {
- if (ai[i] != 0)
- goto nzro;
- if (bi[i] != 0)
- goto nzro;
- }
- return (0);
- nzro:
- if (*p == 0)
- return (1);
- else
- return (-1);
- }
- /* both are the same sign */
- if (*p == 0)
- msign = 1;
- else
- msign = -1;
- i = NI - 1;
- do
- {
- if (*p++ != *q++)
- {
- goto diff;
- }
- }
- while (--i > 0);
-
- return (0); /* equality */
-
- diff:
-
- if (*(--p) > *(--q))
- return (msign); /* p is bigger */
- else
- return (-msign); /* p is littler */
-}
-
-#if 0
-/* Find e-type nearest integer to X, as floor (X + 0.5). */
-
-static void
-eround (x, y)
- const UEMUSHORT *x;
- UEMUSHORT *y;
-{
- eadd (ehalf, x, y);
- efloor (y, y);
-}
-#endif /* 0 */
-
-/* Convert HOST_WIDE_INT LP to e type Y. */
-
-static void
-ltoe (lp, y)
- const HOST_WIDE_INT *lp;
- UEMUSHORT *y;
-{
- UEMUSHORT yi[NI];
- unsigned HOST_WIDE_INT ll;
- int k;
-
- ecleaz (yi);
- if (*lp < 0)
- {
- /* make it positive */
- ll = (unsigned HOST_WIDE_INT) (-(*lp));
- yi[0] = 0xffff; /* put correct sign in the e type number */
- }
- else
- {
- ll = (unsigned HOST_WIDE_INT) (*lp);
- }
- /* move the long integer to yi significand area */
-#if HOST_BITS_PER_WIDE_INT == 64
- yi[M] = (UEMUSHORT) (ll >> 48);
- yi[M + 1] = (UEMUSHORT) (ll >> 32);
- yi[M + 2] = (UEMUSHORT) (ll >> 16);
- yi[M + 3] = (UEMUSHORT) ll;
- yi[E] = EXONE + 47; /* exponent if normalize shift count were 0 */
-#else
- yi[M] = (UEMUSHORT) (ll >> 16);
- yi[M + 1] = (UEMUSHORT) ll;
- yi[E] = EXONE + 15; /* exponent if normalize shift count were 0 */
-#endif
-
- if ((k = enormlz (yi)) > NBITS)/* normalize the significand */
- ecleaz (yi); /* it was zero */
- else
- yi[E] -= (UEMUSHORT) k;/* subtract shift count from exponent */
- emovo (yi, y); /* output the answer */
-}
-
-/* Convert unsigned HOST_WIDE_INT LP to e type Y. */
-
-static void
-ultoe (lp, y)
- const unsigned HOST_WIDE_INT *lp;
- UEMUSHORT *y;
-{
- UEMUSHORT yi[NI];
- unsigned HOST_WIDE_INT ll;
- int k;
-
- ecleaz (yi);
- ll = *lp;
-
- /* move the long integer to ayi significand area */
-#if HOST_BITS_PER_WIDE_INT == 64
- yi[M] = (UEMUSHORT) (ll >> 48);
- yi[M + 1] = (UEMUSHORT) (ll >> 32);
- yi[M + 2] = (UEMUSHORT) (ll >> 16);
- yi[M + 3] = (UEMUSHORT) ll;
- yi[E] = EXONE + 47; /* exponent if normalize shift count were 0 */
-#else
- yi[M] = (UEMUSHORT) (ll >> 16);
- yi[M + 1] = (UEMUSHORT) ll;
- yi[E] = EXONE + 15; /* exponent if normalize shift count were 0 */
-#endif
-
- if ((k = enormlz (yi)) > NBITS)/* normalize the significand */
- ecleaz (yi); /* it was zero */
- else
- yi[E] -= (UEMUSHORT) k; /* subtract shift count from exponent */
- emovo (yi, y); /* output the answer */
-}
-
-
-/* Find signed HOST_WIDE_INT integer I and floating point fractional
- part FRAC of e-type (packed internal format) floating point input X.
- The integer output I has the sign of the input, except that
- positive overflow is permitted if FIXUNS_TRUNC_LIKE_FIX_TRUNC.
- The output e-type fraction FRAC is the positive fractional
- part of abs (X). */
-
-static void
-eifrac (x, i, frac)
- const UEMUSHORT *x;
- HOST_WIDE_INT *i;
- UEMUSHORT *frac;
-{
- UEMUSHORT xi[NI];
- int j, k;
- unsigned HOST_WIDE_INT ll;
-
- emovi (x, xi);
- k = (int) xi[E] - (EXONE - 1);
- if (k <= 0)
- {
- /* if exponent <= 0, integer = 0 and real output is fraction */
- *i = 0L;
- emovo (xi, frac);
- return;
- }
- if (k > (HOST_BITS_PER_WIDE_INT - 1))
- {
- /* long integer overflow: output large integer
- and correct fraction */
- if (xi[0])
- *i = ((unsigned HOST_WIDE_INT) 1) << (HOST_BITS_PER_WIDE_INT - 1);
- else
- {
-#ifdef FIXUNS_TRUNC_LIKE_FIX_TRUNC
- /* In this case, let it overflow and convert as if unsigned. */
- euifrac (x, &ll, frac);
- *i = (HOST_WIDE_INT) ll;
- return;
-#else
- /* In other cases, return the largest positive integer. */
- *i = (((unsigned HOST_WIDE_INT) 1) << (HOST_BITS_PER_WIDE_INT - 1)) - 1;
-#endif
- }
- eshift (xi, k);
- if (extra_warnings)
- warning ("overflow on truncation to integer");
- }
- else if (k > 16)
- {
- /* Shift more than 16 bits: first shift up k-16 mod 16,
- then shift up by 16's. */
- j = k - ((k >> 4) << 4);
- eshift (xi, j);
- ll = xi[M];
- k -= j;
- do
- {
- eshup6 (xi);
- ll = (ll << 16) | xi[M];
- }
- while ((k -= 16) > 0);
- *i = ll;
- if (xi[0])
- *i = -(*i);
- }
- else
- {
- /* shift not more than 16 bits */
- eshift (xi, k);
- *i = (HOST_WIDE_INT) xi[M] & 0xffff;
- if (xi[0])
- *i = -(*i);
- }
- xi[0] = 0;
- xi[E] = EXONE - 1;
- xi[M] = 0;
- if ((k = enormlz (xi)) > NBITS)
- ecleaz (xi);
- else
- xi[E] -= (UEMUSHORT) k;
-
- emovo (xi, frac);
-}
-
-
-/* Find unsigned HOST_WIDE_INT integer I and floating point fractional part
- FRAC of e-type X. A negative input yields integer output = 0 but
- correct fraction. */
-
-static void
-euifrac (x, i, frac)
- const UEMUSHORT *x;
- unsigned HOST_WIDE_INT *i;
- UEMUSHORT *frac;
-{
- unsigned HOST_WIDE_INT ll;
- UEMUSHORT xi[NI];
- int j, k;
-
- emovi (x, xi);
- k = (int) xi[E] - (EXONE - 1);
- if (k <= 0)
- {
- /* if exponent <= 0, integer = 0 and argument is fraction */
- *i = 0L;
- emovo (xi, frac);
+ underflow:
+ get_zero (r, r->sign);
+ case rvc_zero:
+ if (!fmt->has_signed_zero)
+ r->sign = 0;
return;
- }
- if (k > HOST_BITS_PER_WIDE_INT)
- {
- /* Long integer overflow: output large integer
- and correct fraction.
- Note, the BSD MicroVAX compiler says that ~(0UL)
- is a syntax error. */
- *i = ~(0L);
- eshift (xi, k);
- if (extra_warnings)
- warning ("overflow on truncation to unsigned integer");
- }
- else if (k > 16)
- {
- /* Shift more than 16 bits: first shift up k-16 mod 16,
- then shift up by 16's. */
- j = k - ((k >> 4) << 4);
- eshift (xi, j);
- ll = xi[M];
- k -= j;
- do
- {
- eshup6 (xi);
- ll = (ll << 16) | xi[M];
- }
- while ((k -= 16) > 0);
- *i = ll;
- }
- else
- {
- /* shift not more than 16 bits */
- eshift (xi, k);
- *i = (HOST_WIDE_INT) xi[M] & 0xffff;
- }
-
- if (xi[0]) /* A negative value yields unsigned integer 0. */
- *i = 0L;
- xi[0] = 0;
- xi[E] = EXONE - 1;
- xi[M] = 0;
- if ((k = enormlz (xi)) > NBITS)
- ecleaz (xi);
- else
- xi[E] -= (UEMUSHORT) k;
-
- emovo (xi, frac);
-}
-
-/* Shift the significand of exploded e-type X up or down by SC bits. */
-
-static int
-eshift (x, sc)
- UEMUSHORT *x;
- int sc;
-{
- UEMUSHORT lost;
- UEMUSHORT *p;
-
- if (sc == 0)
- return (0);
-
- lost = 0;
- p = x + NI - 1;
-
- if (sc < 0)
- {
- sc = -sc;
- while (sc >= 16)
- {
- lost |= *p; /* remember lost bits */
- eshdn6 (x);
- sc -= 16;
- }
-
- while (sc >= 8)
- {
- lost |= *p & 0xff;
- eshdn8 (x);
- sc -= 8;
- }
-
- while (sc > 0)
- {
- lost |= *p & 1;
- eshdn1 (x);
- sc -= 1;
- }
- }
- else
- {
- while (sc >= 16)
- {
- eshup6 (x);
- sc -= 16;
- }
-
- while (sc >= 8)
- {
- eshup8 (x);
- sc -= 8;
- }
-
- while (sc > 0)
- {
- eshup1 (x);
- sc -= 1;
- }
- }
- if (lost)
- lost = 1;
- return ((int) lost);
-}
+ overflow:
+ get_inf (r, r->sign);
+ case rvc_inf:
+ return;
-/* Shift normalize the significand area of exploded e-type X.
- Return the shift count (up = positive). */
+ case rvc_nan:
+ clear_significand_below (r, np2 + 1);
-static int
-enormlz (x)
- UEMUSHORT x[];
-{
- UEMUSHORT *p;
- int sc;
-
- sc = 0;
- p = &x[M];
- if (*p != 0)
- goto normdn;
- ++p;
- if (*p & 0x8000)
- return (0); /* already normalized */
- while (*p == 0)
- {
- eshup6 (x);
- sc += 16;
+ /* If we've cleared the entire significand, we need one bit
+ set for this to continue to be a NaN. */
+ for (i = 0; i < SIGSZ; ++i)
+ if (r->sig[i])
+ break;
+ if (i == SIGSZ)
+ r->sig[SIGSZ-1] = SIG_MSB >> 1;
+ return;
- /* With guard word, there are NBITS+16 bits available.
- Return true if all are zero. */
- if (sc > NBITS)
- return (sc);
- }
- /* see if high byte is zero */
- while ((*p & 0xff00) == 0)
- {
- eshup8 (x);
- sc += 8;
+ case rvc_normal:
+ break;
+
+ default:
+ abort ();
}
- /* now shift 1 bit at a time */
- while ((*p & 0x8000) == 0)
+
+ /* If we're not base2, normalize the exponent to a multiple of
+ the true base. */
+ if (fmt->log2_b != 1)
{
- eshup1 (x);
- sc += 1;
- if (sc > NBITS)
+ int shift = r->exp & (fmt->log2_b - 1);
+ if (shift)
{
- mtherr ("enormlz", UNDERFLOW);
- return (sc);
+ shift = fmt->log2_b - shift;
+ sticky_rshift_significand (r, r, shift);
+ r->exp += shift;
}
}
- return (sc);
-
- /* Normalize by shifting down out of the high guard word
- of the significand */
- normdn:
- if (*p & 0xff00)
- {
- eshdn8 (x);
- sc -= 8;
- }
- while (*p != 0)
+ /* Check the range of the exponent. If we're out of range,
+ either underflow or overflow. */
+ if (r->exp > emax2)
+ goto overflow;
+ else if (r->exp <= emin2m1)
{
- eshdn1 (x);
- sc -= 1;
+ int diff;
- if (sc < -NBITS)
+ if (!fmt->has_denorm)
{
- mtherr ("enormlz", OVERFLOW);
- return (sc);
+ /* Don't underflow completely until we've had a chance to round. */
+ if (r->exp < emin2m1)
+ goto underflow;
}
+ else
+ {
+ diff = emin2m1 - r->exp + 1;
+ if (diff > p2)
+ goto underflow;
+
+ /* De-normalize the significand. */
+ sticky_rshift_significand (r, r, diff);
+ r->exp += diff;
+ }
}
- return (sc);
-}
-/* Powers of ten used in decimal <-> binary conversions. */
+ /* There are P2 true significand bits, followed by one guard bit,
+ followed by one sticky bit, followed by stuff. Fold non-zero
+ stuff into the sticky bit. */
-#define NTEN 12
-#define MAXP 4096
+ sticky = 0;
+ for (i = 0, w = (np2 - 1) / HOST_BITS_PER_LONG; i < w; ++i)
+ if (r->sig[i])
+ sticky = 1;
+ sticky |=
+ r->sig[w] & (((unsigned long)1 << ((np2 - 1) % HOST_BITS_PER_LONG)) - 1);
-#if MAX_LONG_DOUBLE_TYPE_SIZE == 128 && (INTEL_EXTENDED_IEEE_FORMAT == 0)
-static const UEMUSHORT etens[NTEN + 1][NE] =
-{
- {0x6576, 0x4a92, 0x804a, 0x153f,
- 0xc94c, 0x979a, 0x8a20, 0x5202, 0xc460, 0x7525,}, /* 10**4096 */
- {0x6a32, 0xce52, 0x329a, 0x28ce,
- 0xa74d, 0x5de4, 0xc53d, 0x3b5d, 0x9e8b, 0x5a92,}, /* 10**2048 */
- {0x526c, 0x50ce, 0xf18b, 0x3d28,
- 0x650d, 0x0c17, 0x8175, 0x7586, 0xc976, 0x4d48,},
- {0x9c66, 0x58f8, 0xbc50, 0x5c54,
- 0xcc65, 0x91c6, 0xa60e, 0xa0ae, 0xe319, 0x46a3,},
- {0x851e, 0xeab7, 0x98fe, 0x901b,
- 0xddbb, 0xde8d, 0x9df9, 0xebfb, 0xaa7e, 0x4351,},
- {0x0235, 0x0137, 0x36b1, 0x336c,
- 0xc66f, 0x8cdf, 0x80e9, 0x47c9, 0x93ba, 0x41a8,},
- {0x50f8, 0x25fb, 0xc76b, 0x6b71,
- 0x3cbf, 0xa6d5, 0xffcf, 0x1f49, 0xc278, 0x40d3,},
- {0x0000, 0x0000, 0x0000, 0x0000,
- 0xf020, 0xb59d, 0x2b70, 0xada8, 0x9dc5, 0x4069,},
- {0x0000, 0x0000, 0x0000, 0x0000,
- 0x0000, 0x0000, 0x0400, 0xc9bf, 0x8e1b, 0x4034,},
- {0x0000, 0x0000, 0x0000, 0x0000,
- 0x0000, 0x0000, 0x0000, 0x2000, 0xbebc, 0x4019,},
- {0x0000, 0x0000, 0x0000, 0x0000,
- 0x0000, 0x0000, 0x0000, 0x0000, 0x9c40, 0x400c,},
- {0x0000, 0x0000, 0x0000, 0x0000,
- 0x0000, 0x0000, 0x0000, 0x0000, 0xc800, 0x4005,},
- {0x0000, 0x0000, 0x0000, 0x0000,
- 0x0000, 0x0000, 0x0000, 0x0000, 0xa000, 0x4002,}, /* 10**1 */
-};
+ guard = test_significand_bit (r, np2 - 1);
+ lsb = test_significand_bit (r, np2);
-static const UEMUSHORT emtens[NTEN + 1][NE] =
-{
- {0x2030, 0xcffc, 0xa1c3, 0x8123,
- 0x2de3, 0x9fde, 0xd2ce, 0x04c8, 0xa6dd, 0x0ad8,}, /* 10**-4096 */
- {0x8264, 0xd2cb, 0xf2ea, 0x12d4,
- 0x4925, 0x2de4, 0x3436, 0x534f, 0xceae, 0x256b,}, /* 10**-2048 */
- {0xf53f, 0xf698, 0x6bd3, 0x0158,
- 0x87a6, 0xc0bd, 0xda57, 0x82a5, 0xa2a6, 0x32b5,},
- {0xe731, 0x04d4, 0xe3f2, 0xd332,
- 0x7132, 0xd21c, 0xdb23, 0xee32, 0x9049, 0x395a,},
- {0xa23e, 0x5308, 0xfefb, 0x1155,
- 0xfa91, 0x1939, 0x637a, 0x4325, 0xc031, 0x3cac,},
- {0xe26d, 0xdbde, 0xd05d, 0xb3f6,
- 0xac7c, 0xe4a0, 0x64bc, 0x467c, 0xddd0, 0x3e55,},
- {0x2a20, 0x6224, 0x47b3, 0x98d7,
- 0x3f23, 0xe9a5, 0xa539, 0xea27, 0xa87f, 0x3f2a,},
- {0x0b5b, 0x4af2, 0xa581, 0x18ed,
- 0x67de, 0x94ba, 0x4539, 0x1ead, 0xcfb1, 0x3f94,},
- {0xbf71, 0xa9b3, 0x7989, 0xbe68,
- 0x4c2e, 0xe15b, 0xc44d, 0x94be, 0xe695, 0x3fc9,},
- {0x3d4d, 0x7c3d, 0x36ba, 0x0d2b,
- 0xfdc2, 0xcefc, 0x8461, 0x7711, 0xabcc, 0x3fe4,},
- {0xc155, 0xa4a8, 0x404e, 0x6113,
- 0xd3c3, 0x652b, 0xe219, 0x1758, 0xd1b7, 0x3ff1,},
- {0xd70a, 0x70a3, 0x0a3d, 0xa3d7,
- 0x3d70, 0xd70a, 0x70a3, 0x0a3d, 0xa3d7, 0x3ff8,},
- {0xcccd, 0xcccc, 0xcccc, 0xcccc,
- 0xcccc, 0xcccc, 0xcccc, 0xcccc, 0xcccc, 0x3ffb,}, /* 10**-1 */
-};
-#else
-/* LONG_DOUBLE_TYPE_SIZE is other than 128 */
-static const UEMUSHORT etens[NTEN + 1][NE] =
-{
- {0xc94c, 0x979a, 0x8a20, 0x5202, 0xc460, 0x7525,}, /* 10**4096 */
- {0xa74d, 0x5de4, 0xc53d, 0x3b5d, 0x9e8b, 0x5a92,}, /* 10**2048 */
- {0x650d, 0x0c17, 0x8175, 0x7586, 0xc976, 0x4d48,},
- {0xcc65, 0x91c6, 0xa60e, 0xa0ae, 0xe319, 0x46a3,},
- {0xddbc, 0xde8d, 0x9df9, 0xebfb, 0xaa7e, 0x4351,},
- {0xc66f, 0x8cdf, 0x80e9, 0x47c9, 0x93ba, 0x41a8,},
- {0x3cbf, 0xa6d5, 0xffcf, 0x1f49, 0xc278, 0x40d3,},
- {0xf020, 0xb59d, 0x2b70, 0xada8, 0x9dc5, 0x4069,},
- {0x0000, 0x0000, 0x0400, 0xc9bf, 0x8e1b, 0x4034,},
- {0x0000, 0x0000, 0x0000, 0x2000, 0xbebc, 0x4019,},
- {0x0000, 0x0000, 0x0000, 0x0000, 0x9c40, 0x400c,},
- {0x0000, 0x0000, 0x0000, 0x0000, 0xc800, 0x4005,},
- {0x0000, 0x0000, 0x0000, 0x0000, 0xa000, 0x4002,}, /* 10**1 */
-};
+ /* Round to even. */
+ if (guard && (sticky || lsb))
+ {
+ struct real_value u;
+ get_zero (&u, 0);
+ set_significand_bit (&u, np2);
-static const UEMUSHORT emtens[NTEN + 1][NE] =
-{
- {0x2de4, 0x9fde, 0xd2ce, 0x04c8, 0xa6dd, 0x0ad8,}, /* 10**-4096 */
- {0x4925, 0x2de4, 0x3436, 0x534f, 0xceae, 0x256b,}, /* 10**-2048 */
- {0x87a6, 0xc0bd, 0xda57, 0x82a5, 0xa2a6, 0x32b5,},
- {0x7133, 0xd21c, 0xdb23, 0xee32, 0x9049, 0x395a,},
- {0xfa91, 0x1939, 0x637a, 0x4325, 0xc031, 0x3cac,},
- {0xac7d, 0xe4a0, 0x64bc, 0x467c, 0xddd0, 0x3e55,},
- {0x3f24, 0xe9a5, 0xa539, 0xea27, 0xa87f, 0x3f2a,},
- {0x67de, 0x94ba, 0x4539, 0x1ead, 0xcfb1, 0x3f94,},
- {0x4c2f, 0xe15b, 0xc44d, 0x94be, 0xe695, 0x3fc9,},
- {0xfdc2, 0xcefc, 0x8461, 0x7711, 0xabcc, 0x3fe4,},
- {0xd3c3, 0x652b, 0xe219, 0x1758, 0xd1b7, 0x3ff1,},
- {0x3d71, 0xd70a, 0x70a3, 0x0a3d, 0xa3d7, 0x3ff8,},
- {0xcccd, 0xcccc, 0xcccc, 0xcccc, 0xcccc, 0x3ffb,}, /* 10**-1 */
-};
-#endif
+ if (add_significands (r, r, &u))
+ {
+ /* Overflow. Means the significand had been all ones, and
+ is now all zeros. Need to increase the exponent, and
+ possibly re-normalize it. */
+ if (++r->exp > emax2)
+ goto overflow;
+ r->sig[SIGSZ-1] = SIG_MSB;
-#if 0
-/* Convert float value X to ASCII string STRING with NDIG digits after
- the decimal point. */
+ if (fmt->log2_b != 1)
+ {
+ int shift = r->exp & (fmt->log2_b - 1);
+ if (shift)
+ {
+ shift = fmt->log2_b - shift;
+ sticky_rshift_significand (r, r, shift);
+ r->exp += shift;
+ if (r->exp > emax2)
+ goto overflow;
+ }
+ }
+ }
+ }
-static void
-e24toasc (x, string, ndigs)
- const UEMUSHORT x[];
- char *string;
- int ndigs;
-{
- UEMUSHORT w[NI];
+ /* Catch underflow that we deferred until after rounding. */
+ if (r->exp <= emin2m1)
+ goto underflow;
- e24toe (x, w);
- etoasc (w, string, ndigs);
+ /* Clear out trailing garbage. */
+ clear_significand_below (r, np2);
}
-/* Convert double value X to ASCII string STRING with NDIG digits after
- the decimal point. */
+/* Extend or truncate to a new mode. */
-static void
-e53toasc (x, string, ndigs)
- const UEMUSHORT x[];
- char *string;
- int ndigs;
+void
+real_convert (tr, mode, ta)
+ REAL_VALUE_TYPE *tr;
+ enum machine_mode mode;
+ const REAL_VALUE_TYPE *ta;
{
- UEMUSHORT w[NI];
+ struct real_value *r = (struct real_value *)tr;
+ const struct real_value *a = (const struct real_value *)ta;
+ const struct real_format *fmt;
+
+ fmt = fmt_for_mode[mode - QFmode];
+ if (fmt == NULL)
+ abort ();
- e53toe (x, w);
- etoasc (w, string, ndigs);
+ *r = *a;
+ round_for_format (fmt, r);
+
+ /* round_for_format de-normalizes denormals. Undo just that part. */
+ if (r->class == rvc_normal)
+ normalize (r);
}
-/* Convert double extended value X to ASCII string STRING with NDIG digits
- after the decimal point. */
+/* Legacy. Likewise, except return the struct directly. */
-static void
-e64toasc (x, string, ndigs)
- const UEMUSHORT x[];
- char *string;
- int ndigs;
+REAL_VALUE_TYPE
+real_value_truncate (mode, a)
+ enum machine_mode mode;
+ REAL_VALUE_TYPE a;
{
- UEMUSHORT w[NI];
-
- e64toe (x, w);
- etoasc (w, string, ndigs);
+ REAL_VALUE_TYPE r;
+ real_convert (&r, mode, &a);
+ return r;
}
-/* Convert 128-bit long double value X to ASCII string STRING with NDIG digits
- after the decimal point. */
+/* Return true if truncating to MODE is exact. */
-static void
-e113toasc (x, string, ndigs)
- const UEMUSHORT x[];
- char *string;
- int ndigs;
+bool
+exact_real_truncate (mode, ta)
+ enum machine_mode mode;
+ const REAL_VALUE_TYPE *ta;
{
- UEMUSHORT w[NI];
-
- e113toe (x, w);
- etoasc (w, string, ndigs);
+ REAL_VALUE_TYPE t;
+ real_convert (&t, mode, ta);
+ return real_identical (&t, ta);
}
-#endif /* 0 */
-/* Convert e-type X to ASCII string STRING with NDIGS digits after
- the decimal point. */
+/* Write R to the target format of MODE. Place the words of the
+ result in target word order in BUF. There are always 32 bits
+ in each long, no matter the size of the host long.
-static char wstring[80]; /* working storage for ASCII output */
+ Legacy: return word 0 for implementing REAL_VALUE_TO_TARGET_SINGLE. */
-static void
-etoasc (x, string, ndigs)
- const UEMUSHORT x[];
- char *string;
- int ndigs;
+long
+real_to_target (buf, tr, mode)
+ long *buf;
+ const REAL_VALUE_TYPE *tr;
+ enum machine_mode mode;
{
- EMUSHORT digit;
- UEMUSHORT y[NI], t[NI], u[NI], w[NI];
- const UEMUSHORT *p, *r, *ten;
- UEMUSHORT sign;
- int i, j, k, expon, rndsav;
- char *s, *ss;
- UEMUSHORT m;
-
-
- rndsav = rndprc;
- ss = string;
- s = wstring;
- *ss = '\0';
- *s = '\0';
-#ifdef NANS
- if (eisnan (x))
- {
- sprintf (wstring, " NaN ");
- goto bxit;
- }
-#endif
- rndprc = NBITS; /* set to full precision */
- emov (x, y); /* retain external format */
- if (y[NE - 1] & 0x8000)
- {
- sign = 0xffff;
- y[NE - 1] &= 0x7fff;
- }
- else
- {
- sign = 0;
- }
- expon = 0;
- ten = &etens[NTEN][0];
- emov (eone, t);
- /* Test for zero exponent */
- if (y[NE - 1] == 0)
- {
- for (k = 0; k < NE - 1; k++)
- {
- if (y[k] != 0)
- goto tnzro; /* denormalized number */
- }
- goto isone; /* valid all zeros */
- }
- tnzro:
-
- /* Test for infinity. */
- if (y[NE - 1] == 0x7fff)
- {
- if (sign)
- sprintf (wstring, " -Infinity ");
- else
- sprintf (wstring, " Infinity ");
- goto bxit;
- }
-
- /* Test for exponent nonzero but significand denormalized.
- * This is an error condition.
- */
- if ((y[NE - 1] != 0) && ((y[NE - 2] & 0x8000) == 0))
- {
- mtherr ("etoasc", DOMAIN);
- sprintf (wstring, "NaN");
- goto bxit;
- }
+ struct real_value r;
+ const struct real_format *fmt;
+ long buf1;
- /* Compare to 1.0 */
- i = ecmp (eone, y);
- if (i == 0)
- goto isone;
+ r = *(const struct real_value *) tr;
- if (i == -2)
+ fmt = fmt_for_mode[mode - QFmode];
+ if (fmt == NULL)
abort ();
- if (i < 0)
- { /* Number is greater than 1 */
- /* Convert significand to an integer and strip trailing decimal zeros. */
- emov (y, u);
- u[NE - 1] = EXONE + NBITS - 1;
-
- p = &etens[NTEN - 4][0];
- m = 16;
- do
- {
- ediv (p, u, t);
- efloor (t, w);
- for (j = 0; j < NE - 1; j++)
- {
- if (t[j] != w[j])
- goto noint;
- }
- emov (t, u);
- expon += (int) m;
- noint:
- p += NE;
- m >>= 1;
- }
- while (m != 0);
-
- /* Rescale from integer significand */
- u[NE - 1] += y[NE - 1] - (unsigned int) (EXONE + NBITS - 1);
- emov (u, y);
- /* Find power of 10 */
- emov (eone, t);
- m = MAXP;
- p = &etens[0][0];
- /* An unordered compare result shouldn't happen here. */
- while (ecmp (ten, u) <= 0)
- {
- if (ecmp (p, u) <= 0)
- {
- ediv (p, u, u);
- emul (p, t, t);
- expon += (int) m;
- }
- m >>= 1;
- if (m == 0)
- break;
- p += NE;
- }
- }
- else
- { /* Number is less than 1.0 */
- /* Pad significand with trailing decimal zeros. */
- if (y[NE - 1] == 0)
- {
- while ((y[NE - 2] & 0x8000) == 0)
- {
- emul (ten, y, y);
- expon -= 1;
- }
- }
- else
- {
- emovi (y, w);
- for (i = 0; i < NDEC + 1; i++)
- {
- if ((w[NI - 1] & 0x7) != 0)
- break;
- /* multiply by 10 */
- emovz (w, u);
- eshdn1 (u);
- eshdn1 (u);
- eaddm (w, u);
- u[1] += 3;
- while (u[2] != 0)
- {
- eshdn1 (u);
- u[1] += 1;
- }
- if (u[NI - 1] != 0)
- break;
- if (eone[NE - 1] <= u[1])
- break;
- emovz (u, w);
- expon -= 1;
- }
- emovo (w, y);
- }
- k = -MAXP;
- p = &emtens[0][0];
- r = &etens[0][0];
- emov (y, w);
- emov (eone, t);
- while (ecmp (eone, w) > 0)
- {
- if (ecmp (p, w) >= 0)
- {
- emul (r, w, w);
- emul (r, t, t);
- expon += k;
- }
- k /= 2;
- if (k == 0)
- break;
- p += NE;
- r += NE;
- }
- ediv (t, eone, t);
- }
- isone:
- /* Find the first (leading) digit. */
- emovi (t, w);
- emovz (w, t);
- emovi (y, w);
- emovz (w, y);
- eiremain (t, y);
- digit = equot[NI - 1];
- while ((digit == 0) && (ecmp (y, ezero) != 0))
- {
- eshup1 (y);
- emovz (y, u);
- eshup1 (u);
- eshup1 (u);
- eaddm (u, y);
- eiremain (t, y);
- digit = equot[NI - 1];
- expon -= 1;
- }
- s = wstring;
- if (sign)
- *s++ = '-';
- else
- *s++ = ' ';
- /* Examine number of digits requested by caller. */
- if (ndigs < 0)
- ndigs = 0;
- if (ndigs > NDEC)
- ndigs = NDEC;
- if (digit == 10)
- {
- *s++ = '1';
- *s++ = '.';
- if (ndigs > 0)
- {
- *s++ = '0';
- ndigs -= 1;
- }
- expon += 1;
- }
- else
- {
- *s++ = (char) digit + '0';
- *s++ = '.';
- }
- /* Generate digits after the decimal point. */
- for (k = 0; k <= ndigs; k++)
- {
- /* multiply current number by 10, without normalizing */
- eshup1 (y);
- emovz (y, u);
- eshup1 (u);
- eshup1 (u);
- eaddm (u, y);
- eiremain (t, y);
- *s++ = (char) equot[NI - 1] + '0';
- }
- digit = equot[NI - 1];
- --s;
- ss = s;
- /* round off the ASCII string */
- if (digit > 4)
- {
- /* Test for critical rounding case in ASCII output. */
- if (digit == 5)
- {
- emovo (y, t);
- if (ecmp (t, ezero) != 0)
- goto roun; /* round to nearest */
-#ifndef C4X
- if ((*(s - 1) & 1) == 0)
- goto doexp; /* round to even */
-#endif
- }
- /* Round up and propagate carry-outs */
- roun:
- --s;
- k = *s & CHARMASK;
- /* Carry out to most significant digit? */
- if (k == '.')
- {
- --s;
- k = *s;
- k += 1;
- *s = (char) k;
- /* Most significant digit carries to 10? */
- if (k > '9')
- {
- expon += 1;
- *s = '1';
- }
- goto doexp;
- }
- /* Round up and carry out from less significant digits */
- k += 1;
- *s = (char) k;
- if (k > '9')
- {
- *s = '0';
- goto roun;
- }
- }
- doexp:
- /* Strip trailing zeros, but leave at least one. */
- while (ss[-1] == '0' && ss[-2] != '.')
- --ss;
- sprintf (ss, "e%d", expon);
- bxit:
- rndprc = rndsav;
- /* copy out the working string */
- s = string;
- ss = wstring;
- while (*ss == ' ') /* strip possible leading space */
- ++ss;
- while ((*s++ = *ss++) != '\0')
- ;
-}
-
+ round_for_format (fmt, &r);
+ if (!buf)
+ buf = &buf1;
+ (*fmt->encode) (fmt, buf, &r);
-/* Convert ASCII string to floating point.
-
- Numeric input is a free format decimal number of any length, with
- or without decimal point. Entering E after the number followed by an
- integer number causes the second number to be interpreted as a power of
- 10 to be multiplied by the first number (i.e., "scientific" notation). */
-
-/* Convert ASCII string S to single precision float value Y. */
-
-static void
-asctoe24 (s, y)
- const char *s;
- UEMUSHORT *y;
-{
- asctoeg (s, y, 24);
+ return *buf;
}
+/* Read R from the target format of MODE. Read the words of the
+ result in target word order in BUF. There are always 32 bits
+ in each long, no matter the size of the host long. */
-/* Convert ASCII string S to double precision value Y. */
-
-static void
-asctoe53 (s, y)
- const char *s;
- UEMUSHORT *y;
+void
+real_from_target (tr, buf, mode)
+ REAL_VALUE_TYPE *tr;
+ const long *buf;
+ enum machine_mode mode;
{
-#if defined(DEC) || defined(IBM)
- asctoeg (s, y, 56);
-#else
-#if defined(C4X)
- asctoeg (s, y, 32);
-#else
- asctoeg (s, y, 53);
-#endif
-#endif
-}
+ struct real_value *r = (struct real_value *) tr;
+ const struct real_format *fmt;
+ fmt = fmt_for_mode[mode - QFmode];
+ if (fmt == NULL)
+ abort ();
-/* Convert ASCII string S to double extended value Y. */
-
-static void
-asctoe64 (s, y)
- const char *s;
- UEMUSHORT *y;
-{
- asctoeg (s, y, 64);
-}
+ (*fmt->decode) (fmt, r, buf);
+}
-#if (INTEL_EXTENDED_IEEE_FORMAT == 0)
-/* Convert ASCII string S to 128-bit long double Y. */
+/* Return the number of bits in the significand for MODE. */
+/* ??? Legacy. Should get access to real_format directly. */
-static void
-asctoe113 (s, y)
- const char *s;
- UEMUSHORT *y;
+int
+significand_size (mode)
+ enum machine_mode mode;
{
- asctoeg (s, y, 113);
-}
-#endif
+ const struct real_format *fmt;
-/* Convert ASCII string S to e type Y. */
+ fmt = fmt_for_mode[mode - QFmode];
+ if (fmt == NULL)
+ return 0;
-static void
-asctoe (s, y)
- const char *s;
- UEMUSHORT *y;
-{
- asctoeg (s, y, NBITS);
+ return fmt->p * fmt->log2_b;
}
+\f
+/* IEEE single-precision format. */
-/* Convert ASCII string SS to e type Y, with a specified rounding precision
- of OPREC bits. BASE is 16 for C99 hexadecimal floating constants. */
+static void encode_ieee_single PARAMS ((const struct real_format *fmt,
+ long *, const struct real_value *));
+static void decode_ieee_single PARAMS ((const struct real_format *,
+ struct real_value *, const long *));
static void
-asctoeg (ss, y, oprec)
- const char *ss;
- UEMUSHORT *y;
- int oprec;
+encode_ieee_single (fmt, buf, r)
+ const struct real_format *fmt;
+ long *buf;
+ const struct real_value *r;
{
- UEMUSHORT yy[NI], xt[NI], tt[NI];
- int esign, decflg, sgnflg, nexp, exp, prec, lost;
- int i, k, trail, c, rndsav;
- EMULONG lexp;
- UEMUSHORT nsign;
- char *sp, *s, *lstr;
- int base = 10;
-
- /* Copy the input string. */
- lstr = (char *) alloca (strlen (ss) + 1);
-
- while (*ss == ' ') /* skip leading spaces */
- ++ss;
-
- sp = lstr;
- while ((*sp++ = *ss++) != '\0')
- ;
- s = lstr;
+ unsigned long image, sig, exp;
+ bool denormal = (r->sig[SIGSZ-1] & SIG_MSB) == 0;
- if (s[0] == '0' && (s[1] == 'x' || s[1] == 'X'))
- {
- base = 16;
- s += 2;
- }
+ image = r->sign << 31;
+ sig = (r->sig[SIGSZ-1] >> (HOST_BITS_PER_LONG - 24)) & 0x7fffff;
- rndsav = rndprc;
- rndprc = NBITS; /* Set to full precision */
- lost = 0;
- nsign = 0;
- decflg = 0;
- sgnflg = 0;
- nexp = 0;
- exp = 0;
- prec = 0;
- ecleaz (yy);
- trail = 0;
-
- nxtcom:
- k = hex_value (*s);
- if ((k >= 0) && (k < base))
+ switch (r->class)
{
- /* Ignore leading zeros */
- if ((prec == 0) && (decflg == 0) && (k == 0))
- goto donchr;
- /* Identify and strip trailing zeros after the decimal point. */
- if ((trail == 0) && (decflg != 0))
- {
- sp = s;
- while (ISDIGIT (*sp) || (base == 16 && ISXDIGIT (*sp)))
- ++sp;
- /* Check for syntax error */
- c = *sp & CHARMASK;
- if ((base != 10 || ((c != 'e') && (c != 'E')))
- && (base != 16 || ((c != 'p') && (c != 'P')))
- && (c != '\0')
- && (c != '\n') && (c != '\r') && (c != ' ')
- && (c != ','))
- goto unexpected_char_error;
- --sp;
- while (*sp == '0')
- *sp-- = 'z';
- trail = 1;
- if (*s == 'z')
- goto donchr;
- }
+ case rvc_zero:
+ break;
- /* If enough digits were given to more than fill up the yy register,
- continuing until overflow into the high guard word yy[2]
- guarantees that there will be a roundoff bit at the top
- of the low guard word after normalization. */
+ case rvc_inf:
+ if (fmt->has_inf)
+ image |= 255 << 23;
+ else
+ image |= 0x7fffffff;
+ break;
- if (yy[2] == 0)
+ case rvc_nan:
+ if (fmt->has_nans)
{
- if (base == 16)
- {
- if (decflg)
- nexp += 4; /* count digits after decimal point */
-
- eshup1 (yy); /* multiply current number by 16 */
- eshup1 (yy);
- eshup1 (yy);
- eshup1 (yy);
- }
- else
- {
- if (decflg)
- nexp += 1; /* count digits after decimal point */
-
- eshup1 (yy); /* multiply current number by 10 */
- emovz (yy, xt);
- eshup1 (xt);
- eshup1 (xt);
- eaddm (xt, yy);
- }
- /* Insert the current digit. */
- ecleaz (xt);
- xt[NI - 2] = (UEMUSHORT) k;
- eaddm (xt, yy);
+ image |= 255 << 23;
+ image |= sig;
+ if (!fmt->qnan_msb_set)
+ image ^= 1 << 23 | 1 << 22;
}
else
- {
- /* Mark any lost non-zero digit. */
- lost |= k;
- /* Count lost digits before the decimal point. */
- if (decflg == 0)
- {
- if (base == 10)
- nexp -= 1;
- else
- nexp -= 4;
- }
- }
- prec += 1;
- goto donchr;
- }
-
- switch (*s)
- {
- case 'z':
- break;
- case 'E':
- case 'e':
- case 'P':
- case 'p':
- goto expnt;
- case '.': /* decimal point */
- if (decflg)
- goto unexpected_char_error;
- ++decflg;
- break;
- case '-':
- nsign = 0xffff;
- if (sgnflg)
- goto unexpected_char_error;
- ++sgnflg;
+ image |= 0x7fffffff;
break;
- case '+':
- if (sgnflg)
- goto unexpected_char_error;
- ++sgnflg;
- break;
- case ',':
- case ' ':
- case '\0':
- case '\n':
- case '\r':
- goto daldone;
- case 'i':
- case 'I':
- goto infinite;
- default:
- unexpected_char_error:
-#ifdef NANS
- einan (yy);
-#else
- mtherr ("asctoe", DOMAIN);
- eclear (yy);
-#endif
- goto aexit;
- }
- donchr:
- ++s;
- goto nxtcom;
-
- /* Exponent interpretation */
- expnt:
- /* 0.0eXXX is zero, regardless of XXX. Check for the 0.0. */
- for (k = 0; k < NI; k++)
- {
- if (yy[k] != 0)
- goto read_expnt;
- }
- goto aexit;
-
-read_expnt:
- esign = 1;
- exp = 0;
- ++s;
- /* check for + or - */
- if (*s == '-')
- {
- esign = -1;
- ++s;
- }
- if (*s == '+')
- ++s;
- while (ISDIGIT (*s))
- {
- exp *= 10;
- exp += *s++ - '0';
- if (exp > 999999)
- break;
- }
- if (esign < 0)
- exp = -exp;
- if ((exp > MAXDECEXP) && (base == 10))
- {
- infinite:
- ecleaz (yy);
- yy[E] = 0x7fff; /* infinity */
- goto aexit;
- }
- if ((exp < MINDECEXP) && (base == 10))
- {
- zero:
- ecleaz (yy);
- goto aexit;
- }
- daldone:
- if (base == 16)
- {
- /* Base 16 hexadecimal floating constant. */
- if ((k = enormlz (yy)) > NBITS)
- {
- ecleaz (yy);
- goto aexit;
- }
- /* Adjust the exponent. NEXP is the number of hex digits,
- EXP is a power of 2. */
- lexp = (EXONE - 1 + NBITS) - k + yy[E] + exp - nexp;
- if (lexp > 0x7fff)
- goto infinite;
- if (lexp < 0)
- goto zero;
- yy[E] = lexp;
- goto expdon;
+ case rvc_normal:
+ /* Recall that IEEE numbers are interpreted as 1.F x 2**exp,
+ whereas the intermediate representation is 0.F x 2**exp.
+ Which means we're off by one. */
+ if (denormal)
+ exp = 0;
+ else
+ exp = r->exp + 127 - 1;
+ image |= exp << 23;
+ image |= sig;
+ break;
}
- nexp = exp - nexp;
- /* Pad trailing zeros to minimize power of 10, per IEEE spec. */
- while ((nexp > 0) && (yy[2] == 0))
- {
- emovz (yy, xt);
- eshup1 (xt);
- eshup1 (xt);
- eaddm (yy, xt);
- eshup1 (xt);
- if (xt[2] != 0)
- break;
- nexp -= 1;
- emovz (xt, yy);
- }
- if ((k = enormlz (yy)) > NBITS)
- {
- ecleaz (yy);
- goto aexit;
- }
- lexp = (EXONE - 1 + NBITS) - k;
- emdnorm (yy, lost, 0, lexp, 64);
- lost = 0;
+ buf[0] = image;
+}
- /* Convert to external format:
+static void
+decode_ieee_single (fmt, r, buf)
+ const struct real_format *fmt;
+ struct real_value *r;
+ const long *buf;
+{
+ unsigned long image = buf[0] & 0xffffffff;
+ bool sign = (image >> 31) & 1;
+ int exp = (image >> 23) & 0xff;
- Multiply by 10**nexp. If precision is 64 bits,
- the maximum relative error incurred in forming 10**n
- for 0 <= n <= 324 is 8.2e-20, at 10**180.
- For 0 <= n <= 999, the peak relative error is 1.4e-19 at 10**947.
- For 0 >= n >= -999, it is -1.55e-19 at 10**-435. */
+ memset (r, 0, sizeof (*r));
+ image <<= HOST_BITS_PER_LONG - 24;
+ image &= ~SIG_MSB;
- lexp = yy[E];
- if (nexp == 0)
+ if (exp == 0)
{
- k = 0;
- goto expdon;
- }
- esign = 1;
- if (nexp < 0)
- {
- nexp = -nexp;
- esign = -1;
- if (nexp > 4096)
+ if (image && fmt->has_denorm)
{
- /* Punt. Can't handle this without 2 divides. */
- emovi (etens[0], tt);
- lexp -= tt[E];
- k = edivm (tt, yy);
- lexp += EXONE;
- nexp -= 4096;
+ r->class = rvc_normal;
+ r->sign = sign;
+ r->exp = -126;
+ r->sig[SIGSZ-1] = image << 1;
+ normalize (r);
}
+ else if (fmt->has_signed_zero)
+ r->sign = sign;
}
- emov (eone, xt);
- exp = 1;
- i = NTEN;
- do
- {
- if (exp & nexp)
- emul (etens[i], xt, xt);
- i--;
- exp = exp + exp;
- }
- while (exp <= MAXP);
-
- emovi (xt, tt);
- if (esign < 0)
- {
- lexp -= tt[E];
- k = edivm (tt, yy);
- lexp += EXONE;
- }
- else
- {
- lexp += tt[E];
- k = emulm (tt, yy);
- lexp -= EXONE - 1;
- }
- lost = k;
-
- expdon:
-
- /* Round and convert directly to the destination type */
- if (oprec == 53)
- lexp -= EXONE - 0x3ff;
-#ifdef C4X
- else if (oprec == 24 || oprec == 32)
- lexp -= (EXONE - 0x7f);
-#else
-#ifdef IBM
- else if (oprec == 24 || oprec == 56)
- lexp -= EXONE - (0x41 << 2);
-#else
-#ifdef DEC
- else if (oprec == 24)
- lexp -= dec_f.adjustment;
- else if (oprec == 56)
+ else if (exp == 255 && (fmt->has_nans || fmt->has_inf))
{
- if (TARGET_G_FLOAT)
- lexp -= dec_g.adjustment;
+ if (image)
+ {
+ r->class = rvc_nan;
+ r->sign = sign;
+ if (!fmt->qnan_msb_set)
+ image ^= (SIG_MSB >> 1 | SIG_MSB >> 2);
+ r->sig[SIGSZ-1] = image;
+ }
else
- lexp -= dec_d.adjustment;
+ {
+ r->class = rvc_inf;
+ r->sign = sign;
+ }
}
-#else
-else if (oprec == 24)
- lexp -= EXONE - 0177;
-#endif /* DEC */
-#endif /* IBM */
-#endif /* C4X */
- rndprc = oprec;
- emdnorm (yy, lost, 0, lexp, 64);
-
- aexit:
-
- rndprc = rndsav;
- yy[0] = nsign;
- switch (oprec)
+ else
{
-#ifdef DEC
- case 56:
- todec (yy, y);
- break;
-#endif
-#ifdef IBM
- case 56:
- toibm (yy, y, DFmode);
- break;
-#endif
-#ifdef C4X
- case 32:
- toc4x (yy, y, HFmode);
- break;
-#endif
-
- case 53:
- toe53 (yy, y);
- break;
- case 24:
- toe24 (yy, y);
- break;
- case 64:
- toe64 (yy, y);
- break;
-#if (INTEL_EXTENDED_IEEE_FORMAT == 0)
- case 113:
- toe113 (yy, y);
- break;
-#endif
- case NBITS:
- emovo (yy, y);
- break;
- }
-}
-
+ r->class = rvc_normal;
+ r->sign = sign;
+ r->exp = exp - 127 + 1;
+ r->sig[SIGSZ-1] = image | SIG_MSB;
+ }
+}
+
+const struct real_format ieee_single =
+ {
+ encode_ieee_single,
+ decode_ieee_single,
+ 2,
+ 1,
+ 24,
+ -125,
+ 128,
+ true,
+ true,
+ true,
+ true,
+ true
+ };
+\f
+/* IEEE double-precision format. */
-/* Return Y = largest integer not greater than X (truncated toward minus
- infinity). */
-
-static const UEMUSHORT bmask[] =
-{
- 0xffff,
- 0xfffe,
- 0xfffc,
- 0xfff8,
- 0xfff0,
- 0xffe0,
- 0xffc0,
- 0xff80,
- 0xff00,
- 0xfe00,
- 0xfc00,
- 0xf800,
- 0xf000,
- 0xe000,
- 0xc000,
- 0x8000,
- 0x0000,
-};
+static void encode_ieee_double PARAMS ((const struct real_format *fmt,
+ long *, const struct real_value *));
+static void decode_ieee_double PARAMS ((const struct real_format *,
+ struct real_value *, const long *));
static void
-efloor (x, y)
- const UEMUSHORT x[];
- UEMUSHORT y[];
+encode_ieee_double (fmt, buf, r)
+ const struct real_format *fmt;
+ long *buf;
+ const struct real_value *r;
{
- UEMUSHORT *p;
- int e, expon, i;
- UEMUSHORT f[NE];
-
- emov (x, f); /* leave in external format */
- expon = (int) f[NE - 1];
- e = (expon & 0x7fff) - (EXONE - 1);
- if (e <= 0)
+ unsigned long image_lo, image_hi, sig_lo, sig_hi, exp;
+ bool denormal = (r->sig[SIGSZ-1] & SIG_MSB) == 0;
+
+ image_hi = r->sign << 31;
+ image_lo = 0;
+
+ if (HOST_BITS_PER_LONG == 64)
{
- eclear (y);
- goto isitneg;
+ sig_hi = r->sig[SIGSZ-1];
+ sig_lo = (sig_hi >> (64 - 53)) & 0xffffffff;
+ sig_hi = (sig_hi >> (64 - 53 + 1) >> 31) & 0xfffff;
}
- /* number of bits to clear out */
- e = NBITS - e;
- emov (f, y);
- if (e <= 0)
- return;
-
- p = &y[0];
- while (e >= 16)
+ else
{
- *p++ = 0;
- e -= 16;
+ sig_hi = r->sig[SIGSZ-1];
+ sig_lo = r->sig[SIGSZ-2];
+ sig_lo = (sig_hi << 21) | (sig_lo >> 11);
+ sig_hi = (sig_hi >> 11) & 0xfffff;
}
- /* clear the remaining bits */
- *p &= bmask[e];
- /* truncate negatives toward minus infinity */
- isitneg:
- if ((UEMUSHORT) expon & (UEMUSHORT) 0x8000)
+ switch (r->class)
{
- for (i = 0; i < NE - 1; i++)
+ case rvc_zero:
+ break;
+
+ case rvc_inf:
+ if (fmt->has_inf)
+ image_hi |= 2047 << 20;
+ else
{
- if (f[i] != y[i])
- {
- esub (eone, y, y);
- break;
- }
+ image_hi |= 0x7fffffff;
+ image_lo = 0xffffffff;
}
- }
-}
-
-
-#if 0
-/* Return S and EXP such that S * 2^EXP = X and .5 <= S < 1.
- For example, 1.1 = 0.55 * 2^1. */
-
-static void
-efrexp (x, exp, s)
- const UEMUSHORT x[];
- int *exp;
- UEMUSHORT s[];
-{
- UEMUSHORT xi[NI];
- EMULONG li;
+ break;
- emovi (x, xi);
- /* Handle denormalized numbers properly using long integer exponent. */
- li = (EMULONG) ((EMUSHORT) xi[1]);
+ case rvc_nan:
+ if (fmt->has_nans)
+ {
+ image_hi |= 2047 << 20;
+ image_hi |= sig_hi;
+ if (!fmt->qnan_msb_set)
+ image_hi ^= 1 << 19 | 1 << 18;
+ image_lo = sig_lo;
+ }
+ else
+ {
+ image_hi |= 0x7fffffff;
+ image_lo = 0xffffffff;
+ }
+ break;
- if (li == 0)
- {
- li -= enormlz (xi);
+ case rvc_normal:
+ /* Recall that IEEE numbers are interpreted as 1.F x 2**exp,
+ whereas the intermediate representation is 0.F x 2**exp.
+ Which means we're off by one. */
+ if (denormal)
+ exp = 0;
+ else
+ exp = r->exp + 1023 - 1;
+ image_hi |= exp << 20;
+ image_hi |= sig_hi;
+ image_lo = sig_lo;
+ break;
}
- xi[1] = 0x3ffe;
- emovo (xi, s);
- *exp = (int) (li - 0x3ffe);
-}
-#endif
-/* Return e type Y = X * 2^PWR2. */
+ if (FLOAT_WORDS_BIG_ENDIAN)
+ buf[0] = image_hi, buf[1] = image_lo;
+ else
+ buf[0] = image_lo, buf[1] = image_hi;
+}
static void
-eldexp (x, pwr2, y)
- const UEMUSHORT x[];
- int pwr2;
- UEMUSHORT y[];
+decode_ieee_double (fmt, r, buf)
+ const struct real_format *fmt;
+ struct real_value *r;
+ const long *buf;
{
- UEMUSHORT xi[NI];
- EMULONG li;
- int i;
+ unsigned long image_hi, image_lo;
+ bool sign;
+ int exp;
- emovi (x, xi);
- li = xi[1];
- li += pwr2;
- i = 0;
- emdnorm (xi, i, i, li, !ROUND_TOWARDS_ZERO);
- emovo (xi, y);
-}
+ if (FLOAT_WORDS_BIG_ENDIAN)
+ image_hi = buf[0], image_lo = buf[1];
+ else
+ image_lo = buf[0], image_hi = buf[1];
+ image_lo &= 0xffffffff;
+ image_hi &= 0xffffffff;
+ sign = (image_hi >> 31) & 1;
+ exp = (image_hi >> 20) & 0x7ff;
-#if 0
-/* C = remainder after dividing B by A, all e type values.
- Least significant integer quotient bits left in EQUOT. */
+ memset (r, 0, sizeof (*r));
-static void
-eremain (a, b, c)
- const UEMUSHORT a[], b[];
- UEMUSHORT c[];
-{
- UEMUSHORT den[NI], num[NI];
+ image_hi <<= 32 - 21;
+ image_hi |= image_lo >> 21;
+ image_hi &= 0x7fffffff;
+ image_lo <<= 32 - 21;
-#ifdef NANS
- if (eisinf (b)
- || (ecmp (a, ezero) == 0)
- || eisnan (a)
- || eisnan (b))
+ if (exp == 0)
{
- enan (c, 0);
- return;
+ if ((image_hi || image_lo) && fmt->has_denorm)
+ {
+ r->class = rvc_normal;
+ r->sign = sign;
+ r->exp = -1022;
+ if (HOST_BITS_PER_LONG == 32)
+ {
+ image_hi = (image_hi << 1) | (image_lo >> 31);
+ image_lo <<= 1;
+ r->sig[SIGSZ-1] = image_hi;
+ r->sig[SIGSZ-2] = image_lo;
+ }
+ else
+ {
+ image_hi = (image_hi << 31 << 2) | (image_lo << 1);
+ r->sig[SIGSZ-1] = image_hi;
+ }
+ normalize (r);
+ }
+ else if (fmt->has_signed_zero)
+ r->sign = sign;
}
-#endif
- if (ecmp (a, ezero) == 0)
+ else if (exp == 2047 && (fmt->has_nans || fmt->has_inf))
{
- mtherr ("eremain", SING);
- eclear (c);
- return;
+ if (image_hi || image_lo)
+ {
+ r->class = rvc_nan;
+ r->sign = sign;
+ if (HOST_BITS_PER_LONG == 32)
+ {
+ r->sig[SIGSZ-1] = image_hi;
+ r->sig[SIGSZ-2] = image_lo;
+ }
+ else
+ r->sig[SIGSZ-1] = (image_hi << 31 << 1) | image_lo;
+
+ if (!fmt->qnan_msb_set)
+ r->sig[SIGSZ-1] ^= (SIG_MSB >> 1 | SIG_MSB >> 2);
+ }
+ else
+ {
+ r->class = rvc_inf;
+ r->sign = sign;
+ }
}
- emovi (a, den);
- emovi (b, num);
- eiremain (den, num);
- /* Sign of remainder = sign of quotient */
- if (a[0] == b[0])
- num[0] = 0;
else
- num[0] = 0xffff;
- emovo (num, c);
-}
-#endif
-
-/* Return quotient of exploded e-types NUM / DEN in EQUOT,
- remainder in NUM. */
-
-static void
-eiremain (den, num)
- UEMUSHORT den[], num[];
-{
- EMULONG ld, ln;
- UEMUSHORT j;
-
- ld = den[E];
- ld -= enormlz (den);
- ln = num[E];
- ln -= enormlz (num);
- ecleaz (equot);
- while (ln >= ld)
{
- if (ecmpm (den, num) <= 0)
+ r->class = rvc_normal;
+ r->sign = sign;
+ r->exp = exp - 1023 + 1;
+ if (HOST_BITS_PER_LONG == 32)
{
- esubm (den, num);
- j = 1;
+ r->sig[SIGSZ-1] = image_hi | SIG_MSB;
+ r->sig[SIGSZ-2] = image_lo;
}
else
- j = 0;
- eshup1 (equot);
- equot[NI - 1] |= j;
- eshup1 (num);
- ln -= 1;
- }
- emdnorm (num, 0, 0, ln, 0);
-}
-
-/* Report an error condition CODE encountered in function NAME.
-
- Mnemonic Value Significance
+ r->sig[SIGSZ-1] = (image_hi << 31 << 1) | image_lo | SIG_MSB;
+ }
+}
+
+const struct real_format ieee_double =
+ {
+ encode_ieee_double,
+ decode_ieee_double,
+ 2,
+ 1,
+ 53,
+ -1021,
+ 1024,
+ true,
+ true,
+ true,
+ true,
+ true
+ };
- DOMAIN 1 argument domain error
- SING 2 function singularity
- OVERFLOW 3 overflow range error
- UNDERFLOW 4 underflow range error
- TLOSS 5 total loss of precision
- PLOSS 6 partial loss of precision
- INVALID 7 NaN - producing operation
- EDOM 33 Unix domain error code
- ERANGE 34 Unix range error code
+\f
+/* IEEE extended double precision format. This comes in three
+ flavours: Intel's as a 12 byte image, Intel's as a 16 byte image,
+ and Motorola's. */
- The order of appearance of the following messages is bound to the
- error codes defined above. */
+static void encode_ieee_extended PARAMS ((const struct real_format *fmt,
+ long *, const struct real_value *));
+static void decode_ieee_extended PARAMS ((const struct real_format *,
+ struct real_value *, const long *));
-int merror = 0;
-extern int merror;
+static void encode_ieee_extended_128 PARAMS ((const struct real_format *fmt,
+ long *,
+ const struct real_value *));
+static void decode_ieee_extended_128 PARAMS ((const struct real_format *,
+ struct real_value *,
+ const long *));
static void
-mtherr (name, code)
- const char *name;
- int code;
+encode_ieee_extended (fmt, buf, r)
+ const struct real_format *fmt;
+ long *buf;
+ const struct real_value *r;
{
- /* The string passed by the calling program is supposed to be the
- name of the function in which the error occurred.
- The code argument selects which error message string will be printed. */
-
- if (strcmp (name, "esub") == 0)
- name = "subtraction";
- else if (strcmp (name, "ediv") == 0)
- name = "division";
- else if (strcmp (name, "emul") == 0)
- name = "multiplication";
- else if (strcmp (name, "enormlz") == 0)
- name = "normalization";
- else if (strcmp (name, "etoasc") == 0)
- name = "conversion to text";
- else if (strcmp (name, "asctoe") == 0)
- name = "parsing";
- else if (strcmp (name, "eremain") == 0)
- name = "modulus";
- else if (strcmp (name, "esqrt") == 0)
- name = "square root";
- if (extra_warnings)
+ unsigned long image_hi, sig_hi, sig_lo;
+ bool denormal = (r->sig[SIGSZ-1] & SIG_MSB) == 0;
+
+ image_hi = r->sign << 15;
+ sig_hi = sig_lo = 0;
+
+ switch (r->class)
{
- switch (code)
+ case rvc_zero:
+ break;
+
+ case rvc_inf:
+ if (fmt->has_inf)
{
- case DOMAIN: warning ("%s: argument domain error" , name); break;
- case SING: warning ("%s: function singularity" , name); break;
- case OVERFLOW: warning ("%s: overflow range error" , name); break;
- case UNDERFLOW: warning ("%s: underflow range error" , name); break;
- case TLOSS: warning ("%s: total loss of precision" , name); break;
- case PLOSS: warning ("%s: partial loss of precision", name); break;
- case INVALID: warning ("%s: NaN - producing operation", name); break;
- default: abort ();
+ image_hi |= 32767;
+
+ /* Intel requires the explicit integer bit to be set, otherwise
+ it considers the value a "pseudo-infinity". Motorola docs
+ say it doesn't care. */
+ sig_hi = 0x80000000;
}
- }
+ else
+ {
+ image_hi |= 32767;
+ sig_lo = sig_hi = 0xffffffff;
+ }
+ break;
- /* Set global error message word */
- merror = code + 1;
-}
+ case rvc_nan:
+ if (fmt->has_nans)
+ {
+ image_hi |= 32767;
+ if (HOST_BITS_PER_LONG == 32)
+ {
+ sig_hi = r->sig[SIGSZ-1];
+ sig_lo = r->sig[SIGSZ-2];
+ }
+ else
+ {
+ sig_lo = r->sig[SIGSZ-1];
+ sig_hi = sig_lo >> 31 >> 1;
+ sig_lo &= 0xffffffff;
+ }
+ if (!fmt->qnan_msb_set)
+ sig_hi ^= 1 << 30 | 1 << 29;
-#ifdef DEC
-/* Convert DEC double precision D to e type E. */
+ /* Intel requires the explicit integer bit to be set, otherwise
+ it considers the value a "pseudo-nan". Motorola docs say it
+ doesn't care. */
+ sig_hi |= 0x80000000;
+ }
+ else
+ {
+ image_hi |= 32767;
+ sig_lo = sig_hi = 0xffffffff;
+ }
+ break;
-static void
-dectoe (d, e)
- const UEMUSHORT *d;
- UEMUSHORT *e;
-{
- if (TARGET_G_FLOAT)
- ieeetoe (d, e, &dec_g);
- else
- ieeetoe (d, e, &dec_d);
-}
+ case rvc_normal:
+ {
+ int exp = r->exp;
-/* Convert e type X to DEC double precision D. */
+ /* Recall that IEEE numbers are interpreted as 1.F x 2**exp,
+ whereas the intermediate representation is 0.F x 2**exp.
+ Which means we're off by one.
-static void
-etodec (x, d)
- const UEMUSHORT *x;
- UEMUSHORT *d;
-{
- UEMUSHORT xi[NI];
- EMULONG exp;
- int rndsav;
- const struct ieee_format *fmt;
+ Except for Motorola, which consider exp=0 and explicit
+ integer bit set to continue to be normalized. In theory
+ this descrepency has been taken care of by the difference
+ in fmt->emin in round_for_format. */
+
+ if (denormal)
+ exp = 0;
+ else
+ {
+ exp += 16383 - 1;
+ if (exp < 0)
+ abort ();
+ }
+ image_hi |= exp;
+
+ if (HOST_BITS_PER_LONG == 32)
+ {
+ sig_hi = r->sig[SIGSZ-1];
+ sig_lo = r->sig[SIGSZ-2];
+ }
+ else
+ {
+ sig_lo = r->sig[SIGSZ-1];
+ sig_hi = sig_lo >> 31 >> 1;
+ sig_lo &= 0xffffffff;
+ }
+ }
+ break;
+ }
- if (TARGET_G_FLOAT)
- fmt = &dec_g;
+ if (FLOAT_WORDS_BIG_ENDIAN)
+ buf[0] = image_hi << 16, buf[1] = sig_hi, buf[2] = sig_lo;
else
- fmt = &dec_d;
-
- emovi (x, xi);
- /* Adjust exponent for offsets. */
- exp = (EMULONG) xi[E] - fmt->adjustment;
- /* Round off to nearest or even. */
- rndsav = rndprc;
- rndprc = fmt->precision;
- emdnorm (xi, 0, 0, exp, !ROUND_TOWARDS_ZERO);
- rndprc = rndsav;
- todec (xi, d);
+ buf[0] = sig_lo, buf[1] = sig_hi, buf[2] = image_hi;
}
-/* Convert exploded e-type X, that has already been rounded to
- 56-bit precision, to DEC format double Y. */
-
static void
-todec (x, y)
- UEMUSHORT *x, *y;
+encode_ieee_extended_128 (fmt, buf, r)
+ const struct real_format *fmt;
+ long *buf;
+ const struct real_value *r;
{
- if (TARGET_G_FLOAT)
- toieee (x, y, &dec_g);
- else
- toieee (x, y, &dec_d);
+ buf[3 * !FLOAT_WORDS_BIG_ENDIAN] = 0;
+ encode_ieee_extended (fmt, buf+!!FLOAT_WORDS_BIG_ENDIAN, r);
}
-#endif /* DEC */
-
-#ifdef IBM
-/* Convert IBM single/double precision to e type. */
static void
-ibmtoe (d, e, mode)
- const UEMUSHORT *d;
- UEMUSHORT *e;
- enum machine_mode mode;
+decode_ieee_extended (fmt, r, buf)
+ const struct real_format *fmt;
+ struct real_value *r;
+ const long *buf;
{
- UEMUSHORT y[NI];
- UEMUSHORT r, *p;
-
- ecleaz (y); /* start with a zero */
- p = y; /* point to our number */
- r = *d; /* get IBM exponent word */
- if (*d & (unsigned int) 0x8000)
- *p = 0xffff; /* fill in our sign */
- ++p; /* bump pointer to our exponent word */
- r &= 0x7f00; /* strip the sign bit */
- r >>= 6; /* shift exponent word down 6 bits */
- /* in fact shift by 8 right and 2 left */
- r += EXONE - (0x41 << 2); /* subtract IBM exponent offset */
- /* add our e type exponent offset */
- *p++ = r; /* to form our exponent */
-
- *p++ = *d++ & 0xff; /* now do the high order mantissa */
- /* strip off the IBM exponent and sign bits */
- if (mode != SFmode) /* there are only 2 words in SFmode */
- {
- *p++ = *d++; /* fill in the rest of our mantissa */
- *p++ = *d++;
- }
- *p = *d;
+ unsigned long image_hi, sig_hi, sig_lo;
+ bool sign;
+ int exp;
- if (y[M] == 0 && y[M+1] == 0 && y[M+2] == 0 && y[M+3] == 0)
- y[0] = y[E] = 0;
+ if (FLOAT_WORDS_BIG_ENDIAN)
+ image_hi = buf[0] >> 16, sig_hi = buf[1], sig_lo = buf[2];
else
- y[E] -= 5 + enormlz (y); /* now normalize the mantissa */
- /* handle change in RADIX */
- emovo (y, e);
-}
+ sig_lo = buf[0], sig_hi = buf[1], image_hi = buf[2];
+ sig_lo &= 0xffffffff;
+ sig_hi &= 0xffffffff;
+ image_hi &= 0xffffffff;
+ sign = (image_hi >> 15) & 1;
+ exp = image_hi & 0x7fff;
+ memset (r, 0, sizeof (*r));
-/* Convert e type to IBM single/double precision. */
-
-static void
-etoibm (x, d, mode)
- const UEMUSHORT *x;
- UEMUSHORT *d;
- enum machine_mode mode;
-{
- UEMUSHORT xi[NI];
- EMULONG exp;
- int rndsav;
-
- emovi (x, xi);
- exp = (EMULONG) xi[E] - (EXONE - (0x41 << 2)); /* adjust exponent for offsets */
- /* round off to nearest or even */
- rndsav = rndprc;
- rndprc = 56;
- emdnorm (xi, 0, 0, exp, !ROUND_TOWARDS_ZERO);
- rndprc = rndsav;
- toibm (xi, d, mode);
-}
-
-static void
-toibm (x, y, mode)
- UEMUSHORT *x, *y;
- enum machine_mode mode;
-{
- UEMUSHORT i;
- UEMUSHORT *p;
- int r;
-
- p = x;
- *y = 0;
- if (*p++)
- *y = 0x8000;
- i = *p++;
- if (i == 0)
+ if (exp == 0)
{
- *y++ = 0;
- *y++ = 0;
- if (mode != SFmode)
+ if ((sig_hi || sig_lo) && fmt->has_denorm)
{
- *y++ = 0;
- *y++ = 0;
+ r->class = rvc_normal;
+ r->sign = sign;
+
+ /* When the IEEE format contains a hidden bit, we know that
+ it's zero at this point, and so shift up the significand
+ and decrease the exponent to match. In this case, Motorola
+ defines the explicit integer bit to be valid, so we don't
+ know whether the msb is set or not. */
+ r->exp = fmt->emin;
+ if (HOST_BITS_PER_LONG == 32)
+ {
+ r->sig[SIGSZ-1] = sig_hi;
+ r->sig[SIGSZ-2] = sig_lo;
+ }
+ else
+ r->sig[SIGSZ-1] = (sig_hi << 31 << 1) | sig_lo;
+
+ normalize (r);
}
- return;
+ else if (fmt->has_signed_zero)
+ r->sign = sign;
}
- r = i & 0x3;
- i >>= 2;
- if (i > 0x7f)
+ else if (exp == 32767 && (fmt->has_nans || fmt->has_inf))
{
- *y++ |= 0x7fff;
- *y++ = 0xffff;
- if (mode != SFmode)
+ /* See above re "pseudo-infinities" and "pseudo-nans".
+ Short summary is that the MSB will likely always be
+ set, and that we don't care about it. */
+ sig_hi &= 0x7fffffff;
+
+ if (sig_hi || sig_lo)
{
- *y++ = 0xffff;
- *y++ = 0xffff;
+ r->class = rvc_nan;
+ r->sign = sign;
+ if (HOST_BITS_PER_LONG == 32)
+ {
+ r->sig[SIGSZ-1] = sig_hi;
+ r->sig[SIGSZ-2] = sig_lo;
+ }
+ else
+ r->sig[SIGSZ-1] = (sig_hi << 31 << 1) | sig_lo;
+
+ if (!fmt->qnan_msb_set)
+ r->sig[SIGSZ-1] ^= (SIG_MSB >> 1 | SIG_MSB >> 2);
+ }
+ else
+ {
+ r->class = rvc_inf;
+ r->sign = sign;
}
-#ifdef ERANGE
- errno = ERANGE;
-#endif
- return;
}
- i &= 0x7f;
- *y |= (i << 8);
- eshift (x, r + 5);
- *y++ |= x[M];
- *y++ = x[M + 1];
- if (mode != SFmode)
+ else
{
- *y++ = x[M + 2];
- *y++ = x[M + 3];
- }
-}
-#endif /* IBM */
+ r->class = rvc_normal;
+ r->sign = sign;
+ r->exp = exp - 16383 + 1;
+ if (HOST_BITS_PER_LONG == 32)
+ {
+ r->sig[SIGSZ-1] = sig_hi;
+ r->sig[SIGSZ-2] = sig_lo;
+ }
+ else
+ r->sig[SIGSZ-1] = (sig_hi << 31 << 1) | sig_lo;
+ }
+}
+
+static void
+decode_ieee_extended_128 (fmt, r, buf)
+ const struct real_format *fmt;
+ struct real_value *r;
+ const long *buf;
+{
+ decode_ieee_extended (fmt, r, buf+!!FLOAT_WORDS_BIG_ENDIAN);
+}
+
+const struct real_format ieee_extended_motorola =
+ {
+ encode_ieee_extended,
+ decode_ieee_extended,
+ 2,
+ 1,
+ 64,
+ -16382,
+ 16384,
+ true,
+ true,
+ true,
+ true,
+ true
+ };
+
+const struct real_format ieee_extended_intel_96 =
+ {
+ encode_ieee_extended,
+ decode_ieee_extended,
+ 2,
+ 1,
+ 64,
+ -16381,
+ 16384,
+ true,
+ true,
+ true,
+ true,
+ true
+ };
+
+const struct real_format ieee_extended_intel_128 =
+ {
+ encode_ieee_extended_128,
+ decode_ieee_extended_128,
+ 2,
+ 1,
+ 64,
+ -16381,
+ 16384,
+ true,
+ true,
+ true,
+ true,
+ true
+ };
+\f
+/* IEEE quad precision format. */
-#ifdef C4X
-/* Convert C4X single/double precision to e type. */
+static void encode_ieee_quad PARAMS ((const struct real_format *fmt,
+ long *, const struct real_value *));
+static void decode_ieee_quad PARAMS ((const struct real_format *,
+ struct real_value *, const long *));
static void
-c4xtoe (d, e, mode)
- const UEMUSHORT *d;
- UEMUSHORT *e;
- enum machine_mode mode;
+encode_ieee_quad (fmt, buf, r)
+ const struct real_format *fmt;
+ long *buf;
+ const struct real_value *r;
{
- UEMUSHORT y[NI];
- UEMUSHORT dn[4];
- int r;
- int isnegative;
- int size;
- int i;
- int carry;
-
- dn[0] = d[0];
- dn[1] = d[1];
- if (mode != QFmode)
- {
- dn[2] = d[3] << 8;
- dn[3] = 0;
- }
-
- /* Short-circuit the zero case. */
- if ((dn[0] == 0x8000)
- && (dn[1] == 0x0000)
- && ((mode == QFmode) || ((dn[2] == 0x0000) && (dn[3] == 0x0000))))
- {
- e[0] = 0;
- e[1] = 0;
- e[2] = 0;
- e[3] = 0;
- e[4] = 0;
- e[5] = 0;
- return;
- }
+ unsigned long image3, image2, image1, image0, exp;
+ bool denormal = (r->sig[SIGSZ-1] & SIG_MSB) == 0;
+ struct real_value u;
- ecleaz (y); /* start with a zero */
- r = dn[0]; /* get sign/exponent part */
- if (r & (unsigned int) 0x0080)
- {
- y[0] = 0xffff; /* fill in our sign */
- isnegative = TRUE;
- }
- else
- isnegative = FALSE;
+ image3 = r->sign << 31;
+ image2 = 0;
+ image1 = 0;
+ image0 = 0;
- r >>= 8; /* Shift exponent word down 8 bits. */
- if (r & 0x80) /* Make the exponent negative if it is. */
- r = r | (~0 & ~0xff);
+ rshift_significand (&u, r, SIGNIFICAND_BITS - 113);
- if (isnegative)
+ switch (r->class)
{
- /* Now do the high order mantissa. We don't "or" on the high bit
- because it is 2 (not 1) and is handled a little differently
- below. */
- y[M] = dn[0] & 0x7f;
+ case rvc_zero:
+ break;
- y[M+1] = dn[1];
- if (mode != QFmode) /* There are only 2 words in QFmode. */
+ case rvc_inf:
+ if (fmt->has_inf)
+ image3 |= 32767 << 16;
+ else
{
- y[M+2] = dn[2]; /* Fill in the rest of our mantissa. */
- y[M+3] = dn[3];
- size = 4;
+ image3 |= 0x7fffffff;
+ image2 = 0xffffffff;
+ image1 = 0xffffffff;
+ image0 = 0xffffffff;
}
- else
- size = 2;
- eshift (y, -8);
-
- /* Now do the two's complement on the data. */
+ break;
- carry = 1; /* Initially add 1 for the two's complement. */
- for (i=size + M; i > M; i--)
+ case rvc_nan:
+ if (fmt->has_nans)
{
- if (carry && (y[i] == 0x0000))
- /* We overflowed into the next word, carry is the same. */
- y[i] = carry ? 0x0000 : 0xffff;
+ image3 |= 32767 << 16;
+
+ if (HOST_BITS_PER_LONG == 32)
+ {
+ image0 = u.sig[0];
+ image1 = u.sig[1];
+ image2 = u.sig[2];
+ image3 |= u.sig[3] & 0xffff;
+ }
else
{
- /* No overflow, just invert and add carry. */
- y[i] = ((~y[i]) + carry) & 0xffff;
- carry = 0;
+ image0 = u.sig[0];
+ image1 = image0 >> 31 >> 1;
+ image2 = u.sig[1];
+ image3 |= (image2 >> 31 >> 1) & 0xffff;
+ image0 &= 0xffffffff;
+ image2 &= 0xffffffff;
}
+
+ if (!fmt->qnan_msb_set)
+ image3 ^= 1 << 15 | 1 << 14;
+ }
+ else
+ {
+ image3 |= 0x7fffffff;
+ image2 = 0xffffffff;
+ image1 = 0xffffffff;
+ image0 = 0xffffffff;
}
+ break;
- if (carry)
+ case rvc_normal:
+ /* Recall that IEEE numbers are interpreted as 1.F x 2**exp,
+ whereas the intermediate representation is 0.F x 2**exp.
+ Which means we're off by one. */
+ if (denormal)
+ exp = 0;
+ else
+ exp = r->exp + 16383 - 1;
+ image3 |= exp << 16;
+
+ if (HOST_BITS_PER_LONG == 32)
{
- eshift (y, -1);
- y[M+1] |= 0x8000;
- r++;
+ image0 = u.sig[0];
+ image1 = u.sig[1];
+ image2 = u.sig[2];
+ image3 |= u.sig[3] & 0xffff;
}
- y[1] = r + EXONE;
+ else
+ {
+ image0 = u.sig[0];
+ image1 = image0 >> 31 >> 1;
+ image2 = u.sig[1];
+ image3 |= (image2 >> 31 >> 1) & 0xffff;
+ image0 &= 0xffffffff;
+ image2 &= 0xffffffff;
+ }
+ break;
+ }
+
+ if (FLOAT_WORDS_BIG_ENDIAN)
+ {
+ buf[0] = image3;
+ buf[1] = image2;
+ buf[2] = image1;
+ buf[3] = image0;
}
else
{
- /* Add our e type exponent offset to form our exponent. */
- r += EXONE;
- y[1] = r;
-
- /* Now do the high order mantissa strip off the exponent and sign
- bits and add the high 1 bit. */
- y[M] = (dn[0] & 0x7f) | 0x80;
-
- y[M+1] = dn[1];
- if (mode != QFmode) /* There are only 2 words in QFmode. */
- {
- y[M+2] = dn[2]; /* Fill in the rest of our mantissa. */
- y[M+3] = dn[3];
- }
- eshift (y, -8);
+ buf[0] = image0;
+ buf[1] = image1;
+ buf[2] = image2;
+ buf[3] = image3;
}
-
- emovo (y, e);
}
-
-/* Convert e type to C4X single/double precision. */
-
static void
-etoc4x (x, d, mode)
- const UEMUSHORT *x;
- UEMUSHORT *d;
- enum machine_mode mode;
+decode_ieee_quad (fmt, r, buf)
+ const struct real_format *fmt;
+ struct real_value *r;
+ const long *buf;
{
- UEMUSHORT xi[NI];
- EMULONG exp;
- int rndsav;
+ unsigned long image3, image2, image1, image0;
+ bool sign;
+ int exp;
- emovi (x, xi);
+ if (FLOAT_WORDS_BIG_ENDIAN)
+ {
+ image3 = buf[0];
+ image2 = buf[1];
+ image1 = buf[2];
+ image0 = buf[3];
+ }
+ else
+ {
+ image0 = buf[0];
+ image1 = buf[1];
+ image2 = buf[2];
+ image3 = buf[3];
+ }
+ image0 &= 0xffffffff;
+ image1 &= 0xffffffff;
+ image2 &= 0xffffffff;
- /* Adjust exponent for offsets. */
- exp = (EMULONG) xi[E] - (EXONE - 0x7f);
+ sign = (image3 >> 31) & 1;
+ exp = (image3 >> 16) & 0x7fff;
+ image3 &= 0xffff;
- /* Round off to nearest or even. */
- rndsav = rndprc;
- rndprc = mode == QFmode ? 24 : 32;
- emdnorm (xi, 0, 0, exp, !ROUND_TOWARDS_ZERO);
- rndprc = rndsav;
- toc4x (xi, d, mode);
-}
+ memset (r, 0, sizeof (*r));
-static void
-toc4x (x, y, mode)
- UEMUSHORT *x, *y;
- enum machine_mode mode;
-{
- int i;
- int v;
- int carry;
-
- /* Short-circuit the zero case */
- if ((x[0] == 0) /* Zero exponent and sign */
- && (x[1] == 0)
- && (x[M] == 0) /* The rest is for zero mantissa */
- && (x[M+1] == 0)
- /* Only check for double if necessary */
- && ((mode == QFmode) || ((x[M+2] == 0) && (x[M+3] == 0))))
+ if (exp == 0)
{
- /* We have a zero. Put it into the output and return. */
- *y++ = 0x8000;
- *y++ = 0x0000;
- if (mode != QFmode)
+ if ((image3 | image2 | image1 | image0) && fmt->has_denorm)
{
- *y++ = 0x0000;
- *y++ = 0x0000;
- }
- return;
- }
+ r->class = rvc_normal;
+ r->sign = sign;
- *y = 0;
+ r->exp = -16382 + (SIGNIFICAND_BITS - 112);
+ if (HOST_BITS_PER_LONG == 32)
+ {
+ r->sig[0] = image0;
+ r->sig[1] = image1;
+ r->sig[2] = image2;
+ r->sig[3] = image3;
+ }
+ else
+ {
+ r->sig[0] = (image1 << 31 << 1) | image0;
+ r->sig[1] = (image3 << 31 << 1) | image2;
+ }
- /* Negative number require a two's complement conversion of the
- mantissa. */
- if (x[0])
+ normalize (r);
+ }
+ else if (fmt->has_signed_zero)
+ r->sign = sign;
+ }
+ else if (exp == 32767 && (fmt->has_nans || fmt->has_inf))
{
- *y = 0x0080;
-
- i = ((int) x[1]) - 0x7f;
-
- /* Now add 1 to the inverted data to do the two's complement. */
- if (mode != QFmode)
- v = 4 + M;
- else
- v = 2 + M;
- carry = 1;
- while (v > M)
+ if (image3 | image2 | image1 | image0)
{
- if (x[v] == 0x0000)
- x[v] = carry ? 0x0000 : 0xffff;
+ r->class = rvc_nan;
+ r->sign = sign;
+
+ if (HOST_BITS_PER_LONG == 32)
+ {
+ r->sig[0] = image0;
+ r->sig[1] = image1;
+ r->sig[2] = image2;
+ r->sig[3] = image3;
+ }
else
{
- x[v] = ((~x[v]) + carry) & 0xffff;
- carry = 0;
+ r->sig[0] = (image1 << 31 << 1) | image0;
+ r->sig[1] = (image3 << 31 << 1) | image2;
}
- v--;
- }
+ lshift_significand (r, r, SIGNIFICAND_BITS - 113);
- /* The following is a special case. The C4X negative float requires
- a zero in the high bit (because the format is (2 - x) x 2^m), so
- if a one is in that bit, we have to shift left one to get rid
- of it. This only occurs if the number is -1 x 2^m. */
- if (x[M+1] & 0x8000)
+ if (!fmt->qnan_msb_set)
+ r->sig[SIGSZ-1] ^= (SIG_MSB >> 1 | SIG_MSB >> 2);
+ }
+ else
{
- /* This is the case of -1 x 2^m, we have to rid ourselves of the
- high sign bit and shift the exponent. */
- eshift (x, 1);
- i--;
+ r->class = rvc_inf;
+ r->sign = sign;
}
}
else
- i = ((int) x[1]) - 0x7f;
-
- if ((i < -128) || (i > 127))
{
- y[0] |= 0xff7f;
- y[1] = 0xffff;
- if (mode != QFmode)
+ r->class = rvc_normal;
+ r->sign = sign;
+ r->exp = exp - 16383 + 1;
+
+ if (HOST_BITS_PER_LONG == 32)
{
- y[2] = 0xffff;
- y[3] = 0xffff;
- y[3] = (y[1] << 8) | ((y[2] >> 8) & 0xff);
- y[2] = (y[0] << 8) | ((y[1] >> 8) & 0xff);
+ r->sig[0] = image0;
+ r->sig[1] = image1;
+ r->sig[2] = image2;
+ r->sig[3] = image3;
}
-#ifdef ERANGE
- errno = ERANGE;
-#endif
- return;
- }
-
- y[0] |= ((i & 0xff) << 8);
-
- eshift (x, 8);
-
- y[0] |= x[M] & 0x7f;
- y[1] = x[M + 1];
- if (mode != QFmode)
- {
- y[2] = x[M + 2];
- y[3] = x[M + 3];
- y[3] = (y[1] << 8) | ((y[2] >> 8) & 0xff);
- y[2] = (y[0] << 8) | ((y[1] >> 8) & 0xff);
+ else
+ {
+ r->sig[0] = (image1 << 31 << 1) | image0;
+ r->sig[1] = (image3 << 31 << 1) | image2;
+ }
+ lshift_significand (r, r, SIGNIFICAND_BITS - 113);
+ r->sig[SIGSZ-1] |= SIG_MSB;
}
}
-#endif /* C4X */
-
-/* Output a binary NaN bit pattern in the target machine's format. */
-
-/* If special NaN bit patterns are required, define them in tm.h
- as arrays of unsigned 16-bit shorts. Otherwise, use the default
- patterns here. */
-#ifdef TFMODE_NAN
-TFMODE_NAN;
-#else
-#if defined (IEEE) && (INTEL_EXTENDED_IEEE_FORMAT == 0)
-static const UEMUSHORT TFbignan[8] =
- {0x7fff, 0xffff, 0xffff, 0xffff, 0xffff, 0xffff, 0xffff, 0xffff};
-static const UEMUSHORT TFlittlenan[8] = {0, 0, 0, 0, 0, 0, 0x8000, 0xffff};
-#endif
-#endif
-
-#ifdef XFMODE_NAN
-XFMODE_NAN;
-#else
-#ifdef IEEE
-static const UEMUSHORT XFbignan[6] =
- {0x7fff, 0xffff, 0xffff, 0xffff, 0xffff, 0xffff};
-static const UEMUSHORT XFlittlenan[6] = {0, 0, 0, 0xc000, 0xffff, 0};
-#endif
-#endif
-#ifdef DFMODE_NAN
-DFMODE_NAN;
-#else
-#ifdef IEEE
-static const UEMUSHORT DFbignan[4] = {0x7fff, 0xffff, 0xffff, 0xffff};
-static const UEMUSHORT DFlittlenan[4] = {0, 0, 0, 0xfff8};
-#endif
-#endif
+const struct real_format ieee_quad =
+ {
+ encode_ieee_quad,
+ decode_ieee_quad,
+ 2,
+ 1,
+ 113,
+ -16382,
+ 16384,
+ true,
+ true,
+ true,
+ true,
+ true
+ };
-#ifdef SFMODE_NAN
-SFMODE_NAN;
-#else
-#ifdef IEEE
-static const UEMUSHORT SFbignan[2] = {0x7fff, 0xffff};
-static const UEMUSHORT SFlittlenan[2] = {0, 0xffc0};
-#endif
-#endif
+\f
+/* The VAX floating point formats. */
+static void encode_vax_f PARAMS ((const struct real_format *fmt,
+ long *, const struct real_value *));
+static void decode_vax_f PARAMS ((const struct real_format *,
+ struct real_value *, const long *));
+static void encode_vax_d PARAMS ((const struct real_format *fmt,
+ long *, const struct real_value *));
+static void decode_vax_d PARAMS ((const struct real_format *,
+ struct real_value *, const long *));
+static void encode_vax_g PARAMS ((const struct real_format *fmt,
+ long *, const struct real_value *));
+static void decode_vax_g PARAMS ((const struct real_format *,
+ struct real_value *, const long *));
-#ifdef NANS
static void
-make_nan (nan, sign, mode)
- UEMUSHORT *nan;
- int sign;
- enum machine_mode mode;
+encode_vax_f (fmt, buf, r)
+ const struct real_format *fmt ATTRIBUTE_UNUSED;
+ long *buf;
+ const struct real_value *r;
{
- int n;
- const UEMUSHORT *p;
- int size;
-
- size = GET_MODE_BITSIZE (mode);
- if (LARGEST_EXPONENT_IS_NORMAL (size))
- {
- warning ("%d-bit floats cannot hold NaNs", size);
- saturate (nan, sign, size, 0);
- return;
- }
- switch (mode)
- {
-/* Possibly the `reserved operand' patterns on a VAX can be
- used like NaN's, but probably not in the same way as IEEE. */
-#if !defined(DEC) && !defined(IBM) && !defined(C4X)
- case TFmode:
-#if (INTEL_EXTENDED_IEEE_FORMAT == 0)
- n = 8;
- if (REAL_WORDS_BIG_ENDIAN)
- p = TFbignan;
- else
- p = TFlittlenan;
- break;
-#endif
- /* FALLTHRU */
+ unsigned long sign, exp, sig, image;
- case XFmode:
- n = 6;
- if (REAL_WORDS_BIG_ENDIAN)
- p = XFbignan;
- else
- p = XFlittlenan;
- break;
+ sign = r->sign << 15;
- case DFmode:
- n = 4;
- if (REAL_WORDS_BIG_ENDIAN)
- p = DFbignan;
- else
- p = DFlittlenan;
+ switch (r->class)
+ {
+ case rvc_zero:
+ image = 0;
break;
- case SFmode:
- case HFmode:
- n = 2;
- if (REAL_WORDS_BIG_ENDIAN)
- p = SFbignan;
- else
- p = SFlittlenan;
+ case rvc_inf:
+ case rvc_nan:
+ image = 0xffff7fff | sign;
break;
-#endif
-
- default:
- abort ();
- }
- if (REAL_WORDS_BIG_ENDIAN)
- *nan++ = (sign << 15) | (*p++ & 0x7fff);
- while (--n != 0)
- *nan++ = *p++;
- if (! REAL_WORDS_BIG_ENDIAN)
- *nan = (sign << 15) | (*p & 0x7fff);
-}
-#endif /* NANS */
+ case rvc_normal:
+ sig = (r->sig[SIGSZ-1] >> (HOST_BITS_PER_LONG - 24)) & 0x7fffff;
+ exp = r->exp + 128;
-/* Create a saturation value for a SIZE-bit float, assuming that
- LARGEST_EXPONENT_IS_NORMAL (SIZE).
+ image = (sig << 16) & 0xffff0000;
+ image |= sign;
+ image |= exp << 7;
+ image |= sig >> 16;
+ break;
+ }
- If SIGN is true, fill X with the most negative value, otherwise fill
- it with the most positive value. WARN is true if the function should
- warn about overflow. */
+ buf[0] = image;
+}
static void
-saturate (x, sign, size, warn)
- UEMUSHORT *x;
- int sign, size, warn;
+decode_vax_f (fmt, r, buf)
+ const struct real_format *fmt ATTRIBUTE_UNUSED;
+ struct real_value *r;
+ const long *buf;
{
- int i;
+ unsigned long image = buf[0] & 0xffffffff;
+ int exp = (image >> 7) & 0xff;
- if (warn && extra_warnings)
- warning ("value exceeds the range of a %d-bit float", size);
+ memset (r, 0, sizeof (*r));
- /* Create the most negative value. */
- for (i = 0; i < size / EMUSHORT_SIZE; i++)
- x[i] = 0xffff;
+ if (exp != 0)
+ {
+ r->class = rvc_normal;
+ r->sign = (image >> 15) & 1;
+ r->exp = exp - 128;
- /* Make it positive, if necessary. */
- if (!sign)
- x[REAL_WORDS_BIG_ENDIAN? 0 : i - 1] = 0x7fff;
+ image = ((image & 0x7f) << 16) | ((image >> 16) & 0xffff);
+ r->sig[SIGSZ-1] = (image << (HOST_BITS_PER_LONG - 24)) | SIG_MSB;
+ }
}
-
-/* This is the inverse of the function `etarsingle' invoked by
- REAL_VALUE_TO_TARGET_SINGLE. */
-
-REAL_VALUE_TYPE
-ereal_unto_float (f)
- long f;
+static void
+encode_vax_d (fmt, buf, r)
+ const struct real_format *fmt ATTRIBUTE_UNUSED;
+ long *buf;
+ const struct real_value *r;
{
- REAL_VALUE_TYPE r;
- UEMUSHORT s[2];
- UEMUSHORT e[NE];
+ unsigned long image0, image1, sign = r->sign << 15;
- /* Convert 32 bit integer to array of 16 bit pieces in target machine order.
- This is the inverse operation to what the function `endian' does. */
- if (REAL_WORDS_BIG_ENDIAN)
- {
- s[0] = (UEMUSHORT) (f >> 16);
- s[1] = (UEMUSHORT) f;
- }
- else
+ switch (r->class)
{
- s[0] = (UEMUSHORT) f;
- s[1] = (UEMUSHORT) (f >> 16);
- }
- /* Convert and promote the target float to E-type. */
- e24toe (s, e);
- /* Output E-type to REAL_VALUE_TYPE. */
- PUT_REAL (e, &r);
- return r;
-}
+ case rvc_zero:
+ image0 = image1 = 0;
+ break;
+ case rvc_inf:
+ case rvc_nan:
+ image0 = 0xffff7fff | sign;
+ image1 = 0xffffffff;
+ break;
-/* This is the inverse of the function `etardouble' invoked by
- REAL_VALUE_TO_TARGET_DOUBLE. */
+ case rvc_normal:
+ /* Extract the significand into straight hi:lo. */
+ if (HOST_BITS_PER_LONG == 64)
+ {
+ image0 = r->sig[SIGSZ-1];
+ image1 = (image0 >> (64 - 56)) & 0xffffffff;
+ image0 = (image0 >> (64 - 56 + 1) >> 31) & 0x7fffff;
+ }
+ else
+ {
+ image0 = r->sig[SIGSZ-1];
+ image1 = r->sig[SIGSZ-2];
+ image1 = (image0 << 24) | (image1 >> 8);
+ image0 = (image0 >> 8) & 0xffffff;
+ }
-REAL_VALUE_TYPE
-ereal_unto_double (d)
- long d[];
-{
- REAL_VALUE_TYPE r;
- UEMUSHORT s[4];
- UEMUSHORT e[NE];
+ /* Rearrange the half-words of the significand to match the
+ external format. */
+ image0 = ((image0 << 16) | (image0 >> 16)) & 0xffff007f;
+ image1 = ((image1 << 16) | (image1 >> 16)) & 0xffffffff;
- /* Convert array of HOST_WIDE_INT to equivalent array of 16-bit pieces. */
- if (REAL_WORDS_BIG_ENDIAN)
- {
- s[0] = (UEMUSHORT) (d[0] >> 16);
- s[1] = (UEMUSHORT) d[0];
- s[2] = (UEMUSHORT) (d[1] >> 16);
- s[3] = (UEMUSHORT) d[1];
+ /* Add the sign and exponent. */
+ image0 |= sign;
+ image0 |= (r->exp + 128) << 7;
+ break;
}
+
+ if (FLOAT_WORDS_BIG_ENDIAN)
+ buf[0] = image1, buf[1] = image0;
else
- {
- /* Target float words are little-endian. */
- s[0] = (UEMUSHORT) d[0];
- s[1] = (UEMUSHORT) (d[0] >> 16);
- s[2] = (UEMUSHORT) d[1];
- s[3] = (UEMUSHORT) (d[1] >> 16);
- }
- /* Convert target double to E-type. */
- e53toe (s, e);
- /* Output E-type to REAL_VALUE_TYPE. */
- PUT_REAL (e, &r);
- return r;
+ buf[0] = image0, buf[1] = image1;
}
-
-/* Convert an SFmode target `float' value to a REAL_VALUE_TYPE.
- This is somewhat like ereal_unto_float, but the input types
- for these are different. */
-
-REAL_VALUE_TYPE
-ereal_from_float (f)
- HOST_WIDE_INT f;
+static void
+decode_vax_d (fmt, r, buf)
+ const struct real_format *fmt ATTRIBUTE_UNUSED;
+ struct real_value *r;
+ const long *buf;
{
- REAL_VALUE_TYPE r;
- UEMUSHORT s[2];
- UEMUSHORT e[NE];
+ unsigned long image0, image1;
+ int exp;
- /* Convert 32 bit integer to array of 16 bit pieces in target machine order.
- This is the inverse operation to what the function `endian' does. */
- if (REAL_WORDS_BIG_ENDIAN)
- {
- s[0] = (UEMUSHORT) (f >> 16);
- s[1] = (UEMUSHORT) f;
- }
+ if (FLOAT_WORDS_BIG_ENDIAN)
+ image1 = buf[0], image0 = buf[1];
else
- {
- s[0] = (UEMUSHORT) f;
- s[1] = (UEMUSHORT) (f >> 16);
- }
- /* Convert and promote the target float to E-type. */
- e24toe (s, e);
- /* Output E-type to REAL_VALUE_TYPE. */
- PUT_REAL (e, &r);
- return r;
-}
+ image0 = buf[0], image1 = buf[1];
+ image0 &= 0xffffffff;
+ image1 &= 0xffffffff;
+ exp = (image0 >> 7) & 0x7f;
-/* Convert a DFmode target `double' value to a REAL_VALUE_TYPE.
- This is somewhat like ereal_unto_double, but the input types
- for these are different.
+ memset (r, 0, sizeof (*r));
- The DFmode is stored as an array of HOST_WIDE_INT in the target's
- data format, with no holes in the bit packing. The first element
- of the input array holds the bits that would come first in the
- target computer's memory. */
+ if (exp != 0)
+ {
+ r->class = rvc_normal;
+ r->sign = (image0 >> 15) & 1;
+ r->exp = exp - 128;
-REAL_VALUE_TYPE
-ereal_from_double (d)
- HOST_WIDE_INT d[];
-{
- REAL_VALUE_TYPE r;
- UEMUSHORT s[4];
- UEMUSHORT e[NE];
+ /* Rearrange the half-words of the external format into
+ proper ascending order. */
+ image0 = ((image0 & 0x7f) << 16) | ((image0 >> 16) & 0xffff);
+ image1 = ((image1 & 0xffff) << 16) | ((image1 >> 16) & 0xffff);
- /* Convert array of HOST_WIDE_INT to equivalent array of 16-bit pieces. */
- if (REAL_WORDS_BIG_ENDIAN)
- {
-#if HOST_BITS_PER_WIDE_INT == 32
- s[0] = (UEMUSHORT) (d[0] >> 16);
- s[1] = (UEMUSHORT) d[0];
- s[2] = (UEMUSHORT) (d[1] >> 16);
- s[3] = (UEMUSHORT) d[1];
-#else
- /* In this case the entire target double is contained in the
- first array element. The second element of the input is
- ignored. */
- s[0] = (UEMUSHORT) (d[0] >> 48);
- s[1] = (UEMUSHORT) (d[0] >> 32);
- s[2] = (UEMUSHORT) (d[0] >> 16);
- s[3] = (UEMUSHORT) d[0];
-#endif
- }
- else
- {
- /* Target float words are little-endian. */
- s[0] = (UEMUSHORT) d[0];
- s[1] = (UEMUSHORT) (d[0] >> 16);
-#if HOST_BITS_PER_WIDE_INT == 32
- s[2] = (UEMUSHORT) d[1];
- s[3] = (UEMUSHORT) (d[1] >> 16);
-#else
- s[2] = (UEMUSHORT) (d[0] >> 32);
- s[3] = (UEMUSHORT) (d[0] >> 48);
-#endif
+ if (HOST_BITS_PER_LONG == 64)
+ {
+ image0 = (image0 << 31 << 1) | image1;
+ image0 <<= 64 - 56;
+ image0 |= SIG_MSB;
+ r->sig[SIGSZ-1] = image0;
+ }
+ else
+ {
+ r->sig[SIGSZ-1] = image0;
+ r->sig[SIGSZ-2] = image1;
+ lshift_significand (r, r, 2*HOST_BITS_PER_LONG - 56);
+ r->sig[SIGSZ-1] |= SIG_MSB;
+ }
}
- /* Convert target double to E-type. */
- e53toe (s, e);
- /* Output E-type to REAL_VALUE_TYPE. */
- PUT_REAL (e, &r);
- return r;
}
-
-#if 0
-/* Convert target computer unsigned 64-bit integer to e-type.
- The endian-ness of DImode follows the convention for integers,
- so we use WORDS_BIG_ENDIAN here, not REAL_WORDS_BIG_ENDIAN. */
-
static void
-uditoe (di, e)
- const UEMUSHORT *di; /* Address of the 64-bit int. */
- UEMUSHORT *e;
+encode_vax_g (fmt, buf, r)
+ const struct real_format *fmt ATTRIBUTE_UNUSED;
+ long *buf;
+ const struct real_value *r;
{
- UEMUSHORT yi[NI];
- int k;
+ unsigned long image0, image1, sign = r->sign << 15;
- ecleaz (yi);
- if (WORDS_BIG_ENDIAN)
- {
- for (k = M; k < M + 4; k++)
- yi[k] = *di++;
- }
- else
+ switch (r->class)
{
- for (k = M + 3; k >= M; k--)
- yi[k] = *di++;
+ case rvc_zero:
+ image0 = image1 = 0;
+ break;
+
+ case rvc_inf:
+ case rvc_nan:
+ image0 = 0xffff7fff | sign;
+ image1 = 0xffffffff;
+ break;
+
+ case rvc_normal:
+ /* Extract the significand into straight hi:lo. */
+ if (HOST_BITS_PER_LONG == 64)
+ {
+ image0 = r->sig[SIGSZ-1];
+ image1 = (image0 >> (64 - 53)) & 0xffffffff;
+ image0 = (image0 >> (64 - 53 + 1) >> 31) & 0xfffff;
+ }
+ else
+ {
+ image0 = r->sig[SIGSZ-1];
+ image1 = r->sig[SIGSZ-2];
+ image1 = (image0 << 21) | (image1 >> 11);
+ image0 = (image0 >> 11) & 0xfffff;
+ }
+
+ /* Rearrange the half-words of the significand to match the
+ external format. */
+ image0 = ((image0 << 16) | (image0 >> 16)) & 0xffff000f;
+ image1 = ((image1 << 16) | (image1 >> 16)) & 0xffffffff;
+
+ /* Add the sign and exponent. */
+ image0 |= sign;
+ image0 |= (r->exp + 1024) << 4;
+ break;
}
- yi[E] = EXONE + 47; /* exponent if normalize shift count were 0 */
- if ((k = enormlz (yi)) > NBITS)/* normalize the significand */
- ecleaz (yi); /* it was zero */
+
+ if (FLOAT_WORDS_BIG_ENDIAN)
+ buf[0] = image1, buf[1] = image0;
else
- yi[E] -= (UEMUSHORT) k;/* subtract shift count from exponent */
- emovo (yi, e);
+ buf[0] = image0, buf[1] = image1;
}
-/* Convert target computer signed 64-bit integer to e-type. */
-
static void
-ditoe (di, e)
- const UEMUSHORT *di; /* Address of the 64-bit int. */
- UEMUSHORT *e;
+decode_vax_g (fmt, r, buf)
+ const struct real_format *fmt ATTRIBUTE_UNUSED;
+ struct real_value *r;
+ const long *buf;
{
- unsigned EMULONG acc;
- UEMUSHORT yi[NI];
- UEMUSHORT carry;
- int k, sign;
+ unsigned long image0, image1;
+ int exp;
- ecleaz (yi);
- if (WORDS_BIG_ENDIAN)
- {
- for (k = M; k < M + 4; k++)
- yi[k] = *di++;
- }
+ if (FLOAT_WORDS_BIG_ENDIAN)
+ image1 = buf[0], image0 = buf[1];
else
+ image0 = buf[0], image1 = buf[1];
+ image0 &= 0xffffffff;
+ image1 &= 0xffffffff;
+
+ exp = (image0 >> 4) & 0x7ff;
+
+ memset (r, 0, sizeof (*r));
+
+ if (exp != 0)
{
- for (k = M + 3; k >= M; k--)
- yi[k] = *di++;
- }
- /* Take absolute value */
- sign = 0;
- if (yi[M] & 0x8000)
- {
- sign = 1;
- carry = 0;
- for (k = M + 3; k >= M; k--)
+ r->class = rvc_normal;
+ r->sign = (image0 >> 15) & 1;
+ r->exp = exp - 1024;
+
+ /* Rearrange the half-words of the external format into
+ proper ascending order. */
+ image0 = ((image0 & 0xf) << 16) | ((image0 >> 16) & 0xffff);
+ image1 = ((image1 & 0xffff) << 16) | ((image1 >> 16) & 0xffff);
+
+ if (HOST_BITS_PER_LONG == 64)
{
- acc = (unsigned EMULONG) (~yi[k] & 0xffff) + carry;
- yi[k] = acc;
- carry = 0;
- if (acc & 0x10000)
- carry = 1;
+ image0 = (image0 << 31 << 1) | image1;
+ image0 <<= 64 - 53;
+ image0 |= SIG_MSB;
+ r->sig[SIGSZ-1] = image0;
}
- }
- yi[E] = EXONE + 47; /* exponent if normalize shift count were 0 */
- if ((k = enormlz (yi)) > NBITS)/* normalize the significand */
- ecleaz (yi); /* it was zero */
- else
- yi[E] -= (UEMUSHORT) k;/* subtract shift count from exponent */
- emovo (yi, e);
- if (sign)
- eneg (e);
-}
+ else
+ {
+ r->sig[SIGSZ-1] = image0;
+ r->sig[SIGSZ-2] = image1;
+ lshift_significand (r, r, 64 - 53);
+ r->sig[SIGSZ-1] |= SIG_MSB;
+ }
+ }
+}
+
+const struct real_format vax_f_format =
+ {
+ encode_vax_f,
+ decode_vax_f,
+ 2,
+ 1,
+ 24,
+ -127,
+ 127,
+ false,
+ false,
+ false,
+ false,
+ false
+ };
+
+const struct real_format vax_d_format =
+ {
+ encode_vax_d,
+ decode_vax_d,
+ 2,
+ 1,
+ 56,
+ -127,
+ 127,
+ false,
+ false,
+ false,
+ false,
+ false
+ };
+
+const struct real_format vax_g_format =
+ {
+ encode_vax_g,
+ decode_vax_g,
+ 2,
+ 1,
+ 53,
+ -1023,
+ 1023,
+ false,
+ false,
+ false,
+ false,
+ false
+ };
+
+\f
+/* The IBM S/390 floating point formats. A good reference for these can
+ be found in chapter 9 of "ESA/390 Principles of Operation", IBM document
+ number SA22-7201-01. An on-line version can be found here:
+ http://publibz.boulder.ibm.com/cgi-bin/bookmgr_OS390/BOOKS/DZ9AR001/9.1?DT=19930923083613
+*/
-/* Convert e-type to unsigned 64-bit int. */
+static void encode_i370_single PARAMS ((const struct real_format *fmt,
+ long *, const struct real_value *));
+static void decode_i370_single PARAMS ((const struct real_format *,
+ struct real_value *, const long *));
+static void encode_i370_double PARAMS ((const struct real_format *fmt,
+ long *, const struct real_value *));
+static void decode_i370_double PARAMS ((const struct real_format *,
+ struct real_value *, const long *));
static void
-etoudi (x, i)
- const UEMUSHORT *x;
- UEMUSHORT *i;
+encode_i370_single (fmt, buf, r)
+ const struct real_format *fmt ATTRIBUTE_UNUSED;
+ long *buf;
+ const struct real_value *r;
{
- UEMUSHORT xi[NI];
- int j, k;
+ unsigned long sign, exp, sig, image;
- emovi (x, xi);
- if (xi[0])
- {
- xi[M] = 0;
- goto noshift;
- }
- k = (int) xi[E] - (EXONE - 1);
- if (k <= 0)
+ sign = r->sign << 31;
+
+ switch (r->class)
{
- for (j = 0; j < 4; j++)
- *i++ = 0;
- return;
+ case rvc_zero:
+ image = 0;
+ break;
+
+ case rvc_inf:
+ case rvc_nan:
+ image = 0x7fffffff | sign;
+ break;
+
+ case rvc_normal:
+ sig = (r->sig[SIGSZ-1] >> (HOST_BITS_PER_LONG - 24)) & 0xffffff;
+ exp = ((r->exp / 4) + 64) << 24;
+ image = sign | exp | sig;
+ break;
}
- if (k > 64)
+
+ buf[0] = image;
+}
+
+static void
+decode_i370_single (fmt, r, buf)
+ const struct real_format *fmt ATTRIBUTE_UNUSED;
+ struct real_value *r;
+ const long *buf;
+{
+ unsigned long sign, sig, image = buf[0];
+ int exp;
+
+ sign = (image >> 31) & 1;
+ exp = (image >> 24) & 0x7f;
+ sig = image & 0xffffff;
+
+ memset (r, 0, sizeof (*r));
+
+ if (exp || sig)
{
- for (j = 0; j < 4; j++)
- *i++ = 0xffff;
- if (extra_warnings)
- warning ("overflow on truncation to integer");
- return;
+ r->class = rvc_normal;
+ r->sign = sign;
+ r->exp = (exp - 64) * 4;
+ r->sig[SIGSZ-1] = sig << (HOST_BITS_PER_LONG - 24);
+ normalize (r);
}
- if (k > 16)
+}
+
+static void
+encode_i370_double (fmt, buf, r)
+ const struct real_format *fmt ATTRIBUTE_UNUSED;
+ long *buf;
+ const struct real_value *r;
+{
+ unsigned long sign, exp, image_hi, image_lo;
+
+ sign = r->sign << 31;
+
+ switch (r->class)
{
- /* Shift more than 16 bits: first shift up k-16 mod 16,
- then shift up by 16's. */
- j = k - ((k >> 4) << 4);
- if (j == 0)
- j = 16;
- eshift (xi, j);
- if (WORDS_BIG_ENDIAN)
- *i++ = xi[M];
- else
+ case rvc_zero:
+ image_hi = image_lo = 0;
+ break;
+
+ case rvc_inf:
+ case rvc_nan:
+ image_hi = 0x7fffffff | sign;
+ image_lo = 0xffffffff;
+ break;
+
+ case rvc_normal:
+ if (HOST_BITS_PER_LONG == 64)
{
- i += 3;
- *i-- = xi[M];
+ image_hi = r->sig[SIGSZ-1];
+ image_lo = (image_hi >> (64 - 56)) & 0xffffffff;
+ image_hi = (image_hi >> (64 - 56 + 1) >> 31) & 0xffffff;
}
- k -= j;
- do
+ else
{
- eshup6 (xi);
- if (WORDS_BIG_ENDIAN)
- *i++ = xi[M];
- else
- *i-- = xi[M];
+ image_hi = r->sig[SIGSZ-1];
+ image_lo = r->sig[SIGSZ-2];
+ image_lo = (image_lo >> 8) | (image_hi << 24);
+ image_hi >>= 8;
}
- while ((k -= 16) > 0);
+
+ exp = ((r->exp / 4) + 64) << 24;
+ image_hi |= sign | exp;
+ break;
}
+
+ if (FLOAT_WORDS_BIG_ENDIAN)
+ buf[0] = image_hi, buf[1] = image_lo;
else
- {
- /* shift not more than 16 bits */
- eshift (xi, k);
+ buf[0] = image_lo, buf[1] = image_hi;
+}
+
+static void
+decode_i370_double (fmt, r, buf)
+ const struct real_format *fmt ATTRIBUTE_UNUSED;
+ struct real_value *r;
+ const long *buf;
+{
+ unsigned long sign, image_hi, image_lo;
+ int exp;
+
+ if (FLOAT_WORDS_BIG_ENDIAN)
+ image_hi = buf[0], image_lo = buf[1];
+ else
+ image_lo = buf[0], image_hi = buf[1];
+
+ sign = (image_hi >> 31) & 1;
+ exp = (image_hi >> 24) & 0x7f;
+ image_hi &= 0xffffff;
+ image_lo &= 0xffffffff;
-noshift:
+ memset (r, 0, sizeof (*r));
+
+ if (exp || image_hi || image_lo)
+ {
+ r->class = rvc_normal;
+ r->sign = sign;
+ r->exp = (exp - 64) * 4 + (SIGNIFICAND_BITS - 56);
- if (WORDS_BIG_ENDIAN)
+ if (HOST_BITS_PER_LONG == 32)
{
- i += 3;
- *i-- = xi[M];
- *i-- = 0;
- *i-- = 0;
- *i = 0;
+ r->sig[0] = image_lo;
+ r->sig[1] = image_hi;
}
else
- {
- *i++ = xi[M];
- *i++ = 0;
- *i++ = 0;
- *i = 0;
- }
- }
-}
+ r->sig[0] = image_lo | (image_hi << 31 << 1);
+
+ normalize (r);
+ }
+}
+
+const struct real_format i370_single =
+ {
+ encode_i370_single,
+ decode_i370_single,
+ 16,
+ 4,
+ 6,
+ -64,
+ 63,
+ false,
+ false,
+ false, /* ??? The encoding does allow for "unnormals". */
+ false, /* ??? The encoding does allow for "unnormals". */
+ false
+ };
+
+const struct real_format i370_double =
+ {
+ encode_i370_double,
+ decode_i370_double,
+ 16,
+ 4,
+ 14,
+ -64,
+ 63,
+ false,
+ false,
+ false, /* ??? The encoding does allow for "unnormals". */
+ false, /* ??? The encoding does allow for "unnormals". */
+ false
+ };
+\f
+/* TMS320C[34]x twos complement floating point format. */
-/* Convert e-type to signed 64-bit int. */
+static void encode_c4x_single PARAMS ((const struct real_format *fmt,
+ long *, const struct real_value *));
+static void decode_c4x_single PARAMS ((const struct real_format *,
+ struct real_value *, const long *));
+static void encode_c4x_extended PARAMS ((const struct real_format *fmt,
+ long *, const struct real_value *));
+static void decode_c4x_extended PARAMS ((const struct real_format *,
+ struct real_value *, const long *));
static void
-etodi (x, i)
- const UEMUSHORT *x;
- UEMUSHORT *i;
+encode_c4x_single (fmt, buf, r)
+ const struct real_format *fmt ATTRIBUTE_UNUSED;
+ long *buf;
+ const struct real_value *r;
{
- unsigned EMULONG acc;
- UEMUSHORT xi[NI];
- UEMUSHORT carry;
- UEMUSHORT *isave;
- int j, k;
-
- emovi (x, xi);
- k = (int) xi[E] - (EXONE - 1);
- if (k <= 0)
- {
- for (j = 0; j < 4; j++)
- *i++ = 0;
- return;
- }
- if (k > 64)
- {
- for (j = 0; j < 4; j++)
- *i++ = 0xffff;
- if (extra_warnings)
- warning ("overflow on truncation to integer");
- return;
- }
- isave = i;
- if (k > 16)
+ unsigned long image, exp, sig;
+
+ switch (r->class)
{
- /* Shift more than 16 bits: first shift up k-16 mod 16,
- then shift up by 16's. */
- j = k - ((k >> 4) << 4);
- if (j == 0)
- j = 16;
- eshift (xi, j);
- if (WORDS_BIG_ENDIAN)
- *i++ = xi[M];
- else
- {
- i += 3;
- *i-- = xi[M];
- }
- k -= j;
- do
+ case rvc_zero:
+ exp = -128;
+ sig = 0;
+ break;
+
+ case rvc_inf:
+ case rvc_nan:
+ exp = 127;
+ sig = 0x800000 - r->sign;
+ break;
+
+ case rvc_normal:
+ exp = r->exp - 1;
+ sig = (r->sig[SIGSZ-1] >> (HOST_BITS_PER_LONG - 24)) & 0x7fffff;
+ if (r->sign)
{
- eshup6 (xi);
- if (WORDS_BIG_ENDIAN)
- *i++ = xi[M];
+ if (sig)
+ sig = -sig;
else
- *i-- = xi[M];
+ exp--;
+ sig |= 0x800000;
}
- while ((k -= 16) > 0);
+ break;
}
- else
+
+ image = ((exp & 0xff) << 24) | (sig & 0xffffff);
+ buf[0] = image;
+}
+
+static void
+decode_c4x_single (fmt, r, buf)
+ const struct real_format *fmt ATTRIBUTE_UNUSED;
+ struct real_value *r;
+ const long *buf;
+{
+ unsigned long image = buf[0];
+ unsigned long sig;
+ int exp, sf;
+
+ exp = (((image >> 24) & 0xff) ^ 0x80) - 0x80;
+ sf = ((image & 0xffffff) ^ 0x800000) - 0x800000;
+
+ memset (r, 0, sizeof (*r));
+
+ if (exp != -128)
{
- /* shift not more than 16 bits */
- eshift (xi, k);
+ r->class = rvc_normal;
- if (WORDS_BIG_ENDIAN)
- {
- i += 3;
- *i = xi[M];
- *i-- = 0;
- *i-- = 0;
- *i = 0;
- }
- else
+ sig = sf & 0x7fffff;
+ if (sf < 0)
{
- *i++ = xi[M];
- *i++ = 0;
- *i++ = 0;
- *i = 0;
+ r->sign = 1;
+ if (sig)
+ sig = -sig;
+ else
+ exp++;
}
+ sig = (sig << (HOST_BITS_PER_LONG - 24)) | SIG_MSB;
+
+ r->exp = exp + 1;
+ r->sig[SIGSZ-1] = sig;
}
- /* Negate if negative */
- if (xi[0])
+}
+
+static void
+encode_c4x_extended (fmt, buf, r)
+ const struct real_format *fmt ATTRIBUTE_UNUSED;
+ long *buf;
+ const struct real_value *r;
+{
+ unsigned long exp, sig;
+
+ switch (r->class)
{
- carry = 0;
- if (WORDS_BIG_ENDIAN)
- isave += 3;
- for (k = 0; k < 4; k++)
+ case rvc_zero:
+ exp = -128;
+ sig = 0;
+ break;
+
+ case rvc_inf:
+ case rvc_nan:
+ exp = 127;
+ sig = 0x80000000 - r->sign;
+ break;
+
+ case rvc_normal:
+ exp = r->exp - 1;
+
+ sig = r->sig[SIGSZ-1];
+ if (HOST_BITS_PER_LONG == 64)
+ sig = sig >> 1 >> 31;
+ sig &= 0x7fffffff;
+
+ if (r->sign)
{
- acc = (unsigned EMULONG) (~(*isave) & 0xffff) + carry;
- if (WORDS_BIG_ENDIAN)
- *isave-- = acc;
+ if (sig)
+ sig = -sig;
else
- *isave++ = acc;
- carry = 0;
- if (acc & 0x10000)
- carry = 1;
+ exp--;
+ sig |= 0x80000000;
}
+ break;
}
-}
-
-/* Longhand square root routine. */
+ exp = (exp & 0xff) << 24;
+ sig &= 0xffffffff;
-
-static int esqinited = 0;
-static unsigned short sqrndbit[NI];
+ if (FLOAT_WORDS_BIG_ENDIAN)
+ buf[0] = exp, buf[1] = sig;
+ else
+ buf[0] = sig, buf[0] = exp;
+}
static void
-esqrt (x, y)
- const UEMUSHORT *x;
- UEMUSHORT *y;
+decode_c4x_extended (fmt, r, buf)
+ const struct real_format *fmt ATTRIBUTE_UNUSED;
+ struct real_value *r;
+ const long *buf;
{
- UEMUSHORT temp[NI], num[NI], sq[NI], xx[NI];
- EMULONG m, exp;
- int i, j, k, n, nlups;
+ unsigned long sig;
+ int exp, sf;
- if (esqinited == 0)
- {
- ecleaz (sqrndbit);
- sqrndbit[NI - 2] = 1;
- esqinited = 1;
- }
- /* Check for arg <= 0 */
- i = ecmp (x, ezero);
- if (i <= 0)
+ if (FLOAT_WORDS_BIG_ENDIAN)
+ exp = buf[0], sf = buf[1];
+ else
+ sf = buf[0], exp = buf[1];
+
+ exp = (((exp >> 24) & 0xff) & 0x80) - 0x80;
+ sf = ((sf & 0xffffffff) ^ 0x80000000) - 0x80000000;
+
+ memset (r, 0, sizeof (*r));
+
+ if (exp != -128)
{
- if (i == -1)
+ r->class = rvc_normal;
+
+ sig = sf & 0x7fffffff;
+ if (sf < 0)
{
- mtherr ("esqrt", DOMAIN);
- eclear (y);
- }
- else
- emov (x, y);
- return;
- }
+ r->sign = 1;
+ if (sig)
+ sig = -sig;
+ else
+ exp++;
+ }
+ if (HOST_BITS_PER_LONG == 64)
+ sig = sig << 1 << 31;
+ sig |= SIG_MSB;
+
+ r->exp = exp + 1;
+ r->sig[SIGSZ-1] = sig;
+ }
+}
+
+const struct real_format c4x_single =
+ {
+ encode_c4x_single,
+ decode_c4x_single,
+ 2,
+ 1,
+ 24,
+ -126,
+ 128,
+ false,
+ false,
+ false,
+ false,
+ false
+ };
+
+const struct real_format c4x_extended =
+ {
+ encode_c4x_extended,
+ decode_c4x_extended,
+ 2,
+ 1,
+ 32,
+ -126,
+ 128,
+ false,
+ false,
+ false,
+ false,
+ false
+ };
-#ifdef INFINITY
- if (eisinf (x))
- {
- eclear (y);
- einfin (y);
- return;
- }
+\f
+/* Initialize things at start of compilation. */
+
+static const struct real_format * format_for_size PARAMS ((int));
+
+static const struct real_format *
+format_for_size (size)
+ int size;
+{
+#ifndef TARGET_G_FORMAT
+#define TARGET_G_FORMAT 0
#endif
- /* Bring in the arg and renormalize if it is denormal. */
- emovi (x, xx);
- m = (EMULONG) xx[1]; /* local long word exponent */
- if (m == 0)
- m -= enormlz (xx);
-
- /* Divide exponent by 2 */
- m -= 0x3ffe;
- exp = (unsigned short) ((m / 2) + 0x3ffe);
-
- /* Adjust if exponent odd */
- if ((m & 1) != 0)
+
+ switch (TARGET_FLOAT_FORMAT)
{
- if (m > 0)
- exp += 1;
- eshdn1 (xx);
- }
+ case IEEE_FLOAT_FORMAT:
+ switch (size)
+ {
+ case 32:
+ return &ieee_single;
- ecleaz (sq);
- ecleaz (num);
- n = 8; /* get 8 bits of result per inner loop */
- nlups = rndprc;
- j = 0;
+ case 64:
+ return &ieee_double;
- while (nlups > 0)
- {
- /* bring in next word of arg */
- if (j < NE)
- num[NI - 1] = xx[j + 3];
- /* Do additional bit on last outer loop, for roundoff. */
- if (nlups <= 8)
- n = nlups + 1;
- for (i = 0; i < n; i++)
+ case 96:
+ if (!INTEL_EXTENDED_IEEE_FORMAT)
+ return &ieee_extended_motorola;
+ else
+ return &ieee_extended_intel_96;
+
+ case 128:
+ if (!INTEL_EXTENDED_IEEE_FORMAT)
+ return &ieee_quad;
+ else
+ return &ieee_extended_intel_128;
+ }
+ break;
+
+ case VAX_FLOAT_FORMAT:
+ switch (size)
{
- /* Next 2 bits of arg */
- eshup1 (num);
- eshup1 (num);
- /* Shift up answer */
- eshup1 (sq);
- /* Make trial divisor */
- for (k = 0; k < NI; k++)
- temp[k] = sq[k];
- eshup1 (temp);
- eaddm (sqrndbit, temp);
- /* Subtract and insert answer bit if it goes in */
- if (ecmpm (temp, num) <= 0)
- {
- esubm (temp, num);
- sq[NI - 2] |= 1;
- }
+ case 32:
+ return &vax_f_format;
+
+ case 64:
+ if (TARGET_G_FORMAT)
+ return &vax_g_format;
+ else
+ return &vax_d_format;
}
- nlups -= n;
- j += 1;
- }
+ break;
- /* Adjust for extra, roundoff loop done. */
- exp += (NBITS - 1) - rndprc;
+ case IBM_FLOAT_FORMAT:
+ switch (size)
+ {
+ case 32:
+ return &i370_single;
+ case 64:
+ return &i370_double;
+ }
+ break;
- /* Sticky bit = 1 if the remainder is nonzero. */
- k = 0;
- for (i = 3; i < NI; i++)
- k |= (int) num[i];
+ case C4X_FLOAT_FORMAT:
+ switch (size)
+ {
+ case 32:
+ return &c4x_single;
+ case 64:
+ return &c4x_extended;
+ }
+ break;
+ }
- /* Renormalize and round off. */
- emdnorm (sq, k, 0, exp, !ROUND_TOWARDS_ZERO);
- emovo (sq, y);
+ abort ();
}
-#endif
-\f
-/* Return the binary precision of the significand for a given
- floating point mode. The mode can hold an integer value
- that many bits wide, without losing any bits. */
-unsigned int
-significand_size (mode)
- enum machine_mode mode;
+void
+init_real_once ()
{
+ int i;
- /* Don't test the modes, but their sizes, lest this
- code won't work for BITS_PER_UNIT != 8 . */
-
- switch (GET_MODE_BITSIZE (mode))
+ /* Set up the mode->format table. */
+ for (i = 0; i < 3; ++i)
{
- case 32:
+ enum machine_mode mode;
+ int size;
-#ifdef C4X
- return 56;
-#else
- return 24;
-#endif
-
- case 64:
-#ifdef IEEE
- return 53;
-#else
- return 56;
-#endif
-
- case 96:
- return 64;
+ if (i == 0)
+ size = FLOAT_TYPE_SIZE;
+ else if (i == 1)
+ size = DOUBLE_TYPE_SIZE;
+ else
+ size = LONG_DOUBLE_TYPE_SIZE;
- case 128:
-#if (INTEL_EXTENDED_IEEE_FORMAT == 0)
- return 113;
-#else
- return 64;
-#endif
+ mode = mode_for_size (size, MODE_FLOAT, 0);
+ if (mode == BLKmode)
+ abort ();
- default:
- abort ();
+ fmt_for_mode[mode - QFmode] = format_for_size (size);
}
}
projects / gcc.git / commitdiff