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