Browse Source

Initial revision

ceriel 36 years ago
parent
commit
8e7e1320ac

+ 118 - 0
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 ) 

+ 203 - 0
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<DOWN ! UP ! DOWN)-1
+01310                           ; .INT REM = .ABS(UP-DOWN)
+01320                           ; WHOLE(COUS, 0) + (COUS ! "ST", "ND", "RD" ! "TH") + " COUSIN "
+01330                               + (REM/=0 ! WHOLE(REM, 0) + " TIMES REMOVED " ! "") + "OF " 
+01340                         .ESAC 
+01350                     .ESAC 
+01360                 ) 
+01370               , NAME .OF THAT, NEWLINE
+01380               ))
+01390       ; .LOC .INT COUNT := 1 # USED TO MARK .PERSONS WHICH HAVE BEEN SCANNED #
+01400       ; .PROC MARK = (.REF .PERSON P, .BITS UP).VOID: 
+01410           # MARK ALL ANCESTORS OF 'P' WITH 'COUNT'. 
+01420             'UP' IS NUMBER OF GENERATIONS FROM START #
+01430           .IF P .ISNT NOBODY
+01440           .THEN .IF COUNT .OF P = COUNT 
+01442               .THEN UP .OF P := UP .OF P .OR UP 
+01450               .ELSE COUNT .OF P := COUNT
+01460                 ; UP .OF P := UP
+01462               .FI 
+01470             ; MARK(PA .OF P, UP .SHR 1) 
+01480             ; MARK(MA .OF P, UP .SHR 1) 
+01500           .FI 
+01510       ; .PROC SEARCH = (.REF .PERSON P, .INT DOWN, .BOOL FIRSTIME).BOOL:  
+01520           # SEARCHES ALL ANCESTORS OF 'P' FOR MARKED ANCESTOR.
+01530             'DOWN' IS NUMBER OF GENERATIONS FROM START. 
+01540             RETURNS .FALSE IF NO RELATION FOUND # 
+01550           .IF P .ISNT NOBODY
+01560           .THEN .IF COUNT .OF P = COUNT 
+01562               .THEN .BITS UP = UP .OF P 
+01564                 ; .FOR I .TO BITSWIDTH-1
+01565                   .DO .IF I .ELEM UP
+01566                       .THEN .IF FIRSTIME
+01567                            .THEN INSERT CHAIN(I-1, DOWN)
+01568                            .ELSE INSERT CHAIN(DOWN, I-1)
+01569                            .FI
+01570                        .FI
+01571                    .OD
+01572                 ; .TRUE 
+01573               .ELSE SEARCH(PA .OF P, DOWN+1, FIRSTIME)
+01580                     .OR SEARCH(MA .OF P, DOWN+1, FIRSTIME)
+01590               .FI 
+01600           .ELSE .FALSE
+01610           .FI 
+01620       ; ON LOGICAL FILE END(STANDIN, (.REF .FILE F).BOOL: .GOTO STOP) 
+01630       ; MAKE TERM(STANDIN, ",;.") 
+01640       ; RESTART:  
+01650           ( .PROC COMPLAIN = (.STRING MESSAGE).VOID:  
+01660               ( PRINT((MESSAGE, NEWLINE)) 
+01670               ; READ(NEWLINE) 
+01680               ; .GOTO RESTART 
+01690               ) 
+01700           ; .PROC EXPECT = (.CHAR E).VOID:  
+01710               ( .LOC .CHAR C
+01720               ; READ(C) 
+01730               ; .IF C/=E .THEN COMPLAIN(C+" FOUND INSTEAD OF "+E) .FI 
+01740               ) 
+01750           ; READ(FIRST); EXPECT(",")
+01760           ; THIS := HASHIN(FIRST, .SKIP, NOCHECK) 
+01770           ; READ(SECOND); EXPECT(".") 
+01780           ; THAT := HASHIN(SECOND, .SKIP, NOCHECK)
+01790           ; .IF (THIS .IS NOBODY) .OR (THAT .IS NOBODY) .THEN COMPLAIN("TWO NAMES NOT GIVEN") .FI 
+01800           ; MARK(THIS, 2R1 .SHL (BITSWIDTH-1))
+01810           ; START CHAIN := NOCHAIN
+01820           ; .IF SEARCH(THAT, 0, .TRUE)
+01822             .THEN COUNT +:= 1 
+01823               ; MARK(THAT, 2R1 .SHL (BITSWIDTH-1))
+01824               ; SEARCH(THIS, 0, .FALSE) 
+01830               ; .LOC .REF .CHAIN PTR := START CHAIN 
+01840               ; .WHILE PTR :/=: NOCHAIN 
+01850                 .DO RELATIONS(UP .OF PTR, DOWN .OF PTR) 
+01860                   ; PTR := NEXT .OF PTR 
+01870                 .OD 
+01880             .ELSE PRINT((NAME .OF THIS, " IS NOT RELATED TO ", NAME .OF THAT, NEWLINE)) 
+01890             .FI 
+01900           ; COUNT +:= 1 
+01910           ; READ(NEWLINE) 
+01920           ; .GOTO RESTART 
+01930           ) 
+01940     .END # CHECKING OF RELATIONSHIPS #
+01950 ) 

