Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/misc/volume10/config42

Text File | 1990-02-13 | 65.4 KB | 2,315 lines

Newsgroups: comp.sources.misc
organization: CWI, Amsterdam
subject: v10i062: config.c v4.2, Everything you wanted to know about your C compiler (and more)
from: [e-mail] (Steven Pemberton)
Sender: [e-mail] (Brandon S. Allbery - comp.sources.misc)

Posting-number: Volume 10, Issue 62
Submitted-by: [e-mail] (Steven Pemberton)
Archive-name: config42

Here is the latest version of config.c, a program that finds out all
sorts of properties of your machine and C compiler. It will also
optionally produce the ANSI C float.h and limits.h files for you.

All documentation is in the file itself.

Steven Pemberton, CWI, Amsterdam; [e-mail]
"Let us go then you and I/while the night is laid out against the sky/like a
                    smear of mustard on an old pork pie"
"Nice poem Tom. I have suggestions for changes though, why not come over?"- Ez.

-----------------CUT HERE-------------------------
: This is a shell archive.
: Extract with 'sh this_file'.
echo 'Start of pack.out, part 01 out of 01:'
if test -s 'config.c'
then echo '*** I will not over-write existing file config.c'
else
echo 'x - config.c'
sed 's/^X//' > 'config.c' << 'EOF'
X/* Everything you wanted to know about your machine and C compiler,
X   but didn't know who to ask. */
X
X#ifndef VERSION
X#define VERSION "4.2"
X#endif
X
X/* Author: Steven Pemberton, CWI, Amsterdam; [e-mail]
X   Bugfixes and upgrades gratefully received.
X
X   Copyright (c) 1988, 1989, 1990 Steven Pemberton, CWI, Amsterdam.
X   All rights reserved.
X
X   COMPILING
X   With luck and a following wind, just the following will work:
X    cc config.c -o config
X   You may get some messages about unreachable code. This is OK.
X
X   If your compiler doesn't support:        add flag:
X    signed char (eg pcc)            -DNO_SC
X    unsigned char                -DNO_UC
X    unsigned short and long            -DNO_UI
X    void                    -DNO_VOID
X    signal(), or setjmp/longjmp()        -DNO_SIG
X
X   Try to compile first with no flags, and see if you get any errors -
X   you might be surprised. (Most non-ANSI compilers need -DNO_SC, though.)
X   Some compilers need a -f flag for floating point.
X
X   If your C preprocessor doesn't have the predefined __FILE__ macro, and
X   you don't want to call this file config.c but, say, params.c, add the
X   flag -D__FILE__=\"params.c\" .
X
X   Some naughty compilers define __STDC__, but don't really support it
X   (typically they define __STDC__ as 0). If this is the case for you,
X   add flag -DNO_STDC. (To those compiler writers: for shame).
X
X   Some bad compilers won't accept the line "#include __FILE__" or
X   "#ifdef __FILE__". Add flag -DNO_FILE. In that case, this file *must*
X   be called config.c.
X
X   Don't use any optimisation flags: the program may not work if you do.
X   Though "while (a+1.0-a-1.0 == 0.0)" may look like "while(1)" to an
X   optimiser, to a floating-point unit there's a world of difference.
X
X   Some compilers offer various flags for different floating point
X   modes; it's worth trying all possible combinations of these.
X
X   Add -DID=\"name\" if you want the machine/flags identified in the output.
X
X   While it is not our policy to support defective compilers, pity has been
X   taken on people with compilers that can't produce object files bigger than
X   32k (especially since it was an easy addition). Compile the program
X   into separate parts like this:
X       cc -DSEP -DPASS0 -o p0.o <other flags> config.c
X       cc -DSEP -DPASS1 -o p1.o <other flags> config.c
X       cc -DSEP -DPASS2 -o p2.o <other flags> config.c
X       cc -DSEP -DPASS3 -o p3.o <other flags> config.c
X       cc -o config p0.o p1.o p2.o p3.o
X
X   SYSTEM DEPENDENCIES
X   You may possibly need to add some calls to signal() for other sorts of
X   exception on your machine than SIGFPE, and SIGOVER.  See lines beginning
X   #ifdef SIGxxx in main() (and communicate the differences to me!).
X
X   OUTPUT
X   Run without argument to get the information as English text.  If run
X   with argument -l (e.g. config -l), output is a series of #define's for
X   the ANSI standard limits.h include file, excluding MB_MAX_CHAR.  If run
X   with argument -f, output is a series of #define's for the ANSI standard
X   float.h include file (according to ANSI C Draft of May 13, 1988).
X   Flag -v gives verbose output: output includes the English text above
X   as C comments.  The program exit(0)'s if everything went ok, otherwise
X   it exits with a positive number, telling how many problems there were.
X
X   VERIFYING THE COMPILER
X   If, having produced the float.h and limits.h header files, you want to
X   verify that the compiler reads them back correctly (there are a lot of
X   boundary cases, of course, like minimum and maximum numbers), you can
X   recompile config.c with -DVERIFY set (plus the other flags that you used
X   when compiling the version that produced the header files).  This then
X   recompiles the program so that it #includes "limits.h" and "float.h",
X   and checks that the constants it finds there are the same as the
X   constants it produces. Run the resulting program with config -fl.
X   Very few compilers have passed without error.
X
X   You can also use this option if your compiler already has both files,
X   and you want to confirm that this program produces the right results.
X
X   TROUBLESHOOTING.
X   This program is now quite trustworthy, and suspicious and wrong output
X   may well be caused by bugs in the compiler, not in the program (however
X   of course, this is not guaranteed, and no responsibility can be
X   accepted, etc.)
X
X   The program only works if overflows are ignored by the C system or
X   are catchable with signal().
X
X   If the program fails to run to completion (often with the error message
X   "Unexpected signal at point x"), this often turns out to be a bug in the
X   C compiler's run-time system. Check what was about to be printed, and
X   try to narrow the problem down.
X
X   Another possible problem is that you have compiled the program to produce
X   loss-of-precision arithmetic traps. The program cannot cope with these,
X   and you should re-compile without them. (They should never be the default).
X
X   Make sure you compiled with optimisation turned off.
X
X   Output preceded by *** WARNING: identifies behaviour of the C system
X   deemed incorrect by the program. Likely problems are that printf or
X   scanf don't cope properly with certain boundary numbers: this program
X   goes to a lot of trouble to calculate its values, and these values
X   are mostly boundary numbers.  Experience has shown that often printf
X   cannot cope with these values, and so in an attempt to increase
X   confidence in the output, for each float and double that is printed,
X   the printed value is checked by using sscanf to read it back.
X   Care is taken that numbers are printed with enough digits to uniquely
X   identify them, and therefore that they can be read back identically.
X   If the number read back is different, then there is probably a bug in
X   printf or sscanf, and the program prints the warning message.
X   If the two numbers in the warning look identical, then printf is more
X   than likely rounding the last digit(s) incorrectly. To put you at ease
X   that the two really are different, the bit patterns of the two numbers
X   are also printed.  The difference is very likely in the last bit.
X   Many scanf's read the minimum double back as 0.0, and similarly cause
X   overflow when reading the maximum double.  The program quite ruthlessly
X   declares all these behaviours faulty. The point is that if you get
X   one of these warnings, the output may be wrong, so you should check
X   the result carefully if you intend to use the results. Of course, printf
X   and sscanf may both be wrong, and cancel each other out, so you should
X   check the output carefully anyway.
X
X   The warning that "a cast didn't work" refers to cases like this:
X
X      float f;
X      #define C 1.234567890123456789
X      f= C;
X      if (f != (float) C) printf ("Wrong!");
X
X   A faulty compiler will widen f to double and ignore the cast to float,
X   and because there is more accuracy in a double than a float, fail to
X   recognise that they are the same. In the actual case in point, f and C
X   are passed as parameters to a function that discovers they are not equal,
X   so it's just possible that the error was in the parameter passing,
X   not in the cast (see function Validate()).
X   For ANSI C, which has float constants, the error message is "constant has
X   wrong precision".
X
X   REPORTING PROBLEMS
X   If the program doesn't work for you for any reason that can't be
X   narrowed down to a problem in the C compiler, or it has to be changed in
X   order to get it to compile, or it produces suspicious output (like a very
X   low maximum float, for instance), please mail the problem and an example
X   of the incorrect output to [e-mail] or ..!hp4nl!cwi.nl!steven, so that
X   improvements can be worked into future versions; cwi.nl is the European
X   backbone, and is connected to uunet and other fine hosts.
X
X   The program tries to catch and diagnose bugs in the compiler/run-time
X   system. I would be especially pleased to have reports of failures so
X   that I can improve this service.
X
X   I apologise unreservedly for the contorted use of the preprocessor...
X
X   THE SMALL PRINT
X   You may copy and distribute verbatim copies of this source file.
X
X   You may modify this source file, and copy and distribute such
X   modified versions, provided that you leave the copyright notice
X   at the top of the file and also cause the modified file to carry
X   prominent notices stating that you changed the files and the date
X   of any change; and cause the whole of any work that you distribute
X   or publish, that in whole or in part contains or is a derivative of
X   this program or any part thereof, to be licensed at no charge to
X   all third parties on terms identical to those here.
X
X   If you do have a fix to any problem, please send it to me, so that
X   other people can have the benefits.
X
X   While every effort has been taken to make this program as reliable as
X   possible, no responsibility can be taken for the correctness of the
X   output, or suitability for any particular use.
X
X   ACKNOWLEDGEMENTS
X   Many people have given time and ideas to making this program what it is.
X   To all of them thanks, and apologies for not mentioning them by name.
X
X   HISTORY
X   4.0 Added -f and -l options, and warnings
X   4.1 Added VERIFY
X   4.2 Added SEP
X       Fixed eps/epsneg
X       Added check for pseudo-unsigned chars
X       Added description for each #define output
X       Added check for absence of defines during verify
X       Added prototypes
X       Added NO_STDC and NO_FILE
X       Fixed alignments output
X*/
X
X#ifndef NO_FILE
X#ifndef __FILE__
X#define __FILE__ "config.c"
X#endif
X#endif
X
X/* If PASS isn't defined, then this is the first pass over this file. */
X#ifndef PASS
X#ifndef SEP
X#define PASS 1
X#define PASS0 1
X#define PASS1 1
X#endif /* SEP */
X
X/* A description of the ANSI constants */
X#define D_CHAR_BIT "Number of bits in a storage unit"
X#define D_CHAR_MAX "Maximum char"
X#define D_CHAR_MIN "Minimum char"
X#define D_SCHAR_MAX "Maximum signed char"
X#define D_SCHAR_MIN "Minimum signed char"
X#define D_UCHAR_MAX "Maximum unsigned char (minimum is always 0)"
X
X#define D_INT_MAX "Maximum %s"
X#define D_INT_MIN "Minimum %s"
X#define D_UINT_MAX "Maximum unsigned %s (minimum is always 0)"
X
X#define D_FLT_ROUNDS "Addition rounds to 0: zero, 1: nearest, 2: +inf, 3: -inf, -1: unknown"
X#define D_FLT_RADIX "Radix of exponent representation"
X#define D_MANT_DIG "Number of base-FLT_RADIX digits in the mantissa of a %s"
X#define D_DIG "Number of decimal digits of precision in a %s"
X#define D_MIN_EXP "Minimum int x such that FLT_RADIX**(x-1) is a normalised %s"
X#define D_MIN_10_EXP "Minimum int x such that 10**x is a normalised %s"
X#define D_MAX_EXP "Maximum int x such that FLT_RADIX**(x-1) is a representable %s"
X#define D_MAX_10_EXP "Maximum int x such that 10**x is a representable %s"
X#define D_MAX "Maximum %s"
X#define D_EPSILON "Minimum %s x such that 1.0+x != 1.0"
X#define D_MIN "Minimum normalised %s"
X
X/* Procedure just marks the functions that don't return a result */
X#ifdef NO_VOID
X#define Procedure int
X#else
X#define Procedure void
X#endif
X
X/* Some bad compilers define __STDC__, when they don't support it.
X   Compile with -DNO_STDC to get round this.
X*/
X#ifndef NO_STDC
X#ifdef __STDC__
X#define STDC
X#endif
X#endif
X
X/* Stuff different for ANSI C, and old C:
X   ARGS and NOARGS are used for function prototypes.
X   Volatile is used to reduce the chance of optimisation,
X      and to prevent variables being put in registers (when setjmp/longjmp
X      wouldn't work as we want)
X   Long_double is the longest floating point type available.
X   stdc is used in tests like "if (stdc)", which is less ugly than #ifdef.
X   U is output after unsigned constants.
X */
X#ifdef STDC
X
X#define ARGS(x) x
X#define NOARGS (void)
X#define Volatile volatile
X#define Long_double long double
X#define stdc 1
X#define U "U"
X
X#else /* Old style C */
X
X#define ARGS(x) ()
X#define NOARGS ()
X#define Volatile static
X#define Long_double double
X#define stdc 0
X#define U ""
X
X#endif /* STDC */
X
X/* include files */
X#include <stdio.h>
X
X#ifdef NO_SIG
X#define jmp_buf int
X#else
X#include <signal.h>
X#include <setjmp.h>
X#endif
X
X#ifdef VERIFY
X#include "limits.h"
X#include "float.h"
X#endif
X
X#define Vprintf if (V) printf
X#define Unexpected(place) if (setjmp(lab)!=0) croak(place)
X#define fabs(x) (((x)<0.0)?(-x):(x))
X
X#endif /* PASS */
X
X#ifdef PASS0
X
X/* Prototypes for what's to come: */
X
Xchar *malloc ARGS((unsigned size));
XProcedure exit ARGS((int status));
X
Xchar *f_rep ARGS((int precision, Long_double val));
X
Xint cprop NOARGS;
Xint basic NOARGS;
XProcedure sprop NOARGS;
XProcedure iprop NOARGS;
XProcedure lprop NOARGS;
XProcedure usprop NOARGS;
XProcedure uiprop NOARGS;
XProcedure ulprop NOARGS;
Xint fprop ARGS((int bits_per_byte));
Xint dprop ARGS((int bits_per_byte));
Xint ldprop ARGS((int bits_per_byte));
XProcedure efprop ARGS((int fprec, int dprec, int lprec));
XProcedure edprop ARGS((int fprec, int dprec, int lprec));
XProcedure eldprop ARGS((int fprec, int dprec, int lprec));
X
Xint setmode ARGS((char *s));
XProcedure farewell ARGS((int bugs));
XProcedure describe ARGS((char *description, char *extra));
XProcedure check_defines NOARGS;
XProcedure bitpattern ARGS((char *p, unsigned int size));
Xint ceil_log ARGS((int base, Long_double x));
XProcedure croak ARGS((int place));
XProcedure eek_a_bug ARGS((char *problem));
XProcedure endian ARGS((int bits_per_byte));
Xint exponent ARGS((Long_double x, double *fract, int *exp));
Xint floor_log ARGS((int base, Long_double x));
XProcedure f_define ARGS((char *desc, char *extra, char *sort, char *name,
X             int prec, Long_double val, char *mark));
XProcedure i_define ARGS((char *desc, char *extra, char *sort, char *name,
X             long val, long req, char *mark));
XProcedure u_define ARGS((char *desc, char *extra, char *sort, char *name,
X             unsigned long val, unsigned long req, char *mark));
X
X#ifdef NO_SIG  /* There's no signal(), or setjmp/longjmp() */
X
X    /* Dummy routines instead */
X
X    Procedure setjmp ARGS((int lab));
X
X    int lab=1;
X    int setjmp(lab) int lab; { return(0); }
X    Procedure signal(i, p) int i, (*p)(); {}
X
X#else
X    jmp_buf lab;
X    Procedure overflow(sig) int sig; { /* what to do on over/underflow */
X        signal(sig, overflow);
X        longjmp(lab, 1);
X    }
X
X#endif /*NO_SIG*/
X
Xint V= 0,    /* verbose */
X    L= 0,    /* produce limits.h */
X    F= 0,    /* produce float.h  */
X    bugs=0;    /* The number of (possible) bugs in the output */
X
Xchar co[4], oc[4]; /* Comment starter and ender symbols */
X
Xint bits_per_byte; /* the number of bits per unit returned by sizeof() */
Xint flt_rounds;    /* The calculated value of FLT_ROUNDS */
Xint flt_radix;     /* The calculated value of FLT_RADIX */
X
X#ifdef TEST
X/* Set the fp modes on a SUN with 68881 chip, to check that different
X   rounding modes etc. get properly detected.
X   Compile with additional flag -DTEST, and run with additional parameter
X   +hex-number, to set the 68881 mode register to hex-number
X*/
X
X/* Bits 0x30 = rounding mode: */
X#define ROUND_BITS    0x30
X#define TO_NEAREST    0x00
X#define TO_ZERO        0x10
X#define TO_MINUS_INF    0x20
X#define TO_PLUS_INF    0x30 /* The SUN FP user's guide seems to be wrong here */
X
X/* Bits 0xc0 = extended rounding: */
X#define EXT_BITS    0xc0
X#define ROUND_EXTENDED    0x00
X#define ROUND_SINGLE     0x40
X#define ROUND_DOUBLE    0x80
X
X/* Enabled traps: */
X#define EXE_INEX1  0x100
X#define EXE_INEX2  0x200
X#define EXE_DZ       0x400
X#define EXE_UNFL   0x800
X#define EXE_OVFL  0x1000
X#define EXE_OPERR 0x2000
X#define EXE_SNAN  0x4000
X#define EXE_BSUN  0x8000
X
X/* Only used for testing, on a Sun with 68881 chip */
X/* Print the FP mode */
Xprintmode(new) unsigned new; {
X    fpmode_(&new);
X    printf("New fp mode:\n");
X    printf("  Round toward ");
X    switch (new & ROUND_BITS) {
X          case TO_NEAREST:   printf("nearest"); break;
X          case TO_ZERO:      printf("zero"); break;
X          case TO_MINUS_INF: printf("minus infinity"); break;
X          case TO_PLUS_INF:  printf("plus infinity"); break;
X          default: printf("???"); break;
X    }
X
X    printf("\n  Extended rounding precision: ");
X
X    switch (new & EXT_BITS) {
X          case ROUND_EXTENDED: printf("extended"); break;
X          case ROUND_SINGLE:   printf("single"); break;
X          case ROUND_DOUBLE:   printf("double"); break;
X          default: printf("???"); break;
X    }
X
X    printf("\n  Enabled exceptions:");
X    if (new & (unsigned) EXE_INEX1) printf(" inex1");
X    if (new & (unsigned) EXE_INEX2) printf(" inex2");
X    if (new & (unsigned) EXE_DZ)    printf(" dz");
X    if (new & (unsigned) EXE_UNFL)  printf(" unfl");
X    if (new & (unsigned) EXE_OVFL)  printf(" ovfl");
X    if (new & (unsigned) EXE_OPERR) printf(" operr");
X    if (new & (unsigned) EXE_SNAN)  printf(" snan");
X    if (new & (unsigned) EXE_BSUN)  printf(" bsun");
X    printf("\n");
X}
X
X/* Only used for testing, on a Sun with 68881 chip */
X/* Set the FP mode */
Xint setmode(s) char *s; {
X    unsigned mode=0, dig;
X    char c;
X
X    while (*s) {
X        c= *s++;
X        if  (c>='0' && c<='9') dig= c-'0';
X        else if (c>='a' && c<='f') dig= c-'a'+10;
X        else if (c>='A' && c<='F') dig= c-'A'+10;
X        else return 1;
X        mode= mode<<4 | dig;
X    }
X    printmode(mode);
X    return 0;
X}
X#else
Xint setmode(s) char *s; {
X    fprintf(stderr, "Can't set mode: not compiled with TEST\n");
X    return(1);
X}
X#endif
X
XProcedure farewell(bugs) int bugs; {
X    if (bugs > 0) {
X        printf("\n%sFor hints on dealing with the problems above", co);
X        printf("\n   see the section 'TROUBLESHOOTING' in the file ");
X        printf("%s%s\n", __FILE__, oc);
X    }
X    exit(bugs);
X}
X
X/* The program has received a signal where it wasn't expecting one */
XProcedure croak(place) int place; {
X    printf("*** Unexpected signal at point %d\n", place);
X    farewell(bugs+1); /* An exit isn't essential here, but avoids loops */
X}
X
Xmain(argc, argv) int argc; char *argv[]; {
X    int dprec, fprec, lprec;
X    unsigned int size;
X    long total;
X    int i; char *s; int bad;
X
X#ifdef SIGFPE
X    signal(SIGFPE, overflow);
X#endif
X#ifdef SIGOVER
X    signal(SIGOVER, overflow);
X#endif
X/* Add more calls as necessary */
X
X    Unexpected(1);
X
X    bad=0;
X    for (i=1; i < argc; i++) {
X        s= argv[i];
X        if (*s == '-') {
X            s++;
X            while (*s) {
X                switch (*(s++)) {
X                      case 'v': V=1; break;
X                      case 'l': L=1; break;
X                      case 'f': F=1; break;
X                      default: bad=1; break;
X                }
X            }
X        } else if (*s == '+') {
X            s++;
X            bad= setmode(s);
X        } else bad= 1;
X    }
X    if (bad) {
X        fprintf(stderr,
X            "Usage: %s [-vlf]\n  v=Verbose l=Limits.h f=Float.h\n",
X            argv[0]);
X        exit(1);
X    }
X    if (L || F) {
X        co[0]= '/'; oc[0]= ' ';
X        co[1]= '*'; oc[1]= '*';
X        co[2]= ' '; oc[2]= '/';
X        co[3]= '\0'; oc[3]= '\0';
X    } else {
X        co[0]= '\0'; oc[0]= '\0';
X        V=1;
X    }
X
X    if (L) printf("%slimits.h%s\n", co, oc);
X    if (F) printf("%sfloat.h%s\n", co, oc);
X#ifdef ID
X    printf("%sProduced on %s by config version %s, CWI, Amsterdam%s\n",
X           co, ID, VERSION, oc);
X#else
X    printf("%sProduced by config version %s, CWI, Amsterdam%s\n",
X           co, VERSION, oc);
X#endif
X
X#ifdef VERIFY
X    printf("%sVerification phase%s\n", co, oc);
X#endif
X
X#ifdef NO_SIG
X    Vprintf("%sCompiled without signal(): %s%s\n",
X        co,
X        "there's nothing that can be done if overflow occurs",
X        oc);
X#endif
X#ifdef NO_SC
X    Vprintf("%sCompiled without signed char%s\n", co, oc);
X#endif
X#ifdef NO_UC
X    Vprintf("%Compiled without unsigned char%s\n", co, oc);
X#endif
X#ifdef NO_UI
X    Vprintf("%Compiled without unsigned short or long%s\n", co, oc);
X#endif
X#ifdef __STDC__
X    Vprintf("%sCompiler claims to be ANSI C level %d%s\n",
X        co, __STDC__, oc);
X#else
X    Vprintf("%sCompiler does not claim to be ANSI C%s\n", co, oc);
X#endif
X    printf("\n");
X    check_defines();
X
X    bits_per_byte= basic();
X    Vprintf("\n");
X    if (F||V) {
X        fprec= fprop(bits_per_byte);
X        dprec= dprop(bits_per_byte);
X        lprec= ldprop(bits_per_byte);
X        efprop(fprec, dprec, lprec);
X        edprop(fprec, dprec, lprec);
X        eldprop(fprec, dprec, lprec);
X    }
X    if (V) {
X        /* An extra goody: the approximate amount of data-space */
X        /* Allocate store until no more available */
X        size=1<<((bits_per_byte*sizeof(int))-2);
X        total=0;
X        while (size!=0) {
X            while (malloc(size)!=(char *)NULL) total+=(size/2);
X            size/=2;
X        }
X
X        Vprintf("%sMemory mallocatable ~= %ld Kbytes%s\n",
X            co, (total+511)/512, oc);
X    }
X    farewell(bugs);
X    return bugs; /* To keep compilers and lint happy */
X}
X
XProcedure eek_a_bug(problem) char *problem; {
X    /* The program has discovered a problem */
X    printf("\n%s*** WARNING: %s%s\n", co, problem, oc);
X    bugs++;
X}
X
XProcedure describe(description, extra) char *description, *extra; {
X    /* Produce the description for a #define */
X    printf("   %s", co);
X    printf(description, extra);
X    printf("%s\n", oc);
X}
X
XProcedure i_define(desc, extra, sort, name, val, req, mark)
X     char *desc, *extra, *sort, *name; long val, req; char *mark; {
X    /* Produce a #define for a signed int type */
X    describe(desc, extra);
X    if (val >= 0) {
X        printf("#define %s%s %ld%s\n", sort, name, val, mark);
X    } else {
X        printf("#define %s%s (%ld%s)\n", sort, name, val, mark);
X    }
X    if (val != req) {
X        printf("%s*** Verify failed for above #define!\n", co);
X        printf("       Compiler has %ld for value%s\n\n", req, oc);
X        bugs++;
X    }
X    Vprintf("\n");
X}
X
XProcedure u_define(desc, extra, sort, name, val, req, mark)
X     char *desc, *extra, *sort, *name; unsigned long val, req; char *mark; {
X    /* Produce a #define for an unsigned value */
X    describe(desc, extra);
X    printf("#define %s%s %lu%s%s\n", sort, name, val, U, mark);
X    if (val != req) {
X        printf("%s*** Verify failed for above #define!\n", co);
X        printf("       Compiler has %lu for value%s\n\n", req, oc);
X        bugs++;
X    }
X    Vprintf("\n");
X}
X
XProcedure f_define(desc, extra, sort, name, precision, val, mark)
X     char *desc, *extra, *sort, *name; int precision;
X     Long_double val; char *mark; {
X    /* Produce a #define for a float/double/long double */
X    describe(desc, extra);
X    if (stdc) {
X        printf("#define %s%s %s%s\n",
X               sort, name, f_rep(precision, val), mark);
X    } else if (*mark == 'F') {
X        /* non-ANSI C has no float constants, so cast the constant */
X        printf("#define %s%s ((float)%s)\n",
X               sort, name, f_rep(precision, val));
X    } else {
X        printf("#define %s%s %s\n", sort, name, f_rep(precision, val));
X    }
X    Vprintf("\n");
X}
X
Xint floor_log(base, x) int base; Long_double x; {
X    /* return floor(log base(x)) */
X    int r=0;
X    while (x>=base) { r++; x/=base; }
X    return r;
X}
X
Xint ceil_log(base, x) int base; Long_double x; {
X    int r=0;
X    while (x>1.0) { r++; x/=base; }
X    return r;
X}
X
Xint exponent(x, fract, exp) Long_double x; double *fract; int *exp; {
X    /* Split x into a fraction and a power of ten;
X       returns 0 if x is unusable, 1 otherwise.
X       Only used for error messages about faulty output.
X    */
X    int r=0, neg=0;
X    Long_double old;
X    *fract=0.0; *exp=0;
X    if (x<0.0) {
X        x= -x;
X        neg= 1;
X    }
X    if (x==0.0) return 1;
X    if (x>=10.0) {
X        while (x>=10.0) {
X            old=x; r++; x/=10.0;
X            if (old==x) return 0;
X        }
X    } else {
X        while (x<1.0) {
X            old=x; r--; x*=10.0;
X            if (old==x) return 0;
X        }
X    }
X    if (neg) *fract= -x;
X    else *fract=x;
X    *exp=r;
X    return 1;
X}
X
Xchar *f_rep(precision, val) int precision; Long_double val; {
X    /* Return the floating representation of val */
X    static char buf[1024];
X    char *f1;
X    if (sizeof(double) == sizeof(Long_double)) {
X        /* Assume they're the same, and use non-stdc format */
X        /* This is for stdc compilers using non-stdc libraries */
X        f1= "%.*e";
X    } else {
X        /* It had better support Le then */
X        f1= "%.*Le";
X    }
X    sprintf(buf, f1, precision, val);
X    return buf;
X}
X
XProcedure bitpattern(p, size) char *p; unsigned int size; {
X    /* Printf the bit-pattern of p */
X    char c;
X    int i, j;
X
X    for (i=1; i<=size; i++) {
X        c= *p;
X        p++;
X        for (j=bits_per_byte-1; j>=0; j--)
X            printf("%c", (c>>j)&1 ? '1' : '0');
X        if (i!=size) printf(" ");
X    }
X}
X
X#define Order(x, px, mode)\
X   printf("%s    %s ", co, mode); for (i=0; i<sizeof(x); i++) px[i]= c[i]; \
X   for (i=1; i<=sizeof(x); i++) { putchar((char)((x>>(bits_per_byte*(sizeof(x)-i)))&mask)); }\
X   printf("%s\n", oc);
X
XProcedure endian(bits_per_byte) int bits_per_byte; {
X    /* Printf the byte-order used on this machine */
X    /*unsigned*/ short s=0;
X    /*unsigned*/ int j=0;
X    /*unsigned*/ long l=0;
X
X    char *ps= (char *) &s,
X         *pj= (char *) &j,
X         *pl= (char *) &l,
X         *c= "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
X    unsigned int mask, i;
X
X    mask=0;
X    for (i=1; i<=(unsigned)bits_per_byte; i++) mask= (mask<<1)|1;
X
X    if (V) {
X        printf("%sCharacter order:%s\n", co, oc);
X        Order(s, ps, "short:");
X        Order(j, pj, "int:  ");
X        Order(l, pl, "long: ");
X    }
X}
X
XProcedure check_defines() {
X    /* ensure that all the #defines are present */
X#ifdef VERIFY
X    if (L) {
X#ifndef CHAR_BIT
X    printf("%s*** CHAR_BIT missing from limits.h%s\n", co, oc); bugs++;
X#endif
X#ifndef CHAR_MAX
X    printf("%s*** CHAR_MAX missing from limits.h%s\n", co, oc); bugs++;
X#endif
X#ifndef CHAR_MIN
X    printf("%s*** CHAR_MIN missing from limits.h%s\n", co, oc); bugs++;
X#endif
X#ifndef SCHAR_MAX
X    printf("%s*** SCHAR_MAX missing from limits.h%s\n", co, oc); bugs++;
X#endif
X#ifndef SCHAR_MIN
X    printf("%s*** SCHAR_MIN missing from limits.h%s\n", co, oc); bugs++;
X#endif
X#ifndef UCHAR_MAX
X    printf("%s*** UCHAR_MAX missing from limits.h%s\n", co, oc); bugs++;
X#endif
X#ifndef SHRT_MAX
X    printf("%s*** SHRT_MAX missing from limits.h%s\n", co, oc); bugs++;
X#endif
X#ifndef SHRT_MIN
X    printf("%s*** SHRT_MIN missing from limits.h%s\n", co, oc); bugs++;
X#endif
X#ifndef INT_MAX
X    printf("%s*** INT_MAX missing from limits.h%s\n", co, oc); bugs++;
X#endif
X#ifndef INT_MIN
X    printf("%s*** INT_MIN missing from limits.h%s\n", co, oc); bugs++;
X#endif
X#ifndef LONG_MAX
X    printf("%s*** LONG_MAX missing from limits.h%s\n", co, oc); bugs++;
X#endif
X#ifndef LONG_MIN
X    printf("%s*** LONG_MIN missing from limits.h%s\n", co, oc); bugs++;
X#endif
X#ifndef USHRT_MAX
X    printf("%s*** USHRT_MAX missing from limits.h%s\n", co, oc); bugs++;
X#endif
X#ifndef UINT_MAX
X    printf("%s*** UINT_MAX missing from limits.h%s\n", co, oc); bugs++;
X#endif
X#ifndef ULONG_MAX
X    printf("%s*** ULONG_MAX missing from limits.h%s\n", co, oc); bugs++;
X#endif
X    } /* if (L) */
X
X    if (F) {
X#ifndef FLT_RADIX
X    printf("%s*** FLT_RADIX missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef FLT_MANT_DIG
X    printf("%s*** FLT_MANT_DIG missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef FLT_DIG
X    printf("%s*** FLT_DIG missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef FLT_ROUNDS
X    printf("%s*** FLT_ROUNDS missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef FLT_EPSILON
X    printf("%s*** FLT_EPSILON missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef FLT_MIN_EXP
X    printf("%s*** FLT_MIN_EXP missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef FLT_MIN
X    printf("%s*** FLT_MIN missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef FLT_MIN_10_EXP
X    printf("%s*** FLT_MIN_10_EXP missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef FLT_MAX_EXP
X    printf("%s*** FLT_MAX_EXP missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef FLT_MAX
X    printf("%s*** FLT_MAX missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef FLT_MAX_10_EXP
X    printf("%s*** FLT_MAX_10_EXP missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef DBL_MANT_DIG
X    printf("%s*** DBL_MANT_DIG missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef DBL_DIG
X    printf("%s*** DBL_DIG missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef DBL_EPSILON
X    printf("%s*** DBL_EPSILON missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef DBL_MIN_EXP
X    printf("%s*** DBL_MIN_EXP missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef DBL_MIN
X    printf("%s*** DBL_MIN missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef DBL_MIN_10_EXP
X    printf("%s*** DBL_MIN_10_EXP missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef DBL_MAX_EXP
X    printf("%s*** DBL_MAX_EXP missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef DBL_MAX
X    printf("%s*** DBL_MAX missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef DBL_MAX_10_EXP
X    printf("%s*** DBL_MAX_10_EXP missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifdef STDC
X#ifndef LDBL_MANT_DIG
X    printf("%s*** LDBL_MANT_DIG missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef LDBL_DIG
X    printf("%s*** LDBL_DIG missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef LDBL_EPSILON
X    printf("%s*** LDBL_EPSILON missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef LDBL_MIN_EXP
X    printf("%s*** LDBL_MIN_EXP missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef LDBL_MIN
X    printf("%s*** LDBL_MIN missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef LDBL_MIN_10_EXP
X    printf("%s*** LDBL_MIN_10_EXP missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef LDBL_MAX_EXP
X    printf("%s*** LDBL_MAX_EXP missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef LDBL_MAX
X    printf("%s*** LDBL_MAX missing from float.h%s\n", co, oc); bugs++;
X#endif
X#ifndef LDBL_MAX_10_EXP
X    printf("%s*** LDBL_MAX_10_EXP missing from float.h%s\n", co, oc); bugs++;
X#endif
X#endif /* STDC */
X    } /* if (F) */
X#endif /* VERIFY */
X}
X
X#ifdef VERIFY
X#ifndef SCHAR_MAX
X#define SCHAR_MAX    char_max
X#endif
X#ifndef SCHAR_MIN
X#define SCHAR_MIN    char_min
X#endif
X#ifndef UCHAR_MAX
X#define UCHAR_MAX    char_max
X#endif
X#endif /* VERIFY */
X
X#ifndef CHAR_BIT
X#define CHAR_BIT    char_bit
X#endif
X#ifndef CHAR_MAX
X#define CHAR_MAX    char_max
X#endif
X#ifndef CHAR_MIN
X#define CHAR_MIN    char_min
X#endif
X#ifndef SCHAR_MAX
X#define SCHAR_MAX    char_max
X#endif
X#ifndef SCHAR_MIN
X#define SCHAR_MIN    char_min
X#endif
X#ifndef UCHAR_MAX
X#define UCHAR_MAX    char_max
X#endif
X
Xint cprop() {
X    /* Properties of type char */
X    Volatile char c, char_max, char_min;
X    Volatile int bits_per_byte, is_signed;
X    long char_bit;
X
X    Unexpected(2);
X
X    /* Calculate number of bits per character *************************/
X    c=1; bits_per_byte=0;
X    do { c=c<<1; bits_per_byte++; } while(c!=0);
X    c= (char)(-1);
X    if (((int)c)<0) is_signed=1;
X    else is_signed=0;
X    Vprintf("%sChar = %d bits, %ssigned%s\n",
X        co, (int)sizeof(c)*bits_per_byte, (is_signed?"":"un"), oc);
X    char_bit=(long)(sizeof(c)*bits_per_byte);
X    if (L) i_define(D_CHAR_BIT, "",
X            "CHAR", "_BIT", char_bit, (long) CHAR_BIT, "");
X
X    c=0; char_max=0;
X    c++;
X    if (setjmp(lab)==0) { /* Yields char_max */
X        while (c>char_max) {
X            char_max=c;
X            c++;
X        }
X    } else {
X        Vprintf("%sCharacter overflow generates a trap!%s\n", co, oc);
X    }
X    c=0; char_min=0;
X    c--;
X    if (setjmp(lab)==0) { /* Yields char_min */
X        while (c<char_min) {
X            char_min=c;
X            c--;
X        }
X    }
X    if (is_signed && char_min == 0) {
X        Vprintf("%sBEWARE! Chars are pseudo-unsigned:%s\n", co, oc);
X        Vprintf("%s   %s%s%s\n",
X            "They contain only nonnegative values, ",
X            "but sign extend when used as integers.", co, oc);
X    }
X    Unexpected(3);
X
X    if (L) {
X        i_define(D_CHAR_MAX, "",
X             "CHAR", "_MAX", (long) char_max, (long) CHAR_MAX, "");
X        i_define(D_CHAR_MIN, "",
X             "CHAR", "_MIN", (long) char_min, (long) CHAR_MIN, "");
X        if (is_signed) {
X            i_define(D_SCHAR_MAX, "",
X                 "SCHAR", "_MAX", (long) char_max,
X                 (long) SCHAR_MAX, "");
X            i_define(D_SCHAR_MIN, "",
X                 "SCHAR", "_MIN", (long) char_min,
X                 (long) SCHAR_MIN, "");
X        } else {
X            i_define(D_UCHAR_MAX, "",
X                 "UCHAR", "_MAX", (long) char_max,
X                 (long) UCHAR_MAX, "");
X        }
X
X        if (is_signed) {
X#ifndef NO_UC
X            Volatile unsigned char c, char_max;
X            c=0; char_max=0;
X            c++;
X            if (setjmp(lab)==0) { /* Yields char_max */
X                while (c>char_max) {
X                    char_max=c;
X                    c++;
X                }
X            }
X            Unexpected(4);
X            i_define(D_UCHAR_MAX, "",
X                 "UCHAR", "_MAX", (long) char_max,
X                 (long) UCHAR_MAX, "");
X#endif
X        } else {
X#ifndef NO_SC /* Define NO_SC if the next line gives a syntax error */
X            Volatile signed char c, char_max, char_min;
X            c=0; char_max=0;
X            c++;
X            if (setjmp(lab)==0) { /* Yields char_max */
X                while (c>char_max) {
X                    char_max=c;
X                    c++;
X                }
X            }
X            c=0; char_min=0;
X            c--;
X            if (setjmp(lab)==0) { /* Yields char_min */
X                while (c<char_min) {
X                    char_min=c;
X                    c--;
X                }
X            }
X            Unexpected(5);
X            i_define(D_SCHAR_MIN, "",
X                 "SCHAR", "_MIN", (long) char_min,
X                 (long) SCHAR_MIN, "");
X            i_define(D_SCHAR_MAX, "",
X                 "SCHAR", "_MAX", (long) char_max,
X                 (long) SCHAR_MAX, "");
X#endif /* NO_SC */
X        }
X    }
X    return bits_per_byte;
X}
X
Xint basic() {
X    /* The properties of the basic types.
X       Returns number of bits per sizeof unit */
X    Volatile int bits_per_byte;
X    struct{char i1; char c1;} schar;
X    struct{short i2; char c2;} sshort;
X    struct{int i3; char c3;} sint;
X    struct{long i4; char c4;} slong;
X
X    bits_per_byte= cprop();
X
X    /* Shorts, ints and longs *****************************************/
X    Vprintf("%sShort=%d int=%d long=%d float=%d double=%d bits %s\n",
X        co,
X        (int) sizeof(short)*bits_per_byte,
X        (int) sizeof(int)*bits_per_byte,
X        (int) sizeof(long)*bits_per_byte,
X        (int) sizeof(float)*bits_per_byte,
X        (int) sizeof(double)*bits_per_byte, oc);
X    if (stdc) {
X        Vprintf("%sLong double=%d bits%s\n",
X            co, (int) sizeof(Long_double)*bits_per_byte, oc);
X    }
X    Vprintf("%sChar pointers = %d bits%s%s\n",
X        co, (int)sizeof(char *)*bits_per_byte,
X        sizeof(char *)>sizeof(int)?" BEWARE! larger than int!":"",
X        oc);
X    Vprintf("%sInt pointers = %d bits%s%s\n",
X        co, (int)sizeof(int *)*bits_per_byte,
X        sizeof(int *)>sizeof(int)?" BEWARE! larger than int!":"",
X        oc);
X
X    /* Alignment constants ********************************************/
X    Vprintf("%sAlignments used for char=%ld short=%ld int=%ld long=%ld%s\n",
X        co,
X        ((long)&schar.c1)-((long)&schar.i1),
X        ((long)&sshort.c2)-((long)&sshort.i2),
X        ((long)&sint.c3)-((long)&sint.i3),
X        ((long)&slong.c4)-((long)&slong.i4),
X        oc);
X
X    /* Ten little endians *********************************************/
X
X    endian(bits_per_byte);
X
X    /* Pointers *******************************************************/
X    if (V) {
X        if ("abcd"=="abcd")
X            printf("%sStrings are shared%s\n", co, oc);
X        else printf("%sStrings are not shared%s\n", co, oc);
X    }
X
X    sprop();
X    iprop();
X    lprop();
X    usprop();
X    uiprop();
X    ulprop();
X
X    Unexpected(6);
X
X    return bits_per_byte;
X}
X
X#else /* not PASS0 */
X
X#ifdef SEP
Xextern jmp_buf lab;
Xextern int V, L, F, bugs, bits_per_byte;
Xextern char co[], oc[];
Xextern char *f_rep();
X#endif /* SEP */
X#endif /* ifdef PASS0 */
X
X/* As I said, I apologise for the contortions below. The functions are
X   expanded by the preprocessor twice or three times (for float and double,
X   and maybe for long double, and for short, int and long). That way,
X   I never make a change to one that I forget to make to the other.
X   You can look on it as C's fault for not supporting multi-line macro's.
X   This whole file is read 3 times by the preprocessor, with PASSn set for
X   n=1, 2 or 3, to decide which parts to reprocess.
X*/
X
X/* #undef on an already undefined thing is (wrongly) flagged as an error
X   by some compilers, therefore the #ifdef that follows:
X*/
X#ifdef Number
X#undef Number
X#undef THING
X#undef Thing
X#undef thing
X#undef FPROP
X#undef Fname
X#undef Store
X#undef Sum
X#undef Diff
X#undef Mul
X#undef Div
X#undef ZERO
X#undef HALF
X#undef ONE
X#undef TWO
X#undef THREE
X#undef FOUR
X#undef Self
X#undef F_check
X#undef Validate
X#undef EPROP
X#undef MARK
X
X/* These are the float.h constants */
X#undef F_RADIX
X#undef F_MANT_DIG
X#undef F_DIG
X#undef F_ROUNDS
X#undef F_EPSILON
X#undef F_MIN_EXP
X#undef F_MIN
X#undef F_MIN_10_EXP
X#undef F_MAX_EXP
X#undef F_MAX
X#undef F_MAX_10_EXP
X#endif
X
X#ifdef Integer
X#undef Integer
X#undef INT
X#undef IPROP
X#undef Iname
X#undef UPROP
X#undef Uname
X#undef OK_UI
X#undef IMARK
X
X#undef I_MAX
X#undef I_MIN
X#undef U_MAX
X#endif
X
X#ifdef PASS1
X
X/* Define the things we're going to use this pass */
X
X#define Number    float
X#define THING    "FLOAT"
X#define Thing    "Float"
X#define thing    "float"
X#define Fname    "FLT"
X#define FPROP    fprop
X#define Store    fStore
X#define Sum    fSum
X#define Diff    fDiff
X#define Mul    fMul
X#define Div    fDiv
X#define ZERO    0.0
X#define HALF    0.5
X#define ONE    1.0
X#define TWO    2.0
X#define THREE    3.0
X#define FOUR    4.0
X#define Self    fSelf
X#define F_check    fCheck
X#define MARK    "F"
X#ifdef VERIFY
X#define Validate(prec, val, req, same) fValidate(prec, val, req, same)
X#endif
X
X#define EPROP    efprop
X
X#define Integer    short
X#define INT    "short"
X#define IPROP    sprop
X#define Iname    "SHRT"
X#ifndef NO_UI
X#define OK_UI 1
X#endif
X#define IMARK    ""
X
X#define UPROP    usprop
X#define Uname    "USHRT"
X
X#ifdef VERIFY
X#ifdef SHRT_MAX
X#define I_MAX        SHRT_MAX
X#endif
X#ifdef SHRT_MIN
X#define I_MIN        SHRT_MIN
X#endif
X#ifdef USHRT_MAX
X#define U_MAX        USHRT_MAX
X#endif
X
X#ifdef FLT_RADIX
X#define F_RADIX        FLT_RADIX
X#endif
X#ifdef FLT_MANT_DIG
X#define F_MANT_DIG    FLT_MANT_DIG
X#endif
X#ifdef FLT_DIG
X#define F_DIG        FLT_DIG
X#endif
X#ifdef FLT_ROUNDS
X#define F_ROUNDS    FLT_ROUNDS
X#endif
X#ifdef FLT_EPSILON
X#define F_EPSILON    FLT_EPSILON
X#endif
X#ifdef FLT_MIN_EXP
X#define F_MIN_EXP    FLT_MIN_EXP
X#endif
X#ifdef FLT_MIN
X#define F_MIN        FLT_MIN
X#endif
X#ifdef FLT_MIN_10_EXP
X#define F_MIN_10_EXP    FLT_MIN_10_EXP
X#endif
X#ifdef FLT_MAX_EXP
X#define F_MAX_EXP    FLT_MAX_EXP
X#endif
X#ifdef FLT_MAX
X#define F_MAX        FLT_MAX
X#endif
X#ifdef FLT_MAX_10_EXP
X#define F_MAX_10_EXP    FLT_MAX_10_EXP
X#endif
X#endif /* VERIFY */
X
X#endif /* PASS1 */
X
X#ifdef PASS2
X
X#define Number    double
X#define THING    "DOUBLE"
X#define Thing    "Double"
X#define thing    "double"
X#define Fname    "DBL"
X#define FPROP    dprop
X#define Store    dStore
X#define Sum    dSum
X#define Diff    dDiff
X#define Mul    dMul
X#define Div    dDiv
X#define ZERO    0.0
X#define HALF    0.5
X#define ONE    1.0
X#define TWO    2.0
X#define THREE    3.0
X#define FOUR    4.0
X#define Self    dSelf
X#define F_check    dCheck
X#define MARK    ""
X#ifdef VERIFY
X#define Validate(prec, val, req, same) dValidate(prec, val, req, same)
X#endif
X
X#define EPROP    edprop
X
X#define Integer    int
X#define INT    "int"
X#define IPROP    iprop
X#define Iname    "INT"
X#define OK_UI    1 /* Unsigned int is always possible */
X#define IMARK    ""
X
X#define UPROP    uiprop
X#define Uname    "UINT"
X
X#ifdef VERIFY
X#ifdef INT_MAX
X#define I_MAX        INT_MAX
X#endif
X#ifdef INT_MIN
X#define I_MIN        INT_MIN
X#endif
X#ifdef UINT_MAX
X#define U_MAX        UINT_MAX
X#endif
X
X#ifdef DBL_MANT_DIG
X#define F_MANT_DIG    DBL_MANT_DIG
X#endif
X#ifdef DBL_DIG
X#define F_DIG        DBL_DIG
X#endif
X#ifdef DBL_EPSILON
X#define F_EPSILON    DBL_EPSILON
X#endif
X#ifdef DBL_MIN_EXP
X#define F_MIN_EXP    DBL_MIN_EXP
X#endif
X#ifdef DBL_MIN
X#define F_MIN        DBL_MIN
X#endif
X#ifdef DBL_MIN_10_EXP
X#define F_MIN_10_EXP    DBL_MIN_10_EXP
X#endif
X#ifdef DBL_MAX_EXP
X#define F_MAX_EXP    DBL_MAX_EXP
X#endif
X#ifdef DBL_MAX
X#define F_MAX        DBL_MAX
X#endif
X#ifdef DBL_MAX_10_EXP
X#define F_MAX_10_EXP    DBL_MAX_10_EXP
X#endif
X#endif /* VERIFY */
X
X#endif /* PASS2 */
X
X#ifdef PASS3
X
X#ifdef STDC
X#define Number    long double
X#endif
X
X#define THING    "LONG DOUBLE"
X#define Thing    "Long double"
X#define thing    "long double"
X#define Fname    "LDBL"
X#define FPROP    ldprop
X#define Store    ldStore
X#define Sum    ldSum
X#define Diff    ldDiff
X#define Mul    ldMul
X#define Div    ldDiv
X#define ZERO    0.0L
X#define HALF    0.5L
X#define ONE    1.0L
X#define TWO    2.0L
X#define THREE    3.0L
X#define FOUR    4.0L
X#define Self    ldSelf
X#define F_check    ldCheck
X#define MARK    "L"
X#ifdef VERIFY
X#define Validate(prec, val, req, same) ldValidate(prec, val, req, same)
X#endif
X
X#define EPROP    eldprop
X
X#define Integer    long
X#define INT    "long"
X#define IPROP    lprop
X#define Iname    "LONG"
X#ifndef NO_UI
X#define OK_UI    1
X#endif
X#define IMARK    "L"
X
X#define UPROP    ulprop
X#define Uname    "ULONG"
X
X#ifdef VERIFY
X#ifdef LONG_MAX
X#define I_MAX    LONG_MAX
X#endif
X#ifdef LONG_MIN
X#define I_MIN    LONG_MIN
X#endif
X#ifdef ULONG_MAX
X#define U_MAX    ULONG_MAX
X#endif
X
X#ifdef LDBL_MANT_DIG
X#define F_MANT_DIG    LDBL_MANT_DIG
X#endif
X#ifdef LDBL_DIG
X#define F_DIG        LDBL_DIG
X#endif
X#ifdef LDBL_EPSILON
X#define F_EPSILON    LDBL_EPSILON
X#endif
X#ifdef LDBL_MIN_EXP
X#define F_MIN_EXP    LDBL_MIN_EXP
X#endif
X#ifdef LDBL_MIN
X#define F_MIN        LDBL_MIN
X#endif
X#ifdef LDBL_MIN_10_EXP
X#define F_MIN_10_EXP    LDBL_MIN_10_EXP
X#endif
X#ifdef LDBL_MAX_EXP
X#define F_MAX_EXP    LDBL_MAX_EXP
X#endif
X#ifdef LDBL_MAX
X#define F_MAX        LDBL_MAX
X#endif
X#ifdef LDBL_MAX_10_EXP
X#define F_MAX_10_EXP    LDBL_MAX_10_EXP
X#endif
X#endif /* VERIFY */
X
X#endif /* PASS3 */
X
X#ifndef I_MAX
X#define I_MAX    int_max
X#endif
X#ifndef I_MIN
X#define I_MIN    int_min
X#endif
X#ifndef U_MAX
X#define U_MAX    int_max
X#endif
X
X#ifndef F_RADIX
X#define F_RADIX        f_radix
X#endif
X#ifndef F_MANT_DIG
X#define F_MANT_DIG    f_mant_dig
X#endif
X#ifndef F_DIG
X#define F_DIG        f_dig
X#endif
X#ifndef F_ROUNDS
X#define F_ROUNDS    f_rounds
X#endif
X#ifndef F_EPSILON
X#define F_EPSILON    f_epsilon
X#endif
X#ifndef F_MIN_EXP
X#define F_MIN_EXP    f_min_exp
X#endif
X#ifndef F_MIN
X#define F_MIN        f_min
X#endif
X#ifndef F_MIN_10_EXP
X#define F_MIN_10_EXP    f_min_10_exp
X#endif
X#ifndef F_MAX_EXP
X#define F_MAX_EXP    f_max_exp
X#endif
X#ifndef F_MAX
X#define F_MAX        f_max
X#endif
X#ifndef F_MAX_10_EXP
X#define F_MAX_10_EXP    f_max_10_exp
X#endif
X
X#ifndef VERIFY
X#define Validate(prec, val, req, same) {;}
X#endif
X
X#ifdef Integer
X
XProcedure IPROP() {
X    /* the properties of short, int, and long */
X    Volatile Integer newi, int_max, maxeri, int_min, minneri;
X    Volatile int ibits, ipower, two=2;
X
X    /* Calculate max short/int/long ***********************************/
X    /* Calculate 2**n-1 until overflow - then use the previous value  */
X
X    newi=1; int_max=0;
X
X    if (setjmp(lab)==0) { /* Yields int_max */
X        for(ipower=0; newi>int_max; ipower++) {
X            int_max=newi;
X            newi=newi*two+1;
X        }
X        Vprintf("%sOverflow of a%s %s does not generate a trap%s\n",
X            co, INT[0]=='i'?"n":"", INT, oc);
X    } else {
X        Vprintf("%sOverflow of a%s %s generates a trap%s\n",
X            co, INT[0]=='i'?"n":"", INT, oc);
X    }
X    Unexpected(7);
X
X    /* Minimum value: assume either two's or one's complement *********/
X    int_min= -int_max;
X    if (setjmp(lab)==0) { /* Yields int_min */
X        if (int_min-1 < int_min) int_min--;
X    }
X    Unexpected(8);
X
X    /* Now for those daft Cybers: */
X
X    maxeri=0; newi=int_max;
X
X    if (setjmp(lab)==0) { /* Yields maxeri */
X        for(ibits=ipower; newi>maxeri; ibits++) {
X            maxeri=newi;
X            newi=newi+newi+1;
X        }
X    }
X    Unexpected(9);
X
X    minneri= -maxeri;
X    if (setjmp(lab)==0) { /* Yields minneri */
X        if (minneri-1 < minneri) minneri--;
X    }
X    Unexpected(10);
X
X    Vprintf("%sMaximum %s = %ld (= 2**%d-1)%s\n",
X        co, INT, (long)int_max, ipower, oc);
X    Vprintf("%sMinimum %s = %ld%s\n", co, INT, (long)int_min, oc);
X
X    if (L) i_define(D_INT_MAX, INT,
X            Iname, "_MAX", (long) int_max, (long) I_MAX, IMARK);
X    if (L) i_define(D_INT_MIN, INT,
X            Iname, "_MIN", (long) int_min, (long) I_MIN, IMARK);
X
X    if (maxeri>int_max) {
X        Vprintf("%sThere is a larger %s, %ld (= 2**%d-1), %s %s%s\n",
X            co, INT, (long)maxeri, ibits,
X            "but only for addition, not multiplication",
X            "(I smell a Cyber!)",
X            oc);
X    }
X
X    if (minneri<int_min) {
X        Vprintf("%sThere is a smaller %s, %ld, %s %s%s\n",
X            co, INT, (long)minneri,
X            "but only for addition, not multiplication",
X            "(I smell a Cyber!)",
X            oc);
X    }
X}
X
XProcedure UPROP () {
X    /* The properties of unsigned short/int/long */
X#ifdef OK_UI
X    Volatile unsigned Integer int_max, newi, two;
X    newi=1; int_max=0; two=2;
X
X    if (setjmp(lab)==0) { /* Yields int_max */
X        while(newi>int_max) {
X            int_max=newi;
X            newi=newi*two+1;
X        }
X    }
X    Unexpected(11);
X    Vprintf("%sMaximum unsigned %s = %lu%s\n",
X        co, INT, (unsigned long) int_max, oc);
X    if (L) u_define(D_UINT_MAX, INT,
X            Uname, "_MAX", (unsigned long) int_max,
X            (unsigned long) U_MAX, IMARK);
X#endif
X}
X
X#endif /* Integer */
X
X#ifdef Number
X
X/* The following routines are intended to defeat any attempt at optimisation
X   or use of extended precision, and to defeat faulty narrowing casts.
X   The weird prototypes are because of widening incompatibilities.
X*/
X#ifdef STDC
X#define ARGS1(atype, a) (atype a)
X#define ARGS2(atype, a, btype, b) (atype a, btype b)
X#else
X#define ARGS1(atype, a) (a) atype a;
X#define ARGS2(atype, a, btype, b) (a, b) atype a; btype b;
X#endif
X
XProcedure Store ARGS2(Number, a, Number *, b) { *b=a; }
XNumber Sum ARGS2(Number, a, Number, b) {Number r; Store(a+b, &r); return (r); }
XNumber Diff ARGS2(Number, a, Number, b){Number r; Store(a-b, &r); return (r); }
XNumber Mul ARGS2(Number, a, Number, b) {Number r; Store(a*b, &r); return (r); }
XNumber Div ARGS2(Number, a, Number, b) {Number r; Store(a/b, &r); return (r); }
XNumber Self ARGS1(Number, a)           {Number r; Store(a,   &r); return (r); }
X
XProcedure F_check ARGS((int precision, Long_double val1));
X
XProcedure F_check(precision, val1) int precision; Long_double val1; {
X    /* You don't think I'm going to go to all the trouble of writing
X       a program that works out what all sorts of values are, only to
X       have printf go and print the wrong values out, do you?
X       No, you're right, so this function tries to see if printf
X       has written the right value, by reading it back again.
X       This introduces a new problem of course: suppose printf writes
X       the correct value, and scanf reads it back wrong... oh well.
X       But I'm adamant about this: the precision given is enough
X       to uniquely identify the printed number, therefore I insist
X       that sscanf read the number back identically. Harsh yes, but
X       sometimes you've got to be cruel to be kind.
X    */
X    Long_double new1;
X    Number val, new, diff;
X    double rem;
X    int e;
X    char *rep;
X    char *f2;
X
X    if (sizeof(double) == sizeof(Long_double)) {
X        /* Assume they're the same, and use non-stdc format */
X        /* This is for stdc compilers using non-stdc libraries */
X        f2= "%le";   /* Input */
X    } else {
X        /* It had better support Le then */
X        f2= "%Le";
X    }
X    val= val1;
X    rep= f_rep(precision, (Long_double) val);
X    if (setjmp(lab)==0) {
X        sscanf(rep, f2, &new1);
X    } else {
X        eek_a_bug("sscanf caused a trap");
X        printf("%s    scanning: %s format: %s%s\n\n", co, rep, f2, oc);
X        Unexpected(12);
X        return;
X    }
X
X    if (setjmp(lab)==0) { /* See if new is usable */
X        new= new1;
X        if (new != 0.0) {
X            diff= val/new - 1.0;
X            if (diff < 0.1) diff= 1.0;
X            /* That should be enough to generate a trap */
X        }
X    } else {
X        eek_a_bug("sscanf returned an unusable number");
X        printf("%s    scanning: %s with format: %s%s\n\n",
X               co, rep, f2, oc);
X        Unexpected(13);
X        return;
X    }
X
X    Unexpected(14);
X    if (new != val) {
X        eek_a_bug("Possibly bad output from printf above");
X        if (!exponent((Long_double)val, &rem, &e)) {
X            printf("%s    but value was an unusable number%s\n\n",
X                   co, oc);
X            return;
X        }
X        printf("%s    expected value around %.*fe%d, bit pattern:\n    ",
X               co, precision, rem, e);
X        bitpattern((char *) &val, sizeof(val));
X        printf ("%s\n", oc);
X        printf("%s    sscanf gave           %s, bit pattern:\n    ",
X               co, f_rep(precision, (Long_double) new));
X        bitpattern((char *) &new, sizeof(new));
X        printf ("%s\n", oc);
X        if (setjmp(lab) == 0) {
X            diff= val-new;
X            printf("%s    difference= %s%s\n\n",
X                   co, f_rep(precision, (Long_double) diff), oc);
X        } /* else forget it */
X        Unexpected(15);
X    }
X}
X
X#ifdef VERIFY
XProcedure Validate(prec, val, req, same) int prec, same; Long_double val, req; {
X    /* Check that the compiler has read a #define value correctly */
X    Unexpected(16);
X    if (!same) {
X        printf("%s*** Verify failed for above #define!\n", co);
X        if (setjmp(lab) == 0) { /* for the case that req == nan */
X            printf("       Compiler has %s for value%s\n",
X                   f_rep(prec, req), oc);
X        } else {
X            printf("       Compiler has %s for value%s\n",
X                   "an unusable number", oc);
X        }
X        if (setjmp(lab) == 0) {
X            F_check(prec, (Long_double) req);
X        } /*else forget it*/
X        if (setjmp(lab) == 0) {
X            if (req > 0.0 && val > 0.0) {
X                printf("%s    difference= %s%s\n",
X                       co, f_rep(prec, val-req), oc);
X            }
X        } /*else forget it*/
X        Unexpected(17);
X        printf("\n");
X        bugs++;
X    } else if (val != req) {
X        if (stdc) {
X            printf("%s*** Verify failed for above #define!\n", co);
X            printf("       Constant has the wrong precision%s\n",
X                   oc);
X        } else eek_a_bug("the cast didn't work");
X        printf("\n");
X        bugs++;
X    }
X}
X#endif /* VERIFY */
X
Xint FPROP(bits_per_byte) int bits_per_byte; {
X    /* Properties of floating types, using algorithms by Cody and Waite
X       from MA Malcolm, as modified by WM Gentleman and SB Marovich.
X       Further extended by S Pemberton.
X
X       Returns the number of digits in the fraction.
X    */
X
X    Volatile int
X        i, f_radix, iexp, irnd, mrnd, f_rounds, f_mant_dig,
X        iz, k, inf, machep, f_max_exp, f_min_exp, mx, negeps,
X        mantbits, digs, f_dig, trap,
X        hidden, normal, f_min_10_exp, f_max_10_exp;
X    Volatile Number
X        a, b, base, basein, basem1, f_epsilon, epsneg,
X        eps, epsp1, etop, ebot,
X        f_max, newxmax, f_min, xminner, y, y1, z, z1, z2;
X
X    Unexpected(18);
X
X    Vprintf("%sPROPERTIES OF %s:%s\n", co, THING, oc);
X
X    /* Base and size of mantissa **************************************/
X    /* First repeatedly double until adding 1 has no effect.      */
X    /* For instance, if base is 10, with 3 significant digits      */
X    /* it will try 1, 2, 4, 8, ... 512, 1024, and stop there,      */
X    /* since 1024 is only representable as 1020.              */
X    a=1.0;
X    if (setjmp(lab)==0) { /* inexact trap? */
X        do { a=Sum(a, a); }
X        while (Diff(Diff(Sum(a, ONE), a), ONE) == ZERO);
X    } else {
X        fprintf(stderr, "*** Program got loss-of-precision trap!\n");
X        /* And supporting those is just TOO much trouble! */
X        farewell(bugs+1);
X    }
X    Unexpected(19);
X    /* Now double until you find a number that can be added to the      */
X    /* above number. For 1020 this is 8 or 16, depending whether the  */
X    /* result is rounded or truncated.                  */
X    /* In either case the result is 1030. 1030-1020= the base, 10.      */
X    b=1.0;
X    do { b=Sum(b, b); } while ((base=Diff(Sum(a, b), a)) == ZERO);
X    f_radix=base;
X    Vprintf("%sBase = %d%s\n", co, f_radix, oc);
X
X    /* Sanity check; if base<2, I can't guarantee the rest will work  */
X    if (f_radix < 2) {
X        eek_a_bug("Function return or parameter passing faulty? (This is a guess.)");
X        printf("\n");
X        return(0);
X    }
X
X#ifdef PASS1 /* only for FLT */
X    flt_radix= f_radix;
X    if (F) i_define(D_FLT_RADIX, "",
X            "FLT", "_RADIX", (long) f_radix, (long) F_RADIX, "");
X#else
X    if (f_radix != flt_radix) {
X        printf("\n%s*** WARNING: %s %s (%d) %s%s\n",
X               co, thing, "arithmetic has a different radix",
X               f_radix, "from float", oc);
X        bugs++;
X    }
X#endif
X
X    /* Now the number of digits precision: */
X    f_mant_dig=0; b=1.0;
X    do { f_mant_dig++; b=Mul(b, base); }
X    while (Diff(Diff(Sum(b, ONE), b), ONE) == ZERO);
X    f_dig=floor_log(10, (Long_double)(b/base)) + (base==10?1:0);
X    Vprintf("%sSignificant base digits = %d %s %d %s%s\n",
X        co, f_mant_dig, "(= at least", f_dig, "decimal digits)", oc);
X    if (F) i_define(D_MANT_DIG, thing,
X            Fname, "_MANT_DIG", (long) f_mant_dig,
X            (long) F_MANT_DIG, "");
X    if (F) i_define(D_DIG, thing,
X            Fname, "_DIG", (long) f_dig, (long) F_DIG, "");
X    digs= ceil_log(10, (Long_double)b); /* the number of digits to printf */
X
X    /* Rounding *******************************************************/
X    basem1=Diff(base, HALF);
X    if (Diff(Sum(a, basem1), a) != ZERO) {
X        if (f_radix == 2) basem1=0.375;
X        else basem1=1.0;
X        if (Diff(Sum(a, basem1), a) != ZERO) irnd=2; /* away from 0 */
X        else irnd=1; /* to nearest */
X    } else irnd=0; /* towards 0 */
X
X    basem1=Diff(base, HALF);
X
X    if (Diff(Diff(-a, basem1), -a) != ZERO) {
X        if (f_radix == 2) basem1=0.375;
X        else basem1=1.0;
X        if (Diff(Diff(-a, basem1), -a) != ZERO) mrnd=2; /* away from 0*/
X        else mrnd=1; /* to nearest */
X    } else mrnd=0; /* towards 0 */
X
X    f_rounds= -1; /* Unknown rounding */
X    if (irnd==0 && mrnd==0) f_rounds=0; /* zero = chops */
X    if (irnd==1 && mrnd==1) f_rounds=1; /* nearest */
X    if (irnd==2 && mrnd==0) f_rounds=2; /* +inf */
X    if (irnd==0 && mrnd==2) f_rounds=3; /* -inf */
X
X    if (f_rounds != -1) {
X        Vprintf("%sArithmetic rounds towards ", co);
X        switch (f_rounds) {
X              case 0: Vprintf("zero (i.e. it chops)"); break;
X              case 1: Vprintf("nearest"); break;
X              case 2: Vprintf("+infinity"); break;
X              case 3: Vprintf("-infinity"); break;
X              default: Vprintf("???"); break;
X        }
X        Vprintf("%s\n", oc);
X    } else { /* Hmm, try to give some help here: */
X        Vprintf("%sArithmetic rounds oddly: %s\n", co, oc);
X        Vprintf("%s    Negative numbers %s%s\n",
X            co, mrnd==0 ? "towards zero" :
X                mrnd==1 ? "to nearest" :
X                      "away from zero",
X            oc);
X        Vprintf("%s    Positive numbers %s%s\n",
X            co, irnd==0 ? "towards zero" :
X                irnd==1 ? "to nearest" :
X                      "away from zero",
X            oc);
X    }
X    /* An extra goody */
X    if (f_radix == 2 && f_rounds == 1) {
X        if (Diff(Sum(a, ONE), a) != ZERO) {
X            Vprintf("%s   Tie breaking rounds up%s\n", co, oc);
X        } else if (Diff(Sum(a, THREE), a) == FOUR) {
X            Vprintf("%s   Tie breaking rounds to even%s\n", co, oc);
X        } else {
X            Vprintf("%s   Tie breaking rounds down%s\n", co, oc);
X        }
X    }
X#ifdef PASS1 /* only for FLT */
X    flt_rounds= f_rounds;
X    if (F)
X      i_define(D_FLT_ROUNDS, "",
X           "FLT", "_ROUNDS", (long) f_rounds, (long) F_ROUNDS, "");
X#else
X    if (f_rounds != flt_rounds) {
X        printf("\n%s*** WARNING: %s %s (%d) %s%s\n",
X               co, thing, "arithmetic rounds differently",
X               f_rounds, "from float", oc);
X        bugs++;
X    }
X#endif
X
X    /* Various flavours of epsilon ************************************/
X    negeps=f_mant_dig+f_mant_dig;
X    basein=1.0/base;
X    a=1.0;
X    for(i=1; i<=negeps; i++) a*=basein;
X
X    b=a;
X    while (Diff(Diff(ONE, a), ONE) == ZERO) {
X        a*=base;
X        negeps--;
X    }
X    negeps= -negeps;
X    Vprintf("%sSmallest x such that 1.0-base**x != 1.0 = %d%s\n",
X        co, negeps, oc);
X
X    etop = ONE;
X    ebot = ZERO;
X    eps = Sum(ebot, Div(Diff(etop, ebot), TWO));
X    while (eps != ebot && eps != etop) {
X        epsp1 = Diff(ONE, eps);
X        if (epsp1 < ONE) etop = eps;
X        else ebot = eps;
X        eps = Sum(ebot, Div(Diff(etop, ebot), TWO));
X    }
X    /* Sanity check */
X    if (Diff(ONE, etop) >= ONE || Diff(ONE, ebot) != ONE) {
X        eek_a_bug("internal error calculating epsneg");
X    }
X    Vprintf("%sSmallest x such that 1.0-x != 1.0 = %s%s\n",
X        co, f_rep(digs, (Long_double) eps), oc);
X    if (V) F_check(digs, (Long_double) eps);
X
X    epsneg=a;
X    if ((f_radix!=2) && irnd) {
X    /*    a=(a*(1.0+a))/(1.0+1.0); => */
X        a=Div(Mul(a, Sum(ONE, a)), Sum(ONE, ONE));
X    /*    if ((1.0-a)-1.0 != 0.0) epsneg=a; => */
X        if (Diff(Diff(ONE, a), ONE) != ZERO) epsneg=a;
X    }
X    /* epsneg is used later */
X    Unexpected(20);
X
X    machep= -f_mant_dig-f_mant_dig;
X    a=b;
X    while (Diff(Sum(ONE, a), ONE) == ZERO) { a*=base; machep++; }
X    Vprintf("%sSmallest x such that 1.0+base**x != 1.0 = %d%s\n",
X        co, machep, oc);
X
X    etop = ONE;
X    ebot = ZERO;
X    eps = Sum(ebot, Div(Diff(etop, ebot), TWO));
X    while (eps != ebot && eps != etop) {
X        epsp1 = Sum(ONE, eps);
X        if (epsp1 > ONE) etop = eps;
X        else ebot = eps;
X        eps = Sum(ebot, Div(Diff(etop, ebot), TWO));
X    }
X    /* Sanity check */
X    if (Sum(ONE, etop) <= ONE || Sum(ONE, ebot) != ONE) {
X        eek_a_bug("internal error calculating eps");
X    }
X    f_epsilon=etop;
X
X    Vprintf("%sSmallest x such that 1.0+x != 1.0 = %s%s\n",
X        co, f_rep(digs, (Long_double) f_epsilon), oc);
X    /* Possible loss of precision warnings here from non-stdc compilers: */
X    if (F) f_define(D_EPSILON, thing,
X            Fname, "_EPSILON", digs, (Long_double) f_epsilon, MARK);
X    if (V || F) F_check(digs, (Long_double) f_epsilon);
X    Unexpected(21);
X    if (F) Validate(digs, (Long_double) f_epsilon, (Long_double) F_EPSILON,
X            f_epsilon == Self(F_EPSILON));
X    Unexpected(22);
X
X    /* Extra chop info *************************************************/
X    if (f_rounds == 0) {
X        if (Diff(Mul(Sum(ONE,f_epsilon),ONE),ONE) !=  ZERO) {
X            Vprintf("%sAlthough arithmetic chops, it uses guard digits%s\n", co, oc);
X        }
X    }
X
X    /* Size of and minimum normalised exponent ************************/
X    y=0; i=0; k=1; z=basein; z1=(1.0+f_epsilon)/base;
X
X    /* Coarse search for the largest power of two */
X    if (setjmp(lab)==0) { /* for underflow trap */ /* Yields i, k, y, y1 */
X        do {
X            y=z; y1=z1;
X            z=Mul(y,y); z1=Mul(z1, y);
X            a=Mul(z,ONE);
X            z2=Div(z1,y);
X            if (z2 != y1) break;
X            if ((Sum(a,a) == ZERO) || (fabs(z) >= y)) break;
X            i++;
X            k+=k;
X        } while(1);
X    } else {
X        Vprintf("%s%s underflow generates a trap%s\n", co, Thing, oc);
X    }
X    Unexpected(23);
X
X    if (f_radix != 10) {
X        iexp=i+1; /* for the sign */
X        mx=k+k;
X    } else {
X        iexp=2;
X        iz=f_radix;
X        while (k >= iz) { iz*=f_radix; iexp++; }
X        mx=iz+iz-1;
X    }
X
X    /* Fine tune starting with y and y1 */
X    if (setjmp(lab)==0) { /* for underflow trap */ /* Yields k, f_min */
X        do {
X            f_min=y; z1=y1;
X            y=Div(y,base); y1=Div(y1,base);
X            a=Mul(y,ONE);
X            z2=Mul(y1,base);
X            if (z2 != z1) break;
X            if ((Sum(a,a) == ZERO) || (fabs(y) >= f_min)) break;
X            k++;
X        } while (1);
X    }
X    Unexpected(24);
X
X    f_min_exp=(-k)+1;
X
X    if ((mx <= k+k-3) && (f_radix != 10)) { mx+=mx; iexp+=1; }
X    Vprintf("%sNumber of bits used for exponent = %d%s\n", co, iexp, oc);
X    Vprintf("%sMinimum normalised exponent = %d%s\n", co, f_min_exp, oc);
X    if (F)
X      i_define(D_MIN_EXP, thing,
X           Fname, "_MIN_EXP", (long) f_min_exp, (long) F_MIN_EXP, "");
X
X    if (setjmp(lab)==0) {
X        Vprintf("%sMinimum normalised positive number = %s%s\n",
X            co, f_rep(digs, (Long_double) f_min), oc);
X    } else {
X        eek_a_bug("printf can't print the smallest normalised number");
X        printf("\n");
X    }
X    Unexpected(25);
X    /* Possible loss of precision warnings here from non-stdc compilers: */
X    if (setjmp(lab) == 0) {
X        if (F) f_define(D_MIN, thing,
X                Fname, "_MIN", digs, (Long_double) f_min, MARK);
X        if (V || F) F_check(digs, (Long_double) f_min);
X    } else {
X        eek_a_bug("xxx_MIN caused a trap");
X        printf("\n");
X    }
X
X    if (setjmp(lab) == 0) {
X        if (F) Validate(digs, (Long_double) f_min, (Long_double) F_MIN,
X                f_min == Self(F_MIN));
X    } else {
X        printf("%s*** Verify failed for above #define!\n    %s %s\n\n",
X               co, "Compiler has an unusable number for value", oc);
X        bugs++;
X    }
X    Unexpected(26);
X
X    a=1.0; f_min_10_exp=0;
X    while (a > f_min*10.0) { a/=10.0; f_min_10_exp--; }
X    if (F) i_define(D_MIN_10_EXP, thing,
X            Fname, "_MIN_10_EXP", (long) f_min_10_exp,
X            (long) F_MIN_10_EXP, "");
X
X    /* Minimum exponent ************************************************/
X    if (setjmp(lab)==0) { /* for underflow trap */ /* Yields xminner */
X        do {
X            xminner=y;
X            y=Div(y,base);
X            a=Mul(y,ONE);
X            if ((Sum(a,a) == ZERO) || (fabs(y) >= xminner)) break;
X        } while (1);
X    }
X    Unexpected(27);
X
X    if (xminner != 0.0 && xminner != f_min) {
X        normal= 0;
X        Vprintf("%sThe smallest numbers are not kept normalised%s\n",
X            co, oc);
X        if (setjmp(lab)==0) {
X            Vprintf("%sSmallest unnormalised positive number = %s%s\n",
X                co, f_rep(digs, (Long_double) xminner), oc);
X            if (V) F_check(digs, (Long_double) xminner);
X        } else {
X            eek_a_bug("printf can't print the smallest unnormalised number.");
X            printf("\n");
X        }
X        Unexpected(28);
X    } else {
X        normal= 1;
X        Vprintf("%sThe smallest numbers are normalised%s\n", co, oc);
X    }
X
X    /* Maximum exponent ************************************************/
X    f_max_exp=2; f_max=1.0; newxmax=base+1.0;
X    inf=0; trap=0;
X    while (f_max<newxmax) {
X        f_max=newxmax;
X        if (setjmp(lab) == 0) { /* Yields inf, f_max_exp */
X            newxmax=Mul(newxmax, base);
X        } else {
X            trap=1;
X            break;
X        }
X        if (Div(newxmax, base) != f_max) {
X            inf=1; /* ieee infinity */
X            break;
X        }
X        f_max_exp++;
X    }
X    Unexpected(29);
X    if (trap) {
X        Vprintf("%s%s overflow generates a trap%s\n", co, Thing, oc);
X    }
X
X    if (inf) Vprintf("%sThere is an 'infinite' value%s\n", co, oc);
X    Vprintf("%sMaximum exponent = %d%s\n", co, f_max_exp, oc);
X    if (F) i_define(D_MAX_EXP, thing,
X            Fname, "_MAX_EXP", (long) f_max_exp,
X            (long) F_MAX_EXP, "");
X
X    /* Largest number ***************************************************/
X    f_max=Diff(ONE, epsneg);
X    if (Mul(f_max,ONE) != f_max) f_max=Diff(ONE, Mul(base,epsneg));
X    for (i=1; i<=f_max_exp; i++) f_max=Mul(f_max, base);
X
X    if (setjmp(lab)==0) {
X        Vprintf("%sMaximum number = %s%s\n",
X            co, f_rep(digs, (Long_double) f_max), oc);
X    } else {
X        eek_a_bug("printf can't print the largest double.");
X        printf("\n");
X    }
X    if (setjmp(lab)==0) {
X    /* Possible loss of precision warnings here from non-stdc compilers: */
X        if (F) f_define(D_MAX, thing,
X                Fname, "_MAX", digs, (Long_double) f_max, MARK);
X        if (V || F) F_check(digs, (Long_double) f_max);
X    } else {
X        eek_a_bug("xxx_MAX caused a trap");
X        printf("\n");
X    }
X    if (setjmp(lab)==0) {
X        if (F) Validate(digs, (Long_double) f_max, (Long_double) F_MAX,
X                f_max == Self(F_MAX));
X    } else {
X        printf("%s*** Verify failed for above #define!\n    %s %s\n\n",
X               co, "Compiler has an unusable number for value", oc);
X        bugs++;
X    }
X    Unexpected(30);
X
X    a=1.0; f_max_10_exp=0;
X    while (a < f_max/10.0) { a*=10.0; f_max_10_exp++; }
X    if (F) i_define(D_MAX_10_EXP, thing,
X            Fname, "_MAX_10_EXP", (long) f_max_10_exp,
X            (long) F_MAX_10_EXP, "");
X
X    /* Hidden bit + sanity check ****************************************/
X    if (f_radix != 10) {
X        hidden=0;
X        mantbits=floor_log(2, (Long_double)f_radix)*f_mant_dig;
X        if (mantbits+iexp == (int)sizeof(Number)*bits_per_byte) {
X            hidden=1;
X            Vprintf("%sArithmetic uses a hidden bit%s\n", co, oc);
X        } else if (mantbits+iexp+1 == (int)sizeof(Number)*bits_per_byte) {
X            Vprintf("%sArithmetic doesn't use a hidden bit%s\n",
X                co, oc);
X        } else {
X            printf("\n%s%s\n    %s %s %s!%s\n\n",
X                   co,
X                   "*** Something fishy here!",
X                   "Exponent size + mantissa size doesn't match",
X                   "with the size of a", thing,
X                   oc);
X        }
X        if (hidden && f_radix == 2 && f_max_exp+f_min_exp==3) {
X            Vprintf("%sIt looks like %s length IEEE format%s\n",
X                co, f_mant_dig==24 ? "single" :
X                    f_mant_dig==53 ? "double" :
X                    f_mant_dig >53 ? "extended" :
X                        "some", oc);
X            if (f_rounds != 1 || normal) {
X                Vprintf("%s   though ", co);
X                if (f_rounds != 1) {
X                    Vprintf("the rounding is unusual");
X                    if (normal) Vprintf(" and ");
X                }
X                if (normal) Vprintf("the normalisation is unusual");
X                Vprintf("%s\n", oc);
X            }
X        } else {
X            Vprintf("%sIt doesn't look like IEEE format%s\n",
X                co, oc);
X        }
X    }
X    printf("\n"); /* regardless of verbosity */
X    return f_mant_dig;
X}
X
XProcedure EPROP(fprec, dprec, lprec) int fprec, dprec, lprec; {
X    /* See if expressions are evaluated in extended precision.
X       Some compilers optimise even if you don't want it,
X       and then this function fails to produce the right result.
X       We try to diagnose this if it happens.
X    */
X    Volatile int eprec;
X    Volatile double a, b, base, old;
X    Volatile Number d, oldd, dbase, one, zero;
X    Volatile int bad=0;
X
X    /* Size of mantissa **************************************/
X    a=1.0;
X    if (setjmp(lab) == 0) { /* Yields nothing */
X        do { old=a; a=a+a; }
X        while ((((a+1.0)-a)-1.0) == 0.0 && a>old);
X    } else bad=1;
X    if (a <= old) bad=1;
X
X    if (!bad) {
X        b=1.0;
X        if (setjmp(lab) == 0) { /* Yields nothing */
X            do { old=b; b=b+b; }
X            while ((base=((a+b)-a)) == 0.0 && b>old);
X            if (b <= old) bad=1;
X        } else bad=1;
X    }
X
X    if (!bad) {
X        eprec=0; d=1.0; dbase=base; one=1.0; zero=0.0;
X        if (setjmp(lab) == 0) { /* Yields nothing */
X            do { eprec++; oldd=d; d=d*dbase; }
X            while ((((d+one)-d)-one) == zero && d>oldd);
X            if (d <= oldd) bad=1;
X        } else bad=1;
X    }
X
X    Unexpected(31);
X
X    if (bad) {
X      Vprintf("%sCan't determine precision for %s expressions:\n%s%s\n",
X         co, thing, "   check that you compiled without optimisation!",
X         oc);
X    } else if (eprec==dprec) {
X      Vprintf("%s%s expressions are evaluated in double precision%s\n",
X          co, Thing, oc);
X    } else if (eprec==fprec) {
X      Vprintf("%s%s expressions are evaluated in float precision%s\n",
X          co, Thing, oc);
X    } else if (eprec==lprec) {
X      Vprintf("%s%s expressions are evaluated in long double precision%s\n",
X          co, Thing, oc);
X    } else {
X        Vprintf("%s%s expressions are evaluated in a %s %s %d %s%s\n",
X            co, Thing, eprec>dprec ? "higher" : "lower",
X            "precision than double,\n   using",
X            eprec, "base digits",
X                oc);
X    }
X}
X
X#else /* not Number */
X
X#ifdef FPROP
X/* ARGSUSED */
Xint FPROP(bits_per_byte) int bits_per_byte; { return 0; }
X#endif
X#ifdef EPROP
X/* ARGSUSED */
XProcedure EPROP(fprec, dprec, lprec) int fprec, dprec, lprec; {}
X#endif
X
X#endif /* ifdef Number */
X
X#ifdef PASS3
X#undef PASS
X#endif
X
X#ifdef PASS2
X#undef PASS2
X#define PASS3 1
X#endif
X
X#ifdef PASS1
X#undef PASS1
X#define PASS2 1
X#endif
X
X#ifdef PASS0
X#undef PASS0
X#endif
X
X#ifdef PASS /* then rescan this file */
X#ifdef NO_FILE
X#include "config.c"
X#else /* if the next line fails to compile, define NO_FILE */
X#include __FILE__
X#endif
X#endif /* PASS */
EOF
fi
echo 'Part 01 out of 01 of pack.out complete.'
exit 0