home *** CD-ROM | disk | FTP | other *** search
/ Garbo / Garbo.cdr / pc / source / config.zoo / config.c (.txt)
Microsoft Windows Help File Content  |  1990-02-21  |  66KB  |  1,925 lines
  1. : This is a shell archive.
  2. : Extract with 'sh this_file'.
  3. echo 'Start of pack.out, part 01 out of 01:'
  4. if test -s 'config.c'
  5. then echo '*** I will not over-write existing file config.c'
  6. echo 'x - config.c'
  7. sed 's/^X//' > 'config.c' << 'EOF'
  8. X/* Everything you wanted to know about your machine and C compiler,
  9. X   but didn't know who to ask. */
  10. X#ifndef VERSION
  11. X#define VERSION "4.2"
  12. X#endif
  13. X/* Author: Steven Pemberton, CWI, Amsterdam; steven@cwi.nl
  14. X   Bugfixes and upgrades gratefully received.
  15. X   Copyright (c) 1988, 1989, 1990 Steven Pemberton, CWI, Amsterdam.
  16. X   All rights reserved.
  17. X   COMPILING
  18. X   With luck and a following wind, just the following will work:
  19. X    cc config.c -o config
  20. X   You may get some messages about unreachable code. This is OK.
  21. X   If your compiler doesn't support:        add flag:
  22. X    signed char (eg pcc)            -DNO_SC
  23. X    unsigned char                -DNO_UC
  24. X    unsigned short and long            -DNO_UI
  25. X    void                    -DNO_VOID
  26. X    signal(), or setjmp/longjmp()        -DNO_SIG
  27. X   Try to compile first with no flags, and see if you get any errors - 
  28. X   you might be surprised. (Most non-ANSI compilers need -DNO_SC, though.)
  29. X   Some compilers need a -f flag for floating point.
  30. X   If your C preprocessor doesn't have the predefined __FILE__ macro, and
  31. X   you don't want to call this file config.c but, say, params.c, add the
  32. X   flag -D__FILE__=\"params.c\" .
  33. X   Some naughty compilers define __STDC__, but don't really support it
  34. X   (typically they define __STDC__ as 0). If this is the case for you,
  35. X   add flag -DNO_STDC. (To those compiler writers: for shame).
  36. X   Some bad compilers won't accept the line "#include __FILE__" or
  37. X   "#ifdef __FILE__". Add flag -DNO_FILE. In that case, this file *must*
  38. X   be called config.c.
  39. X   Don't use any optimisation flags: the program may not work if you do.
  40. X   Though "while (a+1.0-a-1.0 == 0.0)" may look like "while(1)" to an
  41. X   optimiser, to a floating-point unit there's a world of difference.
  42. X   Some compilers offer various flags for different floating point
  43. X   modes; it's worth trying all possible combinations of these.
  44. X   Add -DID=\"name\" if you want the machine/flags identified in the output.
  45. X   While it is not our policy to support defective compilers, pity has been
  46. X   taken on people with compilers that can't produce object files bigger than
  47. X   32k (especially since it was an easy addition). Compile the program
  48. X   into separate parts like this:
  49. X       cc -DSEP -DPASS0 -o p0.o <other flags> config.c
  50. X       cc -DSEP -DPASS1 -o p1.o <other flags> config.c
  51. X       cc -DSEP -DPASS2 -o p2.o <other flags> config.c
  52. X       cc -DSEP -DPASS3 -o p3.o <other flags> config.c
  53. X       cc -o config p0.o p1.o p2.o p3.o
  54. X   SYSTEM DEPENDENCIES
  55. X   You may possibly need to add some calls to signal() for other sorts of
  56. X   exception on your machine than SIGFPE, and SIGOVER.  See lines beginning
  57. X   #ifdef SIGxxx in main() (and communicate the differences to me!).
  58. X   OUTPUT
  59. X   Run without argument to get the information as English text.  If run
  60. X   with argument -l (e.g. config -l), output is a series of #define's for
  61. X   the ANSI standard limits.h include file, excluding MB_MAX_CHAR.  If run
  62. X   with argument -f, output is a series of #define's for the ANSI standard
  63. X   float.h include file (according to ANSI C Draft of May 13, 1988).
  64. X   Flag -v gives verbose output: output includes the English text above
  65. X   as C comments.  The program exit(0)'s if everything went ok, otherwise
  66. X   it exits with a positive number, telling how many problems there were.
  67. X   VERIFYING THE COMPILER
  68. X   If, having produced the float.h and limits.h header files, you want to
  69. X   verify that the compiler reads them back correctly (there are a lot of
  70. X   boundary cases, of course, like minimum and maximum numbers), you can
  71. X   recompile config.c with -DVERIFY set (plus the other flags that you used
  72. X   when compiling the version that produced the header files).  This then
  73. X   recompiles the program so that it #includes "limits.h" and "float.h",
  74. X   and checks that the constants it finds there are the same as the
  75. X   constants it produces. Run the resulting program with config -fl.
  76. X   Very few compilers have passed without error.
  77. X   You can also use this option if your compiler already has both files,
  78. X   and you want to confirm that this program produces the right results.
  79. X   TROUBLESHOOTING.
  80. X   This program is now quite trustworthy, and suspicious and wrong output
  81. X   may well be caused by bugs in the compiler, not in the program (however
  82. X   of course, this is not guaranteed, and no responsibility can be
  83. X   accepted, etc.)
  84. X   The program only works if overflows are ignored by the C system or
  85. X   are catchable with signal().
  86. X   If the program fails to run to completion (often with the error message
  87. X   "Unexpected signal at point x"), this often turns out to be a bug in the
  88. X   C compiler's run-time system. Check what was about to be printed, and
  89. X   try to narrow the problem down.
  90. X   Another possible problem is that you have compiled the program to produce
  91. X   loss-of-precision arithmetic traps. The program cannot cope with these,
  92. X   and you should re-compile without them. (They should never be the default).
  93. X   Make sure you compiled with optimisation turned off.
  94. X   Output preceded by *** WARNING: identifies behaviour of the C system
  95. X   deemed incorrect by the program. Likely problems are that printf or
  96. X   scanf don't cope properly with certain boundary numbers: this program
  97. X   goes to a lot of trouble to calculate its values, and these values
  98. X   are mostly boundary numbers.  Experience has shown that often printf
  99. X   cannot cope with these values, and so in an attempt to increase
  100. X   confidence in the output, for each float and double that is printed,
  101. X   the printed value is checked by using sscanf to read it back.
  102. X   Care is taken that numbers are printed with enough digits to uniquely
  103. X   identify them, and therefore that they can be read back identically.
  104. X   If the number read back is different, then there is probably a bug in
  105. X   printf or sscanf, and the program prints the warning message.
  106. X   If the two numbers in the warning look identical, then printf is more
  107. X   than likely rounding the last digit(s) incorrectly. To put you at ease
  108. X   that the two really are different, the bit patterns of the two numbers
  109. X   are also printed.  The difference is very likely in the last bit.
  110. X   Many scanf's read the minimum double back as 0.0, and similarly cause
  111. X   overflow when reading the maximum double.  The program quite ruthlessly
  112. X   declares all these behaviours faulty. The point is that if you get
  113. X   one of these warnings, the output may be wrong, so you should check
  114. X   the result carefully if you intend to use the results. Of course, printf
  115. X   and sscanf may both be wrong, and cancel each other out, so you should
  116. X   check the output carefully anyway.
  117. X   The warning that "a cast didn't work" refers to cases like this:
  118. X      float f;
  119. X      #define C 1.234567890123456789
  120. X      f= C;
  121. X      if (f != (float) C) printf ("Wrong!");
  122. X   A faulty compiler will widen f to double and ignore the cast to float,
  123. X   and because there is more accuracy in a double than a float, fail to
  124. X   recognise that they are the same. In the actual case in point, f and C
  125. X   are passed as parameters to a function that discovers they are not equal,
  126. X   so it's just possible that the error was in the parameter passing,
  127. X   not in the cast (see function Validate()).
  128. X   For ANSI C, which has float constants, the error message is "constant has
  129. X   wrong precision".
  130. X   REPORTING PROBLEMS
  131. X   If the program doesn't work for you for any reason that can't be
  132. X   narrowed down to a problem in the C compiler, or it has to be changed in
  133. X   order to get it to compile, or it produces suspicious output (like a very
  134. X   low maximum float, for instance), please mail the problem and an example
  135. X   of the incorrect output to steven@cwi.nl or ..!hp4nl!cwi.nl!steven, so that
  136. X   improvements can be worked into future versions; cwi.nl is the European
  137. X   backbone, and is connected to uunet and other fine hosts.
  138. X   The program tries to catch and diagnose bugs in the compiler/run-time
  139. X   system. I would be especially pleased to have reports of failures so
  140. X   that I can improve this service.
  141. X   I apologise unreservedly for the contorted use of the preprocessor...
  142. X   THE SMALL PRINT
  143. X   You may copy and distribute verbatim copies of this source file.
  144. X   You may modify this source file, and copy and distribute such
  145. X   modified versions, provided that you leave the copyright notice
  146. X   at the top of the file and also cause the modified file to carry
  147. X   prominent notices stating that you changed the files and the date
  148. X   of any change; and cause the whole of any work that you distribute
  149. X   or publish, that in whole or in part contains or is a derivative of
  150. X   this program or any part thereof, to be licensed at no charge to
  151. X   all third parties on terms identical to those here.
  152. X   If you do have a fix to any problem, please send it to me, so that
  153. X   other people can have the benefits.
  154. X   While every effort has been taken to make this program as reliable as
  155. X   possible, no responsibility can be taken for the correctness of the
  156. X   output, or suitability for any particular use.
  157. X   ACKNOWLEDGEMENTS
  158. X   Many people have given time and ideas to making this program what it is.
  159. X   To all of them thanks, and apologies for not mentioning them by name.
  160. X   HISTORY
  161. X   4.0 Added -f and -l options, and warnings
  162. X   4.1 Added VERIFY
  163. X   4.2 Added SEP
  164. X       Fixed eps/epsneg
  165. X       Added check for pseudo-unsigned chars
  166. X       Added description for each #define output
  167. X       Added check for absence of defines during verify
  168. X       Added prototypes
  169. X       Added NO_STDC and NO_FILE
  170. X       Fixed alignments output
  171. X#ifndef NO_FILE
  172. X#ifndef __FILE__
  173. X#define __FILE__ "config.c"
  174. X#endif
  175. X#endif
  176. X/* If PASS isn't defined, then this is the first pass over this file. */
  177. X#ifndef PASS
  178. X#ifndef SEP
  179. X#define PASS 1
  180. X#define PASS0 1
  181. X#define PASS1 1
  182. X#endif /* SEP */
  183. X/* A description of the ANSI constants */
  184. X#define D_CHAR_BIT "Number of bits in a storage unit"
  185. X#define D_CHAR_MAX "Maximum char"
  186. X#define D_CHAR_MIN "Minimum char"
  187. X#define D_SCHAR_MAX "Maximum signed char"
  188. X#define D_SCHAR_MIN "Minimum signed char"
  189. X#define D_UCHAR_MAX "Maximum unsigned char (minimum is always 0)"
  190. X#define D_INT_MAX "Maximum %s"
  191. X#define D_INT_MIN "Minimum %s"
  192. X#define D_UINT_MAX "Maximum unsigned %s (minimum is always 0)"
  193. X#define D_FLT_ROUNDS "Addition rounds to 0: zero, 1: nearest, 2: +inf, 3: -inf, -1: unknown"
  194. X#define D_FLT_RADIX "Radix of exponent representation"
  195. X#define D_MANT_DIG "Number of base-FLT_RADIX digits in the mantissa of a %s"
  196. X#define D_DIG "Number of decimal digits of precision in a %s"
  197. X#define D_MIN_EXP "Minimum int x such that FLT_RADIX**(x-1) is a normalised %s"
  198. X#define D_MIN_10_EXP "Minimum int x such that 10**x is a normalised %s"
  199. X#define D_MAX_EXP "Maximum int x such that FLT_RADIX**(x-1) is a representable %s"
  200. X#define D_MAX_10_EXP "Maximum int x such that 10**x is a representable %s"
  201. X#define D_MAX "Maximum %s"
  202. X#define D_EPSILON "Minimum %s x such that 1.0+x != 1.0"
  203. X#define D_MIN "Minimum normalised %s"
  204. X/* Procedure just marks the functions that don't return a result */
  205. X#ifdef NO_VOID
  206. X#define Procedure int
  207. X#else
  208. X#define Procedure void
  209. X#endif
  210. X/* Some bad compilers define __STDC__, when they don't support it.
  211. X   Compile with -DNO_STDC to get round this.
  212. X#ifndef NO_STDC
  213. X#ifdef __STDC__
  214. X#define STDC
  215. X#endif
  216. X#endif
  217. X/* Stuff different for ANSI C, and old C:
  218. X   ARGS and NOARGS are used for function prototypes.
  219. X   Volatile is used to reduce the chance of optimisation,
  220. X      and to prevent variables being put in registers (when setjmp/longjmp
  221. X      wouldn't work as we want)
  222. X   Long_double is the longest floating point type available.
  223. X   stdc is used in tests like "if (stdc)", which is less ugly than #ifdef.
  224. X   U is output after unsigned constants.
  225. X#ifdef STDC
  226. X#define ARGS(x) x
  227. X#define NOARGS (void)
  228. X#define Volatile volatile
  229. X#define Long_double long double
  230. X#define stdc 1
  231. X#define U "U"
  232. X#else /* Old style C */
  233. X#define ARGS(x) ()
  234. X#define NOARGS ()
  235. X#define Volatile static
  236. X#define Long_double double
  237. X#define stdc 0
  238. X#define U ""
  239. X#endif /* STDC */
  240. X/* include files */
  241. X#include <stdio.h>
  242. X#ifdef NO_SIG
  243. X#define jmp_buf int
  244. X#else
  245. X#include <signal.h>
  246. X#include <setjmp.h>
  247. X#endif
  248. X#ifdef VERIFY
  249. X#include "limits.h"
  250. X#include "float.h"
  251. X#endif
  252. X#define Vprintf if (V) printf
  253. X#define Unexpected(place) if (setjmp(lab)!=0) croak(place)
  254. X#define fabs(x) (((x)<0.0)?(-x):(x))
  255. X#endif /* PASS */
  256. X#ifdef PASS0
  257. X/* Prototypes for what's to come: */
  258. Xchar *malloc ARGS((unsigned size));
  259. XProcedure exit ARGS((int status));
  260. Xchar *f_rep ARGS((int precision, Long_double val));
  261. Xint cprop NOARGS;
  262. Xint basic NOARGS;
  263. XProcedure sprop NOARGS;
  264. XProcedure iprop NOARGS;
  265. XProcedure lprop NOARGS;
  266. XProcedure usprop NOARGS;
  267. XProcedure uiprop NOARGS;
  268. XProcedure ulprop NOARGS;
  269. Xint fprop ARGS((int bits_per_byte));
  270. Xint dprop ARGS((int bits_per_byte));
  271. Xint ldprop ARGS((int bits_per_byte));
  272. XProcedure efprop ARGS((int fprec, int dprec, int lprec));
  273. XProcedure edprop ARGS((int fprec, int dprec, int lprec));
  274. XProcedure eldprop ARGS((int fprec, int dprec, int lprec));
  275. Xint setmode ARGS((char *s));
  276. XProcedure farewell ARGS((int bugs));
  277. XProcedure describe ARGS((char *description, char *extra));
  278. XProcedure check_defines NOARGS;
  279. XProcedure bitpattern ARGS((char *p, unsigned int size));
  280. Xint ceil_log ARGS((int base, Long_double x));
  281. XProcedure croak ARGS((int place));
  282. XProcedure eek_a_bug ARGS((char *problem));
  283. XProcedure endian ARGS((int bits_per_byte));
  284. Xint exponent ARGS((Long_double x, double *fract, int *exp));
  285. Xint floor_log ARGS((int base, Long_double x));
  286. XProcedure f_define ARGS((char *desc, char *extra, char *sort, char *name,
  287. X             int prec, Long_double val, char *mark));
  288. XProcedure i_define ARGS((char *desc, char *extra, char *sort, char *name,
  289. X             long val, long req, char *mark));
  290. XProcedure u_define ARGS((char *desc, char *extra, char *sort, char *name,
  291. X             unsigned long val, unsigned long req, char *mark));
  292. X#ifdef NO_SIG  /* There's no signal(), or setjmp/longjmp() */
  293. X    /* Dummy routines instead */
  294. X    Procedure setjmp ARGS((int lab));
  295. X    int lab=1;
  296. X    int setjmp(lab) int lab; { return(0); }
  297. X    Procedure signal(i, p) int i, (*p)(); {}
  298. X#else
  299. X    jmp_buf lab;
  300. X    Procedure overflow(sig) int sig; { /* what to do on over/underflow */
  301. X        signal(sig, overflow);
  302. X        longjmp(lab, 1);
  303. X#endif /*NO_SIG*/
  304. Xint V= 0,    /* verbose */
  305. X    L= 0,    /* produce limits.h */
  306. X    F= 0,    /* produce float.h  */
  307. X    bugs=0;    /* The number of (possible) bugs in the output */
  308. Xchar co[4], oc[4]; /* Comment starter and ender symbols */
  309. Xint bits_per_byte; /* the number of bits per unit returned by sizeof() */
  310. Xint flt_rounds;    /* The calculated value of FLT_ROUNDS */
  311. Xint flt_radix;     /* The calculated value of FLT_RADIX */
  312. X#ifdef TEST
  313. X/* Set the fp modes on a SUN with 68881 chip, to check that different
  314. X   rounding modes etc. get properly detected.
  315. X   Compile with additional flag -DTEST, and run with additional parameter
  316. X   +hex-number, to set the 68881 mode register to hex-number
  317. X/* Bits 0x30 = rounding mode: */
  318. X#define ROUND_BITS    0x30
  319. X#define TO_NEAREST    0x00
  320. X#define TO_ZERO        0x10
  321. X#define TO_MINUS_INF    0x20
  322. X#define TO_PLUS_INF    0x30 /* The SUN FP user's guide seems to be wrong here */
  323. X/* Bits 0xc0 = extended rounding: */
  324. X#define EXT_BITS    0xc0
  325. X#define ROUND_EXTENDED    0x00
  326. X#define ROUND_SINGLE     0x40
  327. X#define ROUND_DOUBLE    0x80
  328. X/* Enabled traps: */
  329. X#define EXE_INEX1  0x100
  330. X#define EXE_INEX2  0x200
  331. X#define EXE_DZ       0x400
  332. X#define EXE_UNFL   0x800
  333. X#define EXE_OVFL  0x1000
  334. X#define EXE_OPERR 0x2000
  335. X#define EXE_SNAN  0x4000
  336. X#define EXE_BSUN  0x8000
  337. X/* Only used for testing, on a Sun with 68881 chip */
  338. X/* Print the FP mode */
  339. Xprintmode(new) unsigned new; {
  340. X    fpmode_(&new);
  341. X    printf("New fp mode:\n");
  342. X    printf("  Round toward ");
  343. X    switch (new & ROUND_BITS) {
  344. X          case TO_NEAREST:   printf("nearest"); break;
  345. X          case TO_ZERO:      printf("zero"); break;
  346. X          case TO_MINUS_INF: printf("minus infinity"); break;
  347. X          case TO_PLUS_INF:  printf("plus infinity"); break;
  348. X          default: printf("???"); break;
  349. X    printf("\n  Extended rounding precision: ");
  350. X    switch (new & EXT_BITS) {
  351. X          case ROUND_EXTENDED: printf("extended"); break;
  352. X          case ROUND_SINGLE:   printf("single"); break;
  353. X          case ROUND_DOUBLE:   printf("double"); break;
  354. X          default: printf("???"); break;
  355. X    printf("\n  Enabled exceptions:");
  356. X    if (new & (unsigned) EXE_INEX1) printf(" inex1");
  357. X    if (new & (unsigned) EXE_INEX2) printf(" inex2");
  358. X    if (new & (unsigned) EXE_DZ)    printf(" dz"); 
  359. X    if (new & (unsigned) EXE_UNFL)  printf(" unfl"); 
  360. X    if (new & (unsigned) EXE_OVFL)  printf(" ovfl"); 
  361. X    if (new & (unsigned) EXE_OPERR) printf(" operr"); 
  362. X    if (new & (unsigned) EXE_SNAN)  printf(" snan"); 
  363. X    if (new & (unsigned) EXE_BSUN)  printf(" bsun"); 
  364. X    printf("\n");
  365. X/* Only used for testing, on a Sun with 68881 chip */
  366. X/* Set the FP mode */
  367. Xint setmode(s) char *s; {
  368. X    unsigned mode=0, dig;
  369. X    char c;
  370. X    while (*s) {
  371. X        c= *s++;
  372. X        if  (c>='0' && c<='9') dig= c-'0';
  373. X        else if (c>='a' && c<='f') dig= c-'a'+10;
  374. X        else if (c>='A' && c<='F') dig= c-'A'+10;
  375. X        else return 1;
  376. X        mode= mode<<4 | dig;
  377. X    printmode(mode);
  378. X    return 0;
  379. X#else
  380. Xint setmode(s) char *s; {
  381. X    fprintf(stderr, "Can't set mode: not compiled with TEST\n");
  382. X    return(1);
  383. X#endif
  384. XProcedure farewell(bugs) int bugs; {
  385. X    if (bugs > 0) {
  386. X        printf("\n%sFor hints on dealing with the problems above", co);
  387. X        printf("\n   see the section 'TROUBLESHOOTING' in the file ");
  388. X        printf("%s%s\n", __FILE__, oc);
  389. X    exit(bugs);
  390. X/* The program has received a signal where it wasn't expecting one */
  391. XProcedure croak(place) int place; {
  392. X    printf("*** Unexpected signal at point %d\n", place);
  393. X    farewell(bugs+1); /* An exit isn't essential here, but avoids loops */
  394. Xmain(argc, argv) int argc; char *argv[]; {
  395. X    int dprec, fprec, lprec;
  396. X    unsigned int size;
  397. X    long total;
  398. X    int i; char *s; int bad;
  399. X#ifdef SIGFPE
  400. X    signal(SIGFPE, overflow);
  401. X#endif
  402. X#ifdef SIGOVER
  403. X    signal(SIGOVER, overflow);
  404. X#endif
  405. X/* Add more calls as necessary */
  406. X    Unexpected(1);
  407. X    bad=0;
  408. X    for (i=1; i < argc; i++) {
  409. X        s= argv[i];
  410. X        if (*s == '-') {
  411. X            s++;
  412. X            while (*s) {
  413. X                switch (*(s++)) {
  414. X                      case 'v': V=1; break;
  415. X                      case 'l': L=1; break;
  416. X                      case 'f': F=1; break;
  417. X                      default: bad=1; break;
  418. X                }
  419. X            }
  420. X        } else if (*s == '+') {
  421. X            s++;
  422. X            bad= setmode(s);
  423. X        } else bad= 1;
  424. X    if (bad) {
  425. X        fprintf(stderr,
  426. X            "Usage: %s [-vlf]\n  v=Verbose l=Limits.h f=Float.h\n",
  427. X            argv[0]);
  428. X        exit(1);
  429. X    if (L || F) {
  430. X        co[0]= '/'; oc[0]= ' ';
  431. X        co[1]= '*'; oc[1]= '*';
  432. X        co[2]= ' '; oc[2]= '/';
  433. X        co[3]= '\0'; oc[3]= '\0';
  434. X    } else {
  435. X        co[0]= '\0'; oc[0]= '\0';
  436. X        V=1;
  437. X    if (L) printf("%slimits.h%s\n", co, oc);
  438. X    if (F) printf("%sfloat.h%s\n", co, oc);
  439. X#ifdef ID
  440. X    printf("%sProduced on %s by config version %s, CWI, Amsterdam%s\n",
  441. X           co, ID, VERSION, oc);
  442. X#else
  443. X    printf("%sProduced by config version %s, CWI, Amsterdam%s\n",
  444. X           co, VERSION, oc);
  445. X#endif
  446. X#ifdef VERIFY
  447. X    printf("%sVerification phase%s\n", co, oc);
  448. X#endif
  449. X#ifdef NO_SIG
  450. X    Vprintf("%sCompiled without signal(): %s%s\n",
  451. X        co,
  452. X        "there's nothing that can be done if overflow occurs",
  453. X        oc);
  454. X#endif
  455. X#ifdef NO_SC
  456. X    Vprintf("%sCompiled without signed char%s\n", co, oc);
  457. X#endif
  458. X#ifdef NO_UC
  459. X    Vprintf("%Compiled without unsigned char%s\n", co, oc);
  460. X#endif
  461. X#ifdef NO_UI
  462. X    Vprintf("%Compiled without unsigned short or long%s\n", co, oc);
  463. X#endif
  464. X#ifdef __STDC__
  465. X    Vprintf("%sCompiler claims to be ANSI C level %d%s\n",
  466. X        co, __STDC__, oc);
  467. X#else
  468. X    Vprintf("%sCompiler does not claim to be ANSI C%s\n", co, oc);
  469. X#endif
  470. X    printf("\n");
  471. X    check_defines();
  472. X    bits_per_byte= basic();
  473. X    Vprintf("\n");
  474. X    if (F||V) {
  475. X        fprec= fprop(bits_per_byte);
  476. X        dprec= dprop(bits_per_byte);
  477. X        lprec= ldprop(bits_per_byte);
  478. X        efprop(fprec, dprec, lprec);
  479. X        edprop(fprec, dprec, lprec);
  480. X        eldprop(fprec, dprec, lprec);
  481. X    if (V) {
  482. X        /* An extra goody: the approximate amount of data-space */
  483. X        /* Allocate store until no more available */
  484. X        size=1<<((bits_per_byte*sizeof(int))-2);
  485. X        total=0;
  486. X        while (size!=0) {
  487. X            while (malloc(size)!=(char *)NULL) total+=(size/2);
  488. X            size/=2;
  489. X        Vprintf("%sMemory mallocatable ~= %ld Kbytes%s\n",
  490. X            co, (total+511)/512, oc);
  491. X    farewell(bugs);
  492. X    return bugs; /* To keep compilers and lint happy */
  493. XProcedure eek_a_bug(problem) char *problem; {
  494. X    /* The program has discovered a problem */
  495. X    printf("\n%s*** WARNING: %s%s\n", co, problem, oc);
  496. X    bugs++;
  497. XProcedure describe(description, extra) char *description, *extra; {
  498. X    /* Produce the description for a #define */
  499. X    printf("   %s", co);
  500. X    printf(description, extra);
  501. X    printf("%s\n", oc);
  502. XProcedure i_define(desc, extra, sort, name, val, req, mark)
  503. X     char *desc, *extra, *sort, *name; long val, req; char *mark; {
  504. X    /* Produce a #define for a signed int type */
  505. X    describe(desc, extra);
  506. X    if (val >= 0) {
  507. X        printf("#define %s%s %ld%s\n", sort, name, val, mark);
  508. X    } else {
  509. X        printf("#define %s%s (%ld%s)\n", sort, name, val, mark);
  510. X    if (val != req) {
  511. X        printf("%s*** Verify failed for above #define!\n", co);
  512. X        printf("       Compiler has %ld for value%s\n\n", req, oc);
  513. X        bugs++;
  514. X    Vprintf("\n");
  515. XProcedure u_define(desc, extra, sort, name, val, req, mark)
  516. X     char *desc, *extra, *sort, *name; unsigned long val, req; char *mark; {
  517. X    /* Produce a #define for an unsigned value */
  518. X    describe(desc, extra);
  519. X    printf("#define %s%s %lu%s%s\n", sort, name, val, U, mark);
  520. X    if (val != req) {
  521. X        printf("%s*** Verify failed for above #define!\n", co);
  522. X        printf("       Compiler has %lu for value%s\n\n", req, oc);
  523. X        bugs++;
  524. X    Vprintf("\n");
  525. XProcedure f_define(desc, extra, sort, name, precision, val, mark)
  526. X     char *desc, *extra, *sort, *name; int precision;
  527. X     Long_double val; char *mark; {
  528. X    /* Produce a #define for a float/double/long double */
  529. X    describe(desc, extra);
  530. X    if (stdc) {
  531. X        printf("#define %s%s %s%s\n",
  532. X               sort, name, f_rep(precision, val), mark);
  533. X    } else if (*mark == 'F') {
  534. X        /* non-ANSI C has no float constants, so cast the constant */
  535. X        printf("#define %s%s ((float)%s)\n",
  536. X               sort, name, f_rep(precision, val));
  537. X    } else {
  538. X        printf("#define %s%s %s\n", sort, name, f_rep(precision, val));
  539. X    Vprintf("\n");
  540. Xint floor_log(base, x) int base; Long_double x; {
  541. X    /* return floor(log base(x)) */
  542. X    int r=0;
  543. X    while (x>=base) { r++; x/=base; }
  544. X    return r;
  545. Xint ceil_log(base, x) int base; Long_double x; {
  546. X    int r=0;
  547. X    while (x>1.0) { r++; x/=base; }
  548. X    return r;
  549. Xint exponent(x, fract, exp) Long_double x; double *fract; int *exp; {
  550. X    /* Split x into a fraction and a power of ten;
  551. X       returns 0 if x is unusable, 1 otherwise.
  552. X       Only used for error messages about faulty output.
  553. X    int r=0, neg=0;
  554. X    Long_double old;
  555. X    *fract=0.0; *exp=0;
  556. X    if (x<0.0) {
  557. X        x= -x;
  558. X        neg= 1;
  559. X    if (x==0.0) return 1;
  560. X    if (x>=10.0) {
  561. X        while (x>=10.0) {
  562. X            old=x; r++; x/=10.0;
  563. X            if (old==x) return 0;
  564. X    } else {
  565. X        while (x<1.0) {
  566. X            old=x; r--; x*=10.0;
  567. X            if (old==x) return 0;
  568. X    if (neg) *fract= -x;
  569. X    else *fract=x;
  570. X    *exp=r;
  571. X    return 1;
  572. Xchar *f_rep(precision, val) int precision; Long_double val; {
  573. X    /* Return the floating representation of val */
  574. X    static char buf[1024];
  575. X    char *f1;
  576. X    if (sizeof(double) == sizeof(Long_double)) {
  577. X        /* Assume they're the same, and use non-stdc format */
  578. X        /* This is for stdc compilers using non-stdc libraries */
  579. X        f1= "%.*e";
  580. X    } else {
  581. X        /* It had better support Le then */
  582. X        f1= "%.*Le";
  583. X    sprintf(buf, f1, precision, val);
  584. X    return buf;
  585. XProcedure bitpattern(p, size) char *p; unsigned int size; {
  586. X    /* Printf the bit-pattern of p */
  587. X    char c;
  588. X    int i, j;
  589. X    for (i=1; i<=size; i++) {
  590. X        c= *p;
  591. X        p++;
  592. X        for (j=bits_per_byte-1; j>=0; j--)
  593. X            printf("%c", (c>>j)&1 ? '1' : '0');
  594. X        if (i!=size) printf(" ");
  595. X#define Order(x, px, mode)\
  596. X   printf("%s    %s ", co, mode); for (i=0; i<sizeof(x); i++) px[i]= c[i]; \
  597. X   for (i=1; i<=sizeof(x); i++) { putchar((char)((x>>(bits_per_byte*(sizeof(x)-i)))&mask)); }\
  598. X   printf("%s\n", oc);
  599. XProcedure endian(bits_per_byte) int bits_per_byte; {
  600. X    /* Printf the byte-order used on this machine */
  601. X    /*unsigned*/ short s=0;
  602. X    /*unsigned*/ int j=0;
  603. X    /*unsigned*/ long l=0;
  604. X    char *ps= (char *) &s,
  605. X         *pj= (char *) &j,
  606. X         *pl= (char *) &l,
  607. X         *c= "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
  608. X    unsigned int mask, i;
  609. X    mask=0;
  610. X    for (i=1; i<=(unsigned)bits_per_byte; i++) mask= (mask<<1)|1;
  611. X    if (V) {
  612. X        printf("%sCharacter order:%s\n", co, oc);
  613. X        Order(s, ps, "short:");
  614. X        Order(j, pj, "int:  ");
  615. X        Order(l, pl, "long: ");
  616. XProcedure check_defines() {
  617. X    /* ensure that all the #defines are present */
  618. X#ifdef VERIFY
  619. X    if (L) {
  620. X#ifndef CHAR_BIT
  621. X    printf("%s*** CHAR_BIT missing from limits.h%s\n", co, oc); bugs++;
  622. X#endif
  623. X#ifndef CHAR_MAX
  624. X    printf("%s*** CHAR_MAX missing from limits.h%s\n", co, oc); bugs++;
  625. X#endif
  626. X#ifndef CHAR_MIN
  627. X    printf("%s*** CHAR_MIN missing from limits.h%s\n", co, oc); bugs++;
  628. X#endif
  629. X#ifndef SCHAR_MAX
  630. X    printf("%s*** SCHAR_MAX missing from limits.h%s\n", co, oc); bugs++;
  631. X#endif
  632. X#ifndef SCHAR_MIN
  633. X    printf("%s*** SCHAR_MIN missing from limits.h%s\n", co, oc); bugs++;
  634. X#endif
  635. X#ifndef UCHAR_MAX
  636. X    printf("%s*** UCHAR_MAX missing from limits.h%s\n", co, oc); bugs++;
  637. X#endif
  638. X#ifndef SHRT_MAX
  639. X    printf("%s*** SHRT_MAX missing from limits.h%s\n", co, oc); bugs++;
  640. X#endif
  641. X#ifndef SHRT_MIN
  642. X    printf("%s*** SHRT_MIN missing from limits.h%s\n", co, oc); bugs++;
  643. X#endif
  644. X#ifndef INT_MAX
  645. X    printf("%s*** INT_MAX missing from limits.h%s\n", co, oc); bugs++;
  646. X#endif
  647. X#ifndef INT_MIN
  648. X    printf("%s*** INT_MIN missing from limits.h%s\n", co, oc); bugs++;
  649. X#endif
  650. X#ifndef LONG_MAX
  651. X    printf("%s*** LONG_MAX missing from limits.h%s\n", co, oc); bugs++;
  652. X#endif
  653. X#ifndef LONG_MIN
  654. X    printf("%s*** LONG_MIN missing from limits.h%s\n", co, oc); bugs++;
  655. X#endif
  656. X#ifndef USHRT_MAX
  657. X    printf("%s*** USHRT_MAX missing from limits.h%s\n", co, oc); bugs++;
  658. X#endif
  659. X#ifndef UINT_MAX
  660. X    printf("%s*** UINT_MAX missing from limits.h%s\n", co, oc); bugs++;
  661. X#endif
  662. X#ifndef ULONG_MAX
  663. X    printf("%s*** ULONG_MAX missing from limits.h%s\n", co, oc); bugs++;
  664. X#endif
  665. X    } /* if (L) */
  666. X    if (F) {
  667. X#ifndef FLT_RADIX
  668. X    printf("%s*** FLT_RADIX missing from float.h%s\n", co, oc); bugs++;
  669. X#endif
  670. X#ifndef FLT_MANT_DIG
  671. X    printf("%s*** FLT_MANT_DIG missing from float.h%s\n", co, oc); bugs++;
  672. X#endif
  673. X#ifndef FLT_DIG
  674. X    printf("%s*** FLT_DIG missing from float.h%s\n", co, oc); bugs++;
  675. X#endif
  676. X#ifndef FLT_ROUNDS
  677. X    printf("%s*** FLT_ROUNDS missing from float.h%s\n", co, oc); bugs++;
  678. X#endif
  679. X#ifndef FLT_EPSILON
  680. X    printf("%s*** FLT_EPSILON missing from float.h%s\n", co, oc); bugs++;
  681. X#endif
  682. X#ifndef FLT_MIN_EXP
  683. X    printf("%s*** FLT_MIN_EXP missing from float.h%s\n", co, oc); bugs++;
  684. X#endif
  685. X#ifndef FLT_MIN
  686. X    printf("%s*** FLT_MIN missing from float.h%s\n", co, oc); bugs++;
  687. X#endif
  688. X#ifndef FLT_MIN_10_EXP
  689. X    printf("%s*** FLT_MIN_10_EXP missing from float.h%s\n", co, oc); bugs++;
  690. X#endif
  691. X#ifndef FLT_MAX_EXP
  692. X    printf("%s*** FLT_MAX_EXP missing from float.h%s\n", co, oc); bugs++;
  693. X#endif
  694. X#ifndef FLT_MAX
  695. X    printf("%s*** FLT_MAX missing from float.h%s\n", co, oc); bugs++;
  696. X#endif
  697. X#ifndef FLT_MAX_10_EXP
  698. X    printf("%s*** FLT_MAX_10_EXP missing from float.h%s\n", co, oc); bugs++;
  699. X#endif
  700. X#ifndef DBL_MANT_DIG
  701. X    printf("%s*** DBL_MANT_DIG missing from float.h%s\n", co, oc); bugs++;
  702. X#endif
  703. X#ifndef DBL_DIG
  704. X    printf("%s*** DBL_DIG missing from float.h%s\n", co, oc); bugs++;
  705. X#endif
  706. X#ifndef DBL_EPSILON
  707. X    printf("%s*** DBL_EPSILON missing from float.h%s\n", co, oc); bugs++;
  708. X#endif
  709. X#ifndef DBL_MIN_EXP
  710. X    printf("%s*** DBL_MIN_EXP missing from float.h%s\n", co, oc); bugs++;
  711. X#endif
  712. X#ifndef DBL_MIN
  713. X    printf("%s*** DBL_MIN missing from float.h%s\n", co, oc); bugs++;
  714. X#endif
  715. X#ifndef DBL_MIN_10_EXP
  716. X    printf("%s*** DBL_MIN_10_EXP missing from float.h%s\n", co, oc); bugs++;
  717. X#endif
  718. X#ifndef DBL_MAX_EXP
  719. X    printf("%s*** DBL_MAX_EXP missing from float.h%s\n", co, oc); bugs++;
  720. X#endif
  721. X#ifndef DBL_MAX
  722. X    printf("%s*** DBL_MAX missing from float.h%s\n", co, oc); bugs++;
  723. X#endif
  724. X#ifndef DBL_MAX_10_EXP
  725. X    printf("%s*** DBL_MAX_10_EXP missing from float.h%s\n", co, oc); bugs++;
  726. X#endif
  727. X#ifdef STDC
  728. X#ifndef LDBL_MANT_DIG
  729. X    printf("%s*** LDBL_MANT_DIG missing from float.h%s\n", co, oc); bugs++;
  730. X#endif
  731. X#ifndef LDBL_DIG
  732. X    printf("%s*** LDBL_DIG missing from float.h%s\n", co, oc); bugs++;
  733. X#endif
  734. X#ifndef LDBL_EPSILON
  735. X    printf("%s*** LDBL_EPSILON missing from float.h%s\n", co, oc); bugs++;
  736. X#endif
  737. X#ifndef LDBL_MIN_EXP
  738. X    printf("%s*** LDBL_MIN_EXP missing from float.h%s\n", co, oc); bugs++;
  739. X#endif
  740. X#ifndef LDBL_MIN
  741. X    printf("%s*** LDBL_MIN missing from float.h%s\n", co, oc); bugs++;
  742. X#endif
  743. X#ifndef LDBL_MIN_10_EXP
  744. X    printf("%s*** LDBL_MIN_10_EXP missing from float.h%s\n", co, oc); bugs++;
  745. X#endif
  746. X#ifndef LDBL_MAX_EXP
  747. X    printf("%s*** LDBL_MAX_EXP missing from float.h%s\n", co, oc); bugs++;
  748. X#endif
  749. X#ifndef LDBL_MAX
  750. X    printf("%s*** LDBL_MAX missing from float.h%s\n", co, oc); bugs++;
  751. X#endif
  752. X#ifndef LDBL_MAX_10_EXP
  753. X    printf("%s*** LDBL_MAX_10_EXP missing from float.h%s\n", co, oc); bugs++;
  754. X#endif
  755. X#endif /* STDC */
  756. X    } /* if (F) */
  757. X#endif /* VERIFY */
  758. X#ifdef VERIFY
  759. X#ifndef SCHAR_MAX
  760. X#define SCHAR_MAX    char_max
  761. X#endif
  762. X#ifndef SCHAR_MIN
  763. X#define SCHAR_MIN    char_min
  764. X#endif
  765. X#ifndef UCHAR_MAX
  766. X#define UCHAR_MAX    char_max
  767. X#endif
  768. X#endif /* VERIFY */
  769. X#ifndef CHAR_BIT
  770. X#define CHAR_BIT    char_bit
  771. X#endif
  772. X#ifndef CHAR_MAX
  773. X#define CHAR_MAX    char_max
  774. X#endif
  775. X#ifndef CHAR_MIN
  776. X#define CHAR_MIN    char_min
  777. X#endif
  778. X#ifndef SCHAR_MAX
  779. X#define SCHAR_MAX    char_max
  780. X#endif
  781. X#ifndef SCHAR_MIN
  782. X#define SCHAR_MIN    char_min
  783. X#endif
  784. X#ifndef UCHAR_MAX
  785. X#define UCHAR_MAX    char_max
  786. X#endif
  787. Xint cprop() {
  788. X    /* Properties of type char */
  789. X    Volatile char c, char_max, char_min;
  790. X    Volatile int bits_per_byte, is_signed;
  791. X    long char_bit;
  792. X    Unexpected(2);
  793. X    /* Calculate number of bits per character *************************/
  794. X    c=1; bits_per_byte=0;
  795. X    do { c=c<<1; bits_per_byte++; } while(c!=0);
  796. X    c= (char)(-1);
  797. X    if (((int)c)<0) is_signed=1;
  798. X    else is_signed=0;
  799. X    Vprintf("%sChar = %d bits, %ssigned%s\n",
  800. X        co, (int)sizeof(c)*bits_per_byte, (is_signed?"":"un"), oc);
  801. X    char_bit=(long)(sizeof(c)*bits_per_byte);
  802. X    if (L) i_define(D_CHAR_BIT, "",
  803. X            "CHAR", "_BIT", char_bit, (long) CHAR_BIT, "");
  804. X    c=0; char_max=0;
  805. X    c++;
  806. X    if (setjmp(lab)==0) { /* Yields char_max */
  807. X        while (c>char_max) {
  808. X            char_max=c;
  809. X            c++;
  810. X    } else {
  811. X        Vprintf("%sCharacter overflow generates a trap!%s\n", co, oc);
  812. X    c=0; char_min=0;
  813. X    c--;
  814. X    if (setjmp(lab)==0) { /* Yields char_min */
  815. X        while (c<char_min) {
  816. X            char_min=c;
  817. X            c--;
  818. X    if (is_signed && char_min == 0) {
  819. X        Vprintf("%sBEWARE! Chars are pseudo-unsigned:%s\n", co, oc);
  820. X        Vprintf("%s   %s%s%s\n",
  821. X            "They contain only nonnegative values, ",
  822. X            "but sign extend when used as integers.", co, oc);
  823. X    Unexpected(3);
  824. X    if (L) {
  825. X        i_define(D_CHAR_MAX, "",
  826. X             "CHAR", "_MAX", (long) char_max, (long) CHAR_MAX, "");
  827. X        i_define(D_CHAR_MIN, "",
  828. X             "CHAR", "_MIN", (long) char_min, (long) CHAR_MIN, "");
  829. X        if (is_signed) {
  830. X            i_define(D_SCHAR_MAX, "",
  831. X                 "SCHAR", "_MAX", (long) char_max,
  832. X                 (long) SCHAR_MAX, "");
  833. X            i_define(D_SCHAR_MIN, "",
  834. X                 "SCHAR", "_MIN", (long) char_min,
  835. X                 (long) SCHAR_MIN, "");
  836. X        } else {
  837. X            i_define(D_UCHAR_MAX, "",
  838. X                 "UCHAR", "_MAX", (long) char_max,
  839. X                 (long) UCHAR_MAX, "");
  840. X        if (is_signed) {
  841. X#ifndef NO_UC
  842. X            Volatile unsigned char c, char_max;
  843. X            c=0; char_max=0;
  844. X            c++;
  845. X            if (setjmp(lab)==0) { /* Yields char_max */
  846. X                while (c>char_max) {
  847. X                    char_max=c;
  848. X                    c++;
  849. X                }
  850. X            }
  851. X            Unexpected(4);
  852. X            i_define(D_UCHAR_MAX, "",
  853. X                 "UCHAR", "_MAX", (long) char_max,
  854. X                 (long) UCHAR_MAX, "");
  855. X#endif
  856. X        } else {
  857. X#ifndef NO_SC /* Define NO_SC if the next line gives a syntax error */
  858. X            Volatile signed char c, char_max, char_min;
  859. X            c=0; char_max=0;
  860. X            c++;
  861. X            if (setjmp(lab)==0) { /* Yields char_max */
  862. X                while (c>char_max) {
  863. X                    char_max=c;
  864. X                    c++;
  865. X                }
  866. X            }
  867. X            c=0; char_min=0;
  868. X            c--;
  869. X            if (setjmp(lab)==0) { /* Yields char_min */
  870. X                while (c<char_min) {
  871. X                    char_min=c;
  872. X                    c--;
  873. X                }
  874. X            }
  875. X            Unexpected(5);
  876. X            i_define(D_SCHAR_MIN, "",
  877. X                 "SCHAR", "_MIN", (long) char_min,
  878. X                 (long) SCHAR_MIN, "");
  879. X            i_define(D_SCHAR_MAX, "",
  880. X                 "SCHAR", "_MAX", (long) char_max,
  881. X                 (long) SCHAR_MAX, "");
  882. X#endif /* NO_SC */
  883. X    return bits_per_byte;
  884. Xint basic() {
  885. X    /* The properties of the basic types.
  886. X       Returns number of bits per sizeof unit */
  887. X    Volatile int bits_per_byte;
  888. X    struct{char i1; char c1;} schar;
  889. X    struct{short i2; char c2;} sshort;
  890. X    struct{int i3; char c3;} sint;
  891. X    struct{long i4; char c4;} slong;
  892. X    bits_per_byte= cprop();
  893. X    /* Shorts, ints and longs *****************************************/
  894. X    Vprintf("%sShort=%d int=%d long=%d float=%d double=%d bits %s\n",
  895. X        co,
  896. X        (int) sizeof(short)*bits_per_byte,
  897. X        (int) sizeof(int)*bits_per_byte,
  898. X        (int) sizeof(long)*bits_per_byte,
  899. X        (int) sizeof(float)*bits_per_byte,
  900. X        (int) sizeof(double)*bits_per_byte, oc);
  901. X    if (stdc) {
  902. X        Vprintf("%sLong double=%d bits%s\n",
  903. X            co, (int) sizeof(Long_double)*bits_per_byte, oc);
  904. X    Vprintf("%sChar pointers = %d bits%s%s\n",
  905. X        co, (int)sizeof(char *)*bits_per_byte,
  906. X        sizeof(char *)>sizeof(int)?" BEWARE! larger than int!":"",
  907. X        oc);
  908. X    Vprintf("%sInt pointers = %d bits%s%s\n",
  909. X        co, (int)sizeof(int *)*bits_per_byte,
  910. X        sizeof(int *)>sizeof(int)?" BEWARE! larger than int!":"",
  911. X        oc);
  912. X    /* Alignment constants ********************************************/
  913. X    Vprintf("%sAlignments used for char=%ld short=%ld int=%ld long=%ld%s\n",
  914. X        co,
  915. X        ((long)&schar.c1)-((long)&schar.i1),
  916. X        ((long)&sshort.c2)-((long)&sshort.i2),
  917. X        ((long)&sint.c3)-((long)&sint.i3),
  918. X        ((long)&slong.c4)-((long)&slong.i4),
  919. X        oc);
  920. X    /* Ten little endians *********************************************/
  921. X    endian(bits_per_byte);
  922. X    /* Pointers *******************************************************/
  923. X    if (V) {
  924. X        if ("abcd"=="abcd")
  925. X            printf("%sStrings are shared%s\n", co, oc);
  926. X        else printf("%sStrings are not shared%s\n", co, oc);
  927. X    sprop();
  928. X    iprop();
  929. X    lprop();
  930. X    usprop();
  931. X    uiprop();
  932. X    ulprop();
  933. X    Unexpected(6);
  934. X    return bits_per_byte;
  935. X#else /* not PASS0 */
  936. X#ifdef SEP
  937. Xextern jmp_buf lab;
  938. Xextern int V, L, F, bugs, bits_per_byte;
  939. Xextern char co[], oc[];
  940. Xextern char *f_rep();
  941. X#endif /* SEP */
  942. X#endif /* ifdef PASS0 */
  943. X/* As I said, I apologise for the contortions below. The functions are
  944. X   expanded by the preprocessor twice or three times (for float and double,
  945. X   and maybe for long double, and for short, int and long). That way,
  946. X   I never make a change to one that I forget to make to the other.
  947. X   You can look on it as C's fault for not supporting multi-line macro's.
  948. X   This whole file is read 3 times by the preprocessor, with PASSn set for
  949. X   n=1, 2 or 3, to decide which parts to reprocess.
  950. X/* #undef on an already undefined thing is (wrongly) flagged as an error
  951. X   by some compilers, therefore the #ifdef that follows: 
  952. X#ifdef Number
  953. X#undef Number
  954. X#undef THING
  955. X#undef Thing
  956. X#undef thing
  957. X#undef FPROP
  958. X#undef Fname
  959. X#undef Store
  960. X#undef Sum
  961. X#undef Diff
  962. X#undef Mul
  963. X#undef Div
  964. X#undef ZERO
  965. X#undef HALF
  966. X#undef ONE
  967. X#undef TWO
  968. X#undef THREE
  969. X#undef FOUR
  970. X#undef Self
  971. X#undef F_check
  972. X#undef Validate
  973. X#undef EPROP
  974. X#undef MARK
  975. X/* These are the float.h constants */
  976. X#undef F_RADIX
  977. X#undef F_MANT_DIG
  978. X#undef F_DIG
  979. X#undef F_ROUNDS
  980. X#undef F_EPSILON
  981. X#undef F_MIN_EXP
  982. X#undef F_MIN
  983. X#undef F_MIN_10_EXP
  984. X#undef F_MAX_EXP
  985. X#undef F_MAX
  986. X#undef F_MAX_10_EXP
  987. X#endif
  988. X#ifdef Integer
  989. X#undef Integer
  990. X#undef INT
  991. X#undef IPROP
  992. X#undef Iname
  993. X#undef UPROP
  994. X#undef Uname
  995. X#undef OK_UI
  996. X#undef IMARK
  997. X#undef I_MAX
  998. X#undef I_MIN
  999. X#undef U_MAX
  1000. X#endif
  1001. X#ifdef PASS1
  1002. X/* Define the things we're going to use this pass */
  1003. X#define Number    float
  1004. X#define THING    "FLOAT"
  1005. X#define Thing    "Float"
  1006. X#define thing    "float"
  1007. X#define Fname    "FLT"
  1008. X#define FPROP    fprop
  1009. X#define Store    fStore
  1010. X#define Sum    fSum
  1011. X#define Diff    fDiff
  1012. X#define Mul    fMul
  1013. X#define Div    fDiv
  1014. X#define ZERO    0.0
  1015. X#define HALF    0.5
  1016. X#define ONE    1.0
  1017. X#define TWO    2.0
  1018. X#define THREE    3.0
  1019. X#define FOUR    4.0
  1020. X#define Self    fSelf
  1021. X#define F_check    fCheck
  1022. X#define MARK    "F"
  1023. X#ifdef VERIFY
  1024. X#define Validate(prec, val, req, same) fValidate(prec, val, req, same)
  1025. X#endif
  1026. X#define EPROP    efprop
  1027. X#define Integer    short
  1028. X#define INT    "short"
  1029. X#define IPROP    sprop
  1030. X#define Iname    "SHRT"
  1031. X#ifndef NO_UI
  1032. X#define OK_UI 1
  1033. X#endif
  1034. X#define IMARK    ""
  1035. X#define UPROP    usprop
  1036. X#define Uname    "USHRT"
  1037. X#ifdef VERIFY
  1038. X#ifdef SHRT_MAX
  1039. X#define I_MAX        SHRT_MAX
  1040. X#endif
  1041. X#ifdef SHRT_MIN
  1042. X#define I_MIN        SHRT_MIN
  1043. X#endif
  1044. X#ifdef USHRT_MAX
  1045. X#define U_MAX        USHRT_MAX
  1046. X#endif
  1047. X#ifdef FLT_RADIX
  1048. X#define F_RADIX        FLT_RADIX
  1049. X#endif
  1050. X#ifdef FLT_MANT_DIG
  1051. X#define F_MANT_DIG    FLT_MANT_DIG
  1052. X#endif
  1053. X#ifdef FLT_DIG
  1054. X#define F_DIG        FLT_DIG
  1055. X#endif
  1056. X#ifdef FLT_ROUNDS
  1057. X#define F_ROUNDS    FLT_ROUNDS
  1058. X#endif
  1059. X#ifdef FLT_EPSILON
  1060. X#define F_EPSILON    FLT_EPSILON
  1061. X#endif
  1062. X#ifdef FLT_MIN_EXP
  1063. X#define F_MIN_EXP    FLT_MIN_EXP
  1064. X#endif
  1065. X#ifdef FLT_MIN
  1066. X#define F_MIN        FLT_MIN
  1067. X#endif
  1068. X#ifdef FLT_MIN_10_EXP
  1069. X#define F_MIN_10_EXP    FLT_MIN_10_EXP
  1070. X#endif
  1071. X#ifdef FLT_MAX_EXP
  1072. X#define F_MAX_EXP    FLT_MAX_EXP
  1073. X#endif
  1074. X#ifdef FLT_MAX
  1075. X#define F_MAX        FLT_MAX
  1076. X#endif
  1077. X#ifdef FLT_MAX_10_EXP
  1078. X#define F_MAX_10_EXP    FLT_MAX_10_EXP
  1079. X#endif
  1080. X#endif /* VERIFY */
  1081. X#endif /* PASS1 */
  1082. X#ifdef PASS2
  1083. X#define Number    double
  1084. X#define THING    "DOUBLE"
  1085. X#define Thing    "Double"
  1086. X#define thing    "double"
  1087. X#define Fname    "DBL"
  1088. X#define FPROP    dprop
  1089. X#define Store    dStore
  1090. X#define Sum    dSum
  1091. X#define Diff    dDiff
  1092. X#define Mul    dMul
  1093. X#define Div    dDiv
  1094. X#define ZERO    0.0
  1095. X#define HALF    0.5
  1096. X#define ONE    1.0
  1097. X#define TWO    2.0
  1098. X#define THREE    3.0
  1099. X#define FOUR    4.0
  1100. X#define Self    dSelf
  1101. X#define F_check    dCheck
  1102. X#define MARK    ""
  1103. X#ifdef VERIFY
  1104. X#define Validate(prec, val, req, same) dValidate(prec, val, req, same)
  1105. X#endif
  1106. X#define EPROP    edprop
  1107. X#define Integer    int
  1108. X#define INT    "int"
  1109. X#define IPROP    iprop
  1110. X#define Iname    "INT"
  1111. X#define OK_UI    1 /* Unsigned int is always possible */
  1112. X#define IMARK    ""
  1113. X#define UPROP    uiprop
  1114. X#define Uname    "UINT"
  1115. X#ifdef VERIFY
  1116. X#ifdef INT_MAX
  1117. X#define I_MAX        INT_MAX
  1118. X#endif
  1119. X#ifdef INT_MIN
  1120. X#define I_MIN        INT_MIN
  1121. X#endif
  1122. X#ifdef UINT_MAX
  1123. X#define U_MAX        UINT_MAX
  1124. X#endif
  1125. X#ifdef DBL_MANT_DIG
  1126. X#define F_MANT_DIG    DBL_MANT_DIG
  1127. X#endif
  1128. X#ifdef DBL_DIG
  1129. X#define F_DIG        DBL_DIG
  1130. X#endif
  1131. X#ifdef DBL_EPSILON
  1132. X#define F_EPSILON    DBL_EPSILON
  1133. X#endif
  1134. X#ifdef DBL_MIN_EXP
  1135. X#define F_MIN_EXP    DBL_MIN_EXP
  1136. X#endif
  1137. X#ifdef DBL_MIN
  1138. X#define F_MIN        DBL_MIN
  1139. X#endif
  1140. X#ifdef DBL_MIN_10_EXP
  1141. X#define F_MIN_10_EXP    DBL_MIN_10_EXP
  1142. X#endif
  1143. X#ifdef DBL_MAX_EXP
  1144. X#define F_MAX_EXP    DBL_MAX_EXP
  1145. X#endif
  1146. X#ifdef DBL_MAX
  1147. X#define F_MAX        DBL_MAX
  1148. X#endif
  1149. X#ifdef DBL_MAX_10_EXP
  1150. X#define F_MAX_10_EXP    DBL_MAX_10_EXP
  1151. X#endif
  1152. X#endif /* VERIFY */
  1153. X#endif /* PASS2 */
  1154. X#ifdef PASS3
  1155. X#ifdef STDC
  1156. X#define Number    long double
  1157. X#endif
  1158. X#define THING    "LONG DOUBLE"
  1159. X#define Thing    "Long double"
  1160. X#define thing    "long double"
  1161. X#define Fname    "LDBL"
  1162. X#define FPROP    ldprop
  1163. X#define Store    ldStore
  1164. X#define Sum    ldSum
  1165. X#define Diff    ldDiff
  1166. X#define Mul    ldMul
  1167. X#define Div    ldDiv
  1168. X#define ZERO    0.0L
  1169. X#define HALF    0.5L
  1170. X#define ONE    1.0L
  1171. X#define TWO    2.0L
  1172. X#define THREE    3.0L
  1173. X#define FOUR    4.0L
  1174. X#define Self    ldSelf
  1175. X#define F_check    ldCheck
  1176. X#define MARK    "L"
  1177. X#ifdef VERIFY
  1178. X#define Validate(prec, val, req, same) ldValidate(prec, val, req, same)
  1179. X#endif
  1180. X#define EPROP    eldprop
  1181. X#define Integer    long
  1182. X#define INT    "long"
  1183. X#define IPROP    lprop
  1184. X#define Iname    "LONG"
  1185. X#ifndef NO_UI
  1186. X#define OK_UI    1
  1187. X#endif
  1188. X#define IMARK    "L"
  1189. X#define UPROP    ulprop
  1190. X#define Uname    "ULONG"
  1191. X#ifdef VERIFY
  1192. X#ifdef LONG_MAX
  1193. X#define I_MAX    LONG_MAX
  1194. X#endif
  1195. X#ifdef LONG_MIN
  1196. X#define I_MIN    LONG_MIN
  1197. X#endif
  1198. X#ifdef ULONG_MAX
  1199. X#define U_MAX    ULONG_MAX
  1200. X#endif
  1201. X#ifdef LDBL_MANT_DIG
  1202. X#define F_MANT_DIG    LDBL_MANT_DIG
  1203. X#endif
  1204. X#ifdef LDBL_DIG
  1205. X#define F_DIG        LDBL_DIG
  1206. X#endif
  1207. X#ifdef LDBL_EPSILON
  1208. X#define F_EPSILON    LDBL_EPSILON
  1209. X#endif
  1210. X#ifdef LDBL_MIN_EXP
  1211. X#define F_MIN_EXP    LDBL_MIN_EXP
  1212. X#endif
  1213. X#ifdef LDBL_MIN
  1214. X#define F_MIN        LDBL_MIN
  1215. X#endif
  1216. X#ifdef LDBL_MIN_10_EXP
  1217. X#define F_MIN_10_EXP    LDBL_MIN_10_EXP
  1218. X#endif
  1219. X#ifdef LDBL_MAX_EXP
  1220. X#define F_MAX_EXP    LDBL_MAX_EXP
  1221. X#endif
  1222. X#ifdef LDBL_MAX
  1223. X#define F_MAX        LDBL_MAX
  1224. X#endif
  1225. X#ifdef LDBL_MAX_10_EXP
  1226. X#define F_MAX_10_EXP    LDBL_MAX_10_EXP
  1227. X#endif
  1228. X#endif /* VERIFY */
  1229. X#endif /* PASS3 */
  1230. X#ifndef I_MAX
  1231. X#define I_MAX    int_max
  1232. X#endif
  1233. X#ifndef I_MIN
  1234. X#define I_MIN    int_min
  1235. X#endif
  1236. X#ifndef U_MAX
  1237. X#define U_MAX    int_max
  1238. X#endif
  1239. X#ifndef F_RADIX
  1240. X#define F_RADIX        f_radix
  1241. X#endif
  1242. X#ifndef F_MANT_DIG
  1243. X#define F_MANT_DIG    f_mant_dig
  1244. X#endif
  1245. X#ifndef F_DIG
  1246. X#define F_DIG        f_dig
  1247. X#endif
  1248. X#ifndef F_ROUNDS
  1249. X#define F_ROUNDS    f_rounds
  1250. X#endif
  1251. X#ifndef F_EPSILON
  1252. X#define F_EPSILON    f_epsilon
  1253. X#endif
  1254. X#ifndef F_MIN_EXP
  1255. X#define F_MIN_EXP    f_min_exp
  1256. X#endif
  1257. X#ifndef F_MIN
  1258. X#define F_MIN        f_min
  1259. X#endif
  1260. X#ifndef F_MIN_10_EXP
  1261. X#define F_MIN_10_EXP    f_min_10_exp
  1262. X#endif
  1263. X#ifndef F_MAX_EXP
  1264. X#define F_MAX_EXP    f_max_exp
  1265. X#endif
  1266. X#ifndef F_MAX
  1267. X#define F_MAX        f_max
  1268. X#endif
  1269. X#ifndef F_MAX_10_EXP
  1270. X#define F_MAX_10_EXP    f_max_10_exp
  1271. X#endif
  1272. X#ifndef VERIFY
  1273. X#define Validate(prec, val, req, same) {;}
  1274. X#endif
  1275. X#ifdef Integer
  1276. XProcedure IPROP() {
  1277. X    /* the properties of short, int, and long */
  1278. X    Volatile Integer newi, int_max, maxeri, int_min, minneri;
  1279. X    Volatile int ibits, ipower, two=2;
  1280. X    /* Calculate max short/int/long ***********************************/
  1281. X    /* Calculate 2**n-1 until overflow - then use the previous value  */
  1282. X    newi=1; int_max=0;
  1283. X    if (setjmp(lab)==0) { /* Yields int_max */
  1284. X        for(ipower=0; newi>int_max; ipower++) {
  1285. X            int_max=newi;
  1286. X            newi=newi*two+1;
  1287. X        Vprintf("%sOverflow of a%s %s does not generate a trap%s\n",
  1288. X            co, INT[0]=='i'?"n":"", INT, oc);
  1289. X    } else {
  1290. X        Vprintf("%sOverflow of a%s %s generates a trap%s\n",
  1291. X            co, INT[0]=='i'?"n":"", INT, oc);
  1292. X    Unexpected(7);
  1293. X    /* Minimum value: assume either two's or one's complement *********/
  1294. X    int_min= -int_max;
  1295. X    if (setjmp(lab)==0) { /* Yields int_min */
  1296. X        if (int_min-1 < int_min) int_min--;
  1297. X    Unexpected(8);
  1298. X    /* Now for those daft Cybers: */
  1299. X    maxeri=0; newi=int_max;
  1300. X    if (setjmp(lab)==0) { /* Yields maxeri */
  1301. X        for(ibits=ipower; newi>maxeri; ibits++) {
  1302. X            maxeri=newi;
  1303. X            newi=newi+newi+1;
  1304. X    Unexpected(9);
  1305. X    minneri= -maxeri;
  1306. X    if (setjmp(lab)==0) { /* Yields minneri */
  1307. X        if (minneri-1 < minneri) minneri--;
  1308. X    Unexpected(10);
  1309. X    Vprintf("%sMaximum %s = %ld (= 2**%d-1)%s\n",
  1310. X        co, INT, (long)int_max, ipower, oc);
  1311. X    Vprintf("%sMinimum %s = %ld%s\n", co, INT, (long)int_min, oc);
  1312. X    if (L) i_define(D_INT_MAX, INT,
  1313. X            Iname, "_MAX", (long) int_max, (long) I_MAX, IMARK);
  1314. X    if (L) i_define(D_INT_MIN, INT,
  1315. X            Iname, "_MIN", (long) int_min, (long) I_MIN, IMARK);
  1316. X    if (maxeri>int_max) {
  1317. X        Vprintf("%sThere is a larger %s, %ld (= 2**%d-1), %s %s%s\n",
  1318. X            co, INT, (long)maxeri, ibits, 
  1319. X            "but only for addition, not multiplication",
  1320. X            "(I smell a Cyber!)",
  1321. X            oc);
  1322. X    if (minneri<int_min) {
  1323. X        Vprintf("%sThere is a smaller %s, %ld, %s %s%s\n",
  1324. X            co, INT, (long)minneri, 
  1325. X            "but only for addition, not multiplication",
  1326. X            "(I smell a Cyber!)",
  1327. X            oc);
  1328. XProcedure UPROP () {
  1329. X    /* The properties of unsigned short/int/long */
  1330. X#ifdef OK_UI
  1331. X    Volatile unsigned Integer int_max, newi, two;
  1332. X    newi=1; int_max=0; two=2;
  1333. X    if (setjmp(lab)==0) { /* Yields int_max */
  1334. X        while(newi>int_max) {
  1335. X            int_max=newi;
  1336. X            newi=newi*two+1;
  1337. X    Unexpected(11);
  1338. X    Vprintf("%sMaximum unsigned %s = %lu%s\n",
  1339. X        co, INT, (unsigned long) int_max, oc);
  1340. X    if (L) u_define(D_UINT_MAX, INT,
  1341. X            Uname, "_MAX", (unsigned long) int_max,
  1342. X            (unsigned long) U_MAX, IMARK);
  1343. X#endif
  1344. X#endif /* Integer */
  1345. X#ifdef Number
  1346. X/* The following routines are intended to defeat any attempt at optimisation
  1347. X   or use of extended precision, and to defeat faulty narrowing casts.
  1348. X   The weird prototypes are because of widening incompatibilities.
  1349. X#ifdef STDC
  1350. X#define ARGS1(atype, a) (atype a)
  1351. X#define ARGS2(atype, a, btype, b) (atype a, btype b)
  1352. X#else
  1353. X#define ARGS1(atype, a) (a) atype a;
  1354. X#define ARGS2(atype, a, btype, b) (a, b) atype a; btype b;
  1355. X#endif
  1356. XProcedure Store ARGS2(Number, a, Number *, b) { *b=a; }
  1357. XNumber Sum ARGS2(Number, a, Number, b) {Number r; Store(a+b, &r); return (r); }
  1358. XNumber Diff ARGS2(Number, a, Number, b){Number r; Store(a-b, &r); return (r); }
  1359. XNumber Mul ARGS2(Number, a, Number, b) {Number r; Store(a*b, &r); return (r); }
  1360. XNumber Div ARGS2(Number, a, Number, b) {Number r; Store(a/b, &r); return (r); }
  1361. XNumber Self ARGS1(Number, a)           {Number r; Store(a,   &r); return (r); }
  1362. XProcedure F_check ARGS((int precision, Long_double val1));
  1363. XProcedure F_check(precision, val1) int precision; Long_double val1; {
  1364. X    /* You don't think I'm going to go to all the trouble of writing
  1365. X       a program that works out what all sorts of values are, only to
  1366. X       have printf go and print the wrong values out, do you?
  1367. X       No, you're right, so this function tries to see if printf
  1368. X       has written the right value, by reading it back again.
  1369. X       This introduces a new problem of course: suppose printf writes
  1370. X       the correct value, and scanf reads it back wrong... oh well.
  1371. X       But I'm adamant about this: the precision given is enough
  1372. X       to uniquely identify the printed number, therefore I insist
  1373. X       that sscanf read the number back identically. Harsh yes, but
  1374. X       sometimes you've got to be cruel to be kind.
  1375. X    Long_double new1;
  1376. X    Number val, new, diff;
  1377. X    double rem;
  1378. X    int e;
  1379. X    char *rep;
  1380. X    char *f2;
  1381. X    if (sizeof(double) == sizeof(Long_double)) {
  1382. X        /* Assume they're the same, and use non-stdc format */
  1383. X        /* This is for stdc compilers using non-stdc libraries */
  1384. X        f2= "%le";   /* Input */
  1385. X    } else {
  1386. X        /* It had better support Le then */
  1387. X        f2= "%Le";
  1388. X    val= val1;
  1389. X    rep= f_rep(precision, (Long_double) val);
  1390. X    if (setjmp(lab)==0) {
  1391. X        sscanf(rep, f2, &new1);
  1392. X    } else {
  1393. X        eek_a_bug("sscanf caused a trap");
  1394. X        printf("%s    scanning: %s format: %s%s\n\n", co, rep, f2, oc);
  1395. X        Unexpected(12);
  1396. X        return;
  1397. X    if (setjmp(lab)==0) { /* See if new is usable */
  1398. X        new= new1;
  1399. X        if (new != 0.0) {
  1400. X            diff= val/new - 1.0;
  1401. X            if (diff < 0.1) diff= 1.0;
  1402. X            /* That should be enough to generate a trap */
  1403. X    } else {
  1404. X        eek_a_bug("sscanf returned an unusable number");
  1405. X        printf("%s    scanning: %s with format: %s%s\n\n",
  1406. X               co, rep, f2, oc);
  1407. X        Unexpected(13);
  1408. X        return;
  1409. X    Unexpected(14);
  1410. X    if (new != val) {
  1411. X        eek_a_bug("Possibly bad output from printf above");
  1412. X        if (!exponent((Long_double)val, &rem, &e)) {
  1413. X            printf("%s    but value was an unusable number%s\n\n",
  1414. X                   co, oc);
  1415. X            return;
  1416. X        printf("%s    expected value around %.*fe%d, bit pattern:\n    ",
  1417. X               co, precision, rem, e);
  1418. X        bitpattern((char *) &val, sizeof(val));
  1419. X        printf ("%s\n", oc);
  1420. X        printf("%s    sscanf gave           %s, bit pattern:\n    ",
  1421. X               co, f_rep(precision, (Long_double) new));
  1422. X        bitpattern((char *) &new, sizeof(new));
  1423. X        printf ("%s\n", oc);
  1424. X        if (setjmp(lab) == 0) {
  1425. X            diff= val-new;
  1426. X            printf("%s    difference= %s%s\n\n", 
  1427. X                   co, f_rep(precision, (Long_double) diff), oc);
  1428. X        } /* else forget it */
  1429. X        Unexpected(15);
  1430. X#ifdef VERIFY
  1431. XProcedure Validate(prec, val, req, same) int prec, same; Long_double val, req; {
  1432. X    /* Check that the compiler has read a #define value correctly */
  1433. X    Unexpected(16);
  1434. X    if (!same) {
  1435. X        printf("%s*** Verify failed for above #define!\n", co);
  1436. X        if (setjmp(lab) == 0) { /* for the case that req == nan */
  1437. X            printf("       Compiler has %s for value%s\n", 
  1438. X                   f_rep(prec, req), oc);
  1439. X        } else {
  1440. X            printf("       Compiler has %s for value%s\n",
  1441. X                   "an unusable number", oc);
  1442. X        if (setjmp(lab) == 0) {
  1443. X            F_check(prec, (Long_double) req);
  1444. X        } /*else forget it*/
  1445. X        if (setjmp(lab) == 0) {        
  1446. X            if (req > 0.0 && val > 0.0) {
  1447. X                printf("%s    difference= %s%s\n",
  1448. X                       co, f_rep(prec, val-req), oc);
  1449. X            }
  1450. X        } /*else forget it*/
  1451. X        Unexpected(17);
  1452. X        printf("\n");
  1453. X        bugs++;
  1454. X    } else if (val != req) {
  1455. X        if (stdc) {
  1456. X            printf("%s*** Verify failed for above #define!\n", co);
  1457. X            printf("       Constant has the wrong precision%s\n",
  1458. X                   oc);
  1459. X        } else eek_a_bug("the cast didn't work");
  1460. X        printf("\n");
  1461. X        bugs++;
  1462. X#endif /* VERIFY */
  1463. Xint FPROP(bits_per_byte) int bits_per_byte; {
  1464. X    /* Properties of floating types, using algorithms by Cody and Waite
  1465. X       from MA Malcolm, as modified by WM Gentleman and SB Marovich.
  1466. X       Further extended by S Pemberton.
  1467. X       Returns the number of digits in the fraction.
  1468. X    Volatile int
  1469. X        i, f_radix, iexp, irnd, mrnd, f_rounds, f_mant_dig,
  1470. X        iz, k, inf, machep, f_max_exp, f_min_exp, mx, negeps,
  1471. X        mantbits, digs, f_dig, trap,
  1472. X        hidden, normal, f_min_10_exp, f_max_10_exp;
  1473. X    Volatile Number
  1474. X        a, b, base, basein, basem1, f_epsilon, epsneg,
  1475. X        eps, epsp1, etop, ebot,
  1476. X        f_max, newxmax, f_min, xminner, y, y1, z, z1, z2;
  1477. X    Unexpected(18);
  1478. X    Vprintf("%sPROPERTIES OF %s:%s\n", co, THING, oc);
  1479. X    /* Base and size of mantissa **************************************/
  1480. X    /* First repeatedly double until adding 1 has no effect.      */
  1481. X    /* For instance, if base is 10, with 3 significant digits      */
  1482. X    /* it will try 1, 2, 4, 8, ... 512, 1024, and stop there,      */
  1483. X    /* since 1024 is only representable as 1020.              */
  1484. X    a=1.0;
  1485. X    if (setjmp(lab)==0) { /* inexact trap? */
  1486. X        do { a=Sum(a, a); }
  1487. X        while (Diff(Diff(Sum(a, ONE), a), ONE) == ZERO);
  1488. X    } else {
  1489. X        fprintf(stderr, "*** Program got loss-of-precision trap!\n");
  1490. X        /* And supporting those is just TOO much trouble! */
  1491. X        farewell(bugs+1);
  1492. X    Unexpected(19);
  1493. X    /* Now double until you find a number that can be added to the      */
  1494. X    /* above number. For 1020 this is 8 or 16, depending whether the  */
  1495. X    /* result is rounded or truncated.                  */
  1496. X    /* In either case the result is 1030. 1030-1020= the base, 10.      */
  1497. X    b=1.0;
  1498. X    do { b=Sum(b, b); } while ((base=Diff(Sum(a, b), a)) == ZERO);
  1499. X    f_radix=base;
  1500. X    Vprintf("%sBase = %d%s\n", co, f_radix, oc);
  1501. X    /* Sanity check; if base<2, I can't guarantee the rest will work  */
  1502. X    if (f_radix < 2) {
  1503. X        eek_a_bug("Function return or parameter passing faulty? (This is a guess.)");
  1504. X        printf("\n");
  1505. X        return(0);
  1506. X#ifdef PASS1 /* only for FLT */
  1507. X    flt_radix= f_radix;
  1508. X    if (F) i_define(D_FLT_RADIX, "",
  1509. X            "FLT", "_RADIX", (long) f_radix, (long) F_RADIX, "");
  1510. X#else
  1511. X    if (f_radix != flt_radix) {
  1512. X        printf("\n%s*** WARNING: %s %s (%d) %s%s\n",
  1513. X               co, thing, "arithmetic has a different radix",
  1514. X               f_radix, "from float", oc);
  1515. X        bugs++;
  1516. X#endif
  1517. X    /* Now the number of digits precision: */
  1518. X    f_mant_dig=0; b=1.0;
  1519. X    do { f_mant_dig++; b=Mul(b, base); }
  1520. X    while (Diff(Diff(Sum(b, ONE), b), ONE) == ZERO);
  1521. X    f_dig=floor_log(10, (Long_double)(b/base)) + (base==10?1:0);
  1522. X    Vprintf("%sSignificant base digits = %d %s %d %s%s\n",
  1523. X        co, f_mant_dig, "(= at least", f_dig, "decimal digits)", oc);
  1524. X    if (F) i_define(D_MANT_DIG, thing,
  1525. X            Fname, "_MANT_DIG", (long) f_mant_dig,
  1526. X            (long) F_MANT_DIG, "");
  1527. X    if (F) i_define(D_DIG, thing,
  1528. X            Fname, "_DIG", (long) f_dig, (long) F_DIG, "");
  1529. X    digs= ceil_log(10, (Long_double)b); /* the number of digits to printf */
  1530. X    /* Rounding *******************************************************/
  1531. X    basem1=Diff(base, HALF);
  1532. X    if (Diff(Sum(a, basem1), a) != ZERO) {
  1533. X        if (f_radix == 2) basem1=0.375;
  1534. X        else basem1=1.0;
  1535. X        if (Diff(Sum(a, basem1), a) != ZERO) irnd=2; /* away from 0 */
  1536. X        else irnd=1; /* to nearest */
  1537. X    } else irnd=0; /* towards 0 */
  1538. X    basem1=Diff(base, HALF);
  1539. X    if (Diff(Diff(-a, basem1), -a) != ZERO) {
  1540. X        if (f_radix == 2) basem1=0.375;
  1541. X        else basem1=1.0;
  1542. X        if (Diff(Diff(-a, basem1), -a) != ZERO) mrnd=2; /* away from 0*/
  1543. X        else mrnd=1; /* to nearest */
  1544. X    } else mrnd=0; /* towards 0 */
  1545. X    f_rounds= -1; /* Unknown rounding */
  1546. X    if (irnd==0 && mrnd==0) f_rounds=0; /* zero = chops */
  1547. X    if (irnd==1 && mrnd==1) f_rounds=1; /* nearest */
  1548. X    if (irnd==2 && mrnd==0) f_rounds=2; /* +inf */
  1549. X    if (irnd==0 && mrnd==2) f_rounds=3; /* -inf */
  1550. X    if (f_rounds != -1) {
  1551. X        Vprintf("%sArithmetic rounds towards ", co);
  1552. X        switch (f_rounds) {
  1553. X              case 0: Vprintf("zero (i.e. it chops)"); break;
  1554. X              case 1: Vprintf("nearest"); break;
  1555. X              case 2: Vprintf("+infinity"); break;
  1556. X              case 3: Vprintf("-infinity"); break;
  1557. X              default: Vprintf("???"); break;
  1558. X        Vprintf("%s\n", oc);
  1559. X    } else { /* Hmm, try to give some help here: */
  1560. X        Vprintf("%sArithmetic rounds oddly: %s\n", co, oc);
  1561. X        Vprintf("%s    Negative numbers %s%s\n",
  1562. X            co, mrnd==0 ? "towards zero" :
  1563. X                mrnd==1 ? "to nearest" :
  1564. X                      "away from zero",
  1565. X            oc);
  1566. X        Vprintf("%s    Positive numbers %s%s\n",
  1567. X            co, irnd==0 ? "towards zero" :
  1568. X                irnd==1 ? "to nearest" :
  1569. X                      "away from zero",
  1570. X            oc);
  1571. X    /* An extra goody */
  1572. X    if (f_radix == 2 && f_rounds == 1) {
  1573. X        if (Diff(Sum(a, ONE), a) != ZERO) {
  1574. X            Vprintf("%s   Tie breaking rounds up%s\n", co, oc);
  1575. X        } else if (Diff(Sum(a, THREE), a) == FOUR) {
  1576. X            Vprintf("%s   Tie breaking rounds to even%s\n", co, oc);
  1577. X        } else {
  1578. X            Vprintf("%s   Tie breaking rounds down%s\n", co, oc);
  1579. X#ifdef PASS1 /* only for FLT */
  1580. X    flt_rounds= f_rounds;
  1581. X    if (F)
  1582. X      i_define(D_FLT_ROUNDS, "",
  1583. X           "FLT", "_ROUNDS", (long) f_rounds, (long) F_ROUNDS, "");
  1584. X#else
  1585. X    if (f_rounds != flt_rounds) {
  1586. X        printf("\n%s*** WARNING: %s %s (%d) %s%s\n",
  1587. X               co, thing, "arithmetic rounds differently",
  1588. X               f_rounds, "from float", oc);
  1589. X        bugs++;
  1590. X#endif
  1591. X    /* Various flavours of epsilon ************************************/
  1592. X    negeps=f_mant_dig+f_mant_dig;
  1593. X    basein=1.0/base;
  1594. X    a=1.0;
  1595. X    for(i=1; i<=negeps; i++) a*=basein;
  1596. X    b=a;
  1597. X    while (Diff(Diff(ONE, a), ONE) == ZERO) {
  1598. X        a*=base;
  1599. X        negeps--;
  1600. X    negeps= -negeps;
  1601. X    Vprintf("%sSmallest x such that 1.0-base**x != 1.0 = %d%s\n",
  1602. X        co, negeps, oc);
  1603. X    etop = ONE;
  1604. X    ebot = ZERO;
  1605. X    eps = Sum(ebot, Div(Diff(etop, ebot), TWO));
  1606. X    while (eps != ebot && eps != etop) {
  1607. X        epsp1 = Diff(ONE, eps);
  1608. X        if (epsp1 < ONE) etop = eps;
  1609. X        else ebot = eps;
  1610. X        eps = Sum(ebot, Div(Diff(etop, ebot), TWO));
  1611. X    /* Sanity check */
  1612. X    if (Diff(ONE, etop) >= ONE || Diff(ONE, ebot) != ONE) {
  1613. X        eek_a_bug("internal error calculating epsneg");
  1614. X    Vprintf("%sSmallest x such that 1.0-x != 1.0 = %s%s\n",
  1615. X        co, f_rep(digs, (Long_double) eps), oc);
  1616. X    if (V) F_check(digs, (Long_double) eps);
  1617. X    epsneg=a;
  1618. X    if ((f_radix!=2) && irnd) {
  1619. X    /*    a=(a*(1.0+a))/(1.0+1.0); => */
  1620. X        a=Div(Mul(a, Sum(ONE, a)), Sum(ONE, ONE));
  1621. X    /*    if ((1.0-a)-1.0 != 0.0) epsneg=a; => */
  1622. X        if (Diff(Diff(ONE, a), ONE) != ZERO) epsneg=a;
  1623. X    /* epsneg is used later */
  1624. X    Unexpected(20);
  1625. X    machep= -f_mant_dig-f_mant_dig;
  1626. X    a=b;
  1627. X    while (Diff(Sum(ONE, a), ONE) == ZERO) { a*=base; machep++; }
  1628. X    Vprintf("%sSmallest x such that 1.0+base**x != 1.0 = %d%s\n",
  1629. X        co, machep, oc);
  1630. X    etop = ONE;
  1631. X    ebot = ZERO;
  1632. X    eps = Sum(ebot, Div(Diff(etop, ebot), TWO));
  1633. X    while (eps != ebot && eps != etop) {
  1634. X        epsp1 = Sum(ONE, eps);
  1635. X        if (epsp1 > ONE) etop = eps;
  1636. X        else ebot = eps;
  1637. X        eps = Sum(ebot, Div(Diff(etop, ebot), TWO));
  1638. X    /* Sanity check */
  1639. X    if (Sum(ONE, etop) <= ONE || Sum(ONE, ebot) != ONE) {
  1640. X        eek_a_bug("internal error calculating eps");
  1641. X    f_epsilon=etop;
  1642. X    Vprintf("%sSmallest x such that 1.0+x != 1.0 = %s%s\n",
  1643. X        co, f_rep(digs, (Long_double) f_epsilon), oc);
  1644. X    /* Possible loss of precision warnings here from non-stdc compilers: */
  1645. X    if (F) f_define(D_EPSILON, thing,
  1646. X            Fname, "_EPSILON", digs, (Long_double) f_epsilon, MARK);
  1647. X    if (V || F) F_check(digs, (Long_double) f_epsilon);
  1648. X    Unexpected(21);
  1649. X    if (F) Validate(digs, (Long_double) f_epsilon, (Long_double) F_EPSILON,
  1650. X            f_epsilon == Self(F_EPSILON));
  1651. X    Unexpected(22);
  1652. X    /* Extra chop info *************************************************/
  1653. X    if (f_rounds == 0) {
  1654. X        if (Diff(Mul(Sum(ONE,f_epsilon),ONE),ONE) !=  ZERO) {
  1655. X            Vprintf("%sAlthough arithmetic chops, it uses guard digits%s\n", co, oc);
  1656. X    /* Size of and minimum normalised exponent ************************/
  1657. X    y=0; i=0; k=1; z=basein; z1=(1.0+f_epsilon)/base;
  1658. X    /* Coarse search for the largest power of two */
  1659. X    if (setjmp(lab)==0) { /* for underflow trap */ /* Yields i, k, y, y1 */
  1660. X        do {
  1661. X            y=z; y1=z1;
  1662. X            z=Mul(y,y); z1=Mul(z1, y);
  1663. X            a=Mul(z,ONE);
  1664. X            z2=Div(z1,y);
  1665. X            if (z2 != y1) break;
  1666. X            if ((Sum(a,a) == ZERO) || (fabs(z) >= y)) break;
  1667. X            i++;
  1668. X            k+=k;
  1669. X        } while(1);
  1670. X    } else {
  1671. X        Vprintf("%s%s underflow generates a trap%s\n", co, Thing, oc);
  1672. X    Unexpected(23);
  1673. X    if (f_radix != 10) {
  1674. X        iexp=i+1; /* for the sign */
  1675. X        mx=k+k;
  1676. X    } else {
  1677. X        iexp=2;
  1678. X        iz=f_radix;
  1679. X        while (k >= iz) { iz*=f_radix; iexp++; }
  1680. X        mx=iz+iz-1;
  1681. X    /* Fine tune starting with y and y1 */
  1682. X    if (setjmp(lab)==0) { /* for underflow trap */ /* Yields k, f_min */
  1683. X        do {
  1684. X            f_min=y; z1=y1;
  1685. X            y=Div(y,base); y1=Div(y1,base);
  1686. X            a=Mul(y,ONE);
  1687. X            z2=Mul(y1,base);
  1688. X            if (z2 != z1) break;
  1689. X            if ((Sum(a,a) == ZERO) || (fabs(y) >= f_min)) break;
  1690. X            k++;
  1691. X        } while (1);
  1692. X    Unexpected(24);
  1693. X    f_min_exp=(-k)+1;
  1694. X    if ((mx <= k+k-3) && (f_radix != 10)) { mx+=mx; iexp+=1; }
  1695. X    Vprintf("%sNumber of bits used for exponent = %d%s\n", co, iexp, oc);
  1696. X    Vprintf("%sMinimum normalised exponent = %d%s\n", co, f_min_exp, oc);
  1697. X    if (F)
  1698. X      i_define(D_MIN_EXP, thing,
  1699. X           Fname, "_MIN_EXP", (long) f_min_exp, (long) F_MIN_EXP, "");
  1700. X    if (setjmp(lab)==0) {
  1701. X        Vprintf("%sMinimum normalised positive number = %s%s\n",
  1702. X            co, f_rep(digs, (Long_double) f_min), oc);
  1703. X    } else {
  1704. X        eek_a_bug("printf can't print the smallest normalised number");
  1705. X        printf("\n");
  1706. X    Unexpected(25);
  1707. X    /* Possible loss of precision warnings here from non-stdc compilers: */
  1708. X    if (setjmp(lab) == 0) {
  1709. X        if (F) f_define(D_MIN, thing,
  1710. X                Fname, "_MIN", digs, (Long_double) f_min, MARK);
  1711. X        if (V || F) F_check(digs, (Long_double) f_min);
  1712. X    } else {
  1713. X        eek_a_bug("xxx_MIN caused a trap");
  1714. X        printf("\n");
  1715. X    if (setjmp(lab) == 0) {
  1716. X        if (F) Validate(digs, (Long_double) f_min, (Long_double) F_MIN,
  1717. X                f_min == Self(F_MIN));
  1718. X    } else {
  1719. X        printf("%s*** Verify failed for above #define!\n    %s %s\n\n",
  1720. X               co, "Compiler has an unusable number for value", oc);
  1721. X        bugs++;
  1722. X    Unexpected(26);
  1723. X    a=1.0; f_min_10_exp=0;
  1724. X    while (a > f_min*10.0) { a/=10.0; f_min_10_exp--; }
  1725. X    if (F) i_define(D_MIN_10_EXP, thing,
  1726. X            Fname, "_MIN_10_EXP", (long) f_min_10_exp,
  1727. X            (long) F_MIN_10_EXP, "");
  1728. X    /* Minimum exponent ************************************************/
  1729. X    if (setjmp(lab)==0) { /* for underflow trap */ /* Yields xminner */
  1730. X        do {
  1731. X            xminner=y;
  1732. X            y=Div(y,base);
  1733. X            a=Mul(y,ONE);
  1734. X            if ((Sum(a,a) == ZERO) || (fabs(y) >= xminner)) break;
  1735. X        } while (1);
  1736. X    Unexpected(27);
  1737. X    if (xminner != 0.0 && xminner != f_min) {
  1738. X        normal= 0;
  1739. X        Vprintf("%sThe smallest numbers are not kept normalised%s\n",
  1740. X            co, oc);
  1741. X        if (setjmp(lab)==0) {
  1742. X            Vprintf("%sSmallest unnormalised positive number = %s%s\n",
  1743. X                co, f_rep(digs, (Long_double) xminner), oc);
  1744. X            if (V) F_check(digs, (Long_double) xminner);
  1745. X        } else {
  1746. X            eek_a_bug("printf can't print the smallest unnormalised number.");
  1747. X            printf("\n");
  1748. X        Unexpected(28);
  1749. X    } else {
  1750. X        normal= 1;
  1751. X        Vprintf("%sThe smallest numbers are normalised%s\n", co, oc);
  1752. X    /* Maximum exponent ************************************************/
  1753. X    f_max_exp=2; f_max=1.0; newxmax=base+1.0;
  1754. X    inf=0; trap=0;
  1755. X    while (f_max<newxmax) {
  1756. X        f_max=newxmax;
  1757. X        if (setjmp(lab) == 0) { /* Yields inf, f_max_exp */
  1758. X            newxmax=Mul(newxmax, base);
  1759. X        } else {
  1760. X            trap=1;
  1761. X            break;
  1762. X        if (Div(newxmax, base) != f_max) {
  1763. X            inf=1; /* ieee infinity */
  1764. X            break;
  1765. X        f_max_exp++;
  1766. X    Unexpected(29);
  1767. X    if (trap) {
  1768. X        Vprintf("%s%s overflow generates a trap%s\n", co, Thing, oc);
  1769. X    if (inf) Vprintf("%sThere is an 'infinite' value%s\n", co, oc);
  1770. X    Vprintf("%sMaximum exponent = %d%s\n", co, f_max_exp, oc);
  1771. X    if (F) i_define(D_MAX_EXP, thing,
  1772. X            Fname, "_MAX_EXP", (long) f_max_exp,
  1773. X            (long) F_MAX_EXP, "");
  1774. X    /* Largest number ***************************************************/
  1775. X    f_max=Diff(ONE, epsneg);
  1776. X    if (Mul(f_max,ONE) != f_max) f_max=Diff(ONE, Mul(base,epsneg));
  1777. X    for (i=1; i<=f_max_exp; i++) f_max=Mul(f_max, base);
  1778. X    if (setjmp(lab)==0) {
  1779. X        Vprintf("%sMaximum number = %s%s\n",
  1780. X            co, f_rep(digs, (Long_double) f_max), oc);
  1781. X    } else {
  1782. X        eek_a_bug("printf can't print the largest double.");
  1783. X        printf("\n");
  1784. X    if (setjmp(lab)==0) {
  1785. X    /* Possible loss of precision warnings here from non-stdc compilers: */
  1786. X        if (F) f_define(D_MAX, thing,
  1787. X                Fname, "_MAX", digs, (Long_double) f_max, MARK);
  1788. X        if (V || F) F_check(digs, (Long_double) f_max);
  1789. X    } else {
  1790. X        eek_a_bug("xxx_MAX caused a trap");
  1791. X        printf("\n");
  1792. X    if (setjmp(lab)==0) {
  1793. X        if (F) Validate(digs, (Long_double) f_max, (Long_double) F_MAX,
  1794. X                f_max == Self(F_MAX));
  1795. X    } else {
  1796. X        printf("%s*** Verify failed for above #define!\n    %s %s\n\n",
  1797. X               co, "Compiler has an unusable number for value", oc);
  1798. X        bugs++;
  1799. X    Unexpected(30);
  1800. X    a=1.0; f_max_10_exp=0;
  1801. X    while (a < f_max/10.0) { a*=10.0; f_max_10_exp++; }
  1802. X    if (F) i_define(D_MAX_10_EXP, thing,
  1803. X            Fname, "_MAX_10_EXP", (long) f_max_10_exp,
  1804. X            (long) F_MAX_10_EXP, "");
  1805. X    /* Hidden bit + sanity check ****************************************/
  1806. X    if (f_radix != 10) {
  1807. X        hidden=0;
  1808. X        mantbits=floor_log(2, (Long_double)f_radix)*f_mant_dig;
  1809. X        if (mantbits+iexp == (int)sizeof(Number)*bits_per_byte) {
  1810. X            hidden=1;
  1811. X            Vprintf("%sArithmetic uses a hidden bit%s\n", co, oc);
  1812. X        } else if (mantbits+iexp+1 == (int)sizeof(Number)*bits_per_byte) {
  1813. X            Vprintf("%sArithmetic doesn't use a hidden bit%s\n",
  1814. X                co, oc);
  1815. X        } else {
  1816. X            printf("\n%s%s\n    %s %s %s!%s\n\n",
  1817. X                   co,
  1818. X                   "*** Something fishy here!",
  1819. X                   "Exponent size + mantissa size doesn't match",
  1820. X                   "with the size of a", thing,
  1821. X                   oc);
  1822. X        if (hidden && f_radix == 2 && f_max_exp+f_min_exp==3) {
  1823. X            Vprintf("%sIt looks like %s length IEEE format%s\n",
  1824. X                co, f_mant_dig==24 ? "single" :
  1825. X                    f_mant_dig==53 ? "double" :
  1826. X                    f_mant_dig >53 ? "extended" :
  1827. X                        "some", oc);
  1828. X            if (f_rounds != 1 || normal) {
  1829. X                Vprintf("%s   though ", co);
  1830. X                if (f_rounds != 1) {
  1831. X                    Vprintf("the rounding is unusual");
  1832. X                    if (normal) Vprintf(" and ");
  1833. X                }
  1834. X                if (normal) Vprintf("the normalisation is unusual");
  1835. X                Vprintf("%s\n", oc);
  1836. X            }
  1837. X        } else {
  1838. X            Vprintf("%sIt doesn't look like IEEE format%s\n",
  1839. X                co, oc);
  1840. X    printf("\n"); /* regardless of verbosity */
  1841. X    return f_mant_dig;
  1842. XProcedure EPROP(fprec, dprec, lprec) int fprec, dprec, lprec; {
  1843. X    /* See if expressions are evaluated in extended precision.
  1844. X       Some compilers optimise even if you don't want it,
  1845. X       and then this function fails to produce the right result.
  1846. X       We try to diagnose this if it happens.
  1847. X    Volatile int eprec;
  1848. X    Volatile double a, b, base, old;
  1849. X    Volatile Number d, oldd, dbase, one, zero;
  1850. X    Volatile int bad=0;
  1851. X    /* Size of mantissa **************************************/
  1852. X    a=1.0;
  1853. X    if (setjmp(lab) == 0) { /* Yields nothing */
  1854. X        do { old=a; a=a+a; }
  1855. X        while ((((a+1.0)-a)-1.0) == 0.0 && a>old);
  1856. X    } else bad=1;
  1857. X    if (a <= old) bad=1;
  1858. X    if (!bad) {
  1859. X        b=1.0;
  1860. X        if (setjmp(lab) == 0) { /* Yields nothing */
  1861. X            do { old=b; b=b+b; }
  1862. X            while ((base=((a+b)-a)) == 0.0 && b>old);
  1863. X            if (b <= old) bad=1;
  1864. X        } else bad=1;
  1865. X    if (!bad) {
  1866. X        eprec=0; d=1.0; dbase=base; one=1.0; zero=0.0;
  1867. X        if (setjmp(lab) == 0) { /* Yields nothing */
  1868. X            do { eprec++; oldd=d; d=d*dbase; }
  1869. X            while ((((d+one)-d)-one) == zero && d>oldd);
  1870. X            if (d <= oldd) bad=1;
  1871. X        } else bad=1;
  1872. X    Unexpected(31);
  1873. X    if (bad) {
  1874. X      Vprintf("%sCan't determine precision for %s expressions:\n%s%s\n", 
  1875. X         co, thing, "   check that you compiled without optimisation!",
  1876. X         oc);
  1877. X    } else if (eprec==dprec) {
  1878. X      Vprintf("%s%s expressions are evaluated in double precision%s\n",
  1879. X          co, Thing, oc);
  1880. X    } else if (eprec==fprec) {
  1881. X      Vprintf("%s%s expressions are evaluated in float precision%s\n",
  1882. X          co, Thing, oc);
  1883. X    } else if (eprec==lprec) {
  1884. X      Vprintf("%s%s expressions are evaluated in long double precision%s\n",
  1885. X          co, Thing, oc);
  1886. X    } else {
  1887. X        Vprintf("%s%s expressions are evaluated in a %s %s %d %s%s\n",
  1888. X            co, Thing, eprec>dprec ? "higher" : "lower",
  1889. X            "precision than double,\n   using",
  1890. X            eprec, "base digits",
  1891. X                oc);
  1892. X#else /* not Number */
  1893. X#ifdef FPROP
  1894. X/* ARGSUSED */
  1895. Xint FPROP(bits_per_byte) int bits_per_byte; { return 0; }
  1896. X#endif
  1897. X#ifdef EPROP
  1898. X/* ARGSUSED */
  1899. XProcedure EPROP(fprec, dprec, lprec) int fprec, dprec, lprec; {}
  1900. X#endif
  1901. X#endif /* ifdef Number */
  1902. X#ifdef PASS3
  1903. X#undef PASS
  1904. X#endif
  1905. X#ifdef PASS2
  1906. X#undef PASS2
  1907. X#define PASS3 1
  1908. X#endif
  1909. X#ifdef PASS1
  1910. X#undef PASS1
  1911. X#define PASS2 1
  1912. X#endif
  1913. X#ifdef PASS0
  1914. X#undef PASS0
  1915. X#endif
  1916. X#ifdef PASS /* then rescan this file */
  1917. X#ifdef NO_FILE
  1918. X#include "config.c"
  1919. X#else /* if the next line fails to compile, define NO_FILE */
  1920. X#include __FILE__
  1921. X#endif
  1922. X#endif /* PASS */
  1923. echo 'Part 01 out of 01 of pack.out complete.'
  1924. exit 0
  1925.