d0p1/ack
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Initial revision

Browse source
This commit is contained in:
ceriel 1988-10-05 13:29:42 +00:00
parent 366b492174
commit 8e7e1320ac
10 changed files with 1078 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

118
lang/a68s/test/complex.8 Normal file
View file

@ -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
lang/a68s/test/cousins.8 Normal file
View file

@ -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
lang/a68s/test/prime.8 Normal file
View file

@ -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
lang/a68s/test/queens.8 Normal file
View file

@ -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
lang/a68s/test/sisters Normal file
View file

@ -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
lang/a68s/test/tarith.8 Normal file
View file

@ -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
lang/a68s/test/test.8 Normal file
View file

@ -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
lang/a68s/test/tp8.8 Normal file
View file

@ -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
lang/a68s/test/tp9.8 Normal file
View file

@ -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
lang/a68s/test/wichman.8 Normal file
View file

@ -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