+ 50 - 0
lang/a68s/test/prime.8

@@ -0,0 +1,50 @@
+00900 .PR POINT .PR
+01000 .BEGIN #PRINT FIRST THOUSAND PRIME NUMBERS# 
+01010   .INT THOUSAND = 320;
+01020   .INT THIRTY = 30; #ACCORDING TO NUMBER THEORY, THE 30TH PRIME > 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<ORD #
+01130     .FOR K .FROM 2 .TO THOUSAND 
+01140     .DO .LOC .BOOL JPRIME;
+01150       .WHILE
+01160         J:=J+2; .WHILE SQUARE<=J .DO MULT[ORD]:=SQUARE; ORD+:=1; SQUARE:=P[ORD]**2 .OD; 
+01170           #.ASSERT MULT[ORD] <= J # 
+01180         JPRIME := .TRUE;
+01190         .FOR N .FROM 2 .TO ORD-1 .WHILE JPRIME
+01200         .DO # MAKE JPRIME=(P[N] IS NOT A FACTOR OF J) # 
+01210           .REF .INT MULTN = MULT[N];
+01220           .WHILE MULTN<J
+01230           .DO MULTN+:=P[N] .OD; 
+01240             #.ASSERT J <= MULT[N] < J+P[N] #
+01250           JPRIME := J/=MULTN
+01270         .OD;
+01280         .NOT JPRIME 
+01290       .DO .SKIP .OD;
+01300       P[K] := J 
+01310     .OD 
+01320   .END; 
+01330   .BEGIN # PRINT TABLE P ON 5 PAGES, EACH CONTAINING 4 COLUMNS WITH 50 CONSECUTIVE PRIMES # 
+01340     PRINT(("TABLE OF FIRST ", THOUSAND, " PRIMES", NEWLINE)); 
+01350     .INT COLUMNS = 4, LINES = 50; 
+01360     .FOR PAGE 
+01370     .WHILE .INT K = (PAGE-1)*COLUMNS*LINES+1; K<=THOUSAND 
+01380     .DO # PRINT 1 PAGE #
+01390       PRINT (("PAGE ", PAGE, NEWLINE)); 
+01400       .FOR L .FROM K .TO K+LINES-1 .WHILE L<=THOUSAND 
+01410       .DO # PRINT 1 LINE #
+01420         .FOR M .FROM L .BY LINES .TO L+LINES*(COLUMNS-1) .WHILE M<=THOUSAND 
+01430         .DO PRINT(P[M]) .OD;
+01440         PRINT(NEWLINE)
+01450       .OD;
+01460       PRINT(NEWPAGE)
+01470     .OD 
+01480   .END
+01490 .END

+ 64 - 0
lang/a68s/test/queens.8

@@ -0,0 +1,64 @@
+00050 .PR POINT .PR
+00110 # QUEEN #
+00120 .COMMENT THIS PROGRAM PLACES 8 QUEENS ON A CHESSBOARD
+00130 SUCH THAT NO TWO QUEENS ATTACK ONE ANOTHER. THE METHOD USED
+00140 IS OF RECURSIVE DESCENT : ALL VALID POSSIBILITIES
+00150 ON A GIVEN ROW ARE TRIED - EACH PRODUCES ANOTHER BRANCH OF
+00160 POSSIBILITIES ON FURTHER ROWS. IF A QUEEN MAY BE PLACED ON THE
+00170 LAST ROW THEN THIS IS A SOLUTION AND IS OUTPUT.
+00180 NOTE: TO SAVE MACHINE TIME SIMPLE REFLECTIONS ARE PRODUCED
+00190 MECHANICALLY IF EXHAUSTIVE SOLUTIONS ARE ONLY FOUND FOR
+00200 THE QUEEN ON THE FIRST ROW POSITIONS 1,2,3,4. THE
+00210 SYMMETRY OF THE CHESSBOARD MEANS THAT SOLUTIONS WITH
+00220 THE QUEEN IN ROW 1 IN POSITIONS 5,6,7,8 CORRESPOND 1-1
+00230 WITH THESE.
+00240 .COMMENT
+00250 ##
+00260 .BEGIN
+00270 .LOC .INT ROW := 0, COUNTSOLN := 0;
+00280 .LOC[1:8].INT RESULT;
+00282 .LOC[1:8, -6:15].BOOL ALLOWS;
+00290 ##
+00300 .PROC SOLUTIONHEAD = .VOID:
+00310   .BEGIN PRINT((NEWLINE, "SOLUTION", WHOLE(COUNTSOLN, -5), ":- ")); COUNTSOLN +:=1 .END;
+00320 ##
+00330 .PROC PLACE = (.INT POSITION).VOID:
+00340   .COMMENT THIS IS A RECURSIVE PROCEDURE.
+00350   IT ALLOCATES ALL POSSIBLE VALUES IN THE CURRENT ROW AS DEFINED
+00360   BY EACH ROW. AFTER CONSIDERING WHICH SQUARES ARE NOT PERMISSIBLE
+00370   (BECAUSE ALREADY ATTACKED), IT OUTPUTS ANY SOLUTIONS IT FINDS
+00380   (I.E. WHEN WE REACH THE LAST ROW).
+00390   .COMMENT
+00400   .BEGIN
+00420     ROW +:= 1; RESULT[ROW] := POSITION;
+00422     .REF [] .BOOL ALLOW = ALLOWS[ROW, ];
+00430     .IF ROW=8
+00440     .THEN #WE HAVE FOUND SOLUTION NUMBER COUNTSOLN
+00450           SO OUTPUT IT#
+00460       SOLUTIONHEAD;
+00470       .FOR K .TO 8 .DO PRINT(.REPR(RESULT[K]+.ABS"0")) .OD;
+00480       SOLUTIONHEAD;
+00490       .FOR K .TO 8 .DO PRINT(.REPR(9-RESULT[K]+.ABS"0")) .OD
+00500     .ELSE
+00510       .FOR I .TO 8 .DO ALLOW[I] := .TRUE .OD;
+00520         #DISALLOW ATTACKED SQUARES#
+00530       .FOR I .TO ROW
+00540       .DO .INT RES = RESULT[I];
+00550         ALLOW[RES] := .FALSE;
+00560         ALLOW[RES+ROW+1-I] := .FALSE;
+00570         ALLOW[RES-ROW-1+I] := .FALSE
+00580       .OD;
+00590         #CONSTRUCT ANOTHER LEVEL WHERE POSSIBLE#
+00600       .FOR I .TO 8 .DO .IF ALLOW[I] .THEN PLACE(I) .FI .OD
+00610     .FI;
+00620     #NOW UP A LEVEL#
+00630     ROW -:= 1
+00640   .END; #OF PLACE#
+00650 ##
+00660 #INITIALISE OUTPUT#
+00670 PRINT(("PLACEMENT OF QUEENS SUCH THAT NO TWO"
+00680        " ATTACK EACH OTHER", NEWLINE));
+00690 .FOR J .TO 4 .DO PLACE(J) .OD;
+00700 #TIDY UP OUTPUT#
+00710 PRINT(("LIST COMPLETE", NEWLINE))
+00720 .END

+ 53 - 0
lang/a68s/test/sisters

@@ -0,0 +1,53 @@
+RICHARD OF YORK,CECILY NEVILLE;S=EDWARD IV,S=RICHARD III. 
+EDWARD IV,ELIZABETH WOODVILLE;S=EDWARD V,D=ELIZABETH OF YORK. 
+EDMUND TUDOR,MARGARET BEAUFORT;S=HENRY VII. 
+HENRY VII,ELIZABETH OF YORK;D=MARGARET TUDOR,S=HENRY VIII.
+JAMES IV OF SCOTLAND,MARGARET TUDOR;S=JAMES V OF SCOTLAND.
+JAMES V OF SCOTLAND,MARY OF GUISE;D=MARY QUEEN OF SCOTS.
+HENRY VIII,CATHERINE OF ARAGON;D=MARY I.
+HENRY VIII,ANNE BOLEYN;D=ELIZABETH I. 
+HENRY VIII,JANE SEYMOUR;S=EDWARD VI.
+DARNLEY,MARY QUEEN OF SCOTS;S=JAMES I.
+JAMES I,ANN OF DENMARK;S=CHARLES I. 
+CHARLES I,;S=CHARLES II,S=JAMES II,D=MARY ??. 
+JAMES I,ANN OF DENMARK;D=ELIZABETH ??.
+JAMES II,ANNE HYDE;D=MARY II,D=ANNE.
+,MARY ??;S=WILLIAM OF ORANGE. 
+SOMEBODY FROM HANOVER,ELIZABETH ??;S=ERNEST.
+ERNEST,SOPHIA;S=GEORGE I. 
+GEORGE I,SOPHIA OF ZELL;S=GEORGE II.
+LAGUS,;S=SOTER. 
+SOTER,BERENICE I;S=PHILADELPHUS,D=ARSINOE II. 
+LYSIMACHUS,ARSINOE II;D=ARSINOE I.
+PHILADELPHUS,ARSINOE I;D=BERENICE,S=EUERGETES.
+,BERENICE I;S=MAGAS.
+MAGAS,;D=BERENICE II. 
+EUERGETES,BERENICE II;S=PHILOPATER,D=ARSINOE III. 
+PHILOPATER,ARSINOE III;S=EPIPHANES. 
+ANTIOCHUS,;D=CLEOPATRA I. 
+EPIPHANES,CLEOPATRA I;S=POT BELLY,D=CLEOPATRA II,S=PHILOMETER.
+POT BELLY,CLEOPATRA II;S=MEMPHITES. 
+PHILOMETER,CLEOPATRA II;D=CLEOPATRA KOKKE,S=EUDATOR,D=CLEOPATRA THEA. 
+POT BELLY,CLEOPATRA KOKKE;S=ALEXANDER I,D=CLEOPATRA SELENE,S=CHICKPEA,D=CLEOPATRA IV,D=CLEOPATRA TRYPHAENA. 
+DEMETRIUS,CLEOPATRA THEA;S=CYZICENUS,S=GRYPUS,S=SELEUCUS. 
+ALEXANDER I,;S=ALEXANDER II.
+CHICKPEA,CLEOPATRA IV;D=BERENICE III. 
+CHICKPEA,IRENE;S=FLUTER,D=CLEOPATRA TRYPHAENA II,S=PTOLEMY. 
+FLUTER,CLEOPATRA TRYPHAENA II;D=BERENICE IV,D=CLEOPATRA V,D=ARSINOE,S=PTOLEMY XII,S=PTOLEMY XIII. 
+JULIUS CAESAR,CLEOPATRA V;S=CAESARION.
+MARK ANTONY,CLEOPATRA V;S=ALEXANDER HELIOS,D=CLEO SELENE,S=PTOLEMY PHILOMETER.
+RICHARD III,EDWARD V. 
+ELIZABETH OF YORK,RICHARD III.
+ELIZABETH I,MARY QUEEN OF SCOTS.
+JAMES I,ELIZABETH I.
+GEORGE I,WILLIAM OF ORANGE. 
+EDWARD IV,GEORGE I. 
+ELIZABETH I,EDWARD VI.
+MARY I,HENRY VII. 
+HENRY VII,MARY I. 
+ANNE BOLEYN,JANE SEYMOUR. 
+PHILOPATER,PHILADELPHUS.
+PHILADELPHUS,PHILOPATER.
+MEMPHITES,CHICKPEA. 
+CYZICENUS,CLEOPATRA IV. 
+CAESARION,SOTER.

+ 21 - 0
lang/a68s/test/tarith.8

@@ -0,0 +1,21 @@
+00050 .PR POINT .PR
+00100 .BEGIN
+00110 PRINT(("A",.ABS-2.0,.ABS 2.0,NEWLINE, 
+00120 SPACE,1.1+2.2,NEWLINE,
+00130 "D",1/3,1.1/3.3,NEWLINE,
+00140 "E",.ENTIER 3.3,.ENTIER-3.3,NEWLINE,
+00150 SPACE,2^9,13^2,1.3^2,3.0^3,3.0^-2,NEWLINE,
+00160 "G",2R110>=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

+ 237 - 0
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

+ 108 - 0
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 )

+ 114 - 0
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 )

+ 110 - 0
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