paranoia.c 55 KB

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