Quake-III-Arena

Quake III Arena GPL Source Release
Log | Files | Refs

paranoia.c (57884B)


      1 #undef V9
      2 #define NOPAUSE
      3 /*	A C version of Kahan's Floating Point Test "Paranoia"
      4 
      5 			Thos Sumner, UCSF, Feb. 1985
      6 			David Gay, BTL, Jan. 1986
      7 
      8 	This is a rewrite from the Pascal version by
      9 
     10 			B. A. Wichmann, 18 Jan. 1985
     11 
     12 	(and does NOT exhibit good C programming style).
     13 
     14 (C) Apr 19 1983 in BASIC version by:
     15 	Professor W. M. Kahan,
     16 	567 Evans Hall
     17 	Electrical Engineering & Computer Science Dept.
     18 	University of California
     19 	Berkeley, California 94720
     20 	USA
     21 
     22 converted to Pascal by:
     23 	B. A. Wichmann
     24 	National Physical Laboratory
     25 	Teddington Middx
     26 	TW11 OLW
     27 	UK
     28 
     29 converted to C by:
     30 
     31 	David M. Gay		and	Thos Sumner
     32 	AT&T Bell Labs			Computer Center, Rm. U-76
     33 	600 Mountain Avenue		University of California
     34 	Murray Hill, NJ 07974		San Francisco, CA 94143
     35 	USA				USA
     36 
     37 with simultaneous corrections to the Pascal source (reflected
     38 in the Pascal source available over netlib).
     39 [A couple of bug fixes from dgh = sun!dhough incorporated 31 July 1986.]
     40 
     41 Reports of results on various systems from all the versions
     42 of Paranoia are being collected by Richard Karpinski at the
     43 same address as Thos Sumner.  This includes sample outputs,
     44 bug reports, and criticisms.
     45 
     46 You may copy this program freely if you acknowledge its source.
     47 Comments on the Pascal version to NPL, please.
     48 
     49 
     50 The C version catches signals from floating-point exceptions.
     51 If signal(SIGFPE,...) is unavailable in your environment, you may
     52 #define NOSIGNAL to comment out the invocations of signal.
     53 
     54 This source file is too big for some C compilers, but may be split
     55 into pieces.  Comments containing "SPLIT" suggest convenient places
     56 for this splitting.  At the end of these comments is an "ed script"
     57 (for the UNIX(tm) editor ed) that will do this splitting.
     58 
     59 By #defining Single when you compile this source, you may obtain
     60 a single-precision C version of Paranoia.
     61 
     62 
     63 The following is from the introductory commentary from Wichmann's work:
     64 
     65 The BASIC program of Kahan is written in Microsoft BASIC using many
     66 facilities which have no exact analogy in Pascal.  The Pascal
     67 version below cannot therefore be exactly the same.  Rather than be
     68 a minimal transcription of the BASIC program, the Pascal coding
     69 follows the conventional style of block-structured languages.  Hence
     70 the Pascal version could be useful in producing versions in other
     71 structured languages.
     72 
     73 Rather than use identifiers of minimal length (which therefore have
     74 little mnemonic significance), the Pascal version uses meaningful
     75 identifiers as follows [Note: A few changes have been made for C]:
     76 
     77 
     78 BASIC   C               BASIC   C               BASIC   C               
     79 
     80    A                       J                       S    StickyBit
     81    A1   AInverse           J0   NoErrors           T
     82    B    Radix                    [Failure]         T0   Underflow
     83    B1   BInverse           J1   NoErrors           T2   ThirtyTwo
     84    B2   RadixD2                  [SeriousDefect]   T5   OneAndHalf
     85    B9   BMinusU2           J2   NoErrors           T7   TwentySeven
     86    C                             [Defect]          T8   TwoForty
     87    C1   CInverse           J3   NoErrors           U    OneUlp
     88    D                             [Flaw]            U0   UnderflowThreshold
     89    D4   FourD              K    PageNo             U1
     90    E0                      L    Milestone          U2
     91    E1                      M                       V
     92    E2   Exp2               N                       V0
     93    E3                      N1                      V8
     94    E5   MinSqEr            O    Zero               V9
     95    E6   SqEr               O1   One                W
     96    E7   MaxSqEr            O2   Two                X
     97    E8                      O3   Three              X1
     98    E9                      O4   Four               X8
     99    F1   MinusOne           O5   Five               X9   Random1
    100    F2   Half               O8   Eight              Y
    101    F3   Third              O9   Nine               Y1
    102    F6                      P    Precision          Y2
    103    F9                      Q                       Y9   Random2
    104    G1   GMult              Q8                      Z
    105    G2   GDiv               Q9                      Z0   PseudoZero
    106    G3   GAddSub            R                       Z1
    107    H                       R1   RMult              Z2
    108    H1   HInverse           R2   RDiv               Z9
    109    I                       R3   RAddSub
    110    IO   NoTrials           R4   RSqrt
    111    I3   IEEE               R9   Random9
    112 
    113    SqRWrng
    114 
    115 All the variables in BASIC are true variables and in consequence,
    116 the program is more difficult to follow since the "constants" must
    117 be determined (the glossary is very helpful).  The Pascal version
    118 uses Real constants, but checks are added to ensure that the values
    119 are correctly converted by the compiler.
    120 
    121 The major textual change to the Pascal version apart from the
    122 identifiersis that named procedures are used, inserting parameters
    123 wherehelpful.  New procedures are also introduced.  The
    124 correspondence is as follows:
    125 
    126 
    127 BASIC       Pascal
    128 lines 
    129 
    130   90- 140   Pause
    131  170- 250   Instructions
    132  380- 460   Heading
    133  480- 670   Characteristics
    134  690- 870   History
    135 2940-2950   Random
    136 3710-3740   NewD
    137 4040-4080   DoesYequalX
    138 4090-4110   PrintIfNPositive
    139 4640-4850   TestPartialUnderflow
    140 
    141 =*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=
    142 
    143 Below is an "ed script" that splits para.c into 10 files
    144 of the form part[1-8].c, subs.c, and msgs.c, plus a header
    145 file, paranoia.h, that these files require.
    146 
    147 r paranoia.c
    148 $
    149 ?SPLIT
    150 +,$w msgs.c
    151  .,$d
    152 ?SPLIT
    153  .d
    154 +d
    155 -,$w subs.c
    156 -,$d
    157 ?part8
    158 +d
    159 ?include
    160  .,$w part8.c
    161  .,$d
    162 -d
    163 ?part7
    164 +d
    165 ?include
    166  .,$w part7.c
    167  .,$d
    168 -d
    169 ?part6
    170 +d
    171 ?include
    172  .,$w part6.c
    173  .,$d
    174 -d
    175 ?part5
    176 +d
    177 ?include
    178  .,$w part5.c
    179  .,$d
    180 -d
    181 ?part4
    182 +d
    183 ?include
    184  .,$w part4.c
    185  .,$d
    186 -d
    187 ?part3
    188 +d
    189 ?include
    190  .,$w part3.c
    191  .,$d
    192 -d
    193 ?part2
    194 +d
    195 ?include
    196  .,$w part2.c
    197  .,$d
    198 ?SPLIT
    199  .d
    200 1,/^#include/-1d
    201 1,$w part1.c
    202 /Computed constants/,$d
    203 1,$s/^int/extern &/
    204 1,$s/^FLOAT/extern &/
    205 1,$s/^char/extern &/
    206 1,$s! = .*!;!
    207 /^Guard/,/^Round/s/^/extern /
    208 /^jmp_buf/s/^/extern /
    209 /^Sig_type/s/^/extern /
    210 s/$/\
    211 extern void sigfpe();/
    212 w paranoia.h
    213 q
    214 
    215 */
    216 
    217 #include <stdio.h>
    218 #ifndef NOSIGNAL
    219 #include <signal.h>
    220 #endif
    221 #include <setjmp.h>
    222 
    223 extern double fabs(), floor(), log(), pow(), sqrt();
    224 
    225 #ifdef Single
    226 #define FLOAT float
    227 #define FABS(x) (float)fabs((double)(x))
    228 #define FLOOR(x) (float)floor((double)(x))
    229 #define LOG(x) (float)log((double)(x))
    230 #define POW(x,y) (float)pow((double)(x),(double)(y))
    231 #define SQRT(x) (float)sqrt((double)(x))
    232 #else
    233 #define FLOAT double
    234 #define FABS(x) fabs(x)
    235 #define FLOOR(x) floor(x)
    236 #define LOG(x) log(x)
    237 #define POW(x,y) pow(x,y)
    238 #define SQRT(x) sqrt(x)
    239 #endif
    240 
    241 jmp_buf ovfl_buf;
    242 typedef void (*Sig_type)();
    243 Sig_type sigsave;
    244 
    245 #define KEYBOARD 0
    246 
    247 FLOAT Radix, BInvrse, RadixD2, BMinusU2;
    248 FLOAT Sign(), Random();
    249 
    250 /*Small floating point constants.*/
    251 FLOAT Zero = 0.0;
    252 FLOAT Half = 0.5;
    253 FLOAT One = 1.0;
    254 FLOAT Two = 2.0;
    255 FLOAT Three = 3.0;
    256 FLOAT Four = 4.0;
    257 FLOAT Five = 5.0;
    258 FLOAT Eight = 8.0;
    259 FLOAT Nine = 9.0;
    260 FLOAT TwentySeven = 27.0;
    261 FLOAT ThirtyTwo = 32.0;
    262 FLOAT TwoForty = 240.0;
    263 FLOAT MinusOne = -1.0;
    264 FLOAT OneAndHalf = 1.5;
    265 /*Integer constants*/
    266 int NoTrials = 20; /*Number of tests for commutativity. */
    267 #define False 0
    268 #define True 1
    269 
    270 /* Definitions for declared types 
    271 	Guard == (Yes, No);
    272 	Rounding == (Chopped, Rounded, Other);
    273 	Message == packed array [1..40] of char;
    274 	Class == (Flaw, Defect, Serious, Failure);
    275 	  */
    276 #define Yes 1
    277 #define No  0
    278 #define Chopped 2
    279 #define Rounded 1
    280 #define Other   0
    281 #define Flaw    3
    282 #define Defect  2
    283 #define Serious 1
    284 #define Failure 0
    285 typedef int Guard, Rounding, Class;
    286 typedef char Message;
    287 
    288 /* Declarations of Variables */
    289 int Indx;
    290 char ch[8];
    291 FLOAT AInvrse, A1;
    292 FLOAT C, CInvrse;
    293 FLOAT D, FourD;
    294 FLOAT E0, E1, Exp2, E3, MinSqEr;
    295 FLOAT SqEr, MaxSqEr, E9;
    296 FLOAT Third;
    297 FLOAT F6, F9;
    298 FLOAT H, HInvrse;
    299 int I;
    300 FLOAT StickyBit, J;
    301 FLOAT MyZero;
    302 FLOAT Precision;
    303 FLOAT Q, Q9;
    304 FLOAT R, Random9;
    305 FLOAT T, Underflow, S;
    306 FLOAT OneUlp, UfThold, U1, U2;
    307 FLOAT V, V0, V9;
    308 FLOAT W;
    309 FLOAT X, X1, X2, X8, Random1;
    310 FLOAT Y, Y1, Y2, Random2;
    311 FLOAT Z, PseudoZero, Z1, Z2, Z9;
    312 int ErrCnt[4];
    313 int fpecount;
    314 int Milestone;
    315 int PageNo;
    316 int M, N, N1;
    317 Guard GMult, GDiv, GAddSub;
    318 Rounding RMult, RDiv, RAddSub, RSqrt;
    319 int Break, Done, NotMonot, Monot, Anomaly, IEEE,
    320 		SqRWrng, UfNGrad;
    321 /* Computed constants. */
    322 /*U1  gap below 1.0, i.e, 1.0-U1 is next number below 1.0 */
    323 /*U2  gap above 1.0, i.e, 1.0+U2 is next number above 1.0 */
    324 
    325 /* floating point exception receiver */
    326  void
    327 sigfpe(i)
    328 {
    329 	fpecount++;
    330 	printf("\n* * * FLOATING-POINT ERROR * * *\n");
    331 	fflush(stdout);
    332 	if (sigsave) {
    333 #ifndef NOSIGNAL
    334 		signal(SIGFPE, sigsave);
    335 #endif
    336 		sigsave = 0;
    337 		longjmp(ovfl_buf, 1);
    338 		}
    339 	abort();
    340 }
    341 
    342 main()
    343 {
    344 #ifdef mc
    345 	char *out;
    346 	ieee_flags("set", "precision", "double", &out);
    347 #endif
    348 	/* First two assignments use integer right-hand sides. */
    349 	Zero = 0;
    350 	One = 1;
    351 	Two = One + One;
    352 	Three = Two + One;
    353 	Four = Three + One;
    354 	Five = Four + One;
    355 	Eight = Four + Four;
    356 	Nine = Three * Three;
    357 	TwentySeven = Nine * Three;
    358 	ThirtyTwo = Four * Eight;
    359 	TwoForty = Four * Five * Three * Four;
    360 	MinusOne = -One;
    361 	Half = One / Two;
    362 	OneAndHalf = One + Half;
    363 	ErrCnt[Failure] = 0;
    364 	ErrCnt[Serious] = 0;
    365 	ErrCnt[Defect] = 0;
    366 	ErrCnt[Flaw] = 0;
    367 	PageNo = 1;
    368 	/*=============================================*/
    369 	Milestone = 0;
    370 	/*=============================================*/
    371 #ifndef NOSIGNAL
    372 	signal(SIGFPE, sigfpe);
    373 #endif
    374 	Instructions();
    375 	Pause();
    376 	Heading();
    377 	Pause();
    378 	Characteristics();
    379 	Pause();
    380 	History();
    381 	Pause();
    382 	/*=============================================*/
    383 	Milestone = 7;
    384 	/*=============================================*/
    385 	printf("Program is now RUNNING tests on small integers:\n");
    386 	
    387 	TstCond (Failure, (Zero + Zero == Zero) && (One - One == Zero)
    388 		   && (One > Zero) && (One + One == Two),
    389 			"0+0 != 0, 1-1 != 0, 1 <= 0, or 1+1 != 2");
    390 	Z = - Zero;
    391 	if (Z != 0.0) {
    392 		ErrCnt[Failure] = ErrCnt[Failure] + 1;
    393 		printf("Comparison alleges that -0.0 is Non-zero!\n");
    394 		U1 = 0.001;
    395 		Radix = 1;
    396 		TstPtUf();
    397 		}
    398 	TstCond (Failure, (Three == Two + One) && (Four == Three + One)
    399 		   && (Four + Two * (- Two) == Zero)
    400 		   && (Four - Three - One == Zero),
    401 		   "3 != 2+1, 4 != 3+1, 4+2*(-2) != 0, or 4-3-1 != 0");
    402 	TstCond (Failure, (MinusOne == (0 - One))
    403 		   && (MinusOne + One == Zero ) && (One + MinusOne == Zero)
    404 		   && (MinusOne + FABS(One) == Zero)
    405 		   && (MinusOne + MinusOne * MinusOne == Zero),
    406 		   "-1+1 != 0, (-1)+abs(1) != 0, or -1+(-1)*(-1) != 0");
    407 	TstCond (Failure, Half + MinusOne + Half == Zero,
    408 		  "1/2 + (-1) + 1/2 != 0");
    409 	/*=============================================*/
    410 	/*SPLIT
    411 	part2();
    412 	part3();
    413 	part4();
    414 	part5();
    415 	part6();
    416 	part7();
    417 	part8();
    418 	}
    419 #include "paranoia.h"
    420 part2(){
    421 */
    422 	Milestone = 10;
    423 	/*=============================================*/
    424 	TstCond (Failure, (Nine == Three * Three)
    425 		   && (TwentySeven == Nine * Three) && (Eight == Four + Four)
    426 		   && (ThirtyTwo == Eight * Four)
    427 		   && (ThirtyTwo - TwentySeven - Four - One == Zero),
    428 		   "9 != 3*3, 27 != 9*3, 32 != 8*4, or 32-27-4-1 != 0");
    429 	TstCond (Failure, (Five == Four + One) &&
    430 			(TwoForty == Four * Five * Three * Four)
    431 		   && (TwoForty / Three - Four * Four * Five == Zero)
    432 		   && ( TwoForty / Four - Five * Three * Four == Zero)
    433 		   && ( TwoForty / Five - Four * Three * Four == Zero),
    434 		  "5 != 4+1, 240/3 != 80, 240/4 != 60, or 240/5 != 48");
    435 	if (ErrCnt[Failure] == 0) {
    436 		printf("-1, 0, 1/2, 1, 2, 3, 4, 5, 9, 27, 32 & 240 are O.K.\n");
    437 		printf("\n");
    438 		}
    439 	printf("Searching for Radix and Precision.\n");
    440 	W = One;
    441 	do  {
    442 		W = W + W;
    443 		Y = W + One;
    444 		Z = Y - W;
    445 		Y = Z - One;
    446 		} while (MinusOne + FABS(Y) < Zero);
    447 	/*.. now W is just big enough that |((W+1)-W)-1| >= 1 ...*/
    448 	Precision = Zero;
    449 	Y = One;
    450 	do  {
    451 		Radix = W + Y;
    452 		Y = Y + Y;
    453 		Radix = Radix - W;
    454 		} while ( Radix == Zero);
    455 	if (Radix < Two) Radix = One;
    456 	printf("Radix = %f .\n", Radix);
    457 	if (Radix != 1) {
    458 		W = One;
    459 		do  {
    460 			Precision = Precision + One;
    461 			W = W * Radix;
    462 			Y = W + One;
    463 			} while ((Y - W) == One);
    464 		}
    465 	/*... now W == Radix^Precision is barely too big to satisfy (W+1)-W == 1
    466 			                              ...*/
    467 	U1 = One / W;
    468 	U2 = Radix * U1;
    469 	printf("Closest relative separation found is U1 = %.7e .\n\n", U1);
    470 	printf("Recalculating radix and precision\n ");
    471 	
    472 	/*save old values*/
    473 	E0 = Radix;
    474 	E1 = U1;
    475 	E9 = U2;
    476 	E3 = Precision;
    477 	
    478 	X = Four / Three;
    479 	Third = X - One;
    480 	F6 = Half - Third;
    481 	X = F6 + F6;
    482 	X = FABS(X - Third);
    483 	if (X < U2) X = U2;
    484 	
    485 	/*... now X = (unknown no.) ulps of 1+...*/
    486 	do  {
    487 		U2 = X;
    488 		Y = Half * U2 + ThirtyTwo * U2 * U2;
    489 		Y = One + Y;
    490 		X = Y - One;
    491 		} while ( ! ((U2 <= X) || (X <= Zero)));
    492 	
    493 	/*... now U2 == 1 ulp of 1 + ... */
    494 	X = Two / Three;
    495 	F6 = X - Half;
    496 	Third = F6 + F6;
    497 	X = Third - Half;
    498 	X = FABS(X + F6);
    499 	if (X < U1) X = U1;
    500 	
    501 	/*... now  X == (unknown no.) ulps of 1 -... */
    502 	do  {
    503 		U1 = X;
    504 		Y = Half * U1 + ThirtyTwo * U1 * U1;
    505 		Y = Half - Y;
    506 		X = Half + Y;
    507 		Y = Half - X;
    508 		X = Half + Y;
    509 		} while ( ! ((U1 <= X) || (X <= Zero)));
    510 	/*... now U1 == 1 ulp of 1 - ... */
    511 	if (U1 == E1) printf("confirms closest relative separation U1 .\n");
    512 	else printf("gets better closest relative separation U1 = %.7e .\n", U1);
    513 	W = One / U1;
    514 	F9 = (Half - U1) + Half;
    515 	Radix = FLOOR(0.01 + U2 / U1);
    516 	if (Radix == E0) printf("Radix confirmed.\n");
    517 	else printf("MYSTERY: recalculated Radix = %.7e .\n", Radix);
    518 	TstCond (Defect, Radix <= Eight + Eight,
    519 		   "Radix is too big: roundoff problems");
    520 	TstCond (Flaw, (Radix == Two) || (Radix == 10)
    521 		   || (Radix == One), "Radix is not as good as 2 or 10");
    522 	/*=============================================*/
    523 	Milestone = 20;
    524 	/*=============================================*/
    525 	TstCond (Failure, F9 - Half < Half,
    526 		   "(1-U1)-1/2 < 1/2 is FALSE, prog. fails?");
    527 	X = F9;
    528 	I = 1;
    529 	Y = X - Half;
    530 	Z = Y - Half;
    531 	TstCond (Failure, (X != One)
    532 		   || (Z == Zero), "Comparison is fuzzy,X=1 but X-1/2-1/2 != 0");
    533 	X = One + U2;
    534 	I = 0;
    535 	/*=============================================*/
    536 	Milestone = 25;
    537 	/*=============================================*/
    538 	/*... BMinusU2 = nextafter(Radix, 0) */
    539 	BMinusU2 = Radix - One;
    540 	BMinusU2 = (BMinusU2 - U2) + One;
    541 	/* Purify Integers */
    542 	if (Radix != One)  {
    543 		X = - TwoForty * LOG(U1) / LOG(Radix);
    544 		Y = FLOOR(Half + X);
    545 		if (FABS(X - Y) * Four < One) X = Y;
    546 		Precision = X / TwoForty;
    547 		Y = FLOOR(Half + Precision);
    548 		if (FABS(Precision - Y) * TwoForty < Half) Precision = Y;
    549 		}
    550 	if ((Precision != FLOOR(Precision)) || (Radix == One)) {
    551 		printf("Precision cannot be characterized by an Integer number\n");
    552 		printf("of significant digits but, by itself, this is a minor flaw.\n");
    553 		}
    554 	if (Radix == One) 
    555 		printf("logarithmic encoding has precision characterized solely by U1.\n");
    556 	else printf("The number of significant digits of the Radix is %f .\n",
    557 			Precision);
    558 	TstCond (Serious, U2 * Nine * Nine * TwoForty < One,
    559 		   "Precision worse than 5 decimal figures  ");
    560 	/*=============================================*/
    561 	Milestone = 30;
    562 	/*=============================================*/
    563 	/* Test for extra-precise subepressions */
    564 	X = FABS(((Four / Three - One) - One / Four) * Three - One / Four);
    565 	do  {
    566 		Z2 = X;
    567 		X = (One + (Half * Z2 + ThirtyTwo * Z2 * Z2)) - One;
    568 		} while ( ! ((Z2 <= X) || (X <= Zero)));
    569 	X = Y = Z = FABS((Three / Four - Two / Three) * Three - One / Four);
    570 	do  {
    571 		Z1 = Z;
    572 		Z = (One / Two - ((One / Two - (Half * Z1 + ThirtyTwo * Z1 * Z1))
    573 			+ One / Two)) + One / Two;
    574 		} while ( ! ((Z1 <= Z) || (Z <= Zero)));
    575 	do  {
    576 		do  {
    577 			Y1 = Y;
    578 			Y = (Half - ((Half - (Half * Y1 + ThirtyTwo * Y1 * Y1)) + Half
    579 				)) + Half;
    580 			} while ( ! ((Y1 <= Y) || (Y <= Zero)));
    581 		X1 = X;
    582 		X = ((Half * X1 + ThirtyTwo * X1 * X1) - F9) + F9;
    583 		} while ( ! ((X1 <= X) || (X <= Zero)));
    584 	if ((X1 != Y1) || (X1 != Z1)) {
    585 		BadCond(Serious, "Disagreements among the values X1, Y1, Z1,\n");
    586 		printf("respectively  %.7e,  %.7e,  %.7e,\n", X1, Y1, Z1);
    587 		printf("are symptoms of inconsistencies introduced\n");
    588 		printf("by extra-precise evaluation of arithmetic subexpressions.\n");
    589 		notify("Possibly some part of this");
    590 		if ((X1 == U1) || (Y1 == U1) || (Z1 == U1))  printf(
    591 			"That feature is not tested further by this program.\n") ;
    592 		}
    593 	else  {
    594 		if ((Z1 != U1) || (Z2 != U2)) {
    595 			if ((Z1 >= U1) || (Z2 >= U2)) {
    596 				BadCond(Failure, "");
    597 				notify("Precision");
    598 				printf("\tU1 = %.7e, Z1 - U1 = %.7e\n",U1,Z1-U1);
    599 				printf("\tU2 = %.7e, Z2 - U2 = %.7e\n",U2,Z2-U2);
    600 				}
    601 			else {
    602 				if ((Z1 <= Zero) || (Z2 <= Zero)) {
    603 					printf("Because of unusual Radix = %f", Radix);
    604 					printf(", or exact rational arithmetic a result\n");
    605 					printf("Z1 = %.7e, or Z2 = %.7e ", Z1, Z2);
    606 					notify("of an\nextra-precision");
    607 					}
    608 				if (Z1 != Z2 || Z1 > Zero) {
    609 					X = Z1 / U1;
    610 					Y = Z2 / U2;
    611 					if (Y > X) X = Y;
    612 					Q = - LOG(X);
    613 					printf("Some subexpressions appear to be calculated extra\n");
    614 					printf("precisely with about %g extra B-digits, i.e.\n",
    615 						(Q / LOG(Radix)));
    616 					printf("roughly %g extra significant decimals.\n",
    617 						Q / LOG(10.));
    618 					}
    619 				printf("That feature is not tested further by this program.\n");
    620 				}
    621 			}
    622 		}
    623 	Pause();
    624 	/*=============================================*/
    625 	/*SPLIT
    626 	}
    627 #include "paranoia.h"
    628 part3(){
    629 */
    630 	Milestone = 35;
    631 	/*=============================================*/
    632 	if (Radix >= Two) {
    633 		X = W / (Radix * Radix);
    634 		Y = X + One;
    635 		Z = Y - X;
    636 		T = Z + U2;
    637 		X = T - Z;
    638 		TstCond (Failure, X == U2,
    639 			"Subtraction is not normalized X=Y,X+Z != Y+Z!");
    640 		if (X == U2) printf(
    641 			"Subtraction appears to be normalized, as it should be.");
    642 		}
    643 	printf("\nChecking for guard digit in *, /, and -.\n");
    644 	Y = F9 * One;
    645 	Z = One * F9;
    646 	X = F9 - Half;
    647 	Y = (Y - Half) - X;
    648 	Z = (Z - Half) - X;
    649 	X = One + U2;
    650 	T = X * Radix;
    651 	R = Radix * X;
    652 	X = T - Radix;
    653 	X = X - Radix * U2;
    654 	T = R - Radix;
    655 	T = T - Radix * U2;
    656 	X = X * (Radix - One);
    657 	T = T * (Radix - One);
    658 	if ((X == Zero) && (Y == Zero) && (Z == Zero) && (T == Zero)) GMult = Yes;
    659 	else {
    660 		GMult = No;
    661 		TstCond (Serious, False,
    662 			"* lacks a Guard Digit, so 1*X != X");
    663 		}
    664 	Z = Radix * U2;
    665 	X = One + Z;
    666 	Y = FABS((X + Z) - X * X) - U2;
    667 	X = One - U2;
    668 	Z = FABS((X - U2) - X * X) - U1;
    669 	TstCond (Failure, (Y <= Zero)
    670 		   && (Z <= Zero), "* gets too many final digits wrong.\n");
    671 	Y = One - U2;
    672 	X = One + U2;
    673 	Z = One / Y;
    674 	Y = Z - X;
    675 	X = One / Three;
    676 	Z = Three / Nine;
    677 	X = X - Z;
    678 	T = Nine / TwentySeven;
    679 	Z = Z - T;
    680 	TstCond(Defect, X == Zero && Y == Zero && Z == Zero,
    681 		"Division lacks a Guard Digit, so error can exceed 1 ulp\nor  1/3  and  3/9  and  9/27 may disagree");
    682 	Y = F9 / One;
    683 	X = F9 - Half;
    684 	Y = (Y - Half) - X;
    685 	X = One + U2;
    686 	T = X / One;
    687 	X = T - X;
    688 	if ((X == Zero) && (Y == Zero) && (Z == Zero)) GDiv = Yes;
    689 	else {
    690 		GDiv = No;
    691 		TstCond (Serious, False,
    692 			"Division lacks a Guard Digit, so X/1 != X");
    693 		}
    694 	X = One / (One + U2);
    695 	Y = X - Half - Half;
    696 	TstCond (Serious, Y < Zero,
    697 		   "Computed value of 1/1.000..1 >= 1");
    698 	X = One - U2;
    699 	Y = One + Radix * U2;
    700 	Z = X * Radix;
    701 	T = Y * Radix;
    702 	R = Z / Radix;
    703 	StickyBit = T / Radix;
    704 	X = R - X;
    705 	Y = StickyBit - Y;
    706 	TstCond (Failure, X == Zero && Y == Zero,
    707 			"* and/or / gets too many last digits wrong");
    708 	Y = One - U1;
    709 	X = One - F9;
    710 	Y = One - Y;
    711 	T = Radix - U2;
    712 	Z = Radix - BMinusU2;
    713 	T = Radix - T;
    714 	if ((X == U1) && (Y == U1) && (Z == U2) && (T == U2)) GAddSub = Yes;
    715 	else {
    716 		GAddSub = No;
    717 		TstCond (Serious, False,
    718 			"- lacks Guard Digit, so cancellation is obscured");
    719 		}
    720 	if (F9 != One && F9 - One >= Zero) {
    721 		BadCond(Serious, "comparison alleges  (1-U1) < 1  although\n");
    722 		printf("  subtraction yields  (1-U1) - 1 = 0 , thereby vitiating\n");
    723 		printf("  such precautions against division by zero as\n");
    724 		printf("  ...  if (X == 1.0) {.....} else {.../(X-1.0)...}\n");
    725 		}
    726 	if (GMult == Yes && GDiv == Yes && GAddSub == Yes) printf(
    727 		"     *, /, and - appear to have guard digits, as they should.\n");
    728 	/*=============================================*/
    729 	Milestone = 40;
    730 	/*=============================================*/
    731 	Pause();
    732 	printf("Checking rounding on multiply, divide and add/subtract.\n");
    733 	RMult = Other;
    734 	RDiv = Other;
    735 	RAddSub = Other;
    736 	RadixD2 = Radix / Two;
    737 	A1 = Two;
    738 	Done = False;
    739 	do  {
    740 		AInvrse = Radix;
    741 		do  {
    742 			X = AInvrse;
    743 			AInvrse = AInvrse / A1;
    744 			} while ( ! (FLOOR(AInvrse) != AInvrse));
    745 		Done = (X == One) || (A1 > Three);
    746 		if (! Done) A1 = Nine + One;
    747 		} while ( ! (Done));
    748 	if (X == One) A1 = Radix;
    749 	AInvrse = One / A1;
    750 	X = A1;
    751 	Y = AInvrse;
    752 	Done = False;
    753 	do  {
    754 		Z = X * Y - Half;
    755 		TstCond (Failure, Z == Half,
    756 			"X * (1/X) differs from 1");
    757 		Done = X == Radix;
    758 		X = Radix;
    759 		Y = One / X;
    760 		} while ( ! (Done));
    761 	Y2 = One + U2;
    762 	Y1 = One - U2;
    763 	X = OneAndHalf - U2;
    764 	Y = OneAndHalf + U2;
    765 	Z = (X - U2) * Y2;
    766 	T = Y * Y1;
    767 	Z = Z - X;
    768 	T = T - X;
    769 	X = X * Y2;
    770 	Y = (Y + U2) * Y1;
    771 	X = X - OneAndHalf;
    772 	Y = Y - OneAndHalf;
    773 	if ((X == Zero) && (Y == Zero) && (Z == Zero) && (T <= Zero)) {
    774 		X = (OneAndHalf + U2) * Y2;
    775 		Y = OneAndHalf - U2 - U2;
    776 		Z = OneAndHalf + U2 + U2;
    777 		T = (OneAndHalf - U2) * Y1;
    778 		X = X - (Z + U2);
    779 		StickyBit = Y * Y1;
    780 		S = Z * Y2;
    781 		T = T - Y;
    782 		Y = (U2 - Y) + StickyBit;
    783 		Z = S - (Z + U2 + U2);
    784 		StickyBit = (Y2 + U2) * Y1;
    785 		Y1 = Y2 * Y1;
    786 		StickyBit = StickyBit - Y2;
    787 		Y1 = Y1 - Half;
    788 		if ((X == Zero) && (Y == Zero) && (Z == Zero) && (T == Zero)
    789 			&& ( StickyBit == Zero) && (Y1 == Half)) {
    790 			RMult = Rounded;
    791 			printf("Multiplication appears to round correctly.\n");
    792 			}
    793 		else	if ((X + U2 == Zero) && (Y < Zero) && (Z + U2 == Zero)
    794 				&& (T < Zero) && (StickyBit + U2 == Zero)
    795 				&& (Y1 < Half)) {
    796 				RMult = Chopped;
    797 				printf("Multiplication appears to chop.\n");
    798 				}
    799 			else printf("* is neither chopped nor correctly rounded.\n");
    800 		if ((RMult == Rounded) && (GMult == No)) notify("Multiplication");
    801 		}
    802 	else printf("* is neither chopped nor correctly rounded.\n");
    803 	/*=============================================*/
    804 	Milestone = 45;
    805 	/*=============================================*/
    806 	Y2 = One + U2;
    807 	Y1 = One - U2;
    808 	Z = OneAndHalf + U2 + U2;
    809 	X = Z / Y2;
    810 	T = OneAndHalf - U2 - U2;
    811 	Y = (T - U2) / Y1;
    812 	Z = (Z + U2) / Y2;
    813 	X = X - OneAndHalf;
    814 	Y = Y - T;
    815 	T = T / Y1;
    816 	Z = Z - (OneAndHalf + U2);
    817 	T = (U2 - OneAndHalf) + T;
    818 	if (! ((X > Zero) || (Y > Zero) || (Z > Zero) || (T > Zero))) {
    819 		X = OneAndHalf / Y2;
    820 		Y = OneAndHalf - U2;
    821 		Z = OneAndHalf + U2;
    822 		X = X - Y;
    823 		T = OneAndHalf / Y1;
    824 		Y = Y / Y1;
    825 		T = T - (Z + U2);
    826 		Y = Y - Z;
    827 		Z = Z / Y2;
    828 		Y1 = (Y2 + U2) / Y2;
    829 		Z = Z - OneAndHalf;
    830 		Y2 = Y1 - Y2;
    831 		Y1 = (F9 - U1) / F9;
    832 		if ((X == Zero) && (Y == Zero) && (Z == Zero) && (T == Zero)
    833 			&& (Y2 == Zero) && (Y2 == Zero)
    834 			&& (Y1 - Half == F9 - Half )) {
    835 			RDiv = Rounded;
    836 			printf("Division appears to round correctly.\n");
    837 			if (GDiv == No) notify("Division");
    838 			}
    839 		else if ((X < Zero) && (Y < Zero) && (Z < Zero) && (T < Zero)
    840 			&& (Y2 < Zero) && (Y1 - Half < F9 - Half)) {
    841 			RDiv = Chopped;
    842 			printf("Division appears to chop.\n");
    843 			}
    844 		}
    845 	if (RDiv == Other) printf("/ is neither chopped nor correctly rounded.\n");
    846 	BInvrse = One / Radix;
    847 	TstCond (Failure, (BInvrse * Radix - Half == Half),
    848 		   "Radix * ( 1 / Radix ) differs from 1");
    849 	/*=============================================*/
    850 	/*SPLIT
    851 	}
    852 #include "paranoia.h"
    853 part4(){
    854 */
    855 	Milestone = 50;
    856 	/*=============================================*/
    857 	TstCond (Failure, ((F9 + U1) - Half == Half)
    858 		   && ((BMinusU2 + U2 ) - One == Radix - One),
    859 		   "Incomplete carry-propagation in Addition");
    860 	X = One - U1 * U1;
    861 	Y = One + U2 * (One - U2);
    862 	Z = F9 - Half;
    863 	X = (X - Half) - Z;
    864 	Y = Y - One;
    865 	if ((X == Zero) && (Y == Zero)) {
    866 		RAddSub = Chopped;
    867 		printf("Add/Subtract appears to be chopped.\n");
    868 		}
    869 	if (GAddSub == Yes) {
    870 		X = (Half + U2) * U2;
    871 		Y = (Half - U2) * U2;
    872 		X = One + X;
    873 		Y = One + Y;
    874 		X = (One + U2) - X;
    875 		Y = One - Y;
    876 		if ((X == Zero) && (Y == Zero)) {
    877 			X = (Half + U2) * U1;
    878 			Y = (Half - U2) * U1;
    879 			X = One - X;
    880 			Y = One - Y;
    881 			X = F9 - X;
    882 			Y = One - Y;
    883 			if ((X == Zero) && (Y == Zero)) {
    884 				RAddSub = Rounded;
    885 				printf("Addition/Subtraction appears to round correctly.\n");
    886 				if (GAddSub == No) notify("Add/Subtract");
    887 				}
    888 			else printf("Addition/Subtraction neither rounds nor chops.\n");
    889 			}
    890 		else printf("Addition/Subtraction neither rounds nor chops.\n");
    891 		}
    892 	else printf("Addition/Subtraction neither rounds nor chops.\n");
    893 	S = One;
    894 	X = One + Half * (One + Half);
    895 	Y = (One + U2) * Half;
    896 	Z = X - Y;
    897 	T = Y - X;
    898 	StickyBit = Z + T;
    899 	if (StickyBit != Zero) {
    900 		S = Zero;
    901 		BadCond(Flaw, "(X - Y) + (Y - X) is non zero!\n");
    902 		}
    903 	StickyBit = Zero;
    904 	if ((GMult == Yes) && (GDiv == Yes) && (GAddSub == Yes)
    905 		&& (RMult == Rounded) && (RDiv == Rounded)
    906 		&& (RAddSub == Rounded) && (FLOOR(RadixD2) == RadixD2)) {
    907 		printf("Checking for sticky bit.\n");
    908 		X = (Half + U1) * U2;
    909 		Y = Half * U2;
    910 		Z = One + Y;
    911 		T = One + X;
    912 		if ((Z - One <= Zero) && (T - One >= U2)) {
    913 			Z = T + Y;
    914 			Y = Z - X;
    915 			if ((Z - T >= U2) && (Y - T == Zero)) {
    916 				X = (Half + U1) * U1;
    917 				Y = Half * U1;
    918 				Z = One - Y;
    919 				T = One - X;
    920 				if ((Z - One == Zero) && (T - F9 == Zero)) {
    921 					Z = (Half - U1) * U1;
    922 					T = F9 - Z;
    923 					Q = F9 - Y;
    924 					if ((T - F9 == Zero) && (F9 - U1 - Q == Zero)) {
    925 						Z = (One + U2) * OneAndHalf;
    926 						T = (OneAndHalf + U2) - Z + U2;
    927 						X = One + Half / Radix;
    928 						Y = One + Radix * U2;
    929 						Z = X * Y;
    930 						if (T == Zero && X + Radix * U2 - Z == Zero) {
    931 							if (Radix != Two) {
    932 								X = Two + U2;
    933 								Y = X / Two;
    934 								if ((Y - One == Zero)) StickyBit = S;
    935 								}
    936 							else StickyBit = S;
    937 							}
    938 						}
    939 					}
    940 				}
    941 			}
    942 		}
    943 	if (StickyBit == One) printf("Sticky bit apparently used correctly.\n");
    944 	else printf("Sticky bit used incorrectly or not at all.\n");
    945 	TstCond (Flaw, !(GMult == No || GDiv == No || GAddSub == No ||
    946 			RMult == Other || RDiv == Other || RAddSub == Other),
    947 		"lack(s) of guard digits or failure(s) to correctly round or chop\n(noted above) count as one flaw in the final tally below");
    948 	/*=============================================*/
    949 	Milestone = 60;
    950 	/*=============================================*/
    951 	printf("\n");
    952 	printf("Does Multiplication commute?  ");
    953 	printf("Testing on %d random pairs.\n", NoTrials);
    954 	Random9 = SQRT(3.0);
    955 	Random1 = Third;
    956 	I = 1;
    957 	do  {
    958 		X = Random();
    959 		Y = Random();
    960 		Z9 = Y * X;
    961 		Z = X * Y;
    962 		Z9 = Z - Z9;
    963 		I = I + 1;
    964 		} while ( ! ((I > NoTrials) || (Z9 != Zero)));
    965 	if (I == NoTrials) {
    966 		Random1 = One + Half / Three;
    967 		Random2 = (U2 + U1) + One;
    968 		Z = Random1 * Random2;
    969 		Y = Random2 * Random1;
    970 		Z9 = (One + Half / Three) * ((U2 + U1) + One) - (One + Half /
    971 			Three) * ((U2 + U1) + One);
    972 		}
    973 	if (! ((I == NoTrials) || (Z9 == Zero)))
    974 		BadCond(Defect, "X * Y == Y * X trial fails.\n");
    975 	else printf("     No failures found in %d integer pairs.\n", NoTrials);
    976 	/*=============================================*/
    977 	Milestone = 70;
    978 	/*=============================================*/
    979 	printf("\nRunning test of square root(x).\n");
    980 	TstCond (Failure, (Zero == SQRT(Zero))
    981 		   && (- Zero == SQRT(- Zero))
    982 		   && (One == SQRT(One)), "Square root of 0.0, -0.0 or 1.0 wrong");
    983 	MinSqEr = Zero;
    984 	MaxSqEr = Zero;
    985 	J = Zero;
    986 	X = Radix;
    987 	OneUlp = U2;
    988 	SqXMinX (Serious);
    989 	X = BInvrse;
    990 	OneUlp = BInvrse * U1;
    991 	SqXMinX (Serious);
    992 	X = U1;
    993 	OneUlp = U1 * U1;
    994 	SqXMinX (Serious);
    995 	if (J != Zero) Pause();
    996 	printf("Testing if sqrt(X * X) == X for %d Integers X.\n", NoTrials);
    997 	J = Zero;
    998 	X = Two;
    999 	Y = Radix;
   1000 	if ((Radix != One)) do  {
   1001 		X = Y;
   1002 		Y = Radix * Y;
   1003 		} while ( ! ((Y - X >= NoTrials)));
   1004 	OneUlp = X * U2;
   1005 	I = 1;
   1006 	while (I <= NoTrials) {
   1007 		X = X + One;
   1008 		SqXMinX (Defect);
   1009 		if (J > Zero) break;
   1010 		I = I + 1;
   1011 		}
   1012 	printf("Test for sqrt monotonicity.\n");
   1013 	I = - 1;
   1014 	X = BMinusU2;
   1015 	Y = Radix;
   1016 	Z = Radix + Radix * U2;
   1017 	NotMonot = False;
   1018 	Monot = False;
   1019 	while ( ! (NotMonot || Monot)) {
   1020 		I = I + 1;
   1021 		X = SQRT(X);
   1022 		Q = SQRT(Y);
   1023 		Z = SQRT(Z);
   1024 		if ((X > Q) || (Q > Z)) NotMonot = True;
   1025 		else {
   1026 			Q = FLOOR(Q + Half);
   1027 			if ((I > 0) || (Radix == Q * Q)) Monot = True;
   1028 			else if (I > 0) {
   1029 			if (I > 1) Monot = True;
   1030 			else {
   1031 				Y = Y * BInvrse;
   1032 				X = Y - U1;
   1033 				Z = Y + U1;
   1034 				}
   1035 			}
   1036 			else {
   1037 				Y = Q;
   1038 				X = Y - U2;
   1039 				Z = Y + U2;
   1040 				}
   1041 			}
   1042 		}
   1043 	if (Monot) printf("sqrt has passed a test for Monotonicity.\n");
   1044 	else {
   1045 		BadCond(Defect, "");
   1046 		printf("sqrt(X) is non-monotonic for X near %.7e .\n", Y);
   1047 		}
   1048 	/*=============================================*/
   1049 	/*SPLIT
   1050 	}
   1051 #include "paranoia.h"
   1052 part5(){
   1053 */
   1054 	Milestone = 80;
   1055 	/*=============================================*/
   1056 	MinSqEr = MinSqEr + Half;
   1057 	MaxSqEr = MaxSqEr - Half;
   1058 	Y = (SQRT(One + U2) - One) / U2;
   1059 	SqEr = (Y - One) + U2 / Eight;
   1060 	if (SqEr > MaxSqEr) MaxSqEr = SqEr;
   1061 	SqEr = Y + U2 / Eight;
   1062 	if (SqEr < MinSqEr) MinSqEr = SqEr;
   1063 	Y = ((SQRT(F9) - U2) - (One - U2)) / U1;
   1064 	SqEr = Y + U1 / Eight;
   1065 	if (SqEr > MaxSqEr) MaxSqEr = SqEr;
   1066 	SqEr = (Y + One) + U1 / Eight;
   1067 	if (SqEr < MinSqEr) MinSqEr = SqEr;
   1068 	OneUlp = U2;
   1069 	X = OneUlp;
   1070 	for( Indx = 1; Indx <= 3; ++Indx) {
   1071 		Y = SQRT((X + U1 + X) + F9);
   1072 		Y = ((Y - U2) - ((One - U2) + X)) / OneUlp;
   1073 		Z = ((U1 - X) + F9) * Half * X * X / OneUlp;
   1074 		SqEr = (Y + Half) + Z;
   1075 		if (SqEr < MinSqEr) MinSqEr = SqEr;
   1076 		SqEr = (Y - Half) + Z;
   1077 		if (SqEr > MaxSqEr) MaxSqEr = SqEr;
   1078 		if (((Indx == 1) || (Indx == 3))) 
   1079 			X = OneUlp * Sign (X) * FLOOR(Eight / (Nine * SQRT(OneUlp)));
   1080 		else {
   1081 			OneUlp = U1;
   1082 			X = - OneUlp;
   1083 			}
   1084 		}
   1085 	/*=============================================*/
   1086 	Milestone = 85;
   1087 	/*=============================================*/
   1088 	SqRWrng = False;
   1089 	Anomaly = False;
   1090 	RSqrt = Other; /* ~dgh */
   1091 	if (Radix != One) {
   1092 		printf("Testing whether sqrt is rounded or chopped.\n");
   1093 		D = FLOOR(Half + POW(Radix, One + Precision - FLOOR(Precision)));
   1094 	/* ... == Radix^(1 + fract) if (Precision == Integer + fract. */
   1095 		X = D / Radix;
   1096 		Y = D / A1;
   1097 		if ((X != FLOOR(X)) || (Y != FLOOR(Y))) {
   1098 			Anomaly = True;
   1099 			}
   1100 		else {
   1101 			X = Zero;
   1102 			Z2 = X;
   1103 			Y = One;
   1104 			Y2 = Y;
   1105 			Z1 = Radix - One;
   1106 			FourD = Four * D;
   1107 			do  {
   1108 				if (Y2 > Z2) {
   1109 					Q = Radix;
   1110 					Y1 = Y;
   1111 					do  {
   1112 						X1 = FABS(Q + FLOOR(Half - Q / Y1) * Y1);
   1113 						Q = Y1;
   1114 						Y1 = X1;
   1115 						} while ( ! (X1 <= Zero));
   1116 					if (Q <= One) {
   1117 						Z2 = Y2;
   1118 						Z = Y;
   1119 						}
   1120 					}
   1121 				Y = Y + Two;
   1122 				X = X + Eight;
   1123 				Y2 = Y2 + X;
   1124 				if (Y2 >= FourD) Y2 = Y2 - FourD;
   1125 				} while ( ! (Y >= D));
   1126 			X8 = FourD - Z2;
   1127 			Q = (X8 + Z * Z) / FourD;
   1128 			X8 = X8 / Eight;
   1129 			if (Q != FLOOR(Q)) Anomaly = True;
   1130 			else {
   1131 				Break = False;
   1132 				do  {
   1133 					X = Z1 * Z;
   1134 					X = X - FLOOR(X / Radix) * Radix;
   1135 					if (X == One) 
   1136 						Break = True;
   1137 					else
   1138 						Z1 = Z1 - One;
   1139 					} while ( ! (Break || (Z1 <= Zero)));
   1140 				if ((Z1 <= Zero) && (! Break)) Anomaly = True;
   1141 				else {
   1142 					if (Z1 > RadixD2) Z1 = Z1 - Radix;
   1143 					do  {
   1144 						NewD();
   1145 						} while ( ! (U2 * D >= F9));
   1146 					if (D * Radix - D != W - D) Anomaly = True;
   1147 					else {
   1148 						Z2 = D;
   1149 						I = 0;
   1150 						Y = D + (One + Z) * Half;
   1151 						X = D + Z + Q;
   1152 						SR3750();
   1153 						Y = D + (One - Z) * Half + D;
   1154 						X = D - Z + D;
   1155 						X = X + Q + X;
   1156 						SR3750();
   1157 						NewD();
   1158 						if (D - Z2 != W - Z2) Anomaly = True;
   1159 						else {
   1160 							Y = (D - Z2) + (Z2 + (One - Z) * Half);
   1161 							X = (D - Z2) + (Z2 - Z + Q);
   1162 							SR3750();
   1163 							Y = (One + Z) * Half;
   1164 							X = Q;
   1165 							SR3750();
   1166 							if (I == 0) Anomaly = True;
   1167 							}
   1168 						}
   1169 					}
   1170 				}
   1171 			}
   1172 		if ((I == 0) || Anomaly) {
   1173 			BadCond(Failure, "Anomalous arithmetic with Integer < ");
   1174 			printf("Radix^Precision = %.7e\n", W);
   1175 			printf(" fails test whether sqrt rounds or chops.\n");
   1176 			SqRWrng = True;
   1177 			}
   1178 		}
   1179 	if (! Anomaly) {
   1180 		if (! ((MinSqEr < Zero) || (MaxSqEr > Zero))) {
   1181 			RSqrt = Rounded;
   1182 			printf("Square root appears to be correctly rounded.\n");
   1183 			}
   1184 		else  {
   1185 			if ((MaxSqEr + U2 > U2 - Half) || (MinSqEr > Half)
   1186 				|| (MinSqEr + Radix < Half)) SqRWrng = True;
   1187 			else {
   1188 				RSqrt = Chopped;
   1189 				printf("Square root appears to be chopped.\n");
   1190 				}
   1191 			}
   1192 		}
   1193 	if (SqRWrng) {
   1194 		printf("Square root is neither chopped nor correctly rounded.\n");
   1195 		printf("Observed errors run from %.7e ", MinSqEr - Half);
   1196 		printf("to %.7e ulps.\n", Half + MaxSqEr);
   1197 		TstCond (Serious, MaxSqEr - MinSqEr < Radix * Radix,
   1198 			"sqrt gets too many last digits wrong");
   1199 		}
   1200 	/*=============================================*/
   1201 	Milestone = 90;
   1202 	/*=============================================*/
   1203 	Pause();
   1204 	printf("Testing powers Z^i for small Integers Z and i.\n");
   1205 	N = 0;
   1206 	/* ... test powers of zero. */
   1207 	I = 0;
   1208 	Z = -Zero;
   1209 	M = 3.0;
   1210 	Break = False;
   1211 	do  {
   1212 		X = One;
   1213 		SR3980();
   1214 		if (I <= 10) {
   1215 			I = 1023;
   1216 			SR3980();
   1217 			}
   1218 		if (Z == MinusOne) Break = True;
   1219 		else {
   1220 			Z = MinusOne;
   1221 			PrintIfNPositive();
   1222 			N = 0;
   1223 			/* .. if(-1)^N is invalid, replace MinusOne by One. */
   1224 			I = - 4;
   1225 			}
   1226 		} while ( ! Break);
   1227 	PrintIfNPositive();
   1228 	N1 = N;
   1229 	N = 0;
   1230 	Z = A1;
   1231 	M = FLOOR(Two * LOG(W) / LOG(A1));
   1232 	Break = False;
   1233 	do  {
   1234 		X = Z;
   1235 		I = 1;
   1236 		SR3980();
   1237 		if (Z == AInvrse) Break = True;
   1238 		else Z = AInvrse;
   1239 		} while ( ! (Break));
   1240 	/*=============================================*/
   1241 		Milestone = 100;
   1242 	/*=============================================*/
   1243 	/*  Powers of Radix have been tested, */
   1244 	/*         next try a few primes     */
   1245 	M = NoTrials;
   1246 	Z = Three;
   1247 	do  {
   1248 		X = Z;
   1249 		I = 1;
   1250 		SR3980();
   1251 		do  {
   1252 			Z = Z + Two;
   1253 			} while ( Three * FLOOR(Z / Three) == Z );
   1254 		} while ( Z < Eight * Three );
   1255 	if (N > 0) {
   1256 		printf("Errors like this may invalidate financial calculations\n");
   1257 		printf("\tinvolving interest rates.\n");
   1258 		}
   1259 	PrintIfNPositive();
   1260 	N += N1;
   1261 	if (N == 0) printf("... no discrepancis found.\n");
   1262 	if (N > 0) Pause();
   1263 	else printf("\n");
   1264 	/*=============================================*/
   1265 	/*SPLIT
   1266 	}
   1267 #include "paranoia.h"
   1268 part6(){
   1269 */
   1270 	Milestone = 110;
   1271 	/*=============================================*/
   1272 	printf("Seeking Underflow thresholds UfThold and E0.\n");
   1273 	D = U1;
   1274 	if (Precision != FLOOR(Precision)) {
   1275 		D = BInvrse;
   1276 		X = Precision;
   1277 		do  {
   1278 			D = D * BInvrse;
   1279 			X = X - One;
   1280 			} while ( X > Zero);
   1281 		}
   1282 	Y = One;
   1283 	Z = D;
   1284 	/* ... D is power of 1/Radix < 1. */
   1285 	do  {
   1286 		C = Y;
   1287 		Y = Z;
   1288 		Z = Y * Y;
   1289 		} while ((Y > Z) && (Z + Z > Z));
   1290 	Y = C;
   1291 	Z = Y * D;
   1292 	do  {
   1293 		C = Y;
   1294 		Y = Z;
   1295 		Z = Y * D;
   1296 		} while ((Y > Z) && (Z + Z > Z));
   1297 	if (Radix < Two) HInvrse = Two;
   1298 	else HInvrse = Radix;
   1299 	H = One / HInvrse;
   1300 	/* ... 1/HInvrse == H == Min(1/Radix, 1/2) */
   1301 	CInvrse = One / C;
   1302 	E0 = C;
   1303 	Z = E0 * H;
   1304 	/* ...1/Radix^(BIG Integer) << 1 << CInvrse == 1/C */
   1305 	do  {
   1306 		Y = E0;
   1307 		E0 = Z;
   1308 		Z = E0 * H;
   1309 		} while ((E0 > Z) && (Z + Z > Z));
   1310 	UfThold = E0;
   1311 	E1 = Zero;
   1312 	Q = Zero;
   1313 	E9 = U2;
   1314 	S = One + E9;
   1315 	D = C * S;
   1316 	if (D <= C) {
   1317 		E9 = Radix * U2;
   1318 		S = One + E9;
   1319 		D = C * S;
   1320 		if (D <= C) {
   1321 			BadCond(Failure, "multiplication gets too many last digits wrong.\n");
   1322 			Underflow = E0;
   1323 			Y1 = Zero;
   1324 			PseudoZero = Z;
   1325 			Pause();
   1326 			}
   1327 		}
   1328 	else {
   1329 		Underflow = D;
   1330 		PseudoZero = Underflow * H;
   1331 		UfThold = Zero;
   1332 		do  {
   1333 			Y1 = Underflow;
   1334 			Underflow = PseudoZero;
   1335 			if (E1 + E1 <= E1) {
   1336 				Y2 = Underflow * HInvrse;
   1337 				E1 = FABS(Y1 - Y2);
   1338 				Q = Y1;
   1339 				if ((UfThold == Zero) && (Y1 != Y2)) UfThold = Y1;
   1340 				}
   1341 			PseudoZero = PseudoZero * H;
   1342 			} while ((Underflow > PseudoZero)
   1343 				&& (PseudoZero + PseudoZero > PseudoZero));
   1344 		}
   1345 	/* Comment line 4530 .. 4560 */
   1346 	if (PseudoZero != Zero) {
   1347 		printf("\n");
   1348 		Z = PseudoZero;
   1349 	/* ... Test PseudoZero for "phoney- zero" violates */
   1350 	/* ... PseudoZero < Underflow or PseudoZero < PseudoZero + PseudoZero
   1351 		   ... */
   1352 		if (PseudoZero <= Zero) {
   1353 			BadCond(Failure, "Positive expressions can underflow to an\n");
   1354 			printf("allegedly negative value\n");
   1355 			printf("PseudoZero that prints out as: %g .\n", PseudoZero);
   1356 			X = - PseudoZero;
   1357 			if (X <= Zero) {
   1358 				printf("But -PseudoZero, which should be\n");
   1359 				printf("positive, isn't; it prints out as  %g .\n", X);
   1360 				}
   1361 			}
   1362 		else {
   1363 			BadCond(Flaw, "Underflow can stick at an allegedly positive\n");
   1364 			printf("value PseudoZero that prints out as %g .\n", PseudoZero);
   1365 			}
   1366 		TstPtUf();
   1367 		}
   1368 	/*=============================================*/
   1369 	Milestone = 120;
   1370 	/*=============================================*/
   1371 	if (CInvrse * Y > CInvrse * Y1) {
   1372 		S = H * S;
   1373 		E0 = Underflow;
   1374 		}
   1375 	if (! ((E1 == Zero) || (E1 == E0))) {
   1376 		BadCond(Defect, "");
   1377 		if (E1 < E0) {
   1378 			printf("Products underflow at a higher");
   1379 			printf(" threshold than differences.\n");
   1380 			if (PseudoZero == Zero) 
   1381 			E0 = E1;
   1382 			}
   1383 		else {
   1384 			printf("Difference underflows at a higher");
   1385 			printf(" threshold than products.\n");
   1386 			}
   1387 		}
   1388 	printf("Smallest strictly positive number found is E0 = %g .\n", E0);
   1389 	Z = E0;
   1390 	TstPtUf();
   1391 	Underflow = E0;
   1392 	if (N == 1) Underflow = Y;
   1393 	I = 4;
   1394 	if (E1 == Zero) I = 3;
   1395 	if (UfThold == Zero) I = I - 2;
   1396 	UfNGrad = True;
   1397 	switch (I)  {
   1398 		case	1:
   1399 		UfThold = Underflow;
   1400 		if ((CInvrse * Q) != ((CInvrse * Y) * S)) {
   1401 			UfThold = Y;
   1402 			BadCond(Failure, "Either accuracy deteriorates as numbers\n");
   1403 			printf("approach a threshold = %.17e\n", UfThold);;
   1404 			printf(" coming down from %.17e\n", C);
   1405 			printf(" or else multiplication gets too many last digits wrong.\n");
   1406 			}
   1407 		Pause();
   1408 		break;
   1409 	
   1410 		case	2:
   1411 		BadCond(Failure, "Underflow confuses Comparison, which alleges that\n");
   1412 		printf("Q == Y while denying that |Q - Y| == 0; these values\n");
   1413 		printf("print out as Q = %.17e, Y = %.17e .\n", Q, Y2);
   1414 		printf ("|Q - Y| = %.17e .\n" , FABS(Q - Y2));
   1415 		UfThold = Q;
   1416 		break;
   1417 	
   1418 		case	3:
   1419 		X = X;
   1420 		break;
   1421 	
   1422 		case	4:
   1423 		if ((Q == UfThold) && (E1 == E0)
   1424 			&& (FABS( UfThold - E1 / E9) <= E1)) {
   1425 			UfNGrad = False;
   1426 			printf("Underflow is gradual; it incurs Absolute Error =\n");
   1427 			printf("(roundoff in UfThold) < E0.\n");
   1428 			Y = E0 * CInvrse;
   1429 			Y = Y * (OneAndHalf + U2);
   1430 			X = CInvrse * (One + U2);
   1431 			Y = Y / X;
   1432 			IEEE = (Y == E0);
   1433 			}
   1434 		}
   1435 	if (UfNGrad) {
   1436 		printf("\n");
   1437 		sigsave = sigfpe;
   1438 		if (setjmp(ovfl_buf)) {
   1439 			printf("Underflow / UfThold failed!\n");
   1440 			R = H + H;
   1441 			}
   1442 		else R = SQRT(Underflow / UfThold);
   1443 		sigsave = 0;
   1444 		if (R <= H) {
   1445 			Z = R * UfThold;
   1446 			X = Z * (One + R * H * (One + H));
   1447 			}
   1448 		else {
   1449 			Z = UfThold;
   1450 			X = Z * (One + H * H * (One + H));
   1451 			}
   1452 		if (! ((X == Z) || (X - Z != Zero))) {
   1453 			BadCond(Flaw, "");
   1454 			printf("X = %.17e\n\tis not equal to Z = %.17e .\n", X, Z);
   1455 			Z9 = X - Z;
   1456 			printf("yet X - Z yields %.17e .\n", Z9);
   1457 			printf("    Should this NOT signal Underflow, ");
   1458 			printf("this is a SERIOUS DEFECT\nthat causes ");
   1459 			printf("confusion when innocent statements like\n");;
   1460 			printf("    if (X == Z)  ...  else");
   1461 			printf("  ... (f(X) - f(Z)) / (X - Z) ...\n");
   1462 			printf("encounter Division by Zero although actually\n");
   1463 			sigsave = sigfpe;
   1464 			if (setjmp(ovfl_buf)) printf("X / Z fails!\n");
   1465 			else printf("X / Z = 1 + %g .\n", (X / Z - Half) - Half);
   1466 			sigsave = 0;
   1467 			}
   1468 		}
   1469 	printf("The Underflow threshold is %.17e, %s\n", UfThold,
   1470 		   " below which");
   1471 	printf("calculation may suffer larger Relative error than ");
   1472 	printf("merely roundoff.\n");
   1473 	Y2 = U1 * U1;
   1474 	Y = Y2 * Y2;
   1475 	Y2 = Y * U1;
   1476 	if (Y2 <= UfThold) {
   1477 		if (Y > E0) {
   1478 			BadCond(Defect, "");
   1479 			I = 5;
   1480 			}
   1481 		else {
   1482 			BadCond(Serious, "");
   1483 			I = 4;
   1484 			}
   1485 		printf("Range is too narrow; U1^%d Underflows.\n", I);
   1486 		}
   1487 	/*=============================================*/
   1488 	/*SPLIT
   1489 	}
   1490 #include "paranoia.h"
   1491 part7(){
   1492 */
   1493 	Milestone = 130;
   1494 	/*=============================================*/
   1495 	Y = - FLOOR(Half - TwoForty * LOG(UfThold) / LOG(HInvrse)) / TwoForty;
   1496 	Y2 = Y + Y;
   1497 	printf("Since underflow occurs below the threshold\n");
   1498 	printf("UfThold = (%.17e) ^ (%.17e)\nonly underflow ", HInvrse, Y);
   1499 	printf("should afflict the expression\n\t(%.17e) ^ (%.17e);\n", HInvrse, Y);
   1500 	V9 = POW(HInvrse, Y2);
   1501 	printf("actually calculating yields: %.17e .\n", V9);
   1502 	if (! ((V9 >= Zero) && (V9 <= (Radix + Radix + E9) * UfThold))) {
   1503 		BadCond(Serious, "this is not between 0 and underflow\n");
   1504 		printf("   threshold = %.17e .\n", UfThold);
   1505 		}
   1506 	else if (! (V9 > UfThold * (One + E9)))
   1507 		printf("This computed value is O.K.\n");
   1508 	else {
   1509 		BadCond(Defect, "this is not between 0 and underflow\n");
   1510 		printf("   threshold = %.17e .\n", UfThold);
   1511 		}
   1512 	/*=============================================*/
   1513 	Milestone = 140;
   1514 	/*=============================================*/
   1515 	printf("\n");
   1516 	/* ...calculate Exp2 == exp(2) == 7.389056099... */
   1517 	X = Zero;
   1518 	I = 2;
   1519 	Y = Two * Three;
   1520 	Q = Zero;
   1521 	N = 0;
   1522 	do  {
   1523 		Z = X;
   1524 		I = I + 1;
   1525 		Y = Y / (I + I);
   1526 		R = Y + Q;
   1527 		X = Z + R;
   1528 		Q = (Z - X) + R;
   1529 		} while(X > Z);
   1530 	Z = (OneAndHalf + One / Eight) + X / (OneAndHalf * ThirtyTwo);
   1531 	X = Z * Z;
   1532 	Exp2 = X * X;
   1533 	X = F9;
   1534 	Y = X - U1;
   1535 	printf("Testing X^((X + 1) / (X - 1)) vs. exp(2) = %.17e as X -> 1.\n",
   1536 		Exp2);
   1537 	for(I = 1;;) {
   1538 		Z = X - BInvrse;
   1539 		Z = (X + One) / (Z - (One - BInvrse));
   1540 		Q = POW(X, Z) - Exp2;
   1541 		if (FABS(Q) > TwoForty * U2) {
   1542 			N = 1;
   1543 	 		V9 = (X - BInvrse) - (One - BInvrse);
   1544 			BadCond(Defect, "Calculated");
   1545 			printf(" %.17e for\n", POW(X,Z));
   1546 			printf("\t(1 + (%.17e) ^ (%.17e);\n", V9, Z);
   1547 			printf("\tdiffers from correct value by %.17e .\n", Q);
   1548 			printf("\tThis much error may spoil financial\n");
   1549 			printf("\tcalculations involving tiny interest rates.\n");
   1550 			break;
   1551 			}
   1552 		else {
   1553 			Z = (Y - X) * Two + Y;
   1554 			X = Y;
   1555 			Y = Z;
   1556 			Z = One + (X - F9)*(X - F9);
   1557 			if (Z > One && I < NoTrials) I++;
   1558 			else  {
   1559 				if (X > One) {
   1560 					if (N == 0)
   1561 					   printf("Accuracy seems adequate.\n");
   1562 					break;
   1563 					}
   1564 				else {
   1565 					X = One + U2;
   1566 					Y = U2 + U2;
   1567 					Y += X;
   1568 					I = 1;
   1569 					}
   1570 				}
   1571 			}
   1572 		}
   1573 	/*=============================================*/
   1574 	Milestone = 150;
   1575 	/*=============================================*/
   1576 	printf("Testing powers Z^Q at four nearly extreme values.\n");
   1577 	N = 0;
   1578 	Z = A1;
   1579 	Q = FLOOR(Half - LOG(C) / LOG(A1));
   1580 	Break = False;
   1581 	do  {
   1582 		X = CInvrse;
   1583 		Y = POW(Z, Q);
   1584 		IsYeqX();
   1585 		Q = - Q;
   1586 		X = C;
   1587 		Y = POW(Z, Q);
   1588 		IsYeqX();
   1589 		if (Z < One) Break = True;
   1590 		else Z = AInvrse;
   1591 		} while ( ! (Break));
   1592 	PrintIfNPositive();
   1593 	if (N == 0) printf(" ... no discrepancies found.\n");
   1594 	printf("\n");
   1595 	
   1596 	/*=============================================*/
   1597 	Milestone = 160;
   1598 	/*=============================================*/
   1599 	Pause();
   1600 	printf("Searching for Overflow threshold:\n");
   1601 	printf("This may generate an error.\n");
   1602 	Y = - CInvrse;
   1603 	V9 = HInvrse * Y;
   1604 	sigsave = sigfpe;
   1605 	if (setjmp(ovfl_buf)) { I = 0; V9 = Y; goto overflow; }
   1606 	do {
   1607 		V = Y;
   1608 		Y = V9;
   1609 		V9 = HInvrse * Y;
   1610 		} while(V9 < Y);
   1611 	I = 1;
   1612 overflow:
   1613 	sigsave = 0;
   1614 	Z = V9;
   1615 	printf("Can `Z = -Y' overflow?\n");
   1616 	printf("Trying it on Y = %.17e .\n", Y);
   1617 	V9 = - Y;
   1618 	V0 = V9;
   1619 	if (V - Y == V + V0) printf("Seems O.K.\n");
   1620 	else {
   1621 		printf("finds a ");
   1622 		BadCond(Flaw, "-(-Y) differs from Y.\n");
   1623 		}
   1624 	if (Z != Y) {
   1625 		BadCond(Serious, "");
   1626 		printf("overflow past %.17e\n\tshrinks to %.17e .\n", Y, Z);
   1627 		}
   1628 	if (I) {
   1629 		Y = V * (HInvrse * U2 - HInvrse);
   1630 		Z = Y + ((One - HInvrse) * U2) * V;
   1631 		if (Z < V0) Y = Z;
   1632 		if (Y < V0) V = Y;
   1633 		if (V0 - V < V0) V = V0;
   1634 		}
   1635 	else {
   1636 		V = Y * (HInvrse * U2 - HInvrse);
   1637 		V = V + ((One - HInvrse) * U2) * Y;
   1638 		}
   1639 	printf("Overflow threshold is V  = %.17e .\n", V);
   1640 	if (I) printf("Overflow saturates at V0 = %.17e .\n", V0);
   1641 	else printf("There is no saturation value because the system traps on overflow.\n");
   1642 	V9 = V * One;
   1643 	printf("No Overflow should be signaled for V * 1 = %.17e\n", V9);
   1644 	V9 = V / One;
   1645 	printf("                           nor for V / 1 = %.17e .\n", V9);
   1646 	printf("Any overflow signal separating this * from the one\n");
   1647 	printf("above is a DEFECT.\n");
   1648 	/*=============================================*/
   1649 	Milestone = 170;
   1650 	/*=============================================*/
   1651 	if (!(-V < V && -V0 < V0 && -UfThold < V && UfThold < V)) {
   1652 		BadCond(Failure, "Comparisons involving ");
   1653 		printf("+-%g, +-%g\nand +-%g are confused by Overflow.",
   1654 			V, V0, UfThold);
   1655 		}
   1656 	/*=============================================*/
   1657 	Milestone = 175;
   1658 	/*=============================================*/
   1659 	printf("\n");
   1660 	for(Indx = 1; Indx <= 3; ++Indx) {
   1661 		switch (Indx)  {
   1662 			case 1: Z = UfThold; break;
   1663 			case 2: Z = E0; break;
   1664 			case 3: Z = PseudoZero; break;
   1665 			}
   1666 		if (Z != Zero) {
   1667 			V9 = SQRT(Z);
   1668 			Y = V9 * V9;
   1669 			if (Y / (One - Radix * E9) < Z
   1670 			   || Y > (One + Radix * E9) * Z) { /* dgh: + E9 --> * E9 */
   1671 				if (V9 > U1) BadCond(Serious, "");
   1672 				else BadCond(Defect, "");
   1673 				printf("Comparison alleges that what prints as Z = %.17e\n", Z);
   1674 				printf(" is too far from sqrt(Z) ^ 2 = %.17e .\n", Y);
   1675 				}
   1676 			}
   1677 		}
   1678 	/*=============================================*/
   1679 	Milestone = 180;
   1680 	/*=============================================*/
   1681 	for(Indx = 1; Indx <= 2; ++Indx) {
   1682 		if (Indx == 1) Z = V;
   1683 		else Z = V0;
   1684 		V9 = SQRT(Z);
   1685 		X = (One - Radix * E9) * V9;
   1686 		V9 = V9 * X;
   1687 		if (((V9 < (One - Two * Radix * E9) * Z) || (V9 > Z))) {
   1688 			Y = V9;
   1689 			if (X < W) BadCond(Serious, "");
   1690 			else BadCond(Defect, "");
   1691 			printf("Comparison alleges that Z = %17e\n", Z);
   1692 			printf(" is too far from sqrt(Z) ^ 2 (%.17e) .\n", Y);
   1693 			}
   1694 		}
   1695 	/*=============================================*/
   1696 	/*SPLIT
   1697 	}
   1698 #include "paranoia.h"
   1699 part8(){
   1700 */
   1701 	Milestone = 190;
   1702 	/*=============================================*/
   1703 	Pause();
   1704 	X = UfThold * V;
   1705 	Y = Radix * Radix;
   1706 	if (X*Y < One || X > Y) {
   1707 		if (X * Y < U1 || X > Y/U1) BadCond(Defect, "Badly");
   1708 		else BadCond(Flaw, "");
   1709 			
   1710 		printf(" unbalanced range; UfThold * V = %.17e\n\t%s\n",
   1711 			X, "is too far from 1.\n");
   1712 		}
   1713 	/*=============================================*/
   1714 	Milestone = 200;
   1715 	/*=============================================*/
   1716 	for (Indx = 1; Indx <= 5; ++Indx)  {
   1717 		X = F9;
   1718 		switch (Indx)  {
   1719 			case 2: X = One + U2; break;
   1720 			case 3: X = V; break;
   1721 			case 4: X = UfThold; break;
   1722 			case 5: X = Radix;
   1723 			}
   1724 		Y = X;
   1725 		sigsave = sigfpe;
   1726 		if (setjmp(ovfl_buf))
   1727 			printf("  X / X  traps when X = %g\n", X);
   1728 		else {
   1729 			V9 = (Y / X - Half) - Half;
   1730 			if (V9 == Zero) continue;
   1731 			if (V9 == - U1 && Indx < 5) BadCond(Flaw, "");
   1732 			else BadCond(Serious, "");
   1733 			printf("  X / X differs from 1 when X = %.17e\n", X);
   1734 			printf("  instead, X / X - 1/2 - 1/2 = %.17e .\n", V9);
   1735 			}
   1736 		sigsave = 0;
   1737 		}
   1738 	/*=============================================*/
   1739 	Milestone = 210;
   1740 	/*=============================================*/
   1741 	MyZero = Zero;
   1742 	printf("\n");
   1743 	printf("What message and/or values does Division by Zero produce?\n") ;
   1744 #ifndef NOPAUSE
   1745 	printf("This can interupt your program.  You can ");
   1746 	printf("skip this part if you wish.\n");
   1747 	printf("Do you wish to compute 1 / 0? ");
   1748 	fflush(stdout);
   1749 	read (KEYBOARD, ch, 8);
   1750 	if ((ch[0] == 'Y') || (ch[0] == 'y')) {
   1751 #endif
   1752 		sigsave = sigfpe;
   1753 		printf("    Trying to compute 1 / 0 produces ...");
   1754 		if (!setjmp(ovfl_buf)) printf("  %.7e .\n", One / MyZero);
   1755 		sigsave = 0;
   1756 #ifndef NOPAUSE
   1757 		}
   1758 	else printf("O.K.\n");
   1759 	printf("\nDo you wish to compute 0 / 0? ");
   1760 	fflush(stdout);
   1761 	read (KEYBOARD, ch, 80);
   1762 	if ((ch[0] == 'Y') || (ch[0] == 'y')) {
   1763 #endif
   1764 		sigsave = sigfpe;
   1765 		printf("\n    Trying to compute 0 / 0 produces ...");
   1766 		if (!setjmp(ovfl_buf)) printf("  %.7e .\n", Zero / MyZero);
   1767 		sigsave = 0;
   1768 #ifndef NOPAUSE
   1769 		}
   1770 	else printf("O.K.\n");
   1771 #endif
   1772 	/*=============================================*/
   1773 	Milestone = 220;
   1774 	/*=============================================*/
   1775 	Pause();
   1776 	printf("\n");
   1777 	{
   1778 		static char *msg[] = {
   1779 			"FAILUREs  encountered =",
   1780 			"SERIOUS DEFECTs  discovered =",
   1781 			"DEFECTs  discovered =",
   1782 			"FLAWs  discovered =" };
   1783 		int i;
   1784 		for(i = 0; i < 4; i++) if (ErrCnt[i])
   1785 			printf("The number of  %-29s %d.\n",
   1786 				msg[i], ErrCnt[i]);
   1787 		}
   1788 	printf("\n");
   1789 	if ((ErrCnt[Failure] + ErrCnt[Serious] + ErrCnt[Defect]
   1790 			+ ErrCnt[Flaw]) > 0) {
   1791 		if ((ErrCnt[Failure] + ErrCnt[Serious] + ErrCnt[
   1792 			Defect] == 0) && (ErrCnt[Flaw] > 0)) {
   1793 			printf("The arithmetic diagnosed seems ");
   1794 			printf("Satisfactory though flawed.\n");
   1795 			}
   1796 		if ((ErrCnt[Failure] + ErrCnt[Serious] == 0)
   1797 			&& ( ErrCnt[Defect] > 0)) {
   1798 			printf("The arithmetic diagnosed may be Acceptable\n");
   1799 			printf("despite inconvenient Defects.\n");
   1800 			}
   1801 		if ((ErrCnt[Failure] + ErrCnt[Serious]) > 0) {
   1802 			printf("The arithmetic diagnosed has ");
   1803 			printf("unacceptable Serious Defects.\n");
   1804 			}
   1805 		if (ErrCnt[Failure] > 0) {
   1806 			printf("Potentially fatal FAILURE may have spoiled this");
   1807 			printf(" program's subsequent diagnoses.\n");
   1808 			}
   1809 		}
   1810 	else {
   1811 		printf("No failures, defects nor flaws have been discovered.\n");
   1812 		if (! ((RMult == Rounded) && (RDiv == Rounded)
   1813 			&& (RAddSub == Rounded) && (RSqrt == Rounded))) 
   1814 			printf("The arithmetic diagnosed seems Satisfactory.\n");
   1815 		else {
   1816 			if (StickyBit >= One &&
   1817 				(Radix - Two) * (Radix - Nine - One) == Zero) {
   1818 				printf("Rounding appears to conform to ");
   1819 				printf("the proposed IEEE standard P");
   1820 				if ((Radix == Two) &&
   1821 					 ((Precision - Four * Three * Two) *
   1822 					  ( Precision - TwentySeven -
   1823 					   TwentySeven + One) == Zero)) 
   1824 					printf("754");
   1825 				else printf("854");
   1826 				if (IEEE) printf(".\n");
   1827 				else {
   1828 					printf(",\nexcept for possibly Double Rounding");
   1829 					printf(" during Gradual Underflow.\n");
   1830 					}
   1831 				}
   1832 			printf("The arithmetic diagnosed appears to be Excellent!\n");
   1833 			}
   1834 		}
   1835 	if (fpecount)
   1836 		printf("\nA total of %d floating point exceptions were registered.\n",
   1837 			fpecount);
   1838 	printf("END OF TEST.\n");
   1839 	return 0;
   1840 	}
   1841 
   1842 /*SPLIT subs.c
   1843 #include "paranoia.h"
   1844 */
   1845 
   1846 /* Sign */
   1847 
   1848 FLOAT Sign (X)
   1849 FLOAT X;
   1850 { return X >= 0. ? 1.0 : -1.0; }
   1851 
   1852 /* Pause */
   1853 
   1854 Pause()
   1855 {
   1856 #ifndef NOPAUSE
   1857 	char ch[8];
   1858 
   1859 	printf("\nTo continue, press RETURN");
   1860 	fflush(stdout);
   1861 	read(KEYBOARD, ch, 8);
   1862 #endif
   1863 	printf("\nDiagnosis resumes after milestone Number %d", Milestone);
   1864 	printf("          Page: %d\n\n", PageNo);
   1865 	++Milestone;
   1866 	++PageNo;
   1867 	}
   1868 
   1869  /* TstCond */
   1870 
   1871 TstCond (K, Valid, T)
   1872 int K, Valid;
   1873 char *T;
   1874 { if (! Valid) { BadCond(K,T); printf(".\n"); } }
   1875 
   1876 BadCond(K, T)
   1877 int K;
   1878 char *T;
   1879 {
   1880 	static char *msg[] = { "FAILURE", "SERIOUS DEFECT", "DEFECT", "FLAW" };
   1881 
   1882 	ErrCnt [K] = ErrCnt [K] + 1;
   1883 	printf("%s:  %s", msg[K], T);
   1884 	}
   1885 
   1886 /* Random */
   1887 /*  Random computes
   1888      X = (Random1 + Random9)^5
   1889      Random1 = X - FLOOR(X) + 0.000005 * X;
   1890    and returns the new value of Random1
   1891 */
   1892 
   1893 FLOAT Random()
   1894 {
   1895 	FLOAT X, Y;
   1896 	
   1897 	X = Random1 + Random9;
   1898 	Y = X * X;
   1899 	Y = Y * Y;
   1900 	X = X * Y;
   1901 	Y = X - FLOOR(X);
   1902 	Random1 = Y + X * 0.000005;
   1903 	return(Random1);
   1904 	}
   1905 
   1906 /* SqXMinX */
   1907 
   1908 SqXMinX (ErrKind)
   1909 int ErrKind;
   1910 {
   1911 	FLOAT XA, XB;
   1912 	
   1913 	XB = X * BInvrse;
   1914 	XA = X - XB;
   1915 	SqEr = ((SQRT(X * X) - XB) - XA) / OneUlp;
   1916 	if (SqEr != Zero) {
   1917 		if (SqEr < MinSqEr) MinSqEr = SqEr;
   1918 		if (SqEr > MaxSqEr) MaxSqEr = SqEr;
   1919 		J = J + 1.0;
   1920 		BadCond(ErrKind, "\n");
   1921 		printf("sqrt( %.17e) - %.17e  = %.17e\n", X * X, X, OneUlp * SqEr);
   1922 		printf("\tinstead of correct value 0 .\n");
   1923 		}
   1924 	}
   1925 
   1926 /* NewD */
   1927 
   1928 NewD()
   1929 {
   1930 	X = Z1 * Q;
   1931 	X = FLOOR(Half - X / Radix) * Radix + X;
   1932 	Q = (Q - X * Z) / Radix + X * X * (D / Radix);
   1933 	Z = Z - Two * X * D;
   1934 	if (Z <= Zero) {
   1935 		Z = - Z;
   1936 		Z1 = - Z1;
   1937 		}
   1938 	D = Radix * D;
   1939 	}
   1940 
   1941 /* SR3750 */
   1942 
   1943 SR3750()
   1944 {
   1945 	if (! ((X - Radix < Z2 - Radix) || (X - Z2 > W - Z2))) {
   1946 		I = I + 1;
   1947 		X2 = SQRT(X * D);
   1948 		Y2 = (X2 - Z2) - (Y - Z2);
   1949 		X2 = X8 / (Y - Half);
   1950 		X2 = X2 - Half * X2 * X2;
   1951 		SqEr = (Y2 + Half) + (Half - X2);
   1952 		if (SqEr < MinSqEr) MinSqEr = SqEr;
   1953 		SqEr = Y2 - X2;
   1954 		if (SqEr > MaxSqEr) MaxSqEr = SqEr;
   1955 		}
   1956 	}
   1957 
   1958 /* IsYeqX */
   1959 
   1960 IsYeqX()
   1961 {
   1962 	if (Y != X) {
   1963 		if (N <= 0) {
   1964 			if (Z == Zero && Q <= Zero)
   1965 				printf("WARNING:  computing\n");
   1966 			else BadCond(Defect, "computing\n");
   1967 			printf("\t(%.17e) ^ (%.17e)\n", Z, Q);
   1968 			printf("\tyielded %.17e;\n", Y);
   1969 			printf("\twhich compared unequal to correct %.17e ;\n",
   1970 				X);
   1971 			printf("\t\tthey differ by %.17e .\n", Y - X);
   1972 			}
   1973 		N = N + 1; /* ... count discrepancies. */
   1974 		}
   1975 	}
   1976 
   1977 /* SR3980 */
   1978 
   1979 SR3980()
   1980 {
   1981 	do {
   1982 		Q = (FLOAT) I;
   1983 		Y = POW(Z, Q);
   1984 		IsYeqX();
   1985 		if (++I > M) break;
   1986 		X = Z * X;
   1987 		} while ( X < W );
   1988 	}
   1989 
   1990 /* PrintIfNPositive */
   1991 
   1992 PrintIfNPositive()
   1993 {
   1994 	if (N > 0) printf("Similar discrepancies have occurred %d times.\n", N);
   1995 	}
   1996 
   1997 /* TstPtUf */
   1998 
   1999 TstPtUf()
   2000 {
   2001 	N = 0;
   2002 	if (Z != Zero) {
   2003 		printf("Since comparison denies Z = 0, evaluating ");
   2004 		printf("(Z + Z) / Z should be safe.\n");
   2005 		sigsave = sigfpe;
   2006 		if (setjmp(ovfl_buf)) goto very_serious;
   2007 		Q9 = (Z + Z) / Z;
   2008 		printf("What the machine gets for (Z + Z) / Z is  %.17e .\n",
   2009 			Q9);
   2010 		if (FABS(Q9 - Two) < Radix * U2) {
   2011 			printf("This is O.K., provided Over/Underflow");
   2012 			printf(" has NOT just been signaled.\n");
   2013 			}
   2014 		else {
   2015 			if ((Q9 < One) || (Q9 > Two)) {
   2016 very_serious:
   2017 				N = 1;
   2018 				ErrCnt [Serious] = ErrCnt [Serious] + 1;
   2019 				printf("This is a VERY SERIOUS DEFECT!\n");
   2020 				}
   2021 			else {
   2022 				N = 1;
   2023 				ErrCnt [Defect] = ErrCnt [Defect] + 1;
   2024 				printf("This is a DEFECT!\n");
   2025 				}
   2026 			}
   2027 		sigsave = 0;
   2028 		V9 = Z * One;
   2029 		Random1 = V9;
   2030 		V9 = One * Z;
   2031 		Random2 = V9;
   2032 		V9 = Z / One;
   2033 		if ((Z == Random1) && (Z == Random2) && (Z == V9)) {
   2034 			if (N > 0) Pause();
   2035 			}
   2036 		else {
   2037 			N = 1;
   2038 			BadCond(Defect, "What prints as Z = ");
   2039 			printf("%.17e\n\tcompares different from  ", Z);
   2040 			if (Z != Random1) printf("Z * 1 = %.17e ", Random1);
   2041 			if (! ((Z == Random2)
   2042 				|| (Random2 == Random1)))
   2043 				printf("1 * Z == %g\n", Random2);
   2044 			if (! (Z == V9)) printf("Z / 1 = %.17e\n", V9);
   2045 			if (Random2 != Random1) {
   2046 				ErrCnt [Defect] = ErrCnt [Defect] + 1;
   2047 				BadCond(Defect, "Multiplication does not commute!\n");
   2048 				printf("\tComparison alleges that 1 * Z = %.17e\n",
   2049 					Random2);
   2050 				printf("\tdiffers from Z * 1 = %.17e\n", Random1);
   2051 				}
   2052 			Pause();
   2053 			}
   2054 		}
   2055 	}
   2056 
   2057 notify(s)
   2058 char *s;
   2059 {
   2060 	printf("%s test appears to be inconsistent...\n", s);
   2061 	printf("   PLEASE NOTIFY KARPINKSI!\n");
   2062 	}
   2063 
   2064 /*SPLIT msgs.c */
   2065 
   2066 /* Instructions */
   2067 
   2068 msglist(s)
   2069 char **s;
   2070 { while(*s) printf("%s\n", *s++); }
   2071 
   2072 Instructions()
   2073 {
   2074   static char *instr[] = {
   2075 	"Lest this program stop prematurely, i.e. before displaying\n",
   2076 	"    `END OF TEST',\n",
   2077 	"try to persuade the computer NOT to terminate execution when an",
   2078 	"error like Over/Underflow or Division by Zero occurs, but rather",
   2079 	"to persevere with a surrogate value after, perhaps, displaying some",
   2080 	"warning.  If persuasion avails naught, don't despair but run this",
   2081 	"program anyway to see how many milestones it passes, and then",
   2082 	"amend it to make further progress.\n",
   2083 	"Answer questions with Y, y, N or n (unless otherwise indicated).\n",
   2084 	0};
   2085 
   2086 	msglist(instr);
   2087 	}
   2088 
   2089 /* Heading */
   2090 
   2091 Heading()
   2092 {
   2093   static char *head[] = {
   2094 	"Users are invited to help debug and augment this program so it will",
   2095 	"cope with unanticipated and newly uncovered arithmetic pathologies.\n",
   2096 	"Please send suggestions and interesting results to",
   2097 	"\tRichard Karpinski",
   2098 	"\tComputer Center U-76",
   2099 	"\tUniversity of California",
   2100 	"\tSan Francisco, CA 94143-0704, USA\n",
   2101 	"In doing so, please include the following information:",
   2102 #ifdef Single
   2103 	"\tPrecision:\tsingle;",
   2104 #else
   2105 	"\tPrecision:\tdouble;",
   2106 #endif
   2107 	"\tVersion:\t10 February 1989;",
   2108 	"\tComputer:\n",
   2109 	"\tCompiler:\n",
   2110 	"\tOptimization level:\n",
   2111 	"\tOther relevant compiler options:",
   2112 	0};
   2113 
   2114 	msglist(head);
   2115 	}
   2116 
   2117 /* Characteristics */
   2118 
   2119 Characteristics()
   2120 {
   2121 	static char *chars[] = {
   2122 	 "Running this program should reveal these characteristics:",
   2123 	"     Radix = 1, 2, 4, 8, 10, 16, 100, 256 ...",
   2124 	"     Precision = number of significant digits carried.",
   2125 	"     U2 = Radix/Radix^Precision = One Ulp",
   2126 	"\t(OneUlpnit in the Last Place) of 1.000xxx .",
   2127 	"     U1 = 1/Radix^Precision = One Ulp of numbers a little less than 1.0 .",
   2128 	"     Adequacy of guard digits for Mult., Div. and Subt.",
   2129 	"     Whether arithmetic is chopped, correctly rounded, or something else",
   2130 	"\tfor Mult., Div., Add/Subt. and Sqrt.",
   2131 	"     Whether a Sticky Bit used correctly for rounding.",
   2132 	"     UnderflowThreshold = an underflow threshold.",
   2133 	"     E0 and PseudoZero tell whether underflow is abrupt, gradual, or fuzzy.",
   2134 	"     V = an overflow threshold, roughly.",
   2135 	"     V0  tells, roughly, whether  Infinity  is represented.",
   2136 	"     Comparisions are checked for consistency with subtraction",
   2137 	"\tand for contamination with pseudo-zeros.",
   2138 	"     Sqrt is tested.  Y^X is not tested.",
   2139 	"     Extra-precise subexpressions are revealed but NOT YET tested.",
   2140 	"     Decimal-Binary conversion is NOT YET tested for accuracy.",
   2141 	0};
   2142 
   2143 	msglist(chars);
   2144 	}
   2145 
   2146 History()
   2147 
   2148 { /* History */
   2149  /* Converted from Brian Wichmann's Pascal version to C by Thos Sumner,
   2150 	with further massaging by David M. Gay. */
   2151 
   2152   static char *hist[] = {
   2153 	"The program attempts to discriminate among",
   2154 	"   FLAWs, like lack of a sticky bit,",
   2155 	"   Serious DEFECTs, like lack of a guard digit, and",
   2156 	"   FAILUREs, like 2+2 == 5 .",
   2157 	"Failures may confound subsequent diagnoses.\n",
   2158 	"The diagnostic capabilities of this program go beyond an earlier",
   2159 	"program called `MACHAR', which can be found at the end of the",
   2160 	"book  `Software Manual for the Elementary Functions' (1980) by",
   2161 	"W. J. Cody and W. Waite. Although both programs try to discover",
   2162 	"the Radix, Precision and range (over/underflow thresholds)",
   2163 	"of the arithmetic, this program tries to cope with a wider variety",
   2164 	"of pathologies, and to say how well the arithmetic is implemented.",
   2165 	"\nThe program is based upon a conventional radix representation for",
   2166 	"floating-point numbers, but also allows logarithmic encoding",
   2167 	"as used by certain early WANG machines.\n",
   2168 	"BASIC version of this program (C) 1983 by Prof. W. M. Kahan;",
   2169 	"see source comments for more history.",
   2170 	0};
   2171 
   2172 	msglist(hist);
   2173 	}
   2174 
   2175 double
   2176 pow(x, y) /* return x ^ y (exponentiation) */
   2177 double x, y;
   2178 {
   2179 	extern double exp(), frexp(), ldexp(), log(), modf();
   2180 	double xy, ye;
   2181 	long i;
   2182 	int ex, ey = 0, flip = 0;
   2183 
   2184 	if (!y) return 1.0;
   2185 
   2186 	if ((y < -1100. || y > 1100.) && x != -1.) return exp(y * log(x));
   2187 
   2188 	if (y < 0.) { y = -y; flip = 1; }
   2189 	y = modf(y, &ye);
   2190 	if (y) xy = exp(y * log(x));
   2191 	else xy = 1.0;
   2192 	/* next several lines assume >= 32 bit integers */
   2193 	x = frexp(x, &ex);
   2194 	if (i = ye) for(;;) {
   2195 		if (i & 1) { xy *= x; ey += ex; }
   2196 		if (!(i >>= 1)) break;
   2197 		x *= x;
   2198 		ex *= 2;
   2199 		if (x < .5) { x *= 2.; ex -= 1; }
   2200 		}
   2201 	if (flip) { xy = 1. / xy; ey = -ey; }
   2202 	return ldexp(xy, ey);
   2203 }