Trailing-Edge
-
PDP-10 Archives
-
decus_20tap4_198111
-
decus/20-0134/d0aa.fcl
There is 1 other file named d0aa.fcl in the archive. Click here to see a list.
C FOCAL INSTRUCTION TEST D0AA
C THIS TEST WILL CONSIST OF SEVERAL PAGES EACH WITH DIFFERENT TESTS.
C PAGE 1
TYPE %8.04;SET DUMMY=FOCAL(1,-1)+FOCAL(2,-1)+FOCAL(3,-1)
C -TEST CORE EXPANSION FOR PROGRAM TEXT.
01.01 C - LINE ONE POINT OH ONE.
01.02 C - LINE ONE POINT OH TWO.
01.04 QUIT TO AVOID ERROR.
01.03 CHECK THAT THIS PRESERVES THE ABOVE LINE.
01.05 Z- SHOULD NEVER COME HERE.
GO
1.01 1.02 1.03 1.04 1.05 1.06 1.07 1.08 1.09 1.10 1.11 1.12 1.13 1.14 1.15 1.16 1.17 1.18 1.19 1.20 1.21 1.22 1.23 1.24 1.25 1.26 1.27 1.28 1.29 1.30 1.31 1.32 1.33 1.34 1.35 1.36 1.37 1.38 1.39 1.40 1.41 1.42 1.43 1.44
GO
C -TEST CORE EXPANSION FOR VARIABLES.
FOR I=1,512;SET X(I)=I
1.01 IF(X(I)-I) 1.9,1.2,1.9
1.2 RETURN
1.9 OPERATE OUTPUT TTY: ;TYPE "?",!, "?CORE EXPANSION FAILURE FOR "?I?!;Z
FOR I=1,512;DO 1.01
C - TEST CORE EXPANSION FOR DISK INITIALIZATION.
ERASE ALL
01.01 IF (FOCAL(102)-2) 1.02,1.1,1.8;CHECK OUTPUT CHANNEL.
01.02 IF (-FABS(FOCAL(102)))1.8;X FOCAL(9,9);C SET FLAG 9 FOR "TTY: OUTPUT"
01.10 IF (FOCAL(103)-3) 1.9,1.2,1.9;CHECK INPUT CHANNEL.
01.80 Z - D0AA WORKS CORRECTLY ONLY FOR OUTPUT ON CHANNEL 2 (FILE) OR CHANNEL 0 (TTY:).
01.90 Z - D0AA WORKS CORRECTLY ONLY FOR INPUT ON CHANNEL 3.
01.20 IF (FOCAL(36)-FOCAL(80)+FOCAL(174)-63) 1.3;COUNT SPACE AND TRY FOR 100 OCTAL WORDS.
01.21 S I=I+1,X(I)=I;G 1.2 ;CONTINUE FILLING CORE UNTIL 100 OCTAL OR SO WORDS REMAIN.
01.30 OPERATE OUTPUT DSK:CH4TMP/4
01.31 IF (FOCAL(36)-FOCAL(80)+FOCAL(174)-191) 1.4 ;COUNT SPACE AND TRY FOR 300 OCTAL WORDS.
01.32 S I=I+1,X(I)=I;G 1.31
01.40 OPERATE OUTPUT DSK:CH5TMP/5
01.41 FOR I=1,3200; X FCHR(I)
01.42 O O TTY:/4;O O TTY:/5;TYPE /0;IF(-FOCAL(9,9))1.43;X FOCAL(9,-1);TYPE /2;C - RELEASE I/O CHANNELS.
01.43 O I DSK:CH5TMP.LST/4
01.44 FOR J=1,3200/128;FOR I=1,127;S Q=FCHR(-1);IF -FABS(I-Q) 1.7
01.45 IF FCHR(-1)+1 ,1.47;Z - END-OF-FILE FCHR FAILURE.
01.47 O I TTY:/4;ASK/3;L D CH4TMP.LST;L D CH5TMP.LST;GOTO 2.01
01.70 Z - ERROR IN DISK I/O.
02.01 C - TEST SYMBOL TABLE STABILITY.
02.05 ERASE
02.10 IF FOCAL(36)-FOCAL(176),2.2;Z - .JBREL NOT EQUAL SYMTBH
02.20 IF FOCAL(174)-FOCAL(175),2.3;Z - SYMTBL NOT EQUAL SYMTBC
02.30 RETURN
DO ALL
ERASE
X (-1)^.5+(-1)^.4+(-1)^.6+(-1)^.500000000001+(-1)^.499999999999
C PAGE 2 - LOGIC TESTS
ERASE ALL
1.01 Z - CHECK THIS GETS OVERWRITTEN.
1.06 Z - CHECK THIS GETS OVERWRITTEN.
1.01 C - LOGIC TEST.
1.02 GO TO 1.06;CHECK UPPER CASE "T".
1.04 Z
1.06 GO tO 1.10;CHECK LOWER CASE "t".
1.08 Z
1.10 gOTO 1.14;CHECK LOWER CASE "g".
1.12 Z
1.14 GZAZBZAZDZEZFZGZHZIZJZKZLZMZNZOZPZQZRZSZTZUZVZWZXZYZZ 1.18
1.16 Z;CHECK UPPER CASE LETTERS ARE ALPHANUMERIC.
1.18 gzazbzczdzezfzgzhzizjzkzlzmznzozpzqzrzsztzuzvzwzxzyzz 1.22
1.20 Z;CHECK LOWER CASE LETTERS ARE ALPHANUMERIC.
1.22 S B01=B23,B45=B67,B89=0;G 1.26;CHECK NUMERICS ARE ALPHANUMERIC.
1.24 Z
1.26 GO TO 1.30;CHECK TAB SEPARATORS.
1.28 Z
1.30 CHECK SUPERFLUOUS SPACES.
1.32 E 1.01 , 1.01
1.34 GO TO 1.38 ;
1.36 Z ;
1.38 IF ( -1 ) 1.42 , 1.40 , 1.40 ;
1.40 Z
1.42 IF ( -1 + 0 ) 1.46 ;Z ;Z
1.44 Z
1.46 IF ( +0 ) 1.48 , 1.50 , 1.48 Z
1.48 Z - MODIFY COMMAND CHECKOUT - PLEASE IGNORE ...
1.50 IF ( +1 +0 ) 1.52 , 1.52 , 1.54 Z
1.52 NOW IS THE TIME FOR ALL GOOD MEN TO COME TO THE AID OF THE PARTY.
1.54 IF (+1)1.56,1.56 ;GO TO 1.58 Z
1.56 Z - THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG.
1.58 LIBRA SAVE TMPTMP.TMP 1.01 , 1.05 , 1.03 ; LIBRA CALL TMPTMP.TMP ; L D TMPTMP.TMP
1.59 IF (-FABS(FOCAL(103)-3)) 1.60;SET I=FOCAL(9,9);X FOCAL(9,I);IF (FABS(FOCAL(102)+I-1)) ,1.61
1.60 Z - LIBRA CALL OR SAVE DESTROYS INCHN OR OUTCHN.
1.61 OPERATE OUTPUT DSK:TMPTMP.TMP/4
1.62 MODIFY 1.48 ; MODIFY 1.52 , 1.56
1.64 FOR I=1;TYPE I!
1.66 FOR I=2,10;TYPE I!
1.68 FOR I=1,.2,3;TYPE I!
1.70 FOR I=1,5;TYPE !;FOR J=1,5;TYPE I*J," "
1.72 SET X = 1 + 2 - 3 / 4 * 5 ^ 6 ** 7 ;
1.73 TYPE %8.04 /4 %E16.10 /4 ;
1.74 OPERATE OUTPUT TTY:/4;TYPE/0;IF(-FOCAL(9,9))1.75;X FOCAL(9,-1);TYPE /2
1.75 L D TMPTMP.TMP
1.76 S X=1 , Y = 2
1.78 WRITE 3 , 03.00 , 3. , 03 , 03. , 03.0 , 3.0 , 3.00 ;
1.80 ASK X , Y , Z ;
1.82 S V=2,Y=FOCAL(1,0),Z(V)=1
1.84 S W=FOCAL( 1 , Z ( V ) ) ; IF( 1+W ) 1.86,1.88,1.86
1.86 Z
1.88 CONTINUE
1.90 CONTINUE
1.92 S XX(1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1)=1264
1.94 I(XX(7,7,7,7,7,7)-XX(3,3,3,3,3,3,3,3,3)) 1.96,1.98,1.96
1.96 Z - MULTIPLE SUBSCRIPTING FAILS.
1.98 I(XX(63,63,63) - 1264 ) 1.96,2.01,1.96
2.01 S XX(1,1)=XX(2^18-1)
2.02 I(XX(1+2^9)-1264) 1.96,2.04,1.96
2.04 S PI=4*ATAN(1)
2.06 IF(PI*2-PI-PI) 2.08,2.10,2.08
2.08 Z - ROUNDING ERROR IN MULTIPLY-BY-2.
2.10 CONTINUE
2.12 IF 5=5 ;GO TO 2.16
2.14 Z - LOGICAL IF FAILED.
2.16 IF 5#5 ;Z - LOGICAL IF FAILED.
2.18 IF 5=4 ;Z - LOGICAL IF FAILED.
2.20 IF 5#4 ;GO TO 2.24
2.22 Z - LOGICAL IF FAILED.
2.24 IF 5 .EQ. 5 ;GO TO 2.28
2.26 Z - LOGICAL IF FAILED.
2.28 IF 5 .NE. 5 ;Z - LOGICAL IF FAILED.
2.30 IF 5 .EQ.4 ;Z - LOGICAL IF FAILED.
2.32 IF 5 .NE. 4 ;GO TO 2.36
2.34 Z - LOGICAL IF FAILED.
2.36 I 5 .EQ.5;I 5 .NE.4;I 5=5;I 5#4;I 5 .LE.5;I 5 .LE.6;I 5 .LT.6;I 5 .GE.5;I 5 .GE.4;I 5 .GT.4; GO TO 2.40
2.38 Z - LOGICAL IF FAILED.
2.40 IF 5 .LE. 4 ;Z - LOGICAL IF FAILED.
2.42 IF 5 .LT. 4 ;Z - LOGICAL IF FAILED.
2.44 IF 5 .LT. 5 ;Z - LOGICAL IF FAILED.
2.46 IF 5 .GE. 6 ;Z - LOGICAL IF FAILED.
2.48 IF 5 .GT. 5 ;Z - LOGICAL IF FAILED.
2.50 IF 5 .GT. 6 ;Z - LOGICAL IF FAILED.
2.52 IF 5 .LE.-4 ;Z - LOGICAL IF FAILED.
2.60 I"A".EQ."A";I"A".NE."B";I"A"="A";I"A"#"B";I"A".LE."A";I"A".LE."B";I"A".LT."B";I"A".GE."A";I"B".GT."A";I"AA".GT."A";I"AA".GE."A";I"AA".NE."A";I"AA"#"A";I"A".LT."AA";I"A".LE."AA";I"A".NE."AA";I"A"#"AA";GO TO 2.64
2.62 Z - LOGICAL IF STRING COMPARISONS FAILED.
2.64 IF"B".LE."A";Z - LOGICAL IF FAILED
2.66 IF"B".LT."A";Z - LOGICAL IF FAILED
2.68 IF"B".LT."B";Z - LOGICAL IF FAILED
2.70 IF"B".GE."C";Z - LOGICAL IF FAILED
2.72 IF"B".GT."B";Z - LOGICAL IF FAILED
2.74 IF"B".GT."C";Z - LOGICAL IF FAILED
2.76 IF"A".EQ."B";Z - LOGICAL IF FAILED
2.78 IF"A"= "B";Z - LOGICAL IF FAILED
2.80 IF"A".NE."A";Z - LOGICAL IF FAILED
2.81 IF"A" # "A";Z - LOGICAL IF FAILED
2.84 IF"AA".LE."A";Z - LOGICAL IF FAILED
2.86 IF"AA".LT."A";Z - LOGICAL IF FAILED
2.88 IF"AA".LT."AA";Z - LOGICAL IF FAILED
2.90 IF"AA".GE."C";Z - LOGICAL IF FAILED
2.92 IF"AA".GT."AA";Z - LOGICAL IF FAILED
2.94 IF"AA".GT."C";Z - LOGICAL IF FAILED
2.96 IF"AA".EQ."A";Z - LOGICAL IF FAILED
2.98 IF"AA" = "A";Z - LOGICAL IF FAILED
20.01 C - 'FOR' TESTS
20.02 S REP=4;FOR X=-2,2;FOR INC=-2,2;DO 20.7
20.04 IF -FABS(X-3) 20.95;IF -FABS(INC-3) 20.95;GOTO 20.06
20.06 FOR F=-3,3;FOR INC=-0.35,.1,.3;DO 20.8
20.08 SET C=0;FOR MM=1,5;GOTO 20.82
20.10 IF(C-5) 20.95,20.12,20.95
20.12 CONTINUE
20.40 GOTO 20.99
20.70 IF FABS(INC) 20.75,20.75;DO 20.8;IF INC*(Y-END) 20.95;RETURN
20.75 RETURN
20.80 S END = X+INC*REP,W=X ; FOR Y=X,INC,END;DO 20.9
20.82 SET C=C+1
20.90 IF -FABS(W-Y) 20.95;S W=W+INC
20.95 O O TTY:;T$;Z - ERROR IN 'FOR'.
20.99 C - END OF 'FOR' TESTS.
DO ALL
QQ11 2 3
COMMENT - ABOVE ARE FOR THE MODIFY COMMANDS AT 1.62 AND ASK COMMAND AT 1.48.
C PAGE 3 - MODIFY COMMAND
ERASE ALL,
OPERATE OUTPUT TMPTMP.LST/5
21.01 ZET D
21.02 SET W=23.;ZET X=5.2
21.03 SET X=77;ZET U=89.66
21.04 SET Q=5;Z-CATASTROPHE
21.06 21.06 Z - CHECK ERASE / INSERT
21.07 ERASE 21.07 Z CHECK ERASE
21.08 DO 21.09 Z CHECK MODIFY
21.09 MODIFY 21.08,21.09 Z!
21.10 Z--ZZ;#-) 21.4,21.2,21.4
21.20 C-FIFTH LINE
21.30 IF (D-4.63) 21.4,21.5,21.4
21.40 Z - CATASTROPHE IN MODIFY TESTS
21.45 ?THIS WILL BE MODIFIED TO REMOVE THE ?'S.
21.50 IF (X-5.2) 21.4,21.6,21.4
21.55 Z - NOW IS THE TIME ETC.
21.60 IF(Y-4.532) 21.4,21.7,21.4
21.70 IF (W-23) 21.4,21.8,21.4
21.80 IF (U-89.66) 21.4,21.82,21.4
21.82 OPERATE OUTPUT TTY:/5
21.85 CHECK LINE 21.45
21.86 L S TMPTMP.LST;OPERATE INPUT TMPTMP.LST/5
21.87 S X=FCHR(-1);IF FABS(63-X) 21.89,21.89;IF(X-39) 21.87,21.94,21.87
21.89 Z - THIS PROGRAM STILL HAS ? IN LINE 21.45
21.94 A /3;T /0;IF(-FOCAL(9,9))21.95;X FOCAL(9,-1);TYPE /2;Q
21.95 QUIT
21.05 Z-CAUSE A BLANK ENTRY IN THE INDEX TABLE! DELETE THIS LINE -
21.05
MODIFY 21.01
ZS
MODIFY 21.01
D=4.63
MODIFY 21.02
ZSET Y=4.532;S
MODIFY 21.03
ZS
MODIFY 21.04
;
MODIFY 21.1
#IF (Q-5
MODIFY 21.55;C - TO MAKE A NULL LINE.
DO 21.55
MODIFY 21.3
Z
MODIFY 21.45;CHECK QUESTION MARKS ARE NOT DELETED.
MODIFY 21.45
?Z - ERROR IN MODIFY - QUESTION MARKS ARE DELETED.
MODIFY 21.45;CHECK WE CAN REMOVE INITIAL QUESTION MARKS BY MODIFY.
?C
Z - CHECK THAT SECOND QUESTION MARK WAS FOUND.
DO ALL
QF
LIBRARY DELETE TMPTMP.LST
ERASE ALL
C PAGE 4 - WRITE COMMAND DIAGNOSTIC
C CHECK THAT 'WRITE' WRITES QUESTION MARKS O.K.
01.05 F S=1,18;X FCHR(-1)
01.08 DO 9.2
01.10 S S=34;D 9;S S=75;D 9;S S=83;D 9;O I TTY:/4;A/3;L D TMPTMP.LST;QUIT
01.23 CHECK THIS "?" AND IS THIS OK? OR THIS?
09.10 IF (FCHR(-1)-S) 9.1,9.2,9.1
09.20 S NEX=FCHR(-1);IF (NEX-63) 9.3,9.4,9.3
09.30 Z - BAD MATCH IN WRITE TEST
09.40 RETURN
O O TMPTMP.LST/4
TYPE "CAN YOU CHECK THIS?"!
WRITE 0
O O TTY:/4;T/0;O I TMPTMP.LST/4;DO ALL
ERASE ALL
1.1 TYPE /0;IF(-FOCAL(9,9))1.43;X FOCAL(9,-1);TYPE /2
1.43 QUIT
DO ALL
ERASE ALL
C PAGE 5 - INPUT ROUTINE DIAGNOSTIC
ERASE ALL
23.1 S PI=3.14159265;A PI ; IF (PI-3.14159265) 23.2,23.3,23.2
23.2 Z - ALTMODE ON 'ASK' FAILED
23.3 A X,Y;IF (-FABS(X-742)) 23.4;IF(Y-123456789) 23.4,23.5
23.4 Z - 'ASK' INPUT FAILURE
23.5 A X; IF (X-0.12346789) 23.6,23.7,23.6
23.6 Z - ASK INPUT OF LETTERS FAILURE
23.7 A X;IF(X+63) 23.8,23.9,23.8
23.8 Z - ASK DATA NEGATIVE FAILURE
23.9 A X; IF (+FABS(X+3.473E+6)) 23.05,23.92;Z - ASK ERROR
23.92 RETURN
DO ALL
43.65742 123456789
.ABCDFGHI
-63
-3.473E+6
ERASE ALL
1.01 IF(25.-25) 7.01,1.02,8.01
1.02 IF(25-2.5E1) 7.02,1.03,8.02
1.03 IF(3.0-3.E+0) 7.03,1.04,8.03
1.04 IF(123.456-123.456E-00) 7.04,1.05,8.04
1.05 RETURN
7.01 Z
7.02 Z
7.03 Z
7.04 Z
8.01 Z
8.02 Z
8.03 Z
8.04 Z
DO ALL
C - PAGE 6 ARITHMETIC TESTS
ERASE ALL
C-FOCAL v4(261)-1 1659 4-Aug-74
20.01 ERASE;SET X=1+2^(-58),NB=27
20.02 IF(FOCAL(FOCAL(36)-2))20.08,20.05;IF(FOCAL(FOCAL(36)-1)) 20.05,20.06,20.07
20.05 Z - COME HERE IF NOT DECSYSTEM-10.
20.06 SET NB=54;GO TO 20.10;KA-10 DOUBLE PRECISION.
20.07 SET NB=62;GO TO 20.10;KI-10 DOUBLE PRECISION.
20.08 SET NB=27;GO TO 20.10;C - SINGLE PRECISION.
20.10 SET PI=2*FATN(2^(NB+4))
20.11 SET DR=1;IF-FABS(PI/4-PI*(1/4))20.12;SET DR=0;C - DIVISION-ROUNDING ALLOWANCE.
20.12 SET PS=2^(14-NB);C - SMALL PERTURBATION.
20.13 SET PL=2^(5-NB/2);C - LARGE PERTURBATION.
20.15 SET NR=8;C - MAXIMUM ALLOWABLE NUMBER OF STEPS IN REDUCTION FORMULA.
20.20 SET NS=FITR(NB/2-6);C - MAXIMUM ALLOWABLE NUMBER OF STEPS IN SERIES FORMULA.
20.30 SET FL2=FLOG(2);CONSTANT IS HANDY TO SAVE RE-COMPUTATION ALL THE TIME.
20.40 ERASE 37,38
21.14 IF FCOS(-PI/2) 21.17,21.15;Z
21.15 S N=21.15,X=360,YE=0,YO=FSIND(X),DYDX=PI/180;D 39
21.16 IF FCOSD(-90) 21.17,21.20;Z
21.17 Z - ERROR IN FCOS OR FCOSD.
21.20 37.10 S DYDX=FCOS(X)
21.22 38.10 S YO=FSIN(X)
21.24 S N=21.24,X=1.467,YE=+FSIN(1.467);DO 37,38,39
21.26 S N=21.26,X=-.1239,YE=-FSIN(.1239);DO 37,38,39
21.28 S N=21.28,X=2*PI+PS,YE=+PS;DO 37,38,39
21.30 S N=21.30,X=2*PI-PS,YE=-PS;DO 37,38,39
21.32 S N=21.32,X=PI+PS,YE=-PS;DO 37,38,39
21.34 S N=21.34,X=PI-PS,YE=+PS;DO 37,38,39
21.36 S N=21.28,X=PI/2+PS,YE=+(1-PS^2/2);DO 37,38,39
21.38 S N=21.38,X=PI/2+PS,YE=+FSIN(PI/2-PS);DO 37,38,39
21.40 S N=21.40,X=PI/2+PS,YE=-FSIN(3*PI/2+PS);DO 37,38,39
21.42 S N=21.42,X=3*PI/2+PS,YE=+FSIN(3*PI/2-PS);DO 37,38,39
21.46 S N=21.46,X=PI/2+PL,YE=+(1-PL*PL/2);DO 37,38,39
21.48 S N=21.48,X=PI/2+PL,YE=+FSIN(PI/2-PL);DO 37,38,39
21.50 S N=21.50,X=3*PI/2+PL,YE=-FSIN(PI/2+PL);DO 37,38,39
21.52 S N=21.52,X=3*PI/2-PL,YE=+FSIN(3*PI/2+PL);DO 37,38,39
21.54 S N=21.54,X=PI/4-PS,YE=+.5^.5*(1-PS);DO 37,38,39
21.56 S N=21.56,X=PI/4+PS,YE=+.5^.5*(1+PS);DO 37,38,39
21.58 S N=21.58,X=3*PI/4-PS,YE=+FSIN(PI/4+PS);DO 37,38,39
21.60 S N=21.60,X=3*PI/4+PS,YE=+FSIN(PI/4-PS);DO 37,38,39
21.62 S N=21.62,X=5*PI/4-PS,YE=-FSIN(PI/4-PS);DO 37,38,39
21.64 S N=21.64,X=5*PI/4+PS,YE=-FSIN(PI/4+PS);DO 37,38,39
21.66 S N=21.66,X=7*PI/4-PS,YE=-FSIN(PI/4+PS);DO 37,38,39
21.68 S N=21.68,X=7*PI/4+PS,YE=-FSIN(PI/4-PS);DO 37,38,39
21.70 S N=21.70,X=PI/8,YE=((1-.5^.5)/2)^.5;DO 37,38,39
21.72 S N=21.72,X=3*PI/8,YE=+FSIN(PI/8)*(1+2*.5^.5);DO 37,38,39
21.74 S N=21.74,X=5*PI/8,YE=+FSIN(3*PI/8);DO 37,38,39
21.76 S N=21.76,X=7*PI/8,YE=+FSIN(PI/8);DO 37,38,39
21.78 S N=21.78,X=9*PI/8,YE=-FSIN(PI/8);DO 37,38,39
21.80 S N=21.80,X=11*PI/8,YE=-FSIN(3*PI/8);DO 37,38,39
21.82 S N=21.82,X=13*PI/8,YE=-FSIN(3*PI/8);DO 37,38,39
21.84 S N=21.84,X=15*PI/8,YE=-FSIN(PI/8);DO 37,38,39
21.86 37.10 S DYDX=2*FSIN(2*X)
21.88 38.10 S YO=FSIN(X)^2+FCOS(X)^2
21.92 38.20 S YE=1
21.93 S N=21.93;F X=.001,.001,.01;DO 37,38,39
21.94 S N=21.94;F X=.01, .01, .1 ;DO 37,38,39
21.95 S N=21.95;F X=.1, .1, 1 ;DO 37,38,39
21.96 S N=21.96;F X=1, 1, 10 ;DO 37,38,39
21.97 S N=21.97;F X=10, 10, 100 ;DO 37,38,39
22.01 C Logarithm test.
22.04 37.10 S DYDX=2/X
22.06 38.10 S YO=FLOG(X*(1+PS))+FLOG(X/(1+PS))
22.10 38.20 S YE=2*FLOG(X)
22.20 S N=22.20;F I=1,16.5;S X=1+I/16;DO 37,38,39
22.22 S N=22.22;F W=-3,3;F Z=1.3,15;S X=Z*10^W;DO 37,38,39
22.30 ERASE 37,38
22.31 37.1 S DYDX=2
22.32 38.1 S YE=0,YO=FLOG(FEXP(X))-X
22.33 F X=-70,3.14159265,+84;DO 37,38,39
23.01 IF (FABS(0)) 7.01,23.02;Z-CATASTROPHE - NON-ZERO RESULT
23.02 IF (FABS(1-1)) 7.02,23.03;Z-CATASTROPHE - NON-ZERO RESULT
23.03 IF (FABS(1*0)) 7.03,23.04;Z-CATASTROPHE - NON-ZERO RESULT
23.04 IF (FABS(0*1)) 7.04,23.05;Z-CATASTROPHE - NON-ZERO RESULT
23.05 IF (FABS(3^3-27)) 7.05,23.06;Z-CATASTROPHE - NON-ZERO RESULT
23.06 IF (FABS((+1)-(+1))) 7.06,23.07;Z-CATASTROPHE - NON-ZERO RESULT
23.07 IF (FABS(((+1)+(-1)))) 7.07,23.08;Z-CATASTROPHE - NON-ZERO RESULT
23.08 IF (FABS((-1+1)-(1-1))) 7.08,23.09;Z-CATASTROPHE - NON-ZERO RESULT
23.09 IF (FABS((2*3)-(3*2))) 7.09,23.10;Z-CATASTROPHE - NON-ZERO RESULT
23.10 IF (FABS(0/1)) 7.10,23.11;Z-CATASTROPHE - NON-ZERO RESULT
23.11 IF (FABS(0^5)) 7.11,23.12;Z-CATASTROPHE - NON-ZERO RESULT
23.12 IF (1) 23.13,23.13,23.14
23.13 Z-CATASTROPHE - (1) IS NOT POSITIVE!
23.14 IF (-1) 23.15;Z-CATASTROPHE - (-1) IS NOT NEGATIVE!
23.15 SET RADIUS=23.652;IF (FABS(RAD-23.652)) 7.15,23.16;Z-CATASTROPHE
23.16 S X=(1-(1+2^(-40))*(1/(1+2^(-40))));IF (X-2^(2-NB)) 23.17,23.17;Z
23.17 CONTINUE
24.01 C DATAN TEST
24.02 ERASE 37,38
24.04 37.10 S DYDX=2/(1+X^2)
24.06 38.10 S YO=FATN(X)+FATN(-X),YE=0
24.08 S N=24.08;D 24.90
24.10 38.10 S YO=FATN(X)+FATN(1/X),YE=FSGN(X)*PI/2
24.15 S N=24.15;D 24.90
24.20 38.10 S YO=FATN(X)-FATN((X*3^.5-1)/(X+3^.5)),YE=PI/6
24.22 37.10 S DYDX=(1+FABS(1-X*3^.5)/4+FABS(3+X*3^.5)/4)/(1+X^2)
24.25 S N=24.25;D 24.90
24.30 GO TO 24.99
24.90 S Z=(3)^.5*2^(-27);D 24.92;S Z=2-3^.5;D 24.92;S Z=1;D 24.92
24.92 S ZZ=Z^2;D 24.94;S ZZ=Z;D 24.94
24.94 S ZZZ=ZZ-PL;D 24.96;S ZZZ=ZZ;D 24.96;S ZZZ=ZZ+PL;D 24.96
24.96 S X=ZZZ-PS;D 24.98;S X=ZZZ;D 24.98;S X=ZZZ+PS;D 24.98
24.98 D 37,38,39
24.99 CONTINUE AFTER CONCLUSION OF DATAN TESTS.
25.01 C EXPONENTIATION TEST.
25.02 IF (1/2-0.5),25.04;Z
25.03 Z - EXPONENTIATION TEST FAILURE.
25.04 IF (1/2-2^(-1)),25.05;Z
25.05 IF (1/2-(1/2)^1),25.06;Z
25.06 IF (FSQT(1.000001)-(1.000001)^.5),25.08;Z
25.08 IF (FSQT(1.0000000000001)-(1.0000000000001)^.5),25.10;Z
25.10 37.10 S DYDX=FEXP(X)
25.12 38.10 S YO=FEXP(X),YE=0;F Z=22,-1,1;S YE=1+X*YE/Z
25.14 S N=25.14;F X=0,1/8,1;D 37,38,39
25.16 S N=25.16;F X=PL,1/8,1;D 37,38,39
25.18 S N=25.18;F X=-PL,1/8,1;D 37,38,39
25.20 S N=25.20;F X=PS,1/8,1;D 37,38,39
25.22 S N=25.22;F X=-PS,1/8,1;D 37,38,39
25.24 IF FEXP(0)-1 ,25.26,
25.26 IF 2^26-67108864,25.28,
25.28 IF (2^26*2^(-26)-1),25.99,
25.99 CONTINUE
26.01 C FHIBER TEST
26.02 S X=FHIBER(1);IF X,26.03;IF X-1,26.03,
26.03 S X=GETTAB(9,8);X FHIBER(5000);S X=GETTAB(9,8)-X;IF X-249,
27.01 C ERROR INCREMENT TEST.
27.02 S I=FOCAL(34);X GETTAB(9,8);IF I-FOCAL(34) ,27.04,
27.04 X GETTAB(99,99);IF I-FOCAL(34)+1 ,27.06,
27.06 S X=FOCAL(3,3);X FLOG(0),FOCAL(3,X);IF I-FOCAL(34)+2 ,27.08,
27.08 CONTINUE
29.99 QUIT
37.01 C DERIVATIVE OF FUNCTION WRT X.
38.01 C OBSERVED VALUE OF FUNCTION.
39.01 CHECK THAT YO AND YE AGREE WITHIN TOLERANCE.
39.02 C - THIS METHOD IS NOT VALID IF YE DEPENDS ON X.
39.03 C - IF YO HAS X OCCURRING MORE THAN ONCE, THEN DYDX MUST BE THE SUM
39.04 C - OF THE MAGNITUDES OF THE DERIVATIVES OF YO WITH RESPECT TO
39.05 C - EACH OCCURRENCE OF X.
39.10 S VS=0;I FABS(YE) 39.2,39.2;S VS=NS*2^(FITR(FLOG(YE)/FL2)-NB)
39.20 S VR=0;I FABS(X) 39.3,39.3;S VR=NR*FABS(DYDX)*2^(FITR(FLOG(X)/FL2)-NB)
39.30 I -FABS(YO-YE)+VR+VS 39.4;RETURN
39.40 I VR-VS 39.5
39.41 TYPE "?"!"?INACCURACY IN REDUCTION FORMULA CORRESPONDING TO"!
39.42 TYPE "ARGUMENT DIFFERENCE OF",%8,FABS(YO-YE)*NR/VR," IN LSB"!
39.43 G 39.7
39.50 TYPE "?"!"?INACCURACY IN POWER SERIES FORMULA OF"
39.52 TYPE %8,FABS(YO-YE)*NS/VS," IN LSB"!
39.70 TYPE "?ACCURACY FAILURE ON LINE"%4.02,N!
39.80 TYPE %%E18.16,?X?!?YE?!?YO?!
39.90 TYPE $$;Z
DO ALL
C PAGE 8 LIBRARY SAVE/CALL TEST
E,A
01.10 O O DSK:CH4.TMP/4;TYPE "1.99 C";F X=1,1024;TYPE "ABCDE"
01.20 O O TTY:/4;L C CH4.TMP;S X=FOCAL(36);L C CH4.TMP;S X=FOCAL(36)-X
01.30 IF X ,1.4;Z - SUCCESSIVE LIBRA CALLS OF SAME PROGRAM CAUSE CORE EXPANSION.
01.40 L D CH4.TMP;IF 1#1+2^(-30);IF 1=1+2^(-58); QUIT IF KA-10 DOUBLE PRECISION.
01.50 L D CH4.BAK;X FOCAL(3,3);C - SUPPRESS NON-FATAL ERROR MESSAGES.
01.60 S X=FOCAL(34);L C CH4.TMP;IF X#FOCAL(34)-1;Z - NON-FATAL LIBRA CALL FAILED TO COUNT.
01.70 L S CH4.TMP;L C CH4.TMP;IF X#FOCAL(34)-1;Z - NO ERROR HERE.
01.80 L C CH4.BAK;IF X#FOCAL(34)-2;Z - STILL NO .BAK FILE.
01.87 L S CH4.TMP;L C CH4.BAK;IF X#FOCAL(34)-2;Z .BAK FILE NOT CREATED.
01.89 L D CH4.TMP;L D CH4.BAK
GO
C WRITE A FILE THEN READ IT BACK
ERASE ALL
1.1 RETURN
LIBRARY SAVE FOCAL.TMP
ERASE ALL
1.1 Z - THIS NEVER GOT OVERWRITTEN!
LIBRARY CALL FOCAL.TMP
LIBRARY DELETE FOCAL.TMP
GO
C PAGE 9 - CHECK OF MULTI-CHANNEL I/O.
CHANNELS 2 AND 3 MAY BE IN USE BY THE TEST PROGRAM ITSELF!
O O DSK:CH4.TMP/4
O O DSK:CH5.TMP/5
O O DSK:CH6.TMP/6
O O DSK:CH7.TMP/7
O O DSK:CH8.TMP/8
O O DSK:CH9.TMP/9
O O DSK:CH10.TMP/10
O O DSK:CH11.TMP/11
O O DSK:CH12.TMP/12
O O DSK:CH13.TMP/13
O O DSK:CH14.TMP/14
O O DSK:CH15.TMP/15
TYPE /4,"1.12 GO TO 1.15"!
SET I=FOCAL(2,2);CAUSE SUPPRESSION OF EQUALS TYPE-OUT.
FOR I=1.13,.01,1.50;T %4.02,I," Z"!
TYPE 1.48," QUIT"!
TYPE /5,"1.15 GO TO 1.18"!
TYPE /6,"1.18 GO TO 1.21"!
TYPE /7,"1.21 GO TO 1.24"!
TYPE /8,"1.24 GO TO 1.27"!
TYPE /9,"1.27 GO TO 1.30"!
TYPE /10,"1.30 GO TO 1.33"!
TYPE /11,"1.33 GO TO 1.36"!
TYPE /12,"1.36 GO TO 1.39"!
TYPE /13,"1.39 GO TO 1.42"!
TYPE /14,"1.42 GO TO 1.45"!
TYPE /15,"1.45 GO TO 1.48"!
O O TTY:CH4.TMP/4
O O TTY:CH5.TMP/5
O O TTY:CH6.TMP/6
O O TTY:CH7.TMP/7
O O TTY:CH8.TMP/8
O O TTY:CH9.TMP/9
O O TTY:CH10.TMP/10
O O TTY:CH11.TMP/11
O O TTY:CH12.TMP/12
O O TTY:CH13.TMP/13
O O TTY:CH14.TMP/14
O O TTY:CH15.TMP/15
E A
L C CH4.TMP;L C CH5.TMP;L C CH6.TMP;L C CH7.TMP;L C CH8.TMP;L C CH9.TMP
L C CH10.TMP;L C CH11.TMP;L C CH12.TMP;L C CH13.TMP;L C CH14.TMP;L C CH15.TMP
L D CH4.TMP;L D CH5.TMP;L D CH6.TMP;L D CH7.TMP;L D CH8.TMP;L D CH9.TMP
L D CH10.TMP;L D CH11.TMP;L D CH12.TMP;L D CH13.TMP;L D CH14.TMP;L D CH15.TMP
GO
C - RANDOM NUMBER TEST.
ERASE ALL
ERASE
01.01 C- ACCURACY OF INTERNAL NUMBERS ...
01.02 S X=FOCAL(1,1)+FOCAL(2,2),X=1,DX=1
01.03 S M=N,DX=DX/2,Y=X+DX;D 31;IF (N-1000) 1.03
01.04 S LSB=M+8;C-THE BIT NUMBER OF THE LEAST SIGNIFICANT BIT.
01.10 C - SORT INTO BINS ACCORDING TO VALUE OF EACH BINARY BIT.
01.11 F BIT=9,20;S BIN(BIT)=-50
01.12 F X=1,100;S Y=FRAN;F BIT=9,20;D 3
01.13 F BIT=10,20;IF(15-FABS(BIN(BIT)))1.99
01.40 C - MEASURE SEQUENCE LENGTH.
01.41 F X=1,2000;X FRAN
01.42 SET X=FRAN(0)
01.44 FOR C=1,2000;I FABS(X-FRAN),1.98
01.45 IF(-FABS(FRAN(1)-FRAN(1)))1.99;QUIT
01.98 O O TTY:;T"?"!"?RANDOM NUMBER REPEAT SEQUENCE LENGTH",%5,C;Z
01.99 O O TTY:;T"?"!"?ERROR IN RANDOM NUMBER GENERATOR"!%3$;Z
03.10 S Y=Y*2-1
03.20 I Y 3.3;S BIN(BIT)=BIN(BIT)+1;R
03.30 S Y=Y+1;R
31.10 C- SUBROUTINE TO MEASURE DIFFERENCE BETWEEN X AND Y.
31.11 C- N IS THE NUMBER OF BITS REQUIRED TO SEPARATE X FROM Y.
31.20 SET N=100000;IF (-FABS(X-Y)) 31.3;RETURN
31.30 SET N=1-FLOG(FABS(2*(X-Y)/(X+Y)))/FLOG(2);RETURN
GO
TYPE "END OF D0AA."!
O O TMPTMP.LST;T "L D TMPTMP.LST"!!;O O TTY:;O I TMPTMP.LST;C- EXIT.