]>
Commit | Line | Data |
---|---|---|
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 | ||
20 | converted to Pascal by: | |
21 | B. A. Wichmann | |
22 | National Physical Laboratory | |
23 | Teddington Middx | |
24 | TW11 OLW | |
25 | UK | |
26 | ||
27 | converted 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 | ||
35 | with simultaneous corrections to the Pascal source (reflected | |
36 | in the Pascal source available over netlib). | |
37 | ||
38 | Reports of results on various systems from all the versions | |
39 | of Paranoia are being collected by Richard Karpinski at the | |
40 | same address as Thos Sumner. This includes sample outputs, | |
41 | bug reports, and criticisms. | |
42 | ||
43 | You may copy this program freely if you acknowledge its source. | |
44 | Comments on the Pascal version to NPL, please. | |
45 | ||
46 | ||
47 | The C version catches signals from floating-point exceptions. | |
48 | If signal(SIGFPE,...) is unavailable in your environment, you may | |
49 | #define NOSIGNAL to comment out the invocations of signal. | |
50 | ||
51 | This source file is too big for some C compilers, but may be split | |
52 | into pieces. Comments containing "SPLIT" suggest convenient places | |
53 | for 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 | ||
56 | By #defining Single when you compile this source, you may obtain | |
57 | a single-precision C version of Paranoia. | |
58 | ||
59 | ||
60 | The following is from the introductory commentary from Wichmann's work: | |
61 | ||
62 | The BASIC program of Kahan is written in Microsoft BASIC using many | |
63 | facilities which have no exact analogy in Pascal. The Pascal | |
64 | version below cannot therefore be exactly the same. Rather than be | |
65 | a minimal transcription of the BASIC program, the Pascal coding | |
66 | follows the conventional style of block-structured languages. Hence | |
67 | the Pascal version could be useful in producing versions in other | |
68 | structured languages. | |
69 | ||
70 | Rather than use identifiers of minimal length (which therefore have | |
71 | little mnemonic significance), the Pascal version uses meaningful | |
72 | identifiers as follows [Note: A few changes have been made for C]: | |
73 | ||
74 | ||
75 | BASIC 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 | ||
112 | All the variables in BASIC are true variables and in consequence, | |
113 | the program is more difficult to follow since the "constants" must | |
114 | be determined (the glossary is very helpful). The Pascal version | |
115 | uses Real constants, but checks are added to ensure that the values | |
116 | are correctly converted by the compiler. | |
117 | ||
118 | The major textual change to the Pascal version apart from the | |
119 | identifiersis that named procedures are used, inserting parameters | |
120 | wherehelpful. New procedures are also introduced. The | |
121 | correspondence is as follows: | |
122 | ||
123 | ||
124 | BASIC Pascal | |
125 | lines | |
126 | ||
127 | 90- 140 Pause | |
128 | 170- 250 Instructions | |
129 | 380- 460 Heading | |
130 | 480- 670 Characteristics | |
131 | 690- 870 History | |
132 | 2940-2950 Random | |
133 | 3710-3740 NewD | |
134 | 4040-4080 DoesYequalX | |
135 | 4090-4110 PrintIfNPositive | |
136 | 4640-4850 TestPartialUnderflow | |
137 | ||
138 | =*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*=*= | |
139 | ||
140 | Below is an "ed script" that splits para.c into 10 files | |
141 | of the form part[1-8].c, subs.c, and msgs.c, plus a header | |
142 | file, paranoia.h, that these files require. | |
143 | r 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 | |
196 | 1,/^#include/-1d | |
197 | 1,$w part1.c | |
198 | /Computed constants/,$d | |
199 | 1,$s/^int/extern &/ | |
200 | 1,$s/^FLOAT/extern &/ | |
201 | 1,$s! = .*!;! | |
202 | /^Guard/,/^Round/s/^/extern / | |
203 | /^jmp_buf/s/^/extern / | |
204 | /^Sig_type/s/^/extern / | |
205 | a | |
206 | extern int sigfpe(); | |
207 | . | |
208 | w paranoia.h | |
209 | q | |
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 | |
224 | extern 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 | |
236 | extern 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 | |
246 | extern 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 | ||
261 | jmp_buf ovfl_buf; | |
262 | typedef int (*Sig_type)(); | |
263 | Sig_type sigsave; | |
264 | ||
265 | #define KEYBOARD 0 | |
266 | ||
267 | FLOAT Radix, BInvrse, RadixD2, BMinusU2; | |
268 | FLOAT Sign(), Random(); | |
269 | ||
270 | /*Small floating point constants.*/ | |
271 | FLOAT Zero = 0.0; | |
272 | FLOAT Half = 0.5; | |
273 | FLOAT One = 1.0; | |
274 | FLOAT Two = 2.0; | |
275 | FLOAT Three = 3.0; | |
276 | FLOAT Four = 4.0; | |
277 | FLOAT Five = 5.0; | |
278 | FLOAT Eight = 8.0; | |
279 | FLOAT Nine = 9.0; | |
280 | FLOAT TwentySeven = 27.0; | |
281 | FLOAT ThirtyTwo = 32.0; | |
282 | FLOAT TwoForty = 240.0; | |
283 | FLOAT MinusOne = -1.0; | |
284 | FLOAT OneAndHalf = 1.5; | |
285 | /*Integer constants*/ | |
286 | int 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 | |
305 | typedef int Guard, Rounding, Class; | |
306 | typedef char Message; | |
307 | ||
308 | /* Declarations of Variables */ | |
309 | int Indx; | |
310 | char ch[8]; | |
311 | FLOAT AInvrse, A1; | |
312 | FLOAT C, CInvrse; | |
313 | FLOAT D, FourD; | |
314 | static FLOAT E0, E1, Exp2, E3, MinSqEr; | |
315 | FLOAT SqEr, MaxSqEr, E9; | |
316 | FLOAT Third; | |
317 | FLOAT F6, F9; | |
318 | FLOAT H, HInvrse; | |
319 | int I; | |
320 | FLOAT StickyBit, J; | |
321 | FLOAT MyZero; | |
322 | FLOAT Precision; | |
323 | FLOAT Q, Q9; | |
324 | FLOAT R, Random9; | |
325 | FLOAT T, Underflow, S; | |
326 | FLOAT OneUlp, UfThold, U1, U2; | |
327 | FLOAT V, V0, V9; | |
328 | FLOAT W; | |
329 | FLOAT X, X1, X2, X8, Random1; | |
330 | static FLOAT Y, Y1, Y2, Random2; | |
331 | FLOAT Z, PseudoZero, Z1, Z2, Z9; | |
332 | int ErrCnt[4]; | |
333 | int fpecount; | |
334 | int Milestone; | |
335 | int PageNo; | |
336 | int M, N, N1; | |
337 | Guard GMult, GDiv, GAddSub; | |
338 | Rounding RMult, RDiv, RAddSub, RSqrt; | |
339 | int 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 */ | |
346 | sigfpe() | |
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 | ||
362 | FLOAT Ptemp; | |
363 | ||
364 | pnum( x ) | |
365 | FLOAT *x; | |
366 | { | |
367 | char str[30]; | |
368 | double d; | |
369 | unsigned short *p; | |
370 | int i; | |
371 | ||
372 | p = (unsigned short *)x; | |
373 | for( i=0; i<NPRT; i++ ) | |
374 | printf( "%04x ", *p++ & 0xffff ); | |
375 | #ifdef Ldouble | |
376 | e64toasc( x, str, 20 ); | |
377 | #else | |
378 | #ifdef Single | |
379 | e24toasc( x, str, 20 ); | |
380 | #else | |
381 | e53toasc( x, str, 20 ); | |
382 | #endif | |
383 | #endif | |
384 | printf( " = %s\n", str ); | |
385 | /* | |
386 | d = *x; | |
387 | printf( " = %.16e\n", d ); | |
388 | */ | |
389 | } | |
390 | ||
391 | ||
392 | ||
393 | main() | |
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" | |
471 | part2(){ | |
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" | |
713 | part3(){ | |
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\ | |
767 | or 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" | |
945 | part4(){ | |
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" | |
1147 | part5(){ | |
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" | |
1367 | part6(){ | |
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" | |
1599 | part7(){ | |
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; | |
1736 | overflow: | |
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" | |
1839 | part8(){ | |
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 | ||
1998 | FLOAT Sign (X) | |
1999 | FLOAT X; | |
2000 | { return X >= 0. ? 1.0 : -1.0; } | |
2001 | ||
2002 | /* Pause */ | |
2003 | ||
2004 | Pause() | |
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 | ||
2021 | TstCond (K, Valid, T) | |
2022 | int K, Valid; | |
2023 | char *T; | |
2024 | { if (! Valid) { BadCond(K,T); printf(".\n"); } } | |
2025 | ||
2026 | BadCond(K, T) | |
2027 | int K; | |
2028 | char *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 | ||
2043 | FLOAT 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 | ||
2058 | SqXMinX (ErrKind) | |
2059 | int 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 | ||
2085 | NewD() | |
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 | ||
2100 | SR3750() | |
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 | ||
2117 | IsYeqX() | |
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 | ||
2142 | SR3980() | |
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 | ||
2155 | PrintIfNPositive() | |
2156 | { | |
2157 | if (N > 0) printf("Similar discrepancies have occurred %d times.\n", N); | |
2158 | } | |
2159 | ||
2160 | /* TstPtUf */ | |
2161 | ||
2162 | TstPtUf() | |
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)) { | |
2179 | very_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 | ||
2232 | notify(s) | |
2233 | char *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 | ||
2243 | msglist(s) | |
2244 | char **s; | |
2245 | { while(*s) printf("%s\n", *s++); } | |
2246 | ||
2247 | Instructions() | |
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 | ||
2266 | Heading() | |
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 | ||
2294 | Characteristics() | |
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 | ||
2321 | History() | |
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 | } |