gcc/enquire.c

   1 /* Everything you wanted to know about your machine and C compiler,
   2    but didn't know who to ask. */
   3
   4 #ifndef VERSION
   5 #define VERSION "4.3"
   6 #endif
   7
   8 /* Author: Steven Pemberton, CWI, Amsterdam; steven@cwi.nl
   9    Bugfixes and upgrades gratefully received.
  10
  11    Copyright (c) 1988, 1989, 1990 Steven Pemberton, CWI, Amsterdam.
  12    All rights reserved.
  13
  14    Changes by Richard Stallman:
  15    Undef CHAR_BIT, etc., if defined in stdio.h, Richard Stallman, Aug 90.
  16    In EPROP, avoid a <= old if bad is set, Richard Stallman, May 91.
  17    Use gstddef.h, not stddef.h, Richard Stallman, Nov 91.
  18    Don't declare malloc, instead cast the value, Richard Stallman, Nov 91.
  19    Include sys/types.h before signal.h, Apr 92.
  20    Support NO_LONG_DOUBLE_IO in f_define and f_rep; new fn fake_f_rep, Apr 92.
  21    Enclose -f output in #ifndef _FLOAT_H___, Richard Stallman, May 92.
  22
  23    COMPILING
  24    With luck and a following wind, just the following will work:
  25         cc enquire.c -o enquire
  26    You may get some messages about unreachable code, which you can ignore.
  27
  28    If your compiler doesn't support:            add flag:
  29         signed char (eg pcc)                    -DNO_SC
  30         unsigned char                           -DNO_UC
  31         unsigned short and long                 -DNO_UI
  32         void                                    -DNO_VOID
  33         signal(), or setjmp/longjmp()           -DNO_SIG
  34         %Lf in printf                           -DNO_LONG_DOUBLE_IO
  35
  36    Try to compile first with no flags, and see if you get any errors -
  37    you might be surprised. (Most non-ANSI compilers need -DNO_SC, though.)
  38    Some compilers need a -f flag for floating point.
  39
  40    Don't use any optimisation flags: the program may not work if you do.
  41    Though "while (a+1.0-a-1.0 == 0.0)" may look like "while(1)" to an
  42    optimiser, to a floating-point unit there's a world of difference.
  43
  44    Some compilers offer various flags for different floating point
  45    modes; it's worth trying all possible combinations of these.
  46
  47    Add -DID=\"name\" if you want the machine/flags identified in the output.
  48
  49    FAULTY COMPILERS
  50    Because of bugs and/or inadequacies, some compilers need the following
  51    defines:
  52
  53    If your C preprocessor doesn't have the predefined __FILE__ macro, and
  54    you don't want to call this file enquire.c but, say, tell.c, add the
  55    flag -DFILENAME=\"tell.c\" .
  56
  57    Some compilers won't accept the line "#include FILENAME".
  58    Add flag -DNO_FILE. In that case, this file *must* be called enquire.c.
  59
  60    Some compilers can't cope with "#ifdef __FILE__". Use -DFILENAME=
  61    or -DNO_FILE as above.
  62
  63    Some naughty compilers define __STDC__, but don't really support it.
  64    Some define it as 0, in which case we treat it as undefined.
  65    But if your compiler defines it, and isn't really ANSI C,
  66    add flag -DNO_STDC. (To those compiler writers: for shame).
  67
  68    Some naughty compilers define __STDC__, but don't have the stddef.h
  69    include file. Add flag -DNO_STDDEF.
  70
  71    Summary of naughty-compiler flags:
  72    If your compiler doesn't support:             add flag:
  73         __FILE__ (and you changed the filename) -DFILENAME=\"name.c\"
  74         #ifdef __FILE__                         -DNO_FILE or -DFILENAME=...
  75         #include FILENAME                       -DNO_FILE
  76         __STDC__ (properly)                     -DNO_STDC
  77         stddef.h                                -DNO_STDDEF
  78
  79    Some systems crash when you try to malloc all store. To save users of
  80    such defective systems too much grief, they may compile with -DNO_MEM,
  81    which ignores that bit of the code.
  82
  83    While it is not our policy to support defective compilers, pity has been
  84    taken on people with compilers that can't produce object files bigger than
  85    32k (especially since it was an easy addition). Compile the program
  86    into separate parts like this:
  87        cc -DSEP -DPASS0 -o p0.o <other flags> enquire.c
  88        cc -DSEP -DPASS1 -o p1.o <other flags> enquire.c
  89        cc -DSEP -DPASS2 -o p2.o <other flags> enquire.c
  90        cc -DSEP -DPASS3 -o p3.o <other flags> enquire.c
  91        cc -o enquire p0.o p1.o p2.o p3.o
  92
  93    SYSTEM DEPENDENCIES
  94    You may possibly need to add some calls to signal() for other sorts of
  95    exception on your machine than SIGFPE, and SIGOVER. See lines beginning
  96    #ifdef SIGxxx in main() (and communicate the differences to me!).
  97
  98    OUTPUT
  99    Run without argument to get the information as English text. If run
 100    with argument -l (e.g. enquire -l), output is a series of #define's for
 101    the ANSI standard limits.h include file, excluding MB_MAX_CHAR. If run
 102    with argument -f, output is a series of #define's for the ANSI standard
 103    float.h include file (according to ANSI C Draft of Dec 7, 1988).
 104    Flag -v gives verbose output: output includes the English text above
 105    as C comments. The program exit(0)'s if everything went ok, otherwise
 106    it exits with a positive number, telling how many problems there were.
 107
 108    VERIFYING THE COMPILER
 109    If, having produced the float.h and limits.h header files, you want to
 110    verify that the compiler reads them back correctly (there are a lot of
 111    boundary cases, of course, like minimum and maximum numbers), you can
 112    recompile enquire.c with -DVERIFY set (plus the other flags that you used
 113    when compiling the version that produced the header files). This then
 114    recompiles the program so that it #includes "limits.h" and "float.h",
 115    and checks that the constants it finds there are the same as the
 116    constants it produces. Run the resulting program with enquire -fl.
 117    Very few compilers have passed without error.
 118    NB: You *must* recompile with the same compiler and flags, otherwise
 119    you may get odd results.
 120
 121    You can also use this option if your compiler already has both files,
 122    and you want to confirm that this program produces the right results.
 123
 124    TROUBLESHOOTING.
 125    This program is now quite trustworthy, and suspicious and wrong output
 126    may well be caused by bugs in the compiler, not in the program (however
 127    of course, this is not guaranteed, and no responsibility can be
 128    accepted, etc.)
 129
 130    The program only works if overflows are ignored by the C system or
 131    are catchable with signal().
 132
 133    If the program fails to run to completion (often with the error message
 134    "Unexpected signal at point x"), this often turns out to be a bug in the
 135    C compiler's run-time system. Check what was about to be printed, and
 136    try to narrow the problem down.
 137
 138    Another possible problem is that you have compiled the program to produce
 139    loss-of-precision arithmetic traps. The program cannot cope with these,
 140    and you should re-compile without them. (They should never be the default).
 141
 142    Make sure you compiled with optimisation turned off.
 143
 144    Output preceded by *** WARNING: identifies behaviour of the C system
 145    deemed incorrect by the program. Likely problems are that printf or
 146    scanf don't cope properly with certain boundary numbers: this program
 147    goes to a lot of trouble to calculate its values, and these values
 148    are mostly boundary numbers. Experience has shown that often printf
 149    cannot cope with these values, and so in an attempt to increase
 150    confidence in the output, for each float and double that is printed,
 151    the printed value is checked by using sscanf to read it back.
 152        Care is taken that numbers are printed with enough digits to uniquely
 153    identify them, and therefore that they can be read back identically.
 154    If the number read back is different, then there is probably a bug in
 155    printf or sscanf, and the program prints the warning message.
 156    If the two numbers in the warning look identical, then printf is more
 157    than likely rounding the last digit(s) incorrectly. To put you at ease
 158    that the two really are different, the bit patterns of the two numbers
 159    are also printed. The difference is very likely in the last bit.
 160        Many scanf's read the minimum double back as 0.0, and similarly cause
 161    overflow when reading the maximum double. This program quite ruthlessly
 162    declares all these behaviours faulty. The point is that if you get
 163    one of these warnings, the output may be wrong, so you should check
 164    the result carefully if you intend to use the results. Of course, printf
 165    and sscanf may both be wrong, and cancel each other out, so you should
 166    check the output carefully anyway.
 167
 168    The warning that "a cast didn't work" refers to cases like this:
 169
 170       float f;
 171       #define C 1.234567890123456789
 172       f= C;
 173       if (f != (float) C) printf ("Wrong!");
 174
 175    A faulty compiler will widen f to double and ignore the cast to float,
 176    and because there is more accuracy in a double than a float, fail to
 177    recognise that they are the same. In the actual case in point, f and C
 178    are passed as parameters to a function that discovers they are not equal,
 179    so it's just possible that the error was in the parameter passing,
 180    not in the cast (see function Validate()).
 181    For ANSI C, which has float constants, the error message is "constant has
 182    wrong precision".
 183
 184    REPORTING PROBLEMS
 185    If the program doesn't work for you for any reason that can't be
 186    narrowed down to a problem in the C compiler, or it has to be changed in
 187    order to get it to compile, or it produces suspicious output (like a very
 188    low maximum float, for instance), please mail the problem and an example
 189    of the incorrect output to steven@cwi.nl or ..!hp4nl!cwi.nl!steven, so that
 190    improvements can be worked into future versions; cwi.nl is the European
 191    backbone, and is connected to uunet and other fine hosts.
 192
 193    The program tries to catch and diagnose bugs in the compiler/run-time
 194    system. I would be especially pleased to have reports of failures so
 195    that I can improve this service.
 196
 197    I apologise unreservedly for the contorted use of the preprocessor...
 198
 199    THE SMALL PRINT
 200    You may copy and distribute verbatim copies of this source file.
 201
 202    You may modify this source file, and copy and distribute such
 203    modified versions, provided that you leave the copyright notice
 204    at the top of the file and also cause the modified file to carry
 205    prominent notices stating that you changed the files and the date
 206    of any change; and cause the whole of any work that you distribute
 207    or publish, that in whole or in part contains or is a derivative of
 208    this program or any part thereof, to be licensed at no charge to
 209    all third parties on terms identical to those here.
 210
 211    If you do have a fix to any problem, please send it to me, so that
 212    other people can have the benefits.
 213
 214    While every effort has been taken to make this program as reliable as
 215    possible, no responsibility can be taken for the correctness of the
 216    output, nor suitability for any particular use.
 217
 218    This program is an offshoot of a project funded by public funds.
 219    If you use this program for research or commercial use (i.e. more
 220    than just for the fun of knowing about your compiler) mailing a short
 221    note of acknowledgement may help keep enquire.c supported.
 222
 223    ACKNOWLEDGEMENTS
 224    Many people have given time and ideas to making this program what it is.
 225    To all of them thanks, and apologies for not mentioning them by name.
 226
 227    HISTORY
 228    Originally started as a program to generate configuration constants
 229    for a large piece of software we were writing, which later took on
 230    a life of its own...
 231    1.0 Length 6658!; end 1984?
 232        Unix only. Only printed a dozen maximum int/double values.
 233    2.0 Length 10535; Spring 1985
 234        Prints values as #defines (about 20 of them)
 235        More extensive floating point, using Cody and Waite
 236        Handles signals better
 237        Programs around optimisations
 238        Handles Cybers
 239    3.0 Length 12648; Aug 1987; prints about 42 values
 240        Added PASS stuff, so treats float as well as double
 241    4.0 Length 33891; Feb 1989; prints around 85 values
 242        First GNU version (for gcc, where they call it hard-params.c)
 243        Generates float.h and limits.h files
 244        Handles long double
 245        Generates warnings for dubious output
 246    4.1 Length 47738; April 1989
 247        Added VERIFY and TEST
 248    4.2 Length 63442; Feb 1990
 249        Added SEP
 250        Fixed eps/epsneg
 251        Added check for pseudo-unsigned chars
 252        Added description for each #define output
 253        Added check for absence of defines during verify
 254        Added prototypes
 255        Added NO_STDC and NO_FILE
 256        Fixed alignments output
 257    4.3 Length 75000; Oct 1990; around 114 lines of output
 258        Function xmalloc defined, Richard Stallman, June 89.
 259        Alignments computed from member offsets rather than structure sizes,
 260           Richard Stallman, Oct 89.
 261        Print whether char* and int* pointers have the same format;
 262           also char * and function *.
 263        Update to Draft C version Dec 7, 1988
 264           - types of constants produced in limits.h
 265             (whether to put a U after unsigned shorts and chars and
 266              whether to output -1024 as (-1023-1))
 267           - values of SCHAR_MIN/MAX
 268           - values of *_EPSILON (not the smallest but the effective smallest)
 269        Added FILENAME, since standard C doesn't allow #define __FILE__
 270        Renamed from config.c to enquire.c
 271        Added size_t and ptrdiff_t enquiries
 272        Added promotion enquiries
 273        Added type checks of #defines
 274        Added NO_STDDEF
 275        Changed endian to allow for cases where not all bits are used
 276        Sanity check for max integrals
 277        Fixed definition of setjmp for -DNO_SIG
 278        Moved #define ... 0.0L inside #ifdef STDC, in case some cpp's tokenize
 279        Added NO_MEM
 280 */
 281
 282 /* Set FILENAME to the name of this file */
 283 #ifndef FILENAME
 284 #ifdef NO_FILE
 285 #define FILENAME "enquire.c"
 286 #else
 287 #ifdef __FILE__ /* It's a compiler bug if this fails. Compile with -DNO_FILE */
 288 #define FILENAME __FILE__
 289 #else
 290 #define FILENAME "enquire.c"
 291 #endif /* __FILE__ */
 292 #endif /* NO_FILE */
 293 #endif /* FILENAME */
 294
 295 /* If PASS isn't defined, then this is the first pass over this file. */
 296 #ifndef PASS
 297 #ifndef SEP
 298 #define PASS 1
 299 #define PASS0 1
 300 #define PASS1 1
 301 #endif /* SEP */
 302
 303 /* A description of the ANSI constants */
 304 #define D_CHAR_BIT "Number of bits in a storage unit"
 305 #define D_CHAR_MAX "Maximum char"
 306 #define D_CHAR_MIN "Minimum char"
 307 #define D_SCHAR_MAX "Maximum signed char"
 308 #define D_SCHAR_MIN "Minimum signed char"
 309 #define D_UCHAR_MAX "Maximum unsigned char (minimum is always 0)"
 310
 311 #define D_INT_MAX "Maximum %s"
 312 #define D_INT_MIN "Minimum %s"
 313 #define D_UINT_MAX "Maximum unsigned %s (minimum is always 0)"
 314
 315 #define D_FLT_ROUNDS "Addition rounds to 0: zero, 1: nearest, 2: +inf, 3: -inf, -1: unknown"
 316 #define D_FLT_RADIX "Radix of exponent representation"
 317 #define D_MANT_DIG "Number of base-FLT_RADIX digits in the significand of a %s"
 318 #define D_DIG "Number of decimal digits of precision in a %s"
 319 #define D_MIN_EXP "Minimum int x such that FLT_RADIX**(x-1) is a normalised %s"
 320 #define D_MIN_10_EXP "Minimum int x such that 10**x is a normalised %s"
 321 #define D_MAX_EXP "Maximum int x such that FLT_RADIX**(x-1) is a representable %s"
 322 #define D_MAX_10_EXP "Maximum int x such that 10**x is a representable %s"
 323 #define D_MAX "Maximum %s"
 324 #define D_EPSILON "Difference between 1.0 and the minimum %s greater than 1.0"
 325 #define D_MIN "Minimum normalised %s"
 326
 327 /* Procedure just marks the functions that don't return a result */
 328 #ifdef NO_VOID
 329 #define Procedure int
 330 #else
 331 #define Procedure void
 332 #endif
 333
 334 /* Some bad compilers define __STDC__, when they don't support it.
 335    Compile with -DNO_STDC to get round this.
 336 */
 337 #ifndef NO_STDC
 338 #ifdef __STDC__
 339 #if __STDC__ /* If __STDC__ is 0, assume it isn't supported */
 340 #define STDC
 341 #endif
 342 #endif
 343 #endif
 344
 345 /* Stuff different for ANSI C, and old C:
 346    ARGS and NOARGS are used for function prototypes.
 347    Volatile is used to reduce the chance of optimisation,
 348       and to prevent variables being put in registers (when setjmp/longjmp
 349       wouldn't work as we want)
 350    Long_double is the longest floating point type available.
 351    stdc is used in tests like "if (stdc)", which is less ugly than #ifdef.
 352    U is output after unsigned constants.
 353  */
 354 #ifdef STDC
 355
 356 #define ARGS(x) x
 357 #define NOARGS (void)
 358 #define Volatile volatile
 359 #define Long_double long double
 360 #define stdc 1
 361 #define U "U"
 362
 363 #else /* Old style C */
 364
 365 #define ARGS(x) ()
 366 #define NOARGS ()
 367 #define Volatile static
 368 #define Long_double double
 369 #define stdc 0
 370 #define U ""
 371
 372 #endif /* STDC */
 373
 374 /* include files */
 375 #include <stdio.h>
 376
 377 #ifdef STDC
 378 #ifndef NO_STDDEF
 379 #include "gstddef.h" /* for size_t: if this fails, define NO_STDDEF */
 380 #endif
 381 #endif
 382
 383 #ifdef NO_SIG
 384 #define jmp_buf int
 385 #else
 386 #include <sys/types.h>
 387 #include <signal.h>
 388 #include <setjmp.h>
 389 #endif
 390
 391 /* Kludge around the possibility that <stdio.h> includes <limits.h> */
 392 #ifdef CHAR_BIT
 393 #undef CHAR_BIT
 394 #undef CHAR_MAX
 395 #undef CHAR_MIN
 396 #undef SCHAR_MAX
 397 #undef SCHAR_MIN
 398 #undef UCHAR_MAX
 399 #undef UCHAR_MIN
 400 #endif
 401
 402 #ifdef VERIFY
 403 #include "limits.h"
 404 #include "float.h"
 405 #endif
 406
 407 #define Vprintf if (V) printf
 408 #define Unexpected(place) if (setjmp(lab)!=0) croak(place)
 409 #define fabs(x) (((x)<0.0)?(-x):(x))
 410
 411 #endif /* PASS */
 412
 413 #ifdef PASS0
 414
 415 /* Prototypes for what's to come: */
 416
 417 int false NOARGS;
 418
 419 #ifdef NO_STDDEF
 420 char *malloc (); /* Old style prototype */
 421 #else
 422 char *malloc ARGS((size_t size));
 423 #endif
 424
 425 Procedure exit ARGS((int status));
 426
 427 char *f_rep ARGS((int precision, Long_double val));
 428 char *fake_f_rep ARGS((char *type, Long_double val));
 429
 430 int maximum_int NOARGS;
 431 int cprop NOARGS;
 432 int basic NOARGS;
 433 Procedure sprop NOARGS;
 434 Procedure iprop NOARGS;
 435 Procedure lprop NOARGS;
 436 Procedure usprop NOARGS;
 437 Procedure uiprop NOARGS;
 438 Procedure ulprop NOARGS;
 439 int fprop ARGS((int bits_per_byte));
 440 int dprop ARGS((int bits_per_byte));
 441 int ldprop ARGS((int bits_per_byte));
 442 Procedure efprop ARGS((int fprec, int dprec, int lprec));
 443 Procedure edprop ARGS((int fprec, int dprec, int lprec));
 444 Procedure eldprop ARGS((int fprec, int dprec, int lprec));
 445
 446 int setmode ARGS((char *s));
 447 Procedure farewell ARGS((int bugs));
 448 Procedure describe ARGS((char *description, char *extra));
 449 Procedure missing ARGS((char *s));
 450 Procedure fmissing ARGS((char *s));
 451 Procedure check_defines NOARGS;
 452 Procedure bitpattern ARGS((char *p, unsigned int size));
 453 int ceil_log ARGS((int base, Long_double x));
 454 Procedure croak ARGS((int place));
 455 Procedure eek_a_bug ARGS((char *problem));
 456 Procedure endian ARGS((int bits_per_byte));
 457 int exponent ARGS((Long_double x, double *fract, int *exp));
 458 int floor_log ARGS((int base, Long_double x));
 459 Procedure f_define ARGS((char *desc, char *extra, char *sort, char *name,
 460                          int prec, Long_double val, char *mark));
 461 Procedure i_define ARGS((char *desc, char *extra, char *sort, char *name,
 462                          long val, long lim, long req, char *mark));
 463 Procedure u_define ARGS((char *desc, char *extra, char *sort, char *name,
 464                          unsigned long val, unsigned long req, char *mark));
 465
 466 #ifdef NO_SIG  /* There's no signal(), or setjmp/longjmp() */
 467
 468         /* Dummy routines instead */
 469
 470         int setjmp ARGS((int lab));
 471
 472         int lab=1;
 473         int setjmp(lab) int lab; { return(0); }
 474         Procedure signal(i, p) int i, (*p)(); {}
 475
 476 #else
 477         jmp_buf lab;
 478         Procedure overflow(sig) int sig; { /* what to do on over/underflow */
 479                 signal(sig, overflow);
 480                 longjmp(lab, 1);
 481         }
 482
 483 #endif /*NO_SIG*/
 484
 485 int V= 0,       /* verbose */
 486     L= 0,       /* produce limits.h */
 487     F= 0,       /* produce float.h  */
 488     bugs=0;     /* The number of (possible) bugs in the output */
 489
 490 char co[4], oc[4]; /* Comment starter and ender symbols */
 491
 492 int bits_per_byte; /* the number of bits per unit returned by sizeof() */
 493 int flt_rounds;    /* The calculated value of FLT_ROUNDS */
 494 int flt_radix;     /* The calculated value of FLT_RADIX */
 495
 496 #ifdef TEST
 497 /* Set the fp modes on a SUN with 68881 chip, to check that different
 498    rounding modes etc. get properly detected.
 499    Compile with -f68881 for cc, -m68881 for gcc, and with additional flag
 500    -DTEST. Run with additional parameter +hex-number, to set the 68881 mode
 501    register to hex-number
 502 */
 503
 504 /* Bits 0x30 = rounding mode */
 505 #define ROUND_BITS      0x30
 506 #define TO_NEAREST      0x00
 507 #define TO_ZERO         0x10
 508 #define TO_MINUS_INF    0x20
 509 #define TO_PLUS_INF     0x30 /* The SUN FP user's guide seems to be wrong here */
 510
 511 /* Bits 0xc0 = extended rounding */
 512 #define EXT_BITS        0xc0
 513 #define ROUND_EXTENDED  0x00
 514 #define ROUND_SINGLE    0x40
 515 #define ROUND_DOUBLE    0x80
 516
 517 /* Enabled traps */
 518 #define EXE_INEX1  0x100
 519 #define EXE_INEX2  0x200
 520 #define EXE_DZ     0x400
 521 #define EXE_UNFL   0x800
 522 #define EXE_OVFL  0x1000
 523 #define EXE_OPERR 0x2000
 524 #define EXE_SNAN  0x4000
 525 #define EXE_BSUN  0x8000
 526
 527 /* Only used for testing, on a Sun with 68881 chip */
 528 /* Print the FP mode */
 529 printmode(new) unsigned new; {
 530         fpmode_(&new);
 531         printf("New fp mode:\n");
 532         printf("  Round toward ");
 533         switch (new & ROUND_BITS) {
 534               case TO_NEAREST:   printf("nearest"); break;
 535               case TO_ZERO:      printf("zero"); break;
 536               case TO_MINUS_INF: printf("minus infinity"); break;
 537               case TO_PLUS_INF:  printf("plus infinity"); break;
 538               default: printf("???"); break;
 539         }
 540
 541         printf("\n  Extended rounding precision: ");
 542
 543         switch (new & EXT_BITS) {
 544               case ROUND_EXTENDED: printf("extended"); break;
 545               case ROUND_SINGLE:   printf("single"); break;
 546               case ROUND_DOUBLE:   printf("double"); break;
 547               default: printf("???"); break;
 548         }
 549
 550         printf("\n  Enabled exceptions:");
 551         if (new & (unsigned) EXE_INEX1) printf(" inex1");
 552         if (new & (unsigned) EXE_INEX2) printf(" inex2");
 553         if (new & (unsigned) EXE_DZ)    printf(" dz");
 554         if (new & (unsigned) EXE_UNFL)  printf(" unfl");
 555         if (new & (unsigned) EXE_OVFL)  printf(" ovfl");
 556         if (new & (unsigned) EXE_OPERR) printf(" operr");
 557         if (new & (unsigned) EXE_SNAN)  printf(" snan");
 558         if (new & (unsigned) EXE_BSUN)  printf(" bsun");
 559         printf("\n");
 560 }
 561
 562 /* Only used for testing, on a Sun with 68881 chip */
 563 /* Set the FP mode */
 564 int setmode(s) char *s; {
 565         unsigned mode=0, dig;
 566         char c;
 567
 568         while (*s) {
 569                 c= *s++;
 570                 if  (c>='0' && c<='9') dig= c-'0';
 571                 else if (c>='a' && c<='f') dig= c-'a'+10;
 572                 else if (c>='A' && c<='F') dig= c-'A'+10;
 573                 else return 1;
 574                 mode= mode<<4 | dig;
 575         }
 576         printmode(mode);
 577         return 0;
 578 }
 579 #else
 580 /* ARGSUSED */
 581 int setmode(s) char *s; {
 582         fprintf(stderr, "Can't set mode: not compiled with TEST\n");
 583         return(1);
 584 }
 585 #endif
 586
 587 Procedure farewell(bugs) int bugs; {
 588         if (bugs == 0) exit(0);
 589         printf("\n%sFor hints on dealing with the ", co);
 590         if (bugs == 1) printf("problem");
 591         else printf("%d problems", bugs);
 592         printf(" above\n   see the section 'TROUBLESHOOTING' in the file ");
 593         printf("%s%s\n", FILENAME, oc);
 594         exit(bugs);
 595 }
 596
 597 /* The program has received a signal where it wasn't expecting one */
 598 Procedure croak(place) int place; {
 599         printf("*** Unexpected signal at point %d\n", place);
 600         farewell(bugs+1); /* An exit isn't essential here, but avoids loops */
 601 }
 602
 603 /* This is here in case alloca.c is used, which calls this. */
 604 char *xmalloc(size) unsigned size; {
 605         char *value = (char *)malloc(size);
 606         if (value == 0) {
 607                 fprintf(stderr, "Virtual memory exceeded\n");
 608                 exit(bugs+1);
 609         }
 610         return value;
 611 }
 612
 613 int maxint;
 614
 615 int maximum_int() {
 616         /* Find the maximum integer */
 617         Volatile int newi, int_max, two=2;
 618
 619         /* Calculate maxint ***********************************/
 620         /* Calculate 2**n-1 until overflow - then use the previous value  */
 621
 622         newi=1; int_max=0;
 623
 624         if (setjmp(lab)==0) { /* Yields int_max */
 625                 while(newi>int_max) {
 626                         int_max=newi;
 627                         newi=newi*two+1;
 628                 }
 629         }
 630         Unexpected(0);
 631         return int_max;
 632 }
 633
 634 int main(argc, argv) int argc; char *argv[]; {
 635         int dprec, fprec, lprec;
 636         unsigned int size;
 637         long total;
 638         int i; char *s; int bad;
 639
 640 #ifdef SIGFPE
 641         signal(SIGFPE, overflow);
 642 #endif
 643 #ifdef SIGOVER
 644         signal(SIGOVER, overflow);
 645 #endif
 646 /* Add more calls as necessary */
 647
 648         Unexpected(1);
 649
 650         bad=0;
 651         for (i=1; i < argc; i++) {
 652                 s= argv[i];
 653                 if (*s == '-') {
 654                         s++;
 655                         while (*s) {
 656                                 switch (*(s++)) {
 657                                       case 'v': V=1; break;
 658                                       case 'l': L=1; break;
 659                                       case 'f': F=1; break;
 660                                       default: bad=1; break;
 661                                 }
 662                         }
 663                 } else if (*s == '+') {
 664                         s++;
 665                         bad= setmode(s);
 666                 } else bad= 1;
 667         }
 668         if (bad) {
 669                 fprintf(stderr,
 670                         "Usage: %s [-vlf]\n  v=Verbose l=Limits.h f=Float.h\n",
 671                         argv[0]);
 672                 exit(1);
 673         }
 674         if (L || F) {
 675                 co[0]= '/'; oc[0]= ' ';
 676                 co[1]= '*'; oc[1]= '*';
 677                 co[2]= ' '; oc[2]= '/';
 678                 co[3]= '\0'; oc[3]= '\0';
 679         } else {
 680                 co[0]= '\0'; oc[0]= '\0';
 681                 V=1;
 682         }
 683
 684         if (L) printf("%slimits.h%s\n", co, oc);
 685         if (F) printf("%sfloat.h%s\n", co, oc);
 686         if (F) {
 687                 printf ("#ifndef _FLOAT_H___\n");
 688                 printf ("#define _FLOAT_H___\n");
 689         }
 690 #ifdef ID
 691         printf("%sProduced on %s by enquire version %s, CWI, Amsterdam%s\n",
 692                co, ID, VERSION, oc);
 693 #else
 694         printf("%sProduced by enquire version %s, CWI, Amsterdam%s\n",
 695                co, VERSION, oc);
 696 #endif
 697
 698 #ifdef VERIFY
 699         printf("%sVerification phase%s\n", co, oc);
 700 #endif
 701
 702 #ifdef NO_SIG
 703         Vprintf("%sCompiled without signal(): %s%s\n",
 704                 co,
 705                 "there's nothing that can be done if overflow occurs",
 706                 oc);
 707 #endif
 708 #ifdef NO_SC
 709         Vprintf("%sCompiled without signed char%s\n", co, oc);
 710 #endif
 711 #ifdef NO_UC
 712         Vprintf("%Compiled without unsigned char%s\n", co, oc);
 713 #endif
 714 #ifdef NO_UI
 715         Vprintf("%Compiled without unsigned short or long%s\n", co, oc);
 716 #endif
 717 #ifdef __STDC__
 718         Vprintf("%sCompiler claims to be ANSI C level %d%s\n",
 719                 co, __STDC__, oc);
 720 #else
 721         Vprintf("%sCompiler does not claim to be ANSI C%s\n", co, oc);
 722 #endif
 723         printf("\n");
 724         check_defines();
 725
 726         maxint= maximum_int();
 727         bits_per_byte= basic();
 728         Vprintf("\n");
 729         if (F||V) {
 730                 fprec= fprop(bits_per_byte);
 731                 dprec= dprop(bits_per_byte);
 732                 lprec= ldprop(bits_per_byte);
 733                 efprop(fprec, dprec, lprec);
 734                 edprop(fprec, dprec, lprec);
 735                 eldprop(fprec, dprec, lprec);
 736         }
 737 #ifndef NO_MEM
 738         if (V) {
 739                 /* An extra goody: the approximate amount of data-space */
 740                 /* Allocate store until no more available */
 741                 /* Different implementations have a different argument type
 742                    to malloc. Here we assume that it's the same type as
 743                    that which sizeof() returns */
 744                 size=1<<((bits_per_byte*sizeof(int))-2);
 745                 total=0;
 746                 while (size!=0) {
 747                         while ( malloc((false()?sizeof(int):size)) !=
 748                                 (char *)NULL
 749                                ) {
 750                                 total+=(size/2);
 751                         }
 752                         size/=2;
 753                 }
 754
 755                 Vprintf("%sMemory mallocatable ~= %ld Kbytes%s\n",
 756                         co, (total+511)/512, oc);
 757         }
 758 #endif
 759         if (F) {
 760                 printf ("#endif %s _FLOAT_H___%s\n", co, oc);
 761         }
 762         farewell(bugs);
 763         return bugs; /* To keep compilers and lint happy */
 764 }
 765
 766 Procedure eek_a_bug(problem) char *problem; {
 767         /* The program has discovered a problem */
 768         printf("\n%s*** WARNING: %s%s\n", co, problem, oc);
 769         bugs++;
 770 }
 771
 772 Procedure describe(description, extra) char *description, *extra; {
 773         /* Produce the description for a #define */
 774         printf("   %s", co);
 775         printf(description, extra);
 776         printf("%s\n", oc);
 777 }
 778
 779 Procedure i_define(desc, extra, sort, name, val, lim, req, mark)
 780      char *desc, *extra, *sort, *name; long val, lim, req; char *mark; {
 781         /* Produce a #define for a signed int type */
 782         describe(desc, extra);
 783         if (val >= 0) {
 784                 printf("#define %s%s %ld%s\n", sort, name, val, mark);
 785         } else if (val + lim < 0) {
 786                 /* We may not produce a constant like -1024 if the max
 787                    allowable value is 1023. It has then to be output as
 788                    -1023-1. lim is the max allowable value. */
 789                 printf("#define %s%s (%ld%s%ld%s)\n",
 790                        sort, name, -lim, mark, val+lim, mark);
 791         } else {
 792                 printf("#define %s%s (%ld%s)\n", sort, name, val, mark);
 793         }
 794         /* If VERIFY is not set, val and req are just the same value;
 795            if it is set, val is the value as calculated, and req is
 796            the #defined constant
 797         */
 798         if (val != req) {
 799                 printf("%s*** Verify failed for above #define!\n", co);
 800                 printf("       Compiler has %ld for value%s\n\n", req, oc);
 801                 bugs++;
 802         }
 803         Vprintf("\n");
 804 }
 805
 806 Procedure u_define(desc, extra, sort, name, val, req, mark)
 807      char *desc, *extra, *sort, *name; unsigned long val, req; char *mark; {
 808         /* Produce a #define for an unsigned value */
 809         describe(desc, extra);
 810         printf("#define %s%s %lu%s%s\n", sort, name, val, U, mark);
 811         if (val != req) {
 812                 printf("%s*** Verify failed for above #define!\n", co);
 813                 printf("       Compiler has %lu for value%s\n\n", req, oc);
 814                 bugs++;
 815         }
 816         Vprintf("\n");
 817 }
 818
 819 Procedure f_define(desc, extra, sort, name, precision, val, mark)
 820      char *desc, *extra, *sort, *name; int precision;
 821      Long_double val; char *mark; {
 822         /* Produce a #define for a float/double/long double */
 823         describe(desc, extra);
 824         if (stdc) {
 825 #ifdef NO_LONG_DOUBLE_IO
 826                 static int union_defined = 0;
 827                 if (!strcmp(sort, "LDBL")) {
 828                         if (!union_defined) {
 829                                 printf("#ifndef __LDBL_UNION__\n");
 830                                 printf("#define __LDBL_UNION__\n");
 831                                 printf("union __convert_long_double {\n");
 832                                 printf("  int __convert_long_double_i[4];\n");
 833                                 printf("  long double __convert_long_double_d;\n");
 834                                 printf("};\n");
 835                                 printf("#endif\n");
 836                                 union_defined = 1;
 837                         }
 838                         printf("#define %s%s %s\n",
 839                                sort, name, fake_f_rep("long double", val));
 840                 } else {
 841                         printf("#define %s%s %s%s\n",
 842                                sort, name, f_rep(precision, val), mark);
 843                 }
 844 #else
 845                 printf("#define %s%s %s%s\n",
 846                        sort, name, f_rep(precision, val), mark);
 847 #endif
 848         } else if (*mark == 'F') {
 849                 /* non-ANSI C has no float constants, so cast the constant */
 850                 printf("#define %s%s ((float)%s)\n",
 851                        sort, name, f_rep(precision, val));
 852         } else {
 853                 printf("#define %s%s %s\n", sort, name, f_rep(precision, val));
 854         }
 855         Vprintf("\n");
 856 }
 857
 858 int floor_log(base, x) int base; Long_double x; {
 859         /* return floor(log base(x)) */
 860         int r=0;
 861         while (x>=base) { r++; x/=base; }
 862         return r;
 863 }
 864
 865 int ceil_log(base, x) int base; Long_double x; {
 866         int r=0;
 867         while (x>1.0) { r++; x/=base; }
 868         return r;
 869 }
 870
 871 int exponent(x, fract, exp) Long_double x; double *fract; int *exp; {
 872         /* Split x into a fraction and a power of ten;
 873            returns 0 if x is unusable, 1 otherwise.
 874            Only used for error messages about faulty output.
 875         */
 876         int r=0, neg=0;
 877         Long_double old;
 878         *fract=0.0; *exp=0;
 879         if (x<0.0) {
 880                 x= -x;
 881                 neg= 1;
 882         }
 883         if (x==0.0) return 1;
 884         if (x>=10.0) {
 885                 while (x>=10.0) {
 886                         old=x; r++; x/=10.0;
 887                         if (old==x) return 0;
 888                 }
 889         } else {
 890                 while (x<1.0) {
 891                         old=x; r--; x*=10.0;
 892                         if (old==x) return 0;
 893                 }
 894         }
 895         if (neg) *fract= (double) -x;
 896         else *fract=(double) x;
 897         *exp=r;
 898         return 1;
 899 }
 900
 901 /* Print a value of type TYPE with value VAL,
 902    assuming that sprintf can't handle this type properly (without truncation).
 903    We create an expession that uses type casting to create the value from
 904    a bit pattern.  */
 905
 906 char *fake_f_rep(type, val) char *type; Long_double val; {
 907         static char buf[1024];
 908         union { int i[4]; Long_double ld;} u;
 909         u.ld = val;
 910         sprintf(buf, "(__extension__ ((union __convert_long_double) {0x%x, 0x%x, 0x%x, 0x%x}).__convert_long_double_d)",
 911                 u.i[0], u.i[1], u.i[2], u.i[3]);
 912         return buf;
 913 }
 914
 915 char *f_rep(precision, val) int precision; Long_double val; {
 916         /* Return the floating representation of val */
 917         static char buf[1024];
 918         char *f1;
 919 #ifdef NO_LONG_DOUBLE_IO
 920         if (1)
 921 #else
 922         if (sizeof(double) == sizeof(Long_double))
 923 #endif
 924         {
 925                 double d = val;
 926                 /* Assume they're the same, and use non-stdc format */
 927                 /* This is for stdc compilers using non-stdc libraries */
 928                 sprintf(buf, "%.*e", precision, d);
 929         } else {
 930                 /* It had better support Le then */
 931                 sprintf(buf, "%.*Le", precision, val);
 932         }
 933         return buf;
 934 }
 935
 936 Procedure bitpattern(p, size) char *p; unsigned int size; {
 937         /* Printf the bit-pattern of p */
 938         char c;
 939         int i, j;
 940
 941         for (i=1; i<=size; i++) {
 942                 c= *p;
 943                 p++;
 944                 for (j=bits_per_byte-1; j>=0; j--)
 945                         printf("%c", (c>>j)&1 ? '1' : '0');
 946                 if (i!=size) printf(" ");
 947         }
 948 }
 949
 950 #define Order(x, px, mode)\
 951    printf("%s%s ", co, mode); for (i=0; i<sizeof(x); i++) px[i]= ab[i]; \
 952    for (i=1; i<=sizeof(x); i++) { c=((x>>(bits_per_byte*(sizeof(x)-i)))&mask);\
 953       putchar(c==0 ? '?' : (char)c); }\
 954    printf("%s\n", oc);
 955
 956 Procedure endian(bits_per_byte) int bits_per_byte; {
 957         /* Printf the byte-order used on this machine */
 958         /*unsigned*/ short s=0;
 959         /*unsigned*/ int j=0;
 960         /*unsigned*/ long l=0;
 961
 962         char *ps= (char *) &s,
 963              *pj= (char *) &j,
 964              *pl= (char *) &l,
 965              *ab= "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
 966         unsigned int mask, i, c;
 967
 968         mask=0;
 969         for (i=1; i<=(unsigned)bits_per_byte; i++) mask= (mask<<1)|1;
 970
 971         if (V) {
 972                 printf("%sCHARACTER ORDER%s\n", co, oc);
 973                 Order(s, ps, "short:");
 974                 Order(j, pj, "int:  ");
 975                 Order(l, pl, "long: ");
 976         }
 977 }
 978
 979 Procedure missing(s) char *s; {
 980         printf("%s*** #define %s missing from limits.h%s\n", co, s, oc);
 981         bugs++;
 982 }
 983
 984 Procedure fmissing(s) char *s; {
 985         printf("%s*** #define %s missing from float.h%s\n", co, s, oc);
 986         bugs++;
 987 }
 988
 989 /* To try and fool optimisers */
 990 int false() { return 0; }
 991
 992 #define Promoted(x) (false()?(x):(-1))
 993 #define is_signed(x) (Promoted(x) < 0)
 994 #define sign_of(x) ((x)?"signed":"unsigned")
 995 #define Signed 1
 996 #define Unsigned 0
 997 #define sgn(x) ((is_signed(x))?Signed:Unsigned)
 998
 999 #define showtype(t, x) Vprintf("%s%s %s %s%s\n", co, t, sign_of(is_signed(x)), type_of(sizeof(x)), oc)
1000
1001 char *type_of(x) int x; {
1002         if (x == sizeof(char)) {
1003                 if (sizeof(char) == sizeof(int)) return "char/short/int";
1004                 if (sizeof(char) == sizeof(short)) return "char/short";
1005                 return "char";
1006         }
1007         if (x == sizeof(short)) {
1008                 if (sizeof(short) == sizeof(int)) return "short/int";
1009                 return "short";
1010         }
1011         if (x == sizeof(int)) {
1012                 if (sizeof(int) == sizeof(long)) return "int/long";
1013                 return "int";
1014         }
1015         if (x == sizeof(long)) return "long";
1016         return "unknown-type";
1017 }
1018
1019 char *ftype_of(x) int x; {
1020         if (x == sizeof(float)) {
1021                 return "float";
1022         }
1023         if (x == sizeof(double)) {
1024                 if (sizeof(double) == sizeof(Long_double))
1025                   return "(long)double";
1026                 return "double";
1027         }
1028         if (x == sizeof(Long_double)) {
1029                 return "long double";
1030         }
1031         return "unknown-type";
1032 }
1033
1034 Procedure typerr(name, esign, esize, sign, size)
1035   char *name; int esign, esize, sign, size;
1036 {
1037        Vprintf("*** %s has wrong type: expected %s %s, found %s %s\n",
1038                name, sign_of(esign), type_of(esize),
1039                sign_of(sign), type_of(size));
1040 }
1041
1042 Procedure ftyperr(name, esize, size) char *name; int esize, size; {
1043        Vprintf("*** %s has wrong type: expected %s, found %s\n",
1044                name, ftype_of(esize), ftype_of(size));
1045 }
1046
1047 promotions() {
1048         int si; long sl;
1049         unsigned int ui; unsigned long ul;
1050         short ss; unsigned short us;
1051
1052         Vprintf("\n%sPROMOTIONS%s\n", co, oc);
1053
1054         if (
1055             /* Possible warnings here; no problem */
1056             (sizeof(Promoted(si)) != sizeof(int)) ||
1057             (sizeof(Promoted(sl)) != sizeof(long)) ||
1058             (sizeof(Promoted(ss)) != sizeof(int)) ||
1059             (sizeof(Promoted(ui)) != sizeof(int)) ||
1060             (sizeof(Promoted(ul)) != sizeof(long)) ||
1061             (sizeof(Promoted(us)) != sizeof(int)) ||
1062             is_signed(ui) || is_signed(ul) ||
1063             !is_signed(si) || !is_signed(sl)
1064             )
1065           {
1066             eek_a_bug("promotions don't work properly in conditional expressions\n");
1067           }
1068
1069         showtype("unsigned short promotes to", Promoted((unsigned short)0));
1070         showtype("long+unsigned gives", sl+ui);
1071 }
1072
1073 #define checktype(x, n, s, t) if((sgn(x)!=s)||(sizeof(x)!=sizeof(t))) typerr(n, s, sizeof(t), sign_of(x), sizeof(x));
1074
1075 #define fchecktype(x, n, t) if (sizeof(x) != sizeof(t)) ftyperr(n, sizeof(x), sizeof(t));
1076
1077 Procedure check_defines() {
1078         /* ensure that all #defines are present and have the correct type */
1079 #ifdef VERIFY
1080         int usign;
1081
1082 #ifdef NO_UI
1083         usign= Signed;
1084 #else
1085         /* Implementations promote unsigned short differently */
1086         usign= is_signed((unsigned short)0);
1087 #endif
1088
1089         if (L) {
1090 #ifdef CHAR_BIT
1091         checktype(CHAR_BIT, "CHAR_BIT", Signed, int);
1092 #else
1093         missing("CHAR_BIT");
1094 #endif
1095 #ifdef CHAR_MAX
1096         checktype(CHAR_MAX, "CHAR_MAX", Signed, int);
1097 #else
1098         missing("CHAR_MAX");
1099 #endif
1100 #ifdef CHAR_MIN
1101         checktype(CHAR_MIN, "CHAR_MIN", Signed, int);
1102 #else
1103         missing("CHAR_MIN");
1104 #endif
1105 #ifdef SCHAR_MAX
1106         checktype(SCHAR_MAX, "SCHAR_MAX", Signed, int);
1107 #else
1108         missing("SCHAR_MAX");
1109 #endif
1110 #ifdef SCHAR_MIN
1111         checktype(SCHAR_MIN, "SCHAR_MIN", Signed, int);
1112 #else
1113         missing("SCHAR_MIN");
1114 #endif
1115 #ifdef UCHAR_MAX
1116         checktype(UCHAR_MAX, "UCHAR_MAX", Signed, int);
1117 #else
1118         missing("UCHAR_MAX");
1119 #endif
1120 #ifdef SHRT_MAX
1121         checktype(SHRT_MAX, "SHRT_MAX", Signed, int);
1122 #else
1123         missing("SHRT_MAX");
1124 #endif
1125 #ifdef SHRT_MIN
1126         checktype(SHRT_MIN, "SHRT_MIN", Signed, int);
1127 #else
1128         missing("SHRT_MIN");
1129 #endif
1130 #ifdef INT_MAX
1131         checktype(INT_MAX, "INT_MAX", Signed, int);
1132 #else
1133         missing("INT_MAX");
1134 #endif
1135 #ifdef INT_MIN
1136         checktype(INT_MIN, "INT_MIN", Signed, int);
1137 #else
1138         missing("INT_MIN");
1139 #endif
1140 #ifdef LONG_MAX
1141         checktype(LONG_MAX, "LONG_MAX", Signed, long);
1142 #else
1143         missing("LONG_MAX");
1144 #endif
1145 #ifdef LONG_MIN
1146         checktype(LONG_MIN, "LONG_MIN", Signed, long);
1147 #else
1148         missing("LONG_MIN");
1149 #endif
1150 #ifdef USHRT_MAX
1151         checktype(USHRT_MAX, "USHRT_MAX", usign, int);
1152 #else
1153         missing("USHRT_MAX");
1154 #endif
1155 #ifdef UINT_MAX
1156         checktype(UINT_MAX, "UINT_MAX", Unsigned, int);
1157 #else
1158         missing("UINT_MAX");
1159 #endif
1160 #ifdef ULONG_MAX
1161         checktype(ULONG_MAX, "ULONG_MAX", Unsigned, long);
1162 #else
1163         missing("ULONG_MAX");
1164 #endif
1165         } /* if (L) */
1166
1167         if (F) {
1168 #ifdef FLT_RADIX
1169         checktype(FLT_RADIX, "FLT_RADIX", Signed, int);
1170 #else
1171         fmissing("FLT_RADIX");
1172 #endif
1173 #ifdef FLT_MANT_DIG
1174         checktype(FLT_MANT_DIG, "FLT_MANT_DIG", Signed, int);
1175 #else
1176         fmissing("FLT_MANT_DIG");
1177 #endif
1178 #ifdef FLT_DIG
1179         checktype(FLT_DIG, "FLT_DIG", Signed, int);
1180 #else
1181         fmissing("FLT_DIG");
1182 #endif
1183 #ifdef FLT_ROUNDS
1184         checktype(FLT_ROUNDS, "FLT_ROUNDS", Signed, int);
1185 #else
1186         fmissing("FLT_ROUNDS");
1187 #endif
1188 #ifdef FLT_EPSILON
1189         fchecktype(FLT_EPSILON, "FLT_EPSILON", float);
1190 #else
1191         fmissing("FLT_EPSILON");
1192 #endif
1193 #ifdef FLT_MIN_EXP
1194         checktype(FLT_MIN_EXP, "FLT_MIN_EXP", Signed, int);
1195 #else
1196         fmissing("FLT_MIN_EXP");
1197 #endif
1198 #ifdef FLT_MIN
1199         fchecktype(FLT_MIN, "FLT_MIN", float);
1200 #else
1201         fmissing("FLT_MIN");
1202 #endif
1203 #ifdef FLT_MIN_10_EXP
1204         checktype(FLT_MIN_10_EXP, "FLT_MIN_10_EXP", Signed, int);
1205 #else
1206         fmissing("FLT_MIN_10_EXP");
1207 #endif
1208 #ifdef FLT_MAX_EXP
1209         checktype(FLT_MAX_EXP, "FLT_MAX_EXP", Signed, int);
1210 #else
1211         fmissing("FLT_MAX_EXP");
1212 #endif
1213 #ifdef FLT_MAX
1214         fchecktype(FLT_MAX, "FLT_MAX", float);
1215 #else
1216         fmissing("FLT_MAX");
1217 #endif
1218 #ifdef FLT_MAX_10_EXP
1219         checktype(FLT_MAX_10_EXP, "FLT_MAX_10_EXP", Signed, int);
1220 #else
1221         fmissing("FLT_MAX_10_EXP");
1222 #endif
1223 #ifdef DBL_MANT_DIG
1224         checktype(DBL_MANT_DIG, "DBL_MANT_DIG", Signed, int);
1225 #else
1226         fmissing("DBL_MANT_DIG");
1227 #endif
1228 #ifdef DBL_DIG
1229         checktype(DBL_DIG, "DBL_DIG", Signed, int);
1230 #else
1231         fmissing("DBL_DIG");
1232 #endif
1233 #ifdef DBL_EPSILON
1234         fchecktype(DBL_EPSILON, "DBL_EPSILON", double);
1235 #else
1236         fmissing("DBL_EPSILON");
1237 #endif
1238 #ifdef DBL_MIN_EXP
1239         checktype(DBL_MIN_EXP, "DBL_MIN_EXP", Signed, int);
1240 #else
1241         fmissing("DBL_MIN_EXP");
1242 #endif
1243 #ifdef DBL_MIN
1244         fchecktype(DBL_MIN, "DBL_MIN", double);
1245 #else
1246         fmissing("DBL_MIN");
1247 #endif
1248 #ifdef DBL_MIN_10_EXP
1249         checktype(DBL_MIN_10_EXP, "DBL_MIN_10_EXP", Signed, int);
1250 #else
1251         fmissing("DBL_MIN_10_EXP");
1252 #endif
1253 #ifdef DBL_MAX_EXP
1254         checktype(DBL_MAX_EXP, "DBL_MAX_EXP", Signed, int);
1255 #else
1256         fmissing("DBL_MAX_EXP");
1257 #endif
1258 #ifdef DBL_MAX
1259         fchecktype(DBL_MAX, "DBL_MAX", double);
1260 #else
1261         fmissing("DBL_MAX");
1262 #endif
1263 #ifdef DBL_MAX_10_EXP
1264         checktype(DBL_MAX_10_EXP, "DBL_MAX_10_EXP", Signed, int);
1265 #else
1266         fmissing("DBL_MAX_10_EXP");
1267 #endif
1268 #ifdef STDC
1269 #ifdef LDBL_MANT_DIG
1270         checktype(LDBL_MANT_DIG, "LDBL_MANT_DIG", Signed, int);
1271 #else
1272         fmissing("LDBL_MANT_DIG");
1273 #endif
1274 #ifdef LDBL_DIG
1275         checktype(LDBL_DIG, "LDBL_DIG", Signed, int);
1276 #else
1277         fmissing("LDBL_DIG");
1278 #endif
1279 #ifdef LDBL_EPSILON
1280         fchecktype(LDBL_EPSILON, "LDBL_EPSILON", long double);
1281 #else
1282         fmissing("LDBL_EPSILON");
1283 #endif
1284 #ifdef LDBL_MIN_EXP
1285         checktype(LDBL_MIN_EXP, "LDBL_MIN_EXP", Signed, int);
1286 #else
1287         fmissing("LDBL_MIN_EXP");
1288 #endif
1289 #ifdef LDBL_MIN
1290         fchecktype(LDBL_MIN, "LDBL_MIN", long double);
1291 #else
1292         fmissing("LDBL_MIN");
1293 #endif
1294 #ifdef LDBL_MIN_10_EXP
1295         checktype(LDBL_MIN_10_EXP, "LDBL_MIN_10_EXP", Signed, int);
1296 #else
1297         fmissing("LDBL_MIN_10_EXP");
1298 #endif
1299 #ifdef LDBL_MAX_EXP
1300         checktype(LDBL_MAX_EXP, "LDBL_MAX_EXP", Signed, int);
1301 #else
1302         fmissing("LDBL_MAX_EXP");
1303 #endif
1304 #ifdef LDBL_MAX
1305         fchecktype(LDBL_MAX, "LDBL_MAX", long double);
1306 #else
1307         fmissing("LDBL_MAX");
1308 #endif
1309 #ifdef LDBL_MAX_10_EXP
1310         checktype(LDBL_MAX_10_EXP, "LDBL_MAX_10_EXP", Signed, int);
1311 #else
1312         fmissing("LDBL_MAX_10_EXP");
1313 #endif
1314 #endif /* STDC */
1315         } /* if (F) */
1316 #endif /* VERIFY */
1317 }
1318
1319 #ifdef VERIFY
1320 #ifndef SCHAR_MAX
1321 #define SCHAR_MAX       char_max
1322 #endif
1323 #ifndef SCHAR_MIN
1324 #define SCHAR_MIN       char_min
1325 #endif
1326 #ifndef UCHAR_MAX
1327 #define UCHAR_MAX       char_max
1328 #endif
1329 #endif /* VERIFY */
1330
1331 #ifndef CHAR_BIT
1332 #define CHAR_BIT        char_bit
1333 #endif
1334 #ifndef CHAR_MAX
1335 #define CHAR_MAX        char_max
1336 #endif
1337 #ifndef CHAR_MIN
1338 #define CHAR_MIN        char_min
1339 #endif
1340 #ifndef SCHAR_MAX
1341 #define SCHAR_MAX       char_max
1342 #endif
1343 #ifndef SCHAR_MIN
1344 #define SCHAR_MIN       char_min
1345 #endif
1346 #ifndef UCHAR_MAX
1347 #define UCHAR_MAX       char_max
1348 #endif
1349
1350 int cprop() {
1351         /* Properties of type char */
1352         Volatile char c, char_max, char_min;
1353         Volatile int bits_per_byte, c_signed;
1354         long char_bit;
1355
1356         Unexpected(2);
1357
1358         /* Calculate number of bits per character *************************/
1359         c=1; bits_per_byte=0;
1360         do { c=c<<1; bits_per_byte++; } while(c!=0);
1361         c= (char)(-1);
1362         if (((int)c)<0) c_signed=1;
1363         else c_signed=0;
1364         Vprintf("%schar = %d bits, %ssigned%s\n",
1365                 co, (int)sizeof(c)*bits_per_byte, (c_signed?"":"un"), oc);
1366         char_bit=(long)(sizeof(c)*bits_per_byte);
1367         if (L) i_define(D_CHAR_BIT, "", "CHAR", "_BIT",
1368                         char_bit, 0L, (long) CHAR_BIT, "");
1369
1370         c=0; char_max=0;
1371         c++;
1372         if (setjmp(lab)==0) { /* Yields char_max */
1373                 while (c>char_max) {
1374                         char_max=c;
1375                         c++;
1376                 }
1377         } else {
1378                 Vprintf("%sCharacter overflow generates a trap!%s\n", co, oc);
1379         }
1380         c=0; char_min=0;
1381         c--;
1382         if (setjmp(lab)==0) { /* Yields char_min */
1383                 while (c<char_min) {
1384                         char_min=c;
1385                         c--;
1386                 }
1387         }
1388         if (c_signed && char_min == 0) {
1389                 Vprintf("%sBEWARE! Chars are pseudo-unsigned:%s\n", co, oc);
1390                 Vprintf("%s   %s%s%s\n",
1391                         "They contain only nonnegative values, ",
1392                         "but sign extend when used as integers.", co, oc);
1393         }
1394         Unexpected(3);
1395
1396         if (L) {
1397                 /* Because of the integer promotions, you must use a U after
1398                    the MAX_CHARS in the following cases */
1399                 if ((sizeof(char) == sizeof(int)) && !c_signed) {
1400                         u_define(D_CHAR_MAX, "", "CHAR", "_MAX",
1401                                  (long) char_max,
1402                                  (long) CHAR_MAX, "");
1403                 } else {
1404                         i_define(D_CHAR_MAX, "", "CHAR", "_MAX",
1405                                  (long) char_max, 0L,
1406                                  (long) CHAR_MAX, "");
1407                 }
1408                 i_define(D_CHAR_MIN, "", "CHAR", "_MIN",
1409                          (long) char_min, (long) maxint,
1410                          (long) CHAR_MIN, "");
1411                 if (c_signed) {
1412                         i_define(D_SCHAR_MAX, "", "SCHAR", "_MAX",
1413                                  (long) char_max, 0L,
1414                                  (long) SCHAR_MAX, "");
1415                         i_define(D_SCHAR_MIN, "", "SCHAR", "_MIN",
1416                                  (long) char_min, (long) maxint,
1417                                  (long) SCHAR_MIN, "");
1418                 } else {
1419                         if (sizeof(char) == sizeof(int)) {
1420                                 u_define(D_UCHAR_MAX, "", "UCHAR", "_MAX",
1421                                          (long) char_max,
1422                                          (long) UCHAR_MAX, "");
1423                         } else {
1424                                 i_define(D_UCHAR_MAX, "", "UCHAR", "_MAX",
1425                                          (long) char_max, 0L,
1426                                          (long) UCHAR_MAX, "");
1427                         }
1428                 }
1429
1430                 if (c_signed) {
1431 #ifndef NO_UC
1432                         Volatile unsigned char c, char_max;
1433                         c=0; char_max=0;
1434                         c++;
1435                         if (setjmp(lab)==0) { /* Yields char_max */
1436                                 while (c>char_max) {
1437                                         char_max=c;
1438                                         c++;
1439                                 }
1440                         }
1441                         Unexpected(4);
1442                         if (sizeof(char) == sizeof(int)) {
1443                                 u_define(D_UCHAR_MAX, "", "UCHAR", "_MAX",
1444                                          (long) char_max,
1445                                          (long) UCHAR_MAX, "");
1446                         } else {
1447                                 i_define(D_UCHAR_MAX, "", "UCHAR", "_MAX",
1448                                          (long) char_max, 0L,
1449                                          (long) UCHAR_MAX, "");
1450                         }
1451 #endif
1452                 } else {
1453 #ifndef NO_SC
1454 /* Define NO_SC if this gives a syntax error */ Volatile signed char c, char_max, char_min;
1455                         c=0; char_max=0;
1456                         c++;
1457                         if (setjmp(lab)==0) { /* Yields char_max */
1458                                 while (c>char_max) {
1459                                         char_max=c;
1460                                         c++;
1461                                 }
1462                         }
1463                         c=0; char_min=0;
1464                         c--;
1465                         if (setjmp(lab)==0) { /* Yields char_min */
1466                                 while (c<char_min) {
1467                                         char_min=c;
1468                                         c--;
1469                                 }
1470                         }
1471                         Unexpected(5);
1472                         i_define(D_SCHAR_MIN, "", "SCHAR", "_MIN",
1473                                  (long) char_min, (long) maxint,
1474                                  (long) SCHAR_MIN, "");
1475                         i_define(D_SCHAR_MAX, "", "SCHAR", "_MAX",
1476                                  (long) char_max, 0L,
1477                                  (long) SCHAR_MAX, "");
1478 #endif /* NO_SC */
1479                 }
1480         }
1481         return bits_per_byte;
1482 }
1483
1484 int basic() {
1485         /* The properties of the basic types.
1486            Returns number of bits per sizeof unit */
1487         Volatile int bits_per_byte;
1488         typedef int function ();
1489         int variable;
1490         int *p, *q;
1491
1492         Vprintf("%sSIZES%s\n", co, oc);
1493         bits_per_byte= cprop();
1494
1495         /* Shorts, ints and longs *****************************************/
1496         Vprintf("%sshort=%d int=%d long=%d float=%d double=%d bits %s\n",
1497                 co,
1498                 (int) sizeof(short)*bits_per_byte,
1499                 (int) sizeof(int)*bits_per_byte,
1500                 (int) sizeof(long)*bits_per_byte,
1501                 (int) sizeof(float)*bits_per_byte,
1502                 (int) sizeof(double)*bits_per_byte, oc);
1503         if (stdc) {
1504                 Vprintf("%slong double=%d bits%s\n",
1505                         co, (int) sizeof(Long_double)*bits_per_byte, oc);
1506         }
1507         Vprintf("%schar*=%d bits%s%s\n",
1508                 co, (int)sizeof(char *)*bits_per_byte,
1509                 sizeof(char *)>sizeof(int)?" BEWARE! larger than int!":"",
1510                 oc);
1511         Vprintf("%sint* =%d bits%s%s\n",
1512                 co, (int)sizeof(int *)*bits_per_byte,
1513                 sizeof(int *)>sizeof(int)?" BEWARE! larger than int!":"",
1514                 oc);
1515         Vprintf("%sfunc*=%d bits%s%s\n",
1516                 co, (int)sizeof(function *)*bits_per_byte,
1517                 sizeof(function *)>sizeof(int)?" BEWARE! larger than int!":"",
1518                 oc);
1519 if (V) printf ("%s%s %s %s%s\n", co, "Type size_t is",
1520                        ((((false()?( sizeof(int)):(-1))  < 0) )?
1521                         "signed":"unsigned") ,
1522                        type_of(sizeof(
1523                                       sizeof(int)+0
1524                                       )
1525                                ),
1526                oc);
1527         showtype("Type size_t is", sizeof(0));
1528
1529         /* Alignment constants ********************************************/
1530
1531 #define alignment(TYPE) \
1532         ((long)((char *)&((struct{char c; TYPE d;}*)0)->d - (char *)0))
1533
1534         Vprintf("\n%sALIGNMENTS%s\n", co, oc);
1535
1536         Vprintf("%schar=%ld short=%ld int=%ld long=%ld%s\n",
1537                 co,
1538                 alignment(char), alignment(short),
1539                 alignment(int), alignment(long),
1540                 oc);
1541
1542         Vprintf("%sfloat=%ld double=%ld%s\n",
1543                 co,
1544                 alignment(float), alignment(double),
1545                 oc);
1546
1547         if (stdc) {
1548                 Vprintf("%slong double=%ld%s\n",
1549                         co,
1550                         alignment(Long_double),
1551                         oc);
1552         }
1553         Vprintf("%schar*=%ld int*=%ld func*=%ld%s\n",
1554                 co,
1555                 alignment(char *), alignment(int *), alignment(function *),
1556                 oc);
1557
1558         Vprintf("\n");
1559
1560         /* Ten little endians *********************************************/
1561
1562         endian(bits_per_byte);
1563
1564         /* Pointers *******************************************************/
1565
1566         Vprintf("\n%sPROPERTIES OF POINTERS%s\n", co, oc);
1567
1568         if ((long) (char *) &variable == (long) (int *) &variable)
1569                 Vprintf("%sChar and int pointer formats seem identical%s\n",
1570                        co, oc);
1571         else
1572                 Vprintf("%sChar and int pointer formats are different%s\n",
1573                        co, oc);
1574         if ((long) (char *) &variable == (long) (function *) &variable)
1575                 Vprintf("%sChar and function pointer formats seem identical%s\n",
1576                        co, oc);
1577         else
1578                 Vprintf("%sChar and function pointer formats are different%s\n",
1579                        co, oc);
1580
1581         if (V) {
1582                 if ("abcd"=="abcd")
1583                         printf("%sStrings are shared%s\n", co, oc);
1584                 else printf("%sStrings are not shared%s\n", co, oc);
1585         }
1586
1587         p=0; q=0;
1588         showtype("Type ptrdiff_t is", p-q);
1589
1590         Vprintf("\n%sPROPERTIES OF INTEGRAL TYPES%s\n", co, oc);
1591
1592         sprop();
1593         iprop();
1594         lprop();
1595         usprop();
1596         uiprop();
1597         ulprop();
1598
1599         promotions();
1600
1601         Unexpected(6);
1602
1603         return bits_per_byte;
1604 }
1605
1606 #else /* not PASS0 */
1607
1608 #ifdef SEP
1609 extern jmp_buf lab;
1610 extern int V, L, F, bugs, bits_per_byte;
1611 extern char co[], oc[];
1612 extern char *f_rep();
1613 #endif /* SEP */
1614 #endif /* ifdef PASS0 */
1615
1616 /* As I said, I apologise for the contortions below. The functions are
1617    expanded by the preprocessor twice or three times (for float and double,
1618    and maybe for long double, and for short, int and long). That way,
1619    I never make a change to one that I forget to make to the other.
1620    You can look on it as C's fault for not supporting multi-line macro's.
1621    This whole file is read 3 times by the preprocessor, with PASSn set for
1622    n=1, 2 or 3, to decide which parts to reprocess.
1623 */
1624
1625 /* #undef on an already undefined thing is (wrongly) flagged as an error
1626    by some compilers, therefore the #ifdef that follows:
1627 */
1628 #ifdef Number
1629 #undef Number
1630 #undef THING
1631 #undef Thing
1632 #undef thing
1633 #undef FPROP
1634 #undef Fname
1635 #undef Store
1636 #undef Sum
1637 #undef Diff
1638 #undef Mul
1639 #undef Div
1640 #undef ZERO
1641 #undef HALF
1642 #undef ONE
1643 #undef TWO
1644 #undef THREE
1645 #undef FOUR
1646 #undef Self
1647 #undef F_check
1648 #undef Validate
1649 #undef EPROP
1650 #undef MARK
1651
1652 /* These are the float.h constants */
1653 #undef F_RADIX
1654 #undef F_MANT_DIG
1655 #undef F_DIG
1656 #undef F_ROUNDS
1657 #undef F_EPSILON
1658 #undef F_MIN_EXP
1659 #undef F_MIN
1660 #undef F_MIN_10_EXP
1661 #undef F_MAX_EXP
1662 #undef F_MAX
1663 #undef F_MAX_10_EXP
1664 #endif
1665
1666 #ifdef Integer
1667 #undef Integer
1668 #undef INT
1669 #undef IPROP
1670 #undef Iname
1671 #undef UPROP
1672 #undef Uname
1673 #undef OK_UI
1674 #undef IMARK
1675
1676 #undef I_MAX
1677 #undef I_MIN
1678 #undef U_MAX
1679 #endif
1680
1681 #ifdef PASS1
1682
1683 /* Define the things we're going to use this pass */
1684
1685 #define Number  float
1686 #define THING   "FLOAT"
1687 #define Thing   "Float"
1688 #define thing   "float"
1689 #define Fname   "FLT"
1690 #define FPROP   fprop
1691 #define Store   fStore
1692 #define Sum     fSum
1693 #define Diff    fDiff
1694 #define Mul     fMul
1695 #define Div     fDiv
1696 #define ZERO    0.0
1697 #define HALF    0.5
1698 #define ONE     1.0
1699 #define TWO     2.0
1700 #define THREE   3.0
1701 #define FOUR    4.0
1702 #define Self    fSelf
1703 #define F_check fCheck
1704 #define MARK    "F"
1705 #ifdef VERIFY
1706 #define Validate(prec, val, req, same) fValidate(prec, val, req, same)
1707 #endif
1708
1709 #define EPROP   efprop
1710
1711 #define Integer short
1712 #define INT     "short"
1713 #define IPROP   sprop
1714 #define Iname   "SHRT"
1715 #ifndef NO_UI
1716 #define OK_UI 1
1717 #endif
1718 #define IMARK   ""
1719
1720 #define UPROP   usprop
1721 #define Uname   "USHRT"
1722
1723 #ifdef VERIFY
1724 #ifdef SHRT_MAX
1725 #define I_MAX           SHRT_MAX
1726 #endif
1727 #ifdef SHRT_MIN
1728 #define I_MIN           SHRT_MIN
1729 #endif
1730 #ifdef USHRT_MAX
1731 #define U_MAX           USHRT_MAX
1732 #endif
1733
1734 #ifdef FLT_RADIX
1735 #define F_RADIX         FLT_RADIX
1736 #endif
1737 #ifdef FLT_MANT_DIG
1738 #define F_MANT_DIG      FLT_MANT_DIG
1739 #endif
1740 #ifdef FLT_DIG
1741 #define F_DIG           FLT_DIG
1742 #endif
1743 #ifdef FLT_ROUNDS
1744 #define F_ROUNDS        FLT_ROUNDS
1745 #endif
1746 #ifdef FLT_EPSILON
1747 #define F_EPSILON       FLT_EPSILON
1748 #endif
1749 #ifdef FLT_MIN_EXP
1750 #define F_MIN_EXP       FLT_MIN_EXP
1751 #endif
1752 #ifdef FLT_MIN
1753 #define F_MIN           FLT_MIN
1754 #endif
1755 #ifdef FLT_MIN_10_EXP
1756 #define F_MIN_10_EXP    FLT_MIN_10_EXP
1757 #endif
1758 #ifdef FLT_MAX_EXP
1759 #define F_MAX_EXP       FLT_MAX_EXP
1760 #endif
1761 #ifdef FLT_MAX
1762 #define F_MAX           FLT_MAX
1763 #endif
1764 #ifdef FLT_MAX_10_EXP
1765 #define F_MAX_10_EXP    FLT_MAX_10_EXP
1766 #endif
1767 #endif /* VERIFY */
1768
1769 #endif /* PASS1 */
1770
1771 #ifdef PASS2
1772
1773 #define Number  double
1774 #define THING   "DOUBLE"
1775 #define Thing   "Double"
1776 #define thing   "double"
1777 #define Fname   "DBL"
1778 #define FPROP   dprop
1779 #define Store   dStore
1780 #define Sum     dSum
1781 #define Diff    dDiff
1782 #define Mul     dMul
1783 #define Div     dDiv
1784 #define ZERO    0.0
1785 #define HALF    0.5
1786 #define ONE     1.0
1787 #define TWO     2.0
1788 #define THREE   3.0
1789 #define FOUR    4.0
1790 #define Self    dSelf
1791 #define F_check dCheck
1792 #define MARK    ""
1793 #ifdef VERIFY
1794 #define Validate(prec, val, req, same) dValidate(prec, val, req, same)
1795 #endif
1796
1797 #define EPROP   edprop
1798
1799 #define Integer int
1800 #define INT     "int"
1801 #define IPROP   iprop
1802 #define Iname   "INT"
1803 #define OK_UI   1 /* Unsigned int is always possible */
1804 #define IMARK   ""
1805
1806 #define UPROP   uiprop
1807 #define Uname   "UINT"
1808
1809 #ifdef VERIFY
1810 #ifdef INT_MAX
1811 #define I_MAX           INT_MAX
1812 #endif
1813 #ifdef INT_MIN
1814 #define I_MIN           INT_MIN
1815 #endif
1816 #ifdef UINT_MAX
1817 #define U_MAX           UINT_MAX
1818 #endif
1819
1820 #ifdef DBL_MANT_DIG
1821 #define F_MANT_DIG      DBL_MANT_DIG
1822 #endif
1823 #ifdef DBL_DIG
1824 #define F_DIG           DBL_DIG
1825 #endif
1826 #ifdef DBL_EPSILON
1827 #define F_EPSILON       DBL_EPSILON
1828 #endif
1829 #ifdef DBL_MIN_EXP
1830 #define F_MIN_EXP       DBL_MIN_EXP
1831 #endif
1832 #ifdef DBL_MIN
1833 #define F_MIN           DBL_MIN
1834 #endif
1835 #ifdef DBL_MIN_10_EXP
1836 #define F_MIN_10_EXP    DBL_MIN_10_EXP
1837 #endif
1838 #ifdef DBL_MAX_EXP
1839 #define F_MAX_EXP       DBL_MAX_EXP
1840 #endif
1841 #ifdef DBL_MAX
1842 #define F_MAX           DBL_MAX
1843 #endif
1844 #ifdef DBL_MAX_10_EXP
1845 #define F_MAX_10_EXP    DBL_MAX_10_EXP
1846 #endif
1847 #endif /* VERIFY */
1848
1849 #endif /* PASS2 */
1850
1851 #ifdef PASS3
1852
1853 #ifdef STDC
1854 #define Number  long double
1855
1856 #define ZERO    0.0L
1857 #define HALF    0.5L
1858 #define ONE     1.0L
1859 #define TWO     2.0L
1860 #define THREE   3.0L
1861 #define FOUR    4.0L
1862 #endif
1863
1864 #define THING   "LONG DOUBLE"
1865 #define Thing   "Long double"
1866 #define thing   "long double"
1867 #define Fname   "LDBL"
1868 #define FPROP   ldprop
1869 #define Store   ldStore
1870 #define Sum     ldSum
1871 #define Diff    ldDiff
1872 #define Mul     ldMul
1873 #define Div     ldDiv
1874 #define Self    ldSelf
1875 #define F_check ldCheck
1876 #define MARK    "L"
1877 #ifdef VERIFY
1878 #define Validate(prec, val, req, same) ldValidate(prec, val, req, same)
1879 #endif
1880
1881 #define EPROP   eldprop
1882
1883 #define Integer long
1884 #define INT     "long"
1885 #define IPROP   lprop
1886 #define Iname   "LONG"
1887 #ifndef NO_UI
1888 #define OK_UI   1
1889 #endif
1890 #define IMARK   "L"
1891
1892 #define UPROP   ulprop
1893 #define Uname   "ULONG"
1894
1895 #ifdef VERIFY
1896 #ifdef LONG_MAX
1897 #define I_MAX   LONG_MAX
1898 #endif
1899 #ifdef LONG_MIN
1900 #define I_MIN   LONG_MIN
1901 #endif
1902 #ifdef ULONG_MAX
1903 #define U_MAX   ULONG_MAX
1904 #endif
1905
1906 #ifdef LDBL_MANT_DIG
1907 #define F_MANT_DIG      LDBL_MANT_DIG
1908 #endif
1909 #ifdef LDBL_DIG
1910 #define F_DIG           LDBL_DIG
1911 #endif
1912 #ifdef LDBL_EPSILON
1913 #define F_EPSILON       LDBL_EPSILON
1914 #endif
1915 #ifdef LDBL_MIN_EXP
1916 #define F_MIN_EXP       LDBL_MIN_EXP
1917 #endif
1918 #ifdef LDBL_MIN
1919 #define F_MIN           LDBL_MIN
1920 #endif
1921 #ifdef LDBL_MIN_10_EXP
1922 #define F_MIN_10_EXP    LDBL_MIN_10_EXP
1923 #endif
1924 #ifdef LDBL_MAX_EXP
1925 #define F_MAX_EXP       LDBL_MAX_EXP
1926 #endif
1927 #ifdef LDBL_MAX
1928 #define F_MAX           LDBL_MAX
1929 #endif
1930 #ifdef LDBL_MAX_10_EXP
1931 #define F_MAX_10_EXP    LDBL_MAX_10_EXP
1932 #endif
1933 #endif /* VERIFY */
1934
1935 #endif /* PASS3 */
1936
1937 #ifndef I_MAX
1938 #define I_MAX   int_max
1939 #endif
1940 #ifndef I_MIN
1941 #define I_MIN   int_min
1942 #endif
1943 #ifndef U_MAX
1944 #define U_MAX   u_max
1945 #endif
1946
1947 #ifndef F_RADIX
1948 #define F_RADIX         f_radix
1949 #endif
1950 #ifndef F_MANT_DIG
1951 #define F_MANT_DIG      f_mant_dig
1952 #endif
1953 #ifndef F_DIG
1954 #define F_DIG           f_dig
1955 #endif
1956 #ifndef F_ROUNDS
1957 #define F_ROUNDS        f_rounds
1958 #endif
1959 #ifndef F_EPSILON
1960 #define F_EPSILON       f_epsilon
1961 #endif
1962 #ifndef F_MIN_EXP
1963 #define F_MIN_EXP       f_min_exp
1964 #endif
1965 #ifndef F_MIN
1966 #define F_MIN           f_min
1967 #endif
1968 #ifndef F_MIN_10_EXP
1969 #define F_MIN_10_EXP    f_min_10_exp
1970 #endif
1971 #ifndef F_MAX_EXP
1972 #define F_MAX_EXP       f_max_exp
1973 #endif
1974 #ifndef F_MAX
1975 #define F_MAX           f_max
1976 #endif
1977 #ifndef F_MAX_10_EXP
1978 #define F_MAX_10_EXP    f_max_10_exp
1979 #endif
1980
1981 #ifndef VERIFY
1982 #define Validate(prec, val, req, same) {;}
1983 #endif
1984
1985 #ifdef Integer
1986
1987 Procedure IPROP() {
1988         /* the properties of short, int, and long */
1989         Volatile Integer newi, int_max, maxeri, int_min, minneri;
1990         Volatile int ibits, ipower, two=2;
1991
1992         /* Calculate max short/int/long ***********************************/
1993         /* Calculate 2**n-1 until overflow - then use the previous value  */
1994
1995         newi=1; int_max=0;
1996
1997         if (setjmp(lab)==0) { /* Yields int_max */
1998                 for(ipower=0; newi>int_max; ipower++) {
1999                         int_max=newi;
2000                         newi=newi*two+1;
2001                 }
2002                 Vprintf("%sOverflow of a%s %s does not generate a trap%s\n",
2003                         co, INT[0]=='i'?"n":"", INT, oc);
2004         } else {
2005                 Vprintf("%sOverflow of a%s %s generates a trap%s\n",
2006                         co, INT[0]=='i'?"n":"", INT, oc);
2007         }
2008         Unexpected(7);
2009
2010         /* Minimum value: assume either two's or one's complement *********/
2011         int_min= -int_max;
2012         if (setjmp(lab)==0) { /* Yields int_min */
2013                 if (int_min-1 < int_min) int_min--;
2014         }
2015         Unexpected(8);
2016
2017         /* Now for those daft Cybers */
2018
2019         maxeri=0; newi=int_max;
2020
2021         if (setjmp(lab)==0) { /* Yields maxeri */
2022                 for(ibits=ipower; newi>maxeri; ibits++) {
2023                         maxeri=newi;
2024                         newi=newi+newi+1;
2025                 }
2026         }
2027         Unexpected(9);
2028
2029         minneri= -maxeri;
2030         if (setjmp(lab)==0) { /* Yields minneri */
2031                 if (minneri-1 < minneri) minneri--;
2032         }
2033         Unexpected(10);
2034
2035         Vprintf("%sMaximum %s = %ld (= 2**%d-1)%s\n",
2036                 co, INT, (long)int_max, ipower, oc);
2037         Vprintf("%sMinimum %s = %ld%s\n", co, INT, (long)int_min, oc);
2038
2039         if (L) i_define(D_INT_MAX, INT, Iname, "_MAX",
2040                         (long) int_max, 0L,
2041                         (long) I_MAX, IMARK);
2042         if (L) i_define(D_INT_MIN, INT, Iname, "_MIN",
2043                         (long) int_min, (long) (PASS==1?maxint:int_max),
2044                         (long) I_MIN, IMARK);
2045
2046         if(int_max < 0) { /* It has happened */
2047                 eek_a_bug("signed integral comparison faulty?");
2048         }
2049
2050         if (maxeri>int_max) {
2051                 Vprintf("%sThere is a larger %s, %ld (= 2**%d-1), %s %s%s\n",
2052                         co, INT, (long)maxeri, ibits,
2053                         "but only for addition, not multiplication",
2054                         "(I smell a Cyber!)",
2055                         oc);
2056         }
2057
2058         if (minneri<int_min) {
2059                 Vprintf("%sThere is a smaller %s, %ld, %s %s%s\n",
2060                         co, INT, (long)minneri,
2061                         "but only for addition, not multiplication",
2062                         "(I smell a Cyber!)",
2063                         oc);
2064         }
2065 }
2066
2067 Procedure UPROP () {
2068         /* The properties of unsigned short/int/long */
2069 #ifdef OK_UI
2070         Volatile unsigned Integer u_max, newi, two;
2071         newi=1; u_max=0; two=2;
2072
2073         if (setjmp(lab)==0) { /* Yields u_max */
2074                 while(newi>u_max) {
2075                         u_max=newi;
2076                         newi=newi*two+1;
2077                 }
2078         }
2079         Unexpected(11);
2080         Vprintf("%sMaximum unsigned %s = %lu%s\n",
2081                 co, INT, (unsigned long) u_max, oc);
2082
2083         /* Oh woe: new standard C defines value preserving promotions */
2084         if (L) {
2085                 if (PASS == 1 && sizeof(short) < sizeof(int)) {
2086                         /* Special only for short */
2087                         i_define(D_UINT_MAX, INT, Uname, "_MAX",
2088                                  (unsigned long) u_max, 0L,
2089                                  (unsigned long) U_MAX, IMARK);
2090                 } else {
2091                         u_define(D_UINT_MAX, INT, Uname, "_MAX",
2092                                  (unsigned long) u_max,
2093                                  (unsigned long) U_MAX, IMARK);
2094                 }
2095         }
2096 #endif
2097 }
2098
2099 #endif /* Integer */
2100
2101 #ifdef Number
2102
2103 /* The following routines are intended to defeat any attempt at optimisation
2104    or use of extended precision, and to defeat faulty narrowing casts.
2105    The weird prototypes are because of widening incompatibilities.
2106 */
2107 #ifdef STDC
2108 #define ARGS1(atype, a) (atype a)
2109 #define ARGS2(atype, a, btype, b) (atype a, btype b)
2110 #else
2111 #define ARGS1(atype, a) (a) atype a;
2112 #define ARGS2(atype, a, btype, b) (a, b) atype a; btype b;
2113 #endif
2114
2115 Procedure Store ARGS2(Number, a, Number *, b) { *b=a; }
2116 Number Sum ARGS2(Number, a, Number, b) {Number r; Store(a+b, &r); return (r); }
2117 Number Diff ARGS2(Number, a, Number, b){Number r; Store(a-b, &r); return (r); }
2118 Number Mul ARGS2(Number, a, Number, b) {Number r; Store(a*b, &r); return (r); }
2119 Number Div ARGS2(Number, a, Number, b) {Number r; Store(a/b, &r); return (r); }
2120 Number Self ARGS1(Number, a)           {Number r; Store(a,   &r); return (r); }
2121
2122 Procedure F_check ARGS((int precision, Long_double val1));
2123
2124 Procedure F_check(precision, val1) int precision; Long_double val1; {
2125         /* You don't think I'm going to go to all the trouble of writing
2126            a program that works out what all sorts of values are, only to
2127            have printf go and print the wrong values out, do you?
2128            No, you're right, so this function tries to see if printf
2129            has written the right value, by reading it back again.
2130            This introduces a new problem of course: suppose printf writes
2131            the correct value, and scanf reads it back wrong... oh well.
2132            But I'm adamant about this: the precision given is enough
2133            to uniquely identify the printed number, therefore I insist
2134            that sscanf read the number back identically. Harsh yes, but
2135            sometimes you've got to be cruel to be kind.
2136         */
2137         Long_double new1;
2138         Number val, new, diff;
2139         double rem;
2140         int e;
2141         char *rep;
2142         char *f2;
2143
2144         if (sizeof(double) == sizeof(Long_double)) {
2145                 /* Assume they're the same, and use non-stdc format */
2146                 /* This is for stdc compilers using non-stdc libraries */
2147                 f2= "%le";   /* Input */
2148         } else {
2149                 /* It had better support Le then */
2150                 f2= "%Le";
2151         }
2152         val= val1;
2153         rep= f_rep(precision, (Long_double) val);
2154         if (setjmp(lab)==0) {
2155                 sscanf(rep, f2, &new1);
2156         } else {
2157                 eek_a_bug("sscanf caused a trap");
2158                 printf("%s    scanning: %s format: %s%s\n\n", co, rep, f2, oc);
2159                 Unexpected(12);
2160                 return;
2161         }
2162
2163         if (setjmp(lab)==0) { /* See if new is usable */
2164                 new= new1;
2165                 if (new != 0.0) {
2166                         diff= val/new - 1.0;
2167                         if (diff < 0.1) diff= 1.0;
2168                         /* That should be enough to generate a trap */
2169                 }
2170         } else {
2171                 eek_a_bug("sscanf returned an unusable number");
2172                 printf("%s    scanning: %s with format: %s%s\n\n",
2173                        co, rep, f2, oc);
2174                 Unexpected(13);
2175                 return;
2176         }
2177
2178         Unexpected(14);
2179         if (new != val) {
2180                 eek_a_bug("Possibly bad output from printf above");
2181                 if (!exponent((Long_double)val, &rem, &e)) {
2182                         printf("%s    but value was an unusable number%s\n\n",
2183                                co, oc);
2184                         return;
2185                 }
2186                 printf("%s    expected value around %.*fe%d, bit pattern:\n    ",
2187                        co, precision, rem, e);
2188                 bitpattern((char *) &val, (unsigned)sizeof(val));
2189                 printf ("%s\n", oc);
2190                 printf("%s    sscanf gave           %s, bit pattern:\n    ",
2191                        co, f_rep(precision, (Long_double) new));
2192                 bitpattern((char *) &new, (unsigned)sizeof(new));
2193                 printf ("%s\n", oc);
2194                 if (setjmp(lab) == 0) {
2195                         diff= val-new;
2196                         printf("%s    difference= %s%s\n\n",
2197                                co, f_rep(precision, (Long_double) diff), oc);
2198                 } /* else forget it */
2199                 Unexpected(15);
2200         }
2201 }
2202
2203 #ifdef VERIFY
2204 Procedure Validate(prec, val, req, same) int prec, same; Long_double val, req; {
2205         /* Check that the compiler has read a #define value correctly */
2206         Unexpected(16);
2207         if (!same) {
2208                 printf("%s*** Verify failed for above #define!\n", co);
2209                 if (setjmp(lab) == 0) { /* for the case that req == nan */
2210                         printf("       Compiler has %s for value%s\n",
2211                                f_rep(prec, req), oc);
2212                 } else {
2213                         printf("       Compiler has %s for value%s\n",
2214                                "an unusable number", oc);
2215                 }
2216                 if (setjmp(lab) == 0) {
2217                         F_check(prec, (Long_double) req);
2218                 } /*else forget it*/
2219                 if (setjmp(lab) == 0) {
2220                         if (req > 0.0 && val > 0.0) {
2221                                 printf("%s    difference= %s%s\n",
2222                                        co, f_rep(prec, val-req), oc);
2223                         }
2224                 } /*else forget it*/
2225                 Unexpected(17);
2226                 printf("\n");
2227                 bugs++;
2228         } else if (val != req) {
2229                 if (stdc) eek_a_bug("constant has the wrong precision");
2230                 else eek_a_bug("the cast didn't work");
2231                 printf("\n");
2232         }
2233 }
2234 #endif /* VERIFY */
2235
2236 int FPROP(bits_per_byte) int bits_per_byte; {
2237         /* Properties of floating types, using algorithms by Cody and Waite
2238            from MA Malcolm, as modified by WM Gentleman and SB Marovich.
2239            Further extended by S Pemberton.
2240
2241            Returns the number of digits in the fraction.
2242         */
2243
2244         Volatile int
2245                 i, f_radix, iexp, irnd, mrnd, f_rounds, f_mant_dig,
2246                 iz, k, inf, machep, f_max_exp, f_min_exp, mx, negeps,
2247                 mantbits, digs, f_dig, trap,
2248                 hidden, normal, f_min_10_exp, f_max_10_exp;
2249         Volatile Number
2250                 a, b, base, basein, basem1, f_epsilon, epsneg,
2251                 eps, epsp1, etop, ebot,
2252                 f_max, newxmax, f_min, xminner, y, y1, z, z1, z2;
2253
2254         Unexpected(18);
2255
2256         Vprintf("%sPROPERTIES OF %s%s\n", co, THING, oc);
2257
2258         /* Base and size of significand **************************************/
2259         /* First repeatedly double until adding 1 has no effect.          */
2260         /* For instance, if base is 10, with 3 significant digits         */
2261         /* it will try 1, 2, 4, 8, ... 512, 1024, and stop there,         */
2262         /* since 1024 is only representable as 1020.                      */
2263         a=1.0;
2264         if (setjmp(lab)==0) { /* inexact trap? */
2265                 do { a=Sum(a, a); }
2266                 while (Diff(Diff(Sum(a, ONE), a), ONE) == ZERO);
2267         } else {
2268                 fprintf(stderr, "*** Program got loss-of-precision trap!\n");
2269                 /* And supporting those is just TOO much trouble! */
2270                 farewell(bugs+1);
2271         }
2272         Unexpected(19);
2273         /* Now double until you find a number that can be added to the    */
2274         /* above number. For 1020 this is 8 or 16, depending whether the  */
2275         /* result is rounded or truncated.                                */
2276         /* In either case the result is 1030. 1030-1020= the base, 10.    */
2277         b=1.0;
2278         do { b=Sum(b, b); } while ((base=Diff(Sum(a, b), a)) == ZERO);
2279         f_radix=base;
2280         Vprintf("%sBase = %d%s\n", co, f_radix, oc);
2281
2282         /* Sanity check; if base<2, I can't guarantee the rest will work  */
2283         if (f_radix < 2) {
2284                 eek_a_bug("Function return or parameter passing faulty? (This is a guess.)");
2285                 printf("\n");
2286                 return(0);
2287         }
2288
2289         if (PASS == 1) { /* only for FLT */
2290                 flt_radix= f_radix;
2291                 if (F) i_define(D_FLT_RADIX, "", "FLT", "_RADIX",
2292                                 (long) f_radix, 0L, (long) F_RADIX, "");
2293         } else if (f_radix != flt_radix) {
2294                 printf("\n%s*** WARNING: %s %s (%d) %s%s\n",
2295                        co, thing, "arithmetic has a different radix",
2296                        f_radix, "from float", oc);
2297                 bugs++;
2298         }
2299
2300         /* Now the number of digits precision */
2301         f_mant_dig=0; b=1.0;
2302         do { f_mant_dig++; b=Mul(b, base); }
2303         while (Diff(Diff(Sum(b, ONE), b), ONE) == ZERO);
2304         f_dig=floor_log(10, (Long_double)(b/base)) + (base==10?1:0);
2305         Vprintf("%sSignificant base digits = %d %s %d %s%s\n",
2306                 co, f_mant_dig, "(= at least", f_dig, "decimal digits)", oc);
2307         if (F) i_define(D_MANT_DIG, thing, Fname, "_MANT_DIG",
2308                         (long) f_mant_dig, 0L, (long) F_MANT_DIG, "");
2309         if (F) i_define(D_DIG, thing, Fname, "_DIG",
2310                         (long) f_dig, 0L, (long) F_DIG, "");
2311         digs= ceil_log(10, (Long_double)b); /* the number of digits to printf */
2312
2313         /* Rounding *******************************************************/
2314         basem1=Diff(base, HALF);
2315         if (Diff(Sum(a, basem1), a) != ZERO) {
2316                 if (f_radix == 2) basem1=0.375;
2317                 else basem1=1.0;
2318                 if (Diff(Sum(a, basem1), a) != ZERO) irnd=2; /* away from 0 */
2319                 else irnd=1; /* to nearest */
2320         } else irnd=0; /* towards 0 */
2321
2322         basem1=Diff(base, HALF);
2323
2324         if (Diff(Diff(-a, basem1), -a) != ZERO) {
2325                 if (f_radix == 2) basem1=0.375;
2326                 else basem1=1.0;
2327                 if (Diff(Diff(-a, basem1), -a) != ZERO) mrnd=2; /* away from 0*/
2328                 else mrnd=1; /* to nearest */
2329         } else mrnd=0; /* towards 0 */
2330
2331         f_rounds= -1; /* Unknown rounding */
2332         if (irnd==0 && mrnd==0) f_rounds=0; /* zero = chops */
2333         if (irnd==1 && mrnd==1) f_rounds=1; /* nearest */
2334         if (irnd==2 && mrnd==0) f_rounds=2; /* +inf */
2335         if (irnd==0 && mrnd==2) f_rounds=3; /* -inf */
2336
2337         if (f_rounds != -1) {
2338                 Vprintf("%sArithmetic rounds towards ", co);
2339                 switch (f_rounds) {
2340                       case 0: Vprintf("zero (i.e. it chops)"); break;
2341                       case 1: Vprintf("nearest"); break;
2342                       case 2: Vprintf("+infinity"); break;
2343                       case 3: Vprintf("-infinity"); break;
2344                       default: Vprintf("???"); break;
2345                 }
2346                 Vprintf("%s\n", oc);
2347         } else { /* Hmm, try to give some help here */
2348                 Vprintf("%sArithmetic rounds oddly: %s\n", co, oc);
2349                 Vprintf("%s    Negative numbers %s%s\n",
2350                         co, mrnd==0 ? "towards zero" :
2351                             mrnd==1 ? "to nearest" :
2352                                       "away from zero",
2353                         oc);
2354                 Vprintf("%s    Positive numbers %s%s\n",
2355                         co, irnd==0 ? "towards zero" :
2356                             irnd==1 ? "to nearest" :
2357                                       "away from zero",
2358                         oc);
2359         }
2360         /* An extra goody */
2361         if (f_radix == 2 && f_rounds == 1) {
2362                 if (Diff(Sum(a, ONE), a) != ZERO) {
2363                         Vprintf("%s   Tie breaking rounds up%s\n", co, oc);
2364                 } else if (Diff(Sum(a, THREE), a) == FOUR) {
2365                         Vprintf("%s   Tie breaking rounds to even%s\n", co, oc);
2366                 } else {
2367                         Vprintf("%s   Tie breaking rounds down%s\n", co, oc);
2368                 }
2369         }
2370         if (PASS == 1) { /* only for FLT */
2371                 flt_rounds= f_rounds;
2372                 if (F)
2373                   i_define(D_FLT_ROUNDS, "", "FLT", "_ROUNDS",
2374                            (long) f_rounds, 1L, (long) F_ROUNDS, "");
2375         } else if (f_rounds != flt_rounds) {
2376                 printf("\n%s*** WARNING: %s %s (%d) %s%s\n",
2377                        co, thing, "arithmetic rounds differently",
2378                        f_rounds, "from float", oc);
2379                 bugs++;
2380         }
2381
2382         /* Various flavours of epsilon ************************************/
2383         negeps=f_mant_dig+f_mant_dig;
2384         basein=1.0/base;
2385         a=1.0;
2386         for(i=1; i<=negeps; i++) a*=basein;
2387
2388         b=a;
2389         while (Diff(Diff(ONE, a), ONE) == ZERO) {
2390                 a*=base;
2391                 negeps--;
2392         }
2393         negeps= -negeps;
2394         Vprintf("%sSmallest x such that 1.0-base**x != 1.0 = %d%s\n",
2395                 co, negeps, oc);
2396
2397         etop = ONE;
2398         ebot = ZERO;
2399         eps = Sum(ebot, Div(Diff(etop, ebot), TWO));
2400         /* find the smallest epsneg (1-epsneg != 1) by binary search.
2401            ebot and etop are the current bounds */
2402         while (eps != ebot && eps != etop) {
2403                 epsp1 = Diff(ONE, eps);
2404                 if (epsp1 < ONE) etop = eps;
2405                 else ebot = eps;
2406                 eps = Sum(ebot, Div(Diff(etop, ebot), TWO));
2407         }
2408         eps= etop;
2409         /* Sanity check */
2410         if (Diff(ONE, etop) >= ONE || Diff(ONE, ebot) != ONE) {
2411                 eek_a_bug("internal error calculating epsneg");
2412         }
2413         Vprintf("%sSmallest x such that 1.0-x != 1.0 = %s%s\n",
2414                 co, f_rep(digs, (Long_double) eps), oc);
2415         if (V) F_check(digs, (Long_double) eps);
2416
2417         epsneg=a;
2418         if ((f_radix!=2) && irnd) {
2419         /*      a=(a*(1.0+a))/(1.0+1.0); => */
2420                 a=Div(Mul(a, Sum(ONE, a)), Sum(ONE, ONE));
2421         /*      if ((1.0-a)-1.0 != 0.0) epsneg=a; => */
2422                 if (Diff(Diff(ONE, a), ONE) != ZERO) epsneg=a;
2423         }
2424         /* epsneg is used later */
2425         Unexpected(20);
2426
2427         machep= -f_mant_dig-f_mant_dig;
2428         a=b;
2429         while (Diff(Sum(ONE, a), ONE) == ZERO) { a*=base; machep++; }
2430         Vprintf("%sSmallest x such that 1.0+base**x != 1.0 = %d%s\n",
2431                 co, machep, oc);
2432
2433         etop = ONE;
2434         ebot = ZERO;
2435         eps = Sum(ebot, Div(Diff(etop, ebot), TWO));
2436         /* find the smallest eps (1+eps != 1) by binary search.
2437            ebot and etop are the current bounds */
2438         while (eps != ebot && eps != etop) {
2439                 epsp1 = Sum(ONE, eps);
2440                 if (epsp1 > ONE) etop = eps;
2441                 else ebot = eps;
2442                 eps = Sum(ebot, Div(Diff(etop, ebot), TWO));
2443         }
2444         /* Sanity check */
2445         if (Sum(ONE, etop) <= ONE || Sum(ONE, ebot) != ONE) {
2446                 eek_a_bug("internal error calculating eps");
2447         }
2448         f_epsilon=etop;
2449
2450         Vprintf("%sSmallest x such that 1.0+x != 1.0 = %s%s\n",
2451                 co, f_rep(digs, (Long_double) f_epsilon), oc);
2452
2453         f_epsilon= Diff(Sum(ONE, f_epsilon), ONE); /* New C standard defn */
2454         Vprintf("%s(Above number + 1.0) - 1.0 = %s%s\n",
2455                 co, f_rep(digs, (Long_double) (f_epsilon)), oc);
2456
2457         /* Possible loss of precision warnings here from non-stdc compilers */
2458         if (F) f_define(D_EPSILON, thing,
2459                         Fname, "_EPSILON", digs, (Long_double) f_epsilon, MARK);
2460         if (V || F) F_check(digs, (Long_double) f_epsilon);
2461         Unexpected(21);
2462         if (F) Validate(digs, (Long_double) f_epsilon, (Long_double) F_EPSILON,
2463                         f_epsilon == Self(F_EPSILON));
2464         Unexpected(22);
2465
2466         /* Extra chop info *************************************************/
2467         if (f_rounds == 0) {
2468                 if (Diff(Mul(Sum(ONE,f_epsilon),ONE),ONE) !=  ZERO) {
2469                         Vprintf("%sAlthough arithmetic chops, it uses guard digits%s\n", co, oc);
2470                 }
2471         }
2472
2473         /* Size of and minimum normalised exponent ************************/
2474         y=0; i=0; k=1; z=basein; z1=(1.0+f_epsilon)/base;
2475
2476         /* Coarse search for the largest power of two */
2477         if (setjmp(lab)==0) { /* for underflow trap */ /* Yields i, k, y, y1 */
2478                 do {
2479                         y=z; y1=z1;
2480                         z=Mul(y,y); z1=Mul(z1, y);
2481                         a=Mul(z,ONE);
2482                         z2=Div(z1,y);
2483                         if (z2 != y1) break;
2484                         if ((Sum(a,a) == ZERO) || (fabs(z) >= y)) break;
2485                         i++;
2486                         k+=k;
2487                 } while(1);
2488         } else {
2489                 Vprintf("%s%s underflow generates a trap%s\n", co, Thing, oc);
2490         }
2491         Unexpected(23);
2492
2493         if (f_radix != 10) {
2494                 iexp=i+1; /* for the sign */
2495                 mx=k+k;
2496         } else {
2497                 iexp=2;
2498                 iz=f_radix;
2499                 while (k >= iz) { iz*=f_radix; iexp++; }
2500                 mx=iz+iz-1;
2501         }
2502
2503         /* Fine tune starting with y and y1 */
2504         if (setjmp(lab)==0) { /* for underflow trap */ /* Yields k, f_min */
2505                 do {
2506                         f_min=y; z1=y1;
2507                         y=Div(y,base); y1=Div(y1,base);
2508                         a=Mul(y,ONE);
2509                         z2=Mul(y1,base);
2510                         if (z2 != z1) break;
2511                         if ((Sum(a,a) == ZERO) || (fabs(y) >= f_min)) break;
2512                         k++;
2513                 } while (1);
2514         }
2515         Unexpected(24);
2516
2517         f_min_exp=(-k)+1;
2518
2519         if ((mx <= k+k-3) && (f_radix != 10)) { mx+=mx; iexp+=1; }
2520         Vprintf("%sNumber of bits used for exponent = %d%s\n", co, iexp, oc);
2521         Vprintf("%sMinimum normalised exponent = %d%s\n", co, f_min_exp-1, oc);
2522         if (F)
2523           i_define(D_MIN_EXP, thing, Fname, "_MIN_EXP",
2524                    (long) f_min_exp, (long) maxint, (long) F_MIN_EXP, "");
2525
2526         if (setjmp(lab)==0) {
2527                 Vprintf("%sMinimum normalised positive number = %s%s\n",
2528                         co, f_rep(digs, (Long_double) f_min), oc);
2529         } else {
2530                 eek_a_bug("printf can't print the smallest normalised number");
2531                 printf("\n");
2532         }
2533         Unexpected(25);
2534         /* Possible loss of precision warnings here from non-stdc compilers */
2535         if (setjmp(lab) == 0) {
2536                 if (F) f_define(D_MIN, thing,
2537                                 Fname, "_MIN", digs, (Long_double) f_min, MARK);
2538                 if (V || F) F_check(digs, (Long_double) f_min);
2539         } else {
2540                 eek_a_bug("xxx_MIN caused a trap");
2541                 printf("\n");
2542         }
2543
2544         if (setjmp(lab) == 0) {
2545                 if (F) Validate(digs, (Long_double) f_min, (Long_double) F_MIN,
2546                                 f_min == Self(F_MIN));
2547         } else {
2548                 printf("%s*** Verify failed for above #define!\n    %s %s\n\n",
2549                        co, "Compiler has an unusable number for value", oc);
2550                 bugs++;
2551         }
2552         Unexpected(26);
2553
2554         a=1.0; f_min_10_exp=0;
2555         while (a > f_min*10.0) { a/=10.0; f_min_10_exp--; }
2556         if (F) i_define(D_MIN_10_EXP, thing, Fname, "_MIN_10_EXP",
2557                         (long) f_min_10_exp, (long) maxint,
2558                         (long) F_MIN_10_EXP, "");
2559
2560         /* Minimum exponent ************************************************/
2561         if (setjmp(lab)==0) { /* for underflow trap */ /* Yields xminner */
2562                 do {
2563                         xminner=y;
2564                         y=Div(y,base);
2565                         a=Mul(y,ONE);
2566                         if ((Sum(a,a) == ZERO) || (fabs(y) >= xminner)) break;
2567                 } while (1);
2568         }
2569         Unexpected(27);
2570
2571         if (xminner != 0.0 && xminner != f_min) {
2572                 normal= 0;
2573                 Vprintf("%sThe smallest numbers are not kept normalised%s\n",
2574                         co, oc);
2575                 if (setjmp(lab)==0) {
2576                     Vprintf("%sSmallest unnormalised positive number = %s%s\n",
2577                             co, f_rep(digs, (Long_double) xminner), oc);
2578                     if (V) F_check(digs, (Long_double) xminner);
2579                 } else {
2580                         eek_a_bug("printf can't print the smallest unnormalised number.");
2581                         printf("\n");
2582                 }
2583                 Unexpected(28);
2584         } else {
2585                 normal= 1;
2586                 Vprintf("%sThe smallest numbers are normalised%s\n", co, oc);
2587         }
2588
2589         /* Maximum exponent ************************************************/
2590         f_max_exp=2; f_max=1.0; newxmax=base+1.0;
2591         inf=0; trap=0;
2592         while (f_max<newxmax) {
2593                 f_max=newxmax;
2594                 if (setjmp(lab) == 0) { /* Yields inf, f_max_exp */
2595                         newxmax=Mul(newxmax, base);
2596                 } else {
2597                         trap=1;
2598                         break;
2599                 }
2600                 if (Div(newxmax, base) != f_max) {
2601                         inf=1; /* ieee infinity */
2602                         break;
2603                 }
2604                 f_max_exp++;
2605         }
2606         Unexpected(29);
2607         if (trap) {
2608                 Vprintf("%s%s overflow generates a trap%s\n", co, Thing, oc);
2609         }
2610
2611         if (inf) Vprintf("%sThere is an 'infinite' value%s\n", co, oc);
2612         Vprintf("%sMaximum exponent = %d%s\n", co, f_max_exp, oc);
2613         if (F) i_define(D_MAX_EXP, thing, Fname, "_MAX_EXP",
2614                         (long) f_max_exp, 0L, (long) F_MAX_EXP, "");
2615
2616         /* Largest number ***************************************************/
2617         f_max=Diff(ONE, epsneg);
2618         if (Mul(f_max,ONE) != f_max) f_max=Diff(ONE, Mul(base,epsneg));
2619         for (i=1; i<=f_max_exp; i++) f_max=Mul(f_max, base);
2620
2621         if (setjmp(lab)==0) {
2622                 Vprintf("%sMaximum number = %s%s\n",
2623                         co, f_rep(digs, (Long_double) f_max), oc);
2624         } else {
2625                 eek_a_bug("printf can't print the largest double.");
2626                 printf("\n");
2627         }
2628         if (setjmp(lab)==0) {
2629         /* Possible loss of precision warnings here from non-stdc compilers */
2630                 if (F) f_define(D_MAX, thing,
2631                                 Fname, "_MAX", digs, (Long_double) f_max, MARK);
2632                 if (V || F) F_check(digs, (Long_double) f_max);
2633         } else {
2634                 eek_a_bug("xxx_MAX caused a trap");
2635                 printf("\n");
2636         }
2637         if (setjmp(lab)==0) {
2638                 if (F) Validate(digs, (Long_double) f_max, (Long_double) F_MAX,
2639                                 f_max == Self(F_MAX));
2640         } else {
2641                 printf("%s*** Verify failed for above #define!\n    %s %s\n\n",
2642                        co, "Compiler has an unusable number for value", oc);
2643                 bugs++;
2644         }
2645         Unexpected(30);
2646
2647         a=1.0; f_max_10_exp=0;
2648         while (a < f_max/10.0) { a*=10.0; f_max_10_exp++; }
2649         if (F) i_define(D_MAX_10_EXP, thing, Fname, "_MAX_10_EXP",
2650                         (long) f_max_10_exp, 0L, (long) F_MAX_10_EXP, "");
2651
2652         /* Hidden bit + sanity check ****************************************/
2653         if (f_radix != 10) {
2654                 hidden=0;
2655                 mantbits=floor_log(2, (Long_double)f_radix)*f_mant_dig;
2656                 if (mantbits+iexp == (int)sizeof(Number)*bits_per_byte) {
2657                         hidden=1;
2658                         Vprintf("%sArithmetic uses a hidden bit%s\n", co, oc);
2659                 } else if (mantbits+iexp+1 == (int)sizeof(Number)*bits_per_byte) {
2660                         Vprintf("%sArithmetic doesn't use a hidden bit%s\n",
2661                                 co, oc);
2662                 } else {
2663                         printf("\n%s%s\n    %s %s %s!%s\n\n",
2664                                co,
2665                                "*** Something fishy here!",
2666                                "Exponent size + significand size doesn't match",
2667                                "with the size of a", thing,
2668                                oc);
2669                 }
2670                 if (hidden && f_radix == 2 && f_max_exp+f_min_exp==3) {
2671                         Vprintf("%sIt looks like %s length IEEE format%s\n",
2672                                 co, f_mant_dig==24 ? "single" :
2673                                     f_mant_dig==53 ? "double" :
2674                                     f_mant_dig >53 ? "extended" :
2675                                                 "some", oc);
2676                         if (f_rounds != 1 || normal) {
2677                                 Vprintf("%s   though ", co);
2678                                 if (f_rounds != 1) {
2679                                         Vprintf("the rounding is unusual");
2680                                         if (normal) Vprintf(" and ");
2681                                 }
2682                                 if (normal) Vprintf("the normalisation is unusual");
2683                                 Vprintf("%s\n", oc);
2684                         }
2685                 } else {
2686                         Vprintf("%sIt doesn't look like IEEE format%s\n",
2687                                 co, oc);
2688                 }
2689         }
2690         printf("\n"); /* regardless of verbosity */
2691         return f_mant_dig;
2692 }
2693
2694 Procedure EPROP(fprec, dprec, lprec) int fprec, dprec, lprec; {
2695         /* See if expressions are evaluated in extended precision.
2696            Some compilers optimise even if you don't want it,
2697            and then this function fails to produce the right result.
2698            We try to diagnose this if it happens.
2699         */
2700         Volatile int eprec;
2701         Volatile double a, b, base, old;
2702         Volatile Number d, oldd, dbase, one, zero;
2703         Volatile int bad=0;
2704
2705         /* Size of significand **************************************/
2706         a=1.0;
2707         if (setjmp(lab) == 0) { /* Yields nothing */
2708                 do { old=a; a=a+a; }
2709                 while ((((a+1.0)-a)-1.0) == 0.0 && a>old);
2710         } else bad=1;
2711
2712         /* Avoid the comparison if bad is set,
2713            to avoid trouble on the convex.  */
2714         if (!bad && (a <= old)) bad=1;
2715
2716         if (!bad) {
2717                 b=1.0;
2718                 if (setjmp(lab) == 0) { /* Yields nothing */
2719                         do { old=b; b=b+b; }
2720                         while ((base=((a+b)-a)) == 0.0 && b>old);
2721                         if (b <= old) bad=1;
2722                 } else bad=1;
2723         }
2724
2725         if (!bad) {
2726                 eprec=0; d=1.0; dbase=base; one=1.0; zero=0.0;
2727                 if (setjmp(lab) == 0) { /* Yields nothing */
2728                         do { eprec++; oldd=d; d=d*dbase; }
2729                         while ((((d+one)-d)-one) == zero && d>oldd);
2730                         if (d <= oldd) bad=1;
2731                 } else bad=1;
2732         }
2733
2734         Unexpected(31);
2735
2736         if (bad) {
2737           Vprintf("%sCan't determine precision for %s expressions:\n%s%s\n",
2738                  co, thing, "   check that you compiled without optimisation!",
2739                  oc);
2740         } else if (eprec==dprec) {
2741           Vprintf("%s%s expressions are evaluated in double precision%s\n",
2742                   co, Thing, oc);
2743         } else if (eprec==fprec) {
2744           Vprintf("%s%s expressions are evaluated in float precision%s\n",
2745                   co, Thing, oc);
2746         } else if (eprec==lprec) {
2747           Vprintf("%s%s expressions are evaluated in long double precision%s\n",
2748                   co, Thing, oc);
2749         } else {
2750                 Vprintf("%s%s expressions are evaluated in a %s %s %d %s%s\n",
2751                         co, Thing, eprec>dprec ? "higher" : "lower",
2752                         "precision than double,\n   using",
2753                         eprec, "base digits",
2754                         oc);
2755         }
2756 }
2757
2758 #else /* not Number */
2759
2760 #ifdef FPROP /* Then create dummy routines for long double */
2761 /* ARGSUSED */
2762 int FPROP(bits_per_byte) int bits_per_byte; { return 0; }
2763 #endif
2764 #ifdef EPROP
2765 /* ARGSUSED */
2766 Procedure EPROP(fprec, dprec, lprec) int fprec, dprec, lprec; {}
2767 #endif
2768
2769 #endif /* ifdef Number */
2770
2771 /* Increment the pass number */
2772 #undef PASS
2773
2774 #ifdef PASS2
2775 #undef PASS2
2776 #define PASS 3
2777 #define PASS3 1
2778 #endif
2779
2780 #ifdef PASS1
2781 #undef PASS1
2782 #define PASS 2
2783 #define PASS2 1
2784 #endif
2785
2786 #ifdef PASS0
2787 #undef PASS0
2788 #endif
2789
2790 #ifdef PASS /* then rescan this file */
2791 #ifdef NO_FILE
2792 #include "enquire.c"
2793 #else
2794 #include FILENAME  /* if this line fails to compile, define NO_FILE */
2795 #endif
2796 #endif /* PASS */
2797