--- /dev/null
+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 )
--- /dev/null
+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 )
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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.
+\fRICHARD 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.
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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 )
--- /dev/null
+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 )
--- /dev/null
+.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