diff --git a/lang/a68s/test/complex.8 b/lang/a68s/test/complex.8 new file mode 100644 index 000000000..1014eafe9 --- /dev/null +++ b/lang/a68s/test/complex.8 @@ -0,0 +1,118 @@ +00050 .PR POINT .PR +00100 (.LOC .COMPL X,Y:=3 .I 2,Z:=3 .I (-2) +00110 ;.LOC .REAL A +00120 ;.LOC .FILE RESULTS +00130 ;.LOC [1:10] .COMPL A1,A2,A3,A4,A5,A6 +00140 ;.LOC .STRUCT(.COMPL S,T) S1,S2,S3,S4,S5,S6 +00150 ;OPEN(RESULTS,"RESULTS",STAND OUT CHANNEL) +00160 ;PUT(RESULTS,(Y,NEWLINE,Z,NEWLINE)) +00170 ;.FOR I .TO 10 .DO A1[I]:=A2[I]:=A3[I]:=A4[I]:=A5[I]:=A6[I]:=I .I (I+1) .OD +00180 ;S1:=S2:=S3:=S4:=S5:=S6:=(1 .I 1,4 .I 4) +00190 ;X:=Y+Z +00200 ;PUT(RESULTS,(X,NEWLINE)) +00210 ;X:=Y+3.14159 .I 1.23456789 +00220 ;PUT(RESULTS,(X,NEWLINE)) +00230 ;X:=Y+9.87654321 +00240 ;PUT(RESULTS,(X,NEWLINE)) +00250 ;X:=Y-Z +00260 ;PUT(RESULTS,(X,NEWLINE)) +00270 ;X:=Y-3.14159 .I 1.23456789 +00280 ;PUT(RESULTS,(X,NEWLINE)) +00290 ;X:=Y*Z +00300 ;PUT(RESULTS,(X,NEWLINE)) +00310 ;X:=Y*4 .I 3 +00320 ;PUT(RESULTS,(X,NEWLINE)) +00330 ;X:=Y*3.14159 .I 1.23456789 +00340 ;PUT(RESULTS,(X,NEWLINE)) +00350 ;X:=Y/Z +00360 ;PUT(RESULTS,(X,NEWLINE)) +00370 ;X:=Y/4 .I 3 +00380 ;PUT(RESULTS,(X,NEWLINE)) +00390 ;X:=3.14159 .I 1.23456789/Y +00400 ;PUT(RESULTS,(X,NEWLINE)) +00410 ;X:=-X +00420 ;PUT(RESULTS,(X,NEWLINE)) +00430 ;A:=.RE X +00440 ;PUT(RESULTS,(A,NEWLINE)) +00450 ;A:=.IM X +00460 ;PUT(RESULTS,(A,NEWLINE)) +00470 ;X:=.CONJ X +00480 ;PUT(RESULTS,(X,NEWLINE)) +00490 ;A:=.ABS Y +00500 ;PUT(RESULTS,(A,NEWLINE)) +00510 ;A:=.ABS(3.1519 .I 1.23456789) +00520 ;PUT(RESULTS,(A,NEWLINE)) +00530 ;A:=.ABS(0 .I 1.23456789) +00540 ;PUT(RESULTS,(A,NEWLINE)) +00550 ;A:=.ABS(3.1519 .I 0) +00560 ;PUT(RESULTS,(A,NEWLINE)) +00570 ;X:=Y**2 +00580 ;PUT(RESULTS,(X,NEWLINE)) +00590 ;X:=Z**2 +00600 ;PUT(RESULTS,(X,NEWLINE)) +00610 ;X:=Y**5 +00620 ;PUT(RESULTS,(X,NEWLINE)) +00630 ;X:=Y**-1 +00640 ;PUT(RESULTS,(X,NEWLINE)) +00650 ;X:=Y**-3 +00660 ;PUT(RESULTS,(X,NEWLINE)) +00670 ;X:=3.14159 .I 1.23456789**2 +00680 ;PUT(RESULTS,(X,NEWLINE)) +00690 ;X:=3.14159 .I 0**2 +00700 ;PUT(RESULTS,(X,NEWLINE)) +00710 ;X:=0 .I 1.23456789**2 +00720 ;PUT(RESULTS,(X,NEWLINE)) +00730 ;X:=0 .I 0**2 +00740 ;PUT(RESULTS,(X,NEWLINE)) +00750 ;.IF X=Y .THEN PUT(RESULTS,("X=Y",NEWLINE)) .FI +00760 ;PUT(RESULTS,(X,NEWLINE)) +00770 ;X:=Y +00780 ;.IF X=Y .THEN PUT(RESULTS,("X=Y",NEWLINE)) .FI +00790 ;PUT(RESULTS,(X,NEWLINE)) +00800 ;.IF X/=Y .THEN PUT(RESULTS,("X/=Y",NEWLINE)) .FI +00810 ;PUT(RESULTS,(X,NEWLINE)) +00820 ;X:=Z +00830 ;.IF X/=Y .THEN PUT(RESULTS,("X/=Y",NEWLINE)) .FI +00840 ;PUT(RESULTS,(X,NEWLINE)) +00850 ;X+:=Y +00860 ;PUT(RESULTS,(X,NEWLINE)) +00870 ;X-:=Y +00880 ;PUT(RESULTS,(X,NEWLINE)) +00890 ;X*:=Y +00900 ;PUT(RESULTS,(X,NEWLINE)) +00910 ;X/:=Y +00920 ;PUT(RESULTS,(X,NEWLINE)) +00930 ;A:=.ARG(4 .I 3) +00940 ;PUT(RESULTS,(A,NEWLINE)) +00950 ;A:=.ARG(4 .I -3) +00960 ;PUT(RESULTS,(A,NEWLINE)) +00970 ;A:=.ARG(-4 .I -3) +00980 ;PUT(RESULTS,(A,NEWLINE)) +00990 ;A:=.ARG(-4 .I 3) +01000 ;PUT(RESULTS,(A,NEWLINE)) +01010 ;A:=.ARG(3.14159 .I 1.23456789) +01020 ;PUT(RESULTS,(A,NEWLINE)) +01030 ;A:=.ARG(0 .I 1.23456789) +01040 ;PUT(RESULTS,(A,NEWLINE)) +01050 ;A:=.ARG(3.14159 .I 0) +01060 ;PUT(RESULTS,(A,NEWLINE)) +01070 ;A1[1]+:=Y +01080 ;PUT(RESULTS,(A1[1],A2[1],NEWLINE)) +01090 ;A2[2]-:=Y +01100 ;PUT(RESULTS,(A2[2],A3[2],NEWLINE)) +01110 ;A3[3]*:=Y +01120 ;PUT(RESULTS,(A3[3],A4[3],NEWLINE)) +01130 ;A4[4]/:=Y +01140 ;PUT(RESULTS,(A4[4],A5[4],NEWLINE)) +01150 ;.FOR I .TO 10 .DO PUT(RESULTS,(A6[I],NEWLINE)) .OD +01160 ;S .OF S1+:=Y +01170 ;PUT(RESULTS,(S .OF S1,S .OF S2,NEWLINE)) +01180 ;S .OF S2-:=Y +01190 ;PUT(RESULTS,(S .OF S2,S .OF S3,NEWLINE)) +01200 ;T .OF S3*:=Y +01210 ;PUT(RESULTS,(T .OF S3,T .OF S4,NEWLINE)) +01220 ;T .OF S4/:=Y +01230 ;PUT(RESULTS,(T .OF S4,T .OF S5,NEWLINE)) +01240 ;PUT(RESULTS,(S .OF S6,T .OF S6,NEWLINE)) +01250 ;CLOSE(RESULTS) +01260 ) diff --git a/lang/a68s/test/cousins.8 b/lang/a68s/test/cousins.8 new file mode 100644 index 000000000..c85b972e8 --- /dev/null +++ b/lang/a68s/test/cousins.8 @@ -0,0 +1,203 @@ +00050 .PR POINT .PR +00100 .COMMENT SISTERS, COUSINS AND AUNTS - MODEL SOLUTION .COMMENT +00120 ( .MODE .PERSON = .STRUCT(.STRING NAME, .BOOL SEX, .INT COUNT, .BITS UP +00130 , .REF .PERSON PA, MA, NEXTHASH) +00140 ; .REF .PERSON NOBODY = .NIL +00150 ; .INT HASHSIZE = 43 +00152 ; .INT BITSWIDTH = (MAXINT=32767!16!32) +00160 ; .LOC [0:HASHSIZE-1] .REF .PERSON HASHTABLE +00170 # PERSONS HASHING TO THE SAME HASHTABLE ELEMENT WILL BE CHAINED +00180 USING THE 'NEXTHASH' FIELD # +00190 ; .FOR I .FROM 0 .TO HASHSIZE-1 +00200 .DO HASHTABLE[I] := NOBODY .OD +00210 ; .BOOL MALE = .TRUE, FEMALE = .FALSE, CHECK = .TRUE, NOCHECK = .FALSE +00220 ; .PROC HASHIN = (.STRING NAME, .BOOL SEX, CHECK).REF .PERSON: +00230 # RETURNS EXISTING .REF .PERSON FROM HASHTABLE (CHECKING EXISTING SEX IF 'CHECK'), +00240 OR CREATES A NEW ONE AS REQUIRED. +00250 AN EMPTY 'NAME' RETURNS 'NOBODY' # +00260 .IF NAME="" +00270 .THEN NOBODY +00280 .ELSE .LOC .INT HASHNO := 0 +00290 ; .FOR I .TO .UPB NAME +00300 .DO HASHNO +:= .ABS NAME[I] .OD +00310 ; .LOC .REF .REF .PERSON PTR := HASHTABLE[HASHNO .MOD HASHSIZE] +00320 # NOTE USE OF THE "3 REF TRICK" # +00330 ; .WHILE (PTR .IS NOBODY ! .FALSE ! NAME .OF PTR /= NAME) +00340 .DO PTR := NEXTHASH .OF PTR .OD +00350 ; .IF PTR .IS NOBODY +00360 .THEN .REF .REF .PERSON (PTR) := .HEAP .PERSON := +00370 ( NAME, SEX, 0, .SKIP, NOBODY, NOBODY, NOBODY) +00380 .ELIF SEX .OF PTR = SEX .OR .NOT CHECK +00390 .THEN PTR +00400 .ELSE PRINT((NAME, " SEEMS TO HAVE CHANGED SEX", NEWLINE)) +00410 ; NOBODY +00420 .FI +00430 .FI +00440 ; .BEGIN # INPUT OF FAMILIES # +00450 .LOC .STRING FATHER, MOTHER, CHILD +00460 ; .LOC .REF .PERSON PA, MA, INFANT +00470 ; .LOC .CHAR SD # TO HOLD "S" FOR SON, OR "D" FOR DAUGHTER # +00480 ; .LOC .BOOL SEX # .TRUE FOR MALE # +00482 ; CLOSE(STANDIN) +00484 ; OPEN(STANDIN, "sisters", STAND IN CHANNEL) +00490 ; ON PAGE END(STAND IN, (.REF .FILE F).BOOL: (NEWPAGE(F); .GOTO RELATIONSHIP)) +00500 ; MAKE TERM(STAND IN, ",;.") +00510 ; RESTART: +00520 ( .PROC COMPLAIN = (.STRING MESSAGE).VOID: +00530 # IGNORES REMAINDER OF CURRENT LINE, AND RESTARTS INPUT LOOP # +00540 ( PRINT((MESSAGE, NEWLINE)) +00550 ; READ(NEWLINE) +00560 ; .GOTO RESTART +00570 ) +00580 ; .PROC EXPECT = (.CHAR E).VOID: +00590 # ABSORBS NEXT CHARACTER, COMPLAINING IF IT IS NOT AS EXPECTED # +00600 ( .LOC .CHAR C +00610 ; READ(C) +00620 ; .IF C/=E +00630 .THEN COMPLAIN(C+" FOUND INSTEAD OF "+E) +00640 .FI +00650 ) +00660 ; READ(FATHER); EXPECT(",") +00670 ; PA := HASHIN(FATHER, MALE, CHECK) +00680 ; READ(MOTHER); EXPECT(";") +00690 ; MA := HASHIN(MOTHER, FEMALE, CHECK) +00700 # IF FATHER(MOTHER) IS NOT SPECIFIED, 'NOBODY' GETS ASSIGNED TO PA(MA) # +00710 ; .IF (PA .IS NOBODY) .AND (MA .IS NOBODY) +00720 .THEN COMPLAIN("BOTH PARENTS MISSING") +00730 .FI +00740 ; .WHILE READ(SD) +00750 ; SEX := (SD="S" ! MALE !: SD="D" ! FEMALE ! COMPLAIN(SD+" FOUND INSTEAD OF S OR D"); .SKIP) +00760 ; EXPECT("=") +00770 ; READ(CHILD) +00780 ; INFANT := HASHIN(CHILD, SEX, CHECK) +00790 ; .IF INFANT .ISNT NOBODY +00800 .THEN .IF PA .OF INFANT .ISNT NOBODY +00810 .THEN COMPLAIN(CHILD+" ALREADY HAS A FATHER") +00820 .ELSE PA .OF INFANT := PA +00830 .FI +00840 ; .IF MA .OF INFANT .ISNT NOBODY +00850 .THEN COMPLAIN(CHILD+" ALREADY HAS A MOTHER") +00860 .ELSE MA .OF INFANT := MA +00870 .FI +00880 .ELSE COMPLAIN("CHILD'S NAME NOT GIVEN") +00890 .FI +00900 ; READ(SD) +00910 ; SD/="." +00920 .DO .SKIP .OD +00930 ; READ(NEWLINE) +00940 ; .GOTO RESTART +00950 ) +00960 .END # INPUT OF FAMILIES # +00970 ; RELATIONSHIP: +00980 .BEGIN # CHECKING OF RELATIONSHIPS # +00990 .LOC .STRING FIRST, SECOND +01000 ; .LOC .REF .PERSON THIS, THAT +01010 ; .MODE .CHAIN = .STRUCT(.INT UP, DOWN, .REF .CHAIN NEXT) +01020 ; .REF .CHAIN NOCHAIN = .NIL +01030 ; .LOC .REF .CHAIN START CHAIN +01040 ; .PROC INSERT CHAIN = (.INT UP, DOWN).VOID: +01050 ( .LOC .REF .CHAIN PTR := START CHAIN +01060 ; .WHILE (PTR :/=: NOCHAIN ! UP .OF PTR /= UP .OR DOWN .OF PTR /= DOWN ! .FALSE) +01070 .DO PTR := NEXT .OF PTR .OD +01080 ; .IF PTR :=: NOCHAIN .THEN START CHAIN := .HEAP .CHAIN := (UP, DOWN, START CHAIN) .FI +01090 ) +01100 ; .PROC RELATIONS = (.INT UP, DOWN).VOID: +01110 # PRINTS THE RELATIONSHIP BETWEEN 'THIS' AND 'THAT', ACCORDING TO +01120 'UP' AND 'DOWN' # +01130 PRINT((NAME .OF THIS +01140 , ( .PROC GREATS = (.INT N).STRING: N*"GREAT-" +01150 ; " IS THE " + +01160 .CASE UP+1 +01170 .IN .CASE DOWN+1 +01180 .IN "SAME AS " +01190 , (SEX .OF THIS ! "FATHER" ! "MOTHER") + " OF " +01200 .OUT GREATS(DOWN-UP-2) + "GRAND" + (SEX .OF THIS ! "FATHER" ! "MOTHER") + " OF " +01210 .ESAC +01220 , .CASE DOWN+1 +01230 .IN (SEX .OF THIS ! "SON" ! "DAUGHTER") + " OF " +01240 , (SEX .OF THIS ! "BROTHER" ! "SISTER") + " OF " +01250 .OUT GREATS(DOWN-UP-1) + (SEX .OF THIS ! "UNCLE" ! "AUNT") + " OF " +01260 .ESAC +01270 .OUT .CASE DOWN+1 +01280 .IN GREATS(UP-DOWN-2) + "GRAND" + (SEX .OF THIS ! "SON" ! "DAUGHTER") + " OF " +01290 , GREATS(UP-DOWN-1) + (SEX .OF THIS ! "NEPHEW" ! "NIECE") + " OF " +01300 .OUT .INT COUS = (UP SQRT(THE 1000TH PRIME)# +01030 .LOC [1:THOUSAND] .INT P; # TABLE TO CONTAIN PRIMES # +01040 .BEGIN # FILL TABLE P; P[K] WILL BE THE K'TH PRIME # +01050 P[1] := 2; # THE ONLY EVEN PRIME # +01060 .LOC .INT J := 1; # ODD NUMBER, TO BE INCREMENTED AND TESTED FOR PRIMENESS # +01070 .LOC .INT ORD := 1; +01080 #.INVARIANT P[ORD]**2 > J # +01090 .LOC .INT SQUARE := 4; +01100 #.INVARIANT SQUARE = P[ORD]**2 # +01110 .LOC [1:THIRTY] .INT MULT; +01120 #.INVARIANT MULT[N] IS A MULTIPLE OF P[N] FOR 1<=N=2R100,2R0>=2R1,2R100<=2R110,2R1<=2R0,NEWLINE)); +00170 PRINT(("M", 4%3,4.MOD 3,-4%3,-4.MOD 3,4.MOD-3,NEWLINE, +00180 SPACE,6*8,NEWLINE, +00190 "R",.ROUND 2.45,.ROUND 2.55,.ROUND-2.45,.ROUND-2.55,NEWLINE, +00200 SPACE,1.1-2.2,NEWLINE, +00210 "S",.SIGN 3,.SIGN 0,.SIGN-5,.SIGN 3.3,.SIGN 0.0,.SIGN-3.4,NEWLINE)); +00212 PRINT(("H", .ABS(2R101.SHL 1),.ABS(2R101.SHR-1),.ABS(2R101.SHR 1),.ABS(2R101.SHL-1), +00214 .ABS(8R177777.SHL 16),.ABS(8R177777.SHR-16),NEWLINE, +00220 "W",.REAL(2),NEWLINE)); +00230 .LOC.INT I :=1,.LOC.REAL X:=1.0; +00240 PRINT(("B",I+:=2,I%*:=2,I*:=6,I%:=3,I-:=1,NEWLINE, +00250 SPACE,X+:=2,X*:=6,X/:=2,X/:=2.0,X-:=1,NEWLINE)); +00260 .SKIP +00270 .END diff --git a/lang/a68s/test/test.8 b/lang/a68s/test/test.8 new file mode 100644 index 000000000..ffa796640 --- /dev/null +++ b/lang/a68s/test/test.8 @@ -0,0 +1,237 @@ +00050 .PR POINT .PR +00100 .BEGIN +00110 .PRIO .CHECK = 1; +00120 .OP .CHECK = (.INT C, I).VOID: +00130 PRINT((C=I ! (WHOLE(I,0), NEWLINE) ! ("ERROR ", WHOLE(I,0), " SHOULD BE ", WHOLE(C,0), NEWLINE))); +00140 .OP .CHECK = ([] .INT C, A).VOID: +00150 PRINT((.LOC .BOOL FAIL := .FALSE; +00160 .FOR I .FROM .LWB A .TO .UPB A .DO FAIL := FAIL .OR A[I]/=C[I] .OD; +00170 FAIL ! ("ERROR", A, " SHOULD BE", C, NEWLINE) ! ( A, NEWLINE))); +00180 .MODE .R = .STRUCT(.INT O, P, Q); +00190 .MODE .S = .STRUCT(.INT I, J, K, .R R, .REF .INT RI1, RI2); +00200 .MODE .MA = [1:3].INT, .MB = [1:1].R, .MC = [1:2].REF .INT, .MD = [1:3,1:1].S; +00210 .LOC .INT I; +00220 .LOC .REF .INT II := I; +00230 .LOC .R R1; +00240 .LOC .REF .R RR := R1; +00250 .LOC.S S1, S2, S3; +00260 .LOC .MA M1, M2, M3, .LOC .MB MB1, MB2, .LOC .MC MC1, .LOC .MD MD1, MD2; +00270 .REF .R PR = R.OF S1, QR = R.OF S2; +00280 .REF .R PM = MB1[1], QM = MB2[1]; +00290 .REF .REF .INT RRI = RI1 .OF S1; +00300 .REF .REF .INT MMI = MC1[1]; +00310 .REF.INT RI = I.OF S1; +00320 .REF .INT MI = M1[1]; +00330 #NASSTS(REFN)# +00340 I.OF S1 := 1; J.OF S1 := 2; K.OF S1 := 3; +00350 M1[1] := 1; M1[2] := 2; M1[3] := 3; +00360 #NASSTS(REFSE)# +00370 P .OF PR := 4; +00380 4 .CHECK P .OF R .OF S1; +00390 #NASSTS(REFSL1)# +00400 P .OF PM := 4; +00410 4 .CHECK P .OF MB1[1]; +00420 #NASSTP# +00430 R.OF S2 := PR; +00440 4 .CHECK P.OF R.OF S2; +00450 MB2[1] := PM; +00460 4 .CHECK P .OF MB2[1]; +00470 #TASSTS(REFSE)# +00480 RI := 1; +00490 1 .CHECK I.OF S1; +00500 #TASSTS(REFSL1)# +00510 MI := 1; +00520 1 .CHECK M1[1]; +00530 #TASSTS(CREF)# +00540 .REF .INT (II) := 2; +00550 2 .CHECK I; +00560 #TASSTP(REFN), DREFN(REFN)# +00570 S3 := S2 := S1; +00580 3 .CHECK K.OF S3; +00590 #TASSTM(REFR), DREFN(REFR)# +00600 M3 := M2 := M1; +00610 [].INT(1,2,3) .CHECK M3; +00620 #REFSLN:=REFSLN# +00630 M1[1:2] := M1[2:3]; +00640 [].INT(2,3,3) .CHECK M1; +00650 [] .INT MM1 = M1[@2]; +00660 #REFR:=REFSLN# +00670 M2 := MM1[@1]; +00680 M1[3] := 4; #FORCES COPY OF MM1# +00690 [].INT(2,3,3) .CHECK M2; +00700 #REFSLN:=REFR# +00710 M3[@2] := MM1; +00720 [].INT(2,3,3) .CHECK M3; +00730 #TASSTP(REFSE)# +00740 Q.OF R.OF S2 := 2; +00750 PR := QR; +00760 2 .CHECK Q.OF R.OF S1; +00770 #TASSTP(REFSL1)# +00780 MB2 := R .OF S2; #ROWNM# +00790 PM := QM; +00800 2 .CHECK Q .OF MB1[1]; +00810 #NASSNS(REFN)# +00820 I.OF S1 := J.OF S2; +00830 2 .CHECK RI; +00840 #NASSNS(REFR)# +00850 M1[1] := M2[3]; +00860 3 .CHECK MI; +00870 #NASSNS(REFSLN)# +00880 M1[2:3][1] := M1[3]; +00890 [].INT(3,4,4) .CHECK M1; +00900 #NASSNP# +00910 Q.OF R.OF S2 := 1; +00920 R.OF S1 := R.OF S2; +00930 1 .CHECK Q.OF R.OF S1; +00940 Q .OF MB2[1] := 1; +00950 MB1[1] := MB2[1]; +00960 1 .CHECK Q .OF MB1[1]; +00970 #TASSNS# +00980 RI := K.OF S3; +00990 3 .CHECK RI; +01000 MI := M3[3]; +01010 3 .CHECK MI; +01020 #TASSNP(REFN)# +01030 R1 := R.OF S1; +01040 4 .CHECK P.OF R1; +01050 R1 := MB1[1]; +01060 4 .CHECK P .OF R1; +01070 #TASSNP(REFSE)# +01080 O.OF R.OF S3 := 3; +01090 PR := R .OF S3; +01100 3 .CHECK O.OF PR; +01110 #TASSNP(REFSL1)# +01120 O .OF MB2[1] := 3; +01130 PM := MB2[1]; +01140 3 .CHECK O .OF PM; +01150 #TASSNP(CREF)# +01160 .REF .R (RR) := R .OF S3; +01170 3 .CHECK O .OF R1; +01180 .REF .R (RR) := MB2[1]; +01190 3 .CHECK O .OF R1; +01200 #NASSTPT# +01210 RI2.OF S1 := RI; +01220 3 .CHECK RI2.OF S1; +01230 MC1[2] := MI; +01240 3 .CHECK MC1[2]; +01250 #TASSTPT(REFSE)# +01260 RRI := RI; +01270 3 .CHECK RRI; +01280 MMI := MI; +01290 3 .CHECK MMI; +01300 #NASSNRF# +01310 RI2.OF S1 := J.OF S1; +01320 2 .CHECK RI2.OF S1; +01330 MC1[2] := M1[2]; +01340 4 .CHECK MC1[2]; +01350 #TASSNRF# +01360 RRI := O .OF PM; +01370 3 .CHECK RRI; +01380 MMI := M2[@2][2]; +01390 2 .CHECK MMI; +01400 #2# +01410 #STRUCTURE-DISPLAYS# +01420 S1 := (1 #COLLTS# , 2, .SKIP, (3,4,5), RI #COLLTPT# , .NIL); +01430 1 .CHECK I .OF S1; 4 .CHECK P .OF R .OF S1; 1 .CHECK RI1 .OF S1; +01440 S2 := (J .OF S1 #COLLNS#, 3, .SKIP, R .OF S1 #COLLNP#, .SKIP, .SKIP); +01450 2 .CHECK I .OF S2; 3 .CHECK J .OF S2; 4 .CHECK P .OF R .OF S2; +01460 S2 := (J .OF S1 #COLLNS# , 3, .SKIP, R .OF S1 #COLLNP# , J .OF S1 #COLLNRF# , RI1 .OF S1); +01470 2 .CHECK I .OF S2; 3 .CHECK J .OF S2; 4 .CHECK P .OF R .OF S2; 2 .CHECK RI1 .OF S2; 1 .CHECK RI2 .OF S2; +01480 S3 := (1, 2, 3, R1 #COLLTP# , .NIL, .NIL); +01490 4 .CHECK P .OF R .OF S3; +01500 #ROWNM# +01510 MD1[1, ] := S1; MD1[2, ] := S2; MD1[3, ] := S3; +01520 [].INT(1,2,1) .CHECK I .OF MD1[ ,1]; +01530 #INCR- AND DECRSLICE# +01540 MD1[2, ] := MD1[1, ]; +01550 MD2 := MD1; +01560 1 .CHECK RI1 .OF MD2[2,1]; +01570 #ROWM# +01580 .LOC [1:1,1:3] .S MD3; +01590 MD3 := MD2[ ,1]; +01600 [].INT(1,1,1) .CHECK I .OF MD3[1, ]; +01610 #LOC GENERATOR# +01620 II := .LOC .INT := 5; +01630 5 .CHECK II; +01640 .VOID: +01650 .BEGIN +01660 .MODE .CHAIN = .STRUCT(.INT VAL, .REF .CHAIN NEXT); +01670 .LOC .REF .CHAIN START := .LOC .CHAIN; +01680 .REF .CHAIN (START) := +01690 (1, .LOC .CHAIN := (2, .LOC .CHAIN := (3, START))); +01700 .MODE .REFCHAIN = .REF .STRUCT(.INT VAL, .REF .STRUCT(.INT VAL, .REFCHAIN NEXT) NEXT); +01710 .LOC .REFCHAIN P := START; +01720 .FOR I .WHILE I .CHECK VAL .OF P; P := NEXT .OF P; .REF .CHAIN (P) .ISNT START .DO .SKIP .OD; +01730 START := P := .NIL +01740 #THE .CHAIN LOOP IS NOW ISOLATED, AND THE GARBAGE COLLECTOR SHOULD +01750 LOSE IT UPON EXIT FROM THIS ROUTINE# +01760 .END; +01770 .PROC T=.VOID: +01780 (.LOC.INT A:=0 +01790 ;.PROC PC=(.PROC.VOID P).VOID:P +01800 ;.PROC P1=.VOID: +01810 (.PROC P2=.VOID: +01820 (A:=99) +01830 ;PC(P2) +01840 ) +01850 ;PC(P1) +01860 ;99.CHECK A +01870 ) +01880 ;T +01890 ; .LOC .INT III, J := 0 +01900 ; [] .INT A0 = (9,9,9,9) +01910 ; .LOC [0:3] .INT A := A0[@0] +01920 ; START: +01930 III := 0 +01940 ; J +:= 1 +01950 ; .GOTO LOOP +01960 ; III := 1 +01970 ; LOOP: +01980 A[III] := III +01990 ; .IF (III+:=1)=3 +02000 .THEN .LOC .INT Y +02010 ; .GO .TO END +02020 .FI +02030 ; .GOTO LOOP +02040 ; END: +02050 [] .INT(0,1,2,9)[@0] .CHECK A +02060 ; A := A0[@0] +02070 ; .IF J<=1 +02080 .THEN .GOTO START +02090 .FI +02100 ; 2 .CHECK J +02110 ; .PR NOWARN .PR +02120 ( .PROC P = (.STRING S1, .INT I1, .STRING S2, S3).INT: .SKIP +02130 ; 13 .CHECK 4+4+(1+1+.INT(.LOC .INT Y; (.FALSE ! .SKIP ! +02140 1+1+2*2*(.LOC .INT X; .TRUE ! 1+1+2*2*3^2^P(""+"", 2, ""+"", .GOTO L)) +02150 )) +02160 ; L: 5 +02170 ) +02180 ; .FOR I .TO 2 .DO +02190 50.CHECK .ROUND(100*.CASE I.IN SIN,COS.ESAC(PI*I/6)) +02200 .OD +02210 .PR WARN .PR +02220 ; .PROC R = (.PROC .VOID Q, .INT LEVEL, .STRING ST).STRING: +02230 """"+ST+ +02240 ( .STRING TS = ST+"." +02250 ; ( .PROC S = .VOID: +02260 ( .INT L = LEVEL +02270 ; L=5 +02280 ! PRINT((R(.VOID: +02290 ( .LOC .STRING T; T +:= .STRING(.GOTO M)) +02300 , LEVEL+1 +02310 , TS +02320 ), NEWLINE)) +02330 !: LEVEL=10 ! Q +02340 ! PRINT((R(Q, LEVEL+1, TS), NEWLINE)) +02350 ) +02360 ; S +02370 ; ";" +02380 ) +02390 .EXIT +02400 M: "!" +02410 ) +02420 ; PRINT((R(.SKIP, 0, ""), NEWLINE)) +02430 ; .GOTO STOP +02440 ) +02450 .END diff --git a/lang/a68s/test/tp8.8 b/lang/a68s/test/tp8.8 new file mode 100644 index 000000000..b35ba7d2b --- /dev/null +++ b/lang/a68s/test/tp8.8 @@ -0,0 +1,108 @@ +00025 .PR POINT .PR +00050 .COMMENT TRANSPUT TEST .COMMENT +00060 # NEEDS TO BE RUN WITH LARGISH FIELDLENGTH AND REDUCE,- # +00070 .PR NOGO .PR +00110 ( .PROC TWOLINES = (.REF.FILE F).VOID: (NEWLINE(F); NEWLINE(F)) +00112 # A USER-WRITTEN LAYOUT ROUTINE # +00120 ; .LOC.FILE FYLA, FYLB +00130 ; .STRING S = "THIS IS A VERY LONG STRING AND IT WILL USE MORE THAN ONE LINE" +00140 " IN FACT IT WILL PROBABLY USE LOTS OF LINES: IT MAY EVEN GO " +00150 "ONTO MORE THAN ONE PAGE, THEN AGAIN IT MAY NOT. BY GUM THIS " +00160 "IS A VERY LONG STRING; PLEASE STOP WRITING THIS RUBBISH." +00170 , [].CHAR T = "************************************************************" +00180 , U = "THIS IS THE END" +00190 ; .INT K = 9876#54321# +00200 ; .REAL X = 1234.5E4#100#, Y = 67.89E4#100# +00210 ; .COMPL Z = (X, Y) +00220 ; .CHAR CHA = ":", CHB = "<" +00230 ; .BOOL BOOL = .TRUE, BOO = .FALSE +00240 ; .BITS BIT = 2R111100001110001#10010# +00250 ; .BYTES BYT = BYTESPACK("BT") +00252 # # +00254 ; # TEST OF ASSOCIATE # +00260 .LOC .FILE FYLX +00290 ; .INT COLS=30, ROWS=15 +00300 ; .LOC.INT LINENO := 1 +00310 ; .LOC [1:ROWS, 1:COLS].CHAR BUFFER +00320 ; .PROC CLEAR = (.REF [] .CHAR B).VOID: .FOR I .TO .UPB B .DO B[I] := " " .OD +00330 ; .LOC [1:COLS].FILE FF +00340 ; .FOR I .TO COLS +00350 .DO ASSOCIATE(FF[I], BUFFER[ , I]) +00360 ; ON LINE END(FF[I], (.REF.FILE F).BOOL: +00370 ( LINENO +:= 1 +00380 ; ( LINENO+1>COLS +00382 ! (LINENO=COLS ! CLEAR(BUFFER[ , LINENO])) +00390 ; .FOR I .TO ROWS +00400 .DO PUT(STANDOUT, (BUFFER[I, ], NEWLINE)) .OD +00402 ; NEWLINE(STANDOUT) +00410 ; NEWPAGE(STANDOUT) +00420 ; LINENO := 0 +00432 ! CLEAR(BUFFER[ , LINENO]) +00434 ) +00436 ; RESET(FYLX) +00440 ; FYLX := FF[LINENO+:=1] +00450 ; CLEAR(BUFFER[ , LINENO]) +00460 ; .TRUE +00470 )) +00480 .OD +00490 ; FYLX := FF[LINENO] +00500 ; .PROC NEXTLINE = (.REF.FILE F).VOID: +00510 ( .WHILE SPACE(F); CHAR NUMBER(F)>2 .DO .SKIP .OD +00512 # UNTIL LINE END EVENT HAS HAPPENED # +00520 ) +00521 ; PUT(FYLX, (S, NEXTLINE)) +00522 ; .WHILE NEXTLINE(FYLX); LINENO>1 .DO .SKIP .OD +00523 # UNTIL 'COLS' LINES HAVE BEEN FILLED # +00524 # # +00525 ; # TEST ALL OUTTYPES # +00526 ESTABLISH(FYLA, "FYLA", STANDOUTCHANNEL, 3, 10, 58) +00527 ; ON PAGE END(FYLA, (.REF.FILE F).BOOL: (NEWPAGE(F); PUT(F, ("CLEAN PAGE", PAGENUMBER(F), NEWLINE)); .TRUE)) +00528 ; ON PHYSICAL FILE END(FYLA, (.REF.FILE F).BOOL: (CLOSE(F); ESTABLISH(F, "FYLB", STANDOUTCHANNEL, 60, 6, 60); .TRUE)) +00530 ; PUT(FYLA, (T, X, Y, Z, K, S, NEWLINE)); PUT(FYLA, (BIT, SPACE, BIT, SPACE)); PUT(FYLA, (BYT, CHA, CHB, BOOL, BOO, NEWLINE)) +00540 ; .TO #20#40 .DO PUT(FYLA, BYT) .OD +00550 ; PUT(FYLA, (NEWPAGE, "DELIBERATE CLEAN PAGE", NEWLINE)) +00560 ; .FOR J .TO 9 .DO PUT(FYLA, (J, TWOLINES)) .OD +00562 # SHOULD CHANGE TO "FYLB" IN THE MIDDLE OF HERE # +00570 ; ( .LOC.INT I := 0 +00580 ; .LOC.FILE FYLC := FYLA +00590 ; ON LINE END(FYLC, (.REF.FILE F).BOOL: (NEWLINE(F); PUT(F, (WHOLE(I+:=1, -3), SPACE)); .TRUE)) +00600 ; PUT(FYLC, (NEWLINE, T, S, NEWLINE, T))# LINES SHOULD BE NUMBERED # +00610 ; .FOR J .TO 6 .DO PUT(FYLA, (J, K)) .OD # LINES SHOULD NOT BE NUMBERED # +00620 ) +00630 ; PUT(FYLA, U) +00640 ; NEWPAGE(FYLA) +00641 # # +00642 ; # READ BACK CONTENTS OF "FYLA" # +00650 OPEN(FYLB, "FYLA", STANDINCHANNEL) +00660 ; .LOC[1:60].CHAR TT, .LOC.STRING SS, ST, .LOC.REAL XX, YY, .LOC.COMPL ZZ, .LOC.INT KK +00670 , .LOC.BITS BITBIT, .LOC.BYTES BYTBYT, .LOC.CHAR CHACHA, CHBCHB, .LOC.BOOL BOOLBOOL, BOOBOO +00672 ; .PRIO .NEQ = 4 +00674 ; .OP .NEQ = (.REAL A, B).BOOL: +00675 ( A/=0.0!.ABS((A-B)/A)>SMALLREAL*2!B/=0.0) +00676 ; .OP .NEQ = (.COMPL A, B).BOOL: +00677 RE .OF A .NEQ RE .OF B .OR IM .OF A .NEQ IM .OF B +00680 ; ON PAGE END(FYLB, (.REF.FILE F).BOOL: (NEWPAGE(F); GET(F, SS); PRINT((NEWLINE, SS, NEWLINE)); NEWLINE(F); .TRUE)) +00690 ; ON LOGICAL FILE END(FYLB, (.REF.FILE F).BOOL: (PRINT(("""FYLA"" READ BACK OK", NEWLINE)); GET(F, CLOSE); .GOTO CLOSED)) +00700 ; GET(FYLB, (TT, XX, YY, ZZ, KK)) +00702 ; .FOR I .TO 60 .DO .IF TT[I]/=T[I] .THEN SQRT(-1) .FI .OD +00710 ; ( .LOC.FILE FYLC := FYLB +00720 ; ON LINE END(FYLC, (.REF.FILE F).BOOL: (NEWLINE(F); .TRUE)) +00730 ; MAKE TERM(FYLC, ".") +00740 ; GET(FYLC, SS) +00750 ; GET(FYLC, (CHACHA, ST)) +00760 ; .IF S /= SS+CHACHA+ST+"." .THEN SQRT(-1) .FI +00780 ) +00790 ; GET(FYLB, (NEWLINE, BITBIT, BITBIT, SPACE)); GET(FYLB, (BYTBYT, CHACHA, CHBCHB, BOOLBOOL, BOOBOO, NEWLINE)) +00800 ; .IF XX.NEQ X.OR YY.NEQ Y.OR ZZ.NEQ Z.OR KK/=K.OR BITBIT/=BIT.OR BYTBYT/=BYT +00810 .OR CHACHA/=CHA.OR CHBCHB/=CHB.OR BOOLBOOL/=BOOL.OR BOOBOO/=BOO +00820 .THEN SQRT(-1) +00830 .FI +00840 ; .TO #20#40 .DO GET(FYLB, BYTBYT); .IF BYTBYT/=BYT .THEN SQRT(-1) .FI .OD +00850 ; .FOR J .TO 9 +00860 .DO GET(FYLB, (KK, TWOLINES)) +00870 ; .IF KK/=J .THEN SQRT(-1) .FI +00872 # SHOULD REACH LOGICAL END OF "FYLA" IN HERE # +00880 .OD +00890 ; CLOSED: +00970 CLOSE(FYLA) +00990 ) diff --git a/lang/a68s/test/tp9.8 b/lang/a68s/test/tp9.8 new file mode 100644 index 000000000..c1aa984d2 --- /dev/null +++ b/lang/a68s/test/tp9.8 @@ -0,0 +1,114 @@ +00025 .PR POINT .PR +00050 .COMMENT TRANSPUT TEST .COMMENT +00060 # NEEDS TO BE RUN WITH LARGISH FIELDLENGTH AND REDUCE,- # +00070 .PR NOGO .PR +00110 ( .PROC TWOLINES = (.REF.FILE F).VOID: (NEWLINE(F); NEWLINE(F)) +00112 # A USER-WRITTEN LAYOUT ROUTINE # +00120 ; .LOC.FILE FYLA, FYLB +00130 ; .STRING S = "THIS IS A VERY LONG STRING AND IT WILL USE MORE THAN ONE LINE" +00140 " IN FACT IT WILL PROBABLY USE LOTS OF LINES: IT MAY EVEN GO " +00150 "ONTO MORE THAN ONE PAGE, THEN AGAIN IT MAY NOT. BY GUM THIS " +00160 "IS A VERY LONG STRING; PLEASE STOP WRITING THIS RUBBISH." +00170 , [].CHAR T = "************************************************************" +00180 , U = "THIS IS THE END" +00190 ; .INT K = 9876#54321# +00192 .COMMENT NOFLOAT +00200 ; .REAL X = 1234.5E4#100#, Y = 67.89E4#100# +00210 ; .COMPL Z = (X, Y) +00212 .COMMENT +00220 ; .CHAR CHA = ":", CHB = "<" +00230 ; .BOOL BOOL = .TRUE, BOO = .FALSE +00240 ; .BITS BIT = 2R111100001110001#10010# +00250 ; .BYTES BYT = BYTESPACK("BT") +00252 # # +00254 ; # TEST OF ASSOCIATE # +00260 .LOC .FILE FYLX +00290 ; .INT COLS=30, ROWS=15 +00300 ; .LOC.INT LINENO := 1 +00310 ; .LOC [1:ROWS, 1:COLS].CHAR BUFFER +00320 ; .PROC CLEAR = (.REF [] .CHAR B).VOID: .FOR I .TO .UPB B .DO B[I] := " " .OD +00330 ; .LOC [1:COLS].FILE FF +00340 ; .FOR I .TO COLS +00350 .DO ASSOCIATE(FF[I], BUFFER[ , I]) +00360 ; ON LINE END(FF[I], (.REF.FILE F).BOOL: +00370 ( LINENO +:= 1 +00380 ; ( LINENO+1>COLS +00382 ! (LINENO=COLS ! CLEAR(BUFFER[ , LINENO])) +00390 ; .FOR I .TO ROWS +00400 .DO PUT(STANDOUT, (BUFFER[I, ], NEWLINE)) .OD +00402 ; NEWLINE(STANDOUT) +00410 ; NEWPAGE(STANDOUT) +00420 ; LINENO := 0 +00432 ! CLEAR(BUFFER[ , LINENO]) +00434 ) +00436 ; RESET(FYLX) +00440 ; FYLX := FF[LINENO+:=1] +00450 ; CLEAR(BUFFER[ , LINENO]) +00460 ; .TRUE +00470 )) +00480 .OD +00490 ; FYLX := FF[LINENO] +00500 ; .PROC NEXTLINE = (.REF.FILE F).VOID: +00510 ( .WHILE SPACE(F); CHAR NUMBER(F)>2 .DO .SKIP .OD +00512 # UNTIL LINE END EVENT HAS HAPPENED # +00520 ) +00521 ; PUT(FYLX, (S, NEXTLINE)) +00522 ; .WHILE NEXTLINE(FYLX); LINENO>1 .DO .SKIP .OD +00523 # UNTIL 'COLS' LINES HAVE BEEN FILLED # +00524 # # +00525 ; # TEST ALL OUTTYPES # +00526 ESTABLISH(FYLA, "FYLA", STANDOUTCHANNEL, 3, 10, 58) +00527 ; ON PAGE END(FYLA, (.REF.FILE F).BOOL: (NEWPAGE(F); PUT(F, ("CLEAN PAGE", PAGENUMBER(F), NEWLINE)); .TRUE)) +00528 ; ON PHYSICAL FILE END(FYLA, (.REF.FILE F).BOOL: (CLOSE(F); ESTABLISH(F, "FYLB", STANDOUTCHANNEL, 60, 6, 60); .TRUE)) +00530 ; PUT(FYLA, (T, #X, Y, Z,# K, S, NEWLINE)); PUT(FYLA, (BIT, SPACE, BIT, SPACE)); PUT(FYLA, (BYT, CHA, CHB, BOOL, BOO, NEWLINE)) +00540 ; .TO #20#40 .DO PUT(FYLA, BYT) .OD +00550 ; PUT(FYLA, (NEWPAGE, "DELIBERATE CLEAN PAGE", NEWLINE)) +00560 ; .FOR J .TO 10 .DO PUT(FYLA, (J, TWOLINES)) .OD +00562 # SHOULD CHANGE TO "FYLB" IN THE MIDDLE OF HERE # +00570 ; ( .LOC.INT I := 0 +00580 ; .LOC.FILE FYLC := FYLA +00590 ; ON LINE END(FYLC, (.REF.FILE F).BOOL: (NEWLINE(F); PUT(F, (WHOLE(I+:=1, -3), SPACE)); .TRUE)) +00600 ; PUT(FYLC, (NEWLINE, T, S, NEWLINE, T))# LINES SHOULD BE NUMBERED # +00610 ; .FOR J .TO 6 .DO PUT(FYLA, (J, K)) .OD # LINES SHOULD NOT BE NUMBERED # +00620 ) +00630 ; PUT(FYLA, U) +00640 ; NEWPAGE(FYLA) +00641 # # +00642 ; # READ BACK CONTENTS OF "FYLA" # +00650 OPEN(FYLB, "FYLA", STANDINCHANNEL) +00660 ; .LOC[1:60].CHAR TT, .LOC.STRING SS, ST, #.LOC.REAL XX, YY, .LOC.COMPL ZZ,# .LOC.INT KK +00670 , .LOC.BITS BITBIT, .LOC.BYTES BYTBYT, .LOC.CHAR CHACHA, CHBCHB, .LOC.BOOL BOOLBOOL, BOOBOO +00671 .COMMENT NOFLOAT +00672 ; .PRIO .NEQ = 4 +00674 ; .OP .NEQ = (.REAL A, B).BOOL: +00675 ( A/=0.0!.ABS((A-B)/A)>SMALLREAL*2!B/=0.0) +00676 ; .OP .NEQ = (.COMPL A, B).BOOL: +00677 RE .OF A .NEQ RE .OF B .OR IM .OF A .NEQ IM .OF B +00678 .COMMENT +00680 ; ON PAGE END(FYLB, (.REF.FILE F).BOOL: (NEWPAGE(F); GET(F, SS); PRINT((NEWLINE, SS, NEWLINE)); NEWLINE(F); .TRUE)) +00690 ; ON LOGICAL FILE END(FYLB, (.REF.FILE F).BOOL: (PRINT(("""FYLA"" READ BACK OK", NEWLINE)); GET(F, CLOSE); .GOTO CLOSED)) +00700 ; GET(FYLB, (TT,# XX, YY, ZZ,# KK)) +00702 ; .FOR I .TO 60 .DO .IF TT[I]/=T[I] .THEN SQRT(-1) .FI .OD +00710 ; ( .LOC.FILE FYLC := FYLB +00720 ; ON LINE END(FYLC, (.REF.FILE F).BOOL: (NEWLINE(F); .TRUE)) +00730 ; MAKE TERM(FYLC, ".") +00740 ; GET(FYLC, SS) +00750 ; GET(FYLC, (CHACHA, ST)) +00760 ; .IF S /= SS+CHACHA+ST+"." .THEN SQRT(-1) .FI +00780 ) +00790 ; GET(FYLB, (NEWLINE, BITBIT, BITBIT, SPACE)); GET(FYLB, (BYTBYT, CHACHA, CHBCHB, BOOLBOOL, BOOBOO, NEWLINE)) +00798 .COMMENT NOFLOAT +00800 ; .IF XX.NEQ X.OR YY.NEQ Y.OR ZZ.NEQ Z.OR KK/=K.OR BITBIT/=BIT.OR BYTBYT/=BYT +00810 .OR CHACHA/=CHA.OR CHBCHB/=CHB.OR BOOLBOOL/=BOOL.OR BOOBOO/=BOO +00820 .THEN SQRT(-1) +00830 .FI +00832 .COMMENT +00840 ; .TO #20#40 .DO GET(FYLB, BYTBYT); .IF BYTBYT/=BYT .THEN SQRT(-1) .FI .OD +00850 ; .FOR J .TO 10 +00860 .DO GET(FYLB, (KK, TWOLINES)) +00870 ; .IF KK/=J .THEN SQRT(-1) .FI +00872 # SHOULD REACH LOGICAL END OF "FYLA" IN HERE # +00880 .OD +00890 ; CLOSED: +00970 CLOSE(FYLA) +00990 ) diff --git a/lang/a68s/test/wichman.8 b/lang/a68s/test/wichman.8 new file mode 100644 index 000000000..2fecdc6bb --- /dev/null +++ b/lang/a68s/test/wichman.8 @@ -0,0 +1,110 @@ +.PR POINT,NOLIST .PR +.CO THE WICHMAN BENCHMARK .CO +.BEGIN + .MODE .ARR = [1 : 4] .REAL; + .REAL X1,X2,X3,X4,X,Y,Z,T1,T2,T, + .INT I,J,K,L,N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11, + .ARR E1; + .PROC PA = (.REF .ARR E) .VOID: + .BEGIN + .INT J; + J := 0; +.WHILE J < 6 .DO + E[1] := (E[1] + E[2] + E[3] - E[4]) * T; + E[2] := (E[1] + E[2] - E[3] + E[4]) * T; + E[3] := (E[1] - E[2] + E[3] + E[4]) * T; + E[4] := ( - E[1] + E[2] + E[3] + E[4]) / T2; + J := J + 1 +.OD + .END; # OF PA # + .PROC P0 = .VOID: + .BEGIN + E1[J] := E1[K]; + E1[K]:= E1[L]; + E1[L] := E1[J] + .END; # OF P0# + .PROC P3 = (.REAL X,Y, .REF .REAL Z) .VOID : + .BEGIN +.REAL X1 := X, Y1 := Y; + X1 := T*(X1+Y1); + Y1 := T*(X1+Y1); + Z := (X1+Y1) / T2 + .END; # OF P3# + T := 0.499975; T1 := 0.50025; T2 := 2.0; +.CO READ(I); .CO I := 2; + N1 := 0; N2 := 12*I; N3 := 14*I; N4 :=345*I;N5 :=0; + N6 := 210*I;N7 := 32*I; N8 :=899*I;N9 :=616*I; + N10 := 0; N11 := 93*I; + # MODULE 1: SIMPLE IDENTIFIERS# + X1 := 1.0; + X2 := X3 := X4 := -1.0; + .FOR I .TO N1 .DO + X1 := (X1 + X2 + X3 - X4)*T; + X2 := (X1 + X2 - X3 + X4)*T; + X3 := (X1 - X2 + X3 + X4)*T; + X4 := ( - X1 + X2 + X3 + X4)*T + .OD; + PRINT ((N1,N1,N1,X1,X2,X3,X4, NEWLINE)); + # MODULE 2: ARRAY ELEMENTS# + E1[1] := 1.0; + E1[2] := E1[3] := E1[4] := -1.0; + .FOR I .TO N2 .DO + E1[1] := (E1[1] + E1[2] + E1[3] - E1[4])*T; + E1[2] := (E1[1] + E1[2] - E1[3] + E1[4])*T; + E1[3] := (E1[1] - E1[2] + E1[3] + E1[4])*T; + E1[4] := ( - E1[1] + E1[2] + E1[3] + E1[4])*T + .OD; + PRINT ((N2,N3,N2)); .FOR I .TO 4 .DO PRINT(E1[I]) .OD; PRINT((NEWLINE)); + #MODULE 3: ARRAY AS PARAMETER# + .FOR I .TO N3 .DO PA(E1) .OD; + PRINT ((N3,N2,N2)); .FOR I .TO 4 .DO PRINT(E1[I]) .OD; PRINT((NEWLINE)); + #MODULE 4: CONDITIONAL JUMPS# + J := 1; + .FOR I .TO N4 .DO + .IF J = 1 .THEN J := 2 + .ELSE J := 3 .FI; + .IF J > 2 .THEN J := 0 + .ELSE J := 1 .FI; + .IF J < 1 .THEN J := 1 + .ELSE J := 0 .FI + .OD; + PRINT ((N4,J,J,X1,X2,X3,X4, NEWLINE)); + # MODULE 5: OMITTED# + # MODULE 6: INTEGER ARITHMETIC# + J := 1; K := 2; L := 3; + .FOR I .TO N6 .DO + J := J*(K-J)*(L-K); + K := L*K - (L-J)*K; + L := (L-K)*(K+J); + E1[L-1] := J+K+L; + E1[K-1] := J*K*L + .OD; + PRINT ((N6,J,K)); .FOR I .TO 4 .DO PRINT(E1[I]) .OD; PRINT((NEWLINE)); + #MODULE 7: TRIG FUNCTIONS# + X := Y := 0.5; + .FOR I .TO N7 .DO + X := T*ARCTAN(T2*SIN(X)*COS(X)/(COS(X+Y)+COS(X-Y)-1.0)); + Y := T*ARCTAN(T2*SIN(Y)*COS(Y)/(COS(X+Y)+COS(X-Y)-1.0)) + .OD; + PRINT ((N7,J,K,X,X,Y,Y, NEWLINE)); + #MODULE 8: PROCEDURE CALLS# + X := Y := Z := 1.0; + .FOR I .TO N8 .DO P3(X,Y,Z) .OD; + PRINT ((N8,J,K,X,Y,Z,Z, NEWLINE)); #MODULE 9: ARRAY REFERENCES# + J :=1; K :=2; L :=3; + E1[1]:=1.0;E1[2] :=2.0;E1[3] :=3.0; + .FOR I .TO N9 .DO P0 .OD; + PRINT ((N9,J,K)); .FOR I .TO 4 .DO PRINT(E1[I]) .OD; PRINT((NEWLINE)); + #MODULE 10: INTEGER ARITHMETIC# + J :=2;K :=3; + .FOR I .TO N10 .DO + J := J+K;K :=J+K;J := K-J;K := K-J-J +.OD; + PRINT((N10,J,K,X1,X2,X3,X4, NEWLINE)); + #MODULE 11: STANDARD FUNCTIONS# +X := 0.75; +.FOR I .TO N11 .DO + X := SQRT(EXP(LN(X)/T1)) + .OD; + PRINT ((N11,J,K,X,X,X,X, NEWLINE)) + .END