!!This version was typed in by RWT (Feb 2002)
!!from a paper copy believed to date from 1975.
BEGIN; !EDIT15: ECCE FOR PDP9/15
OWNINTEGER IN=1; !CURRENT INPUT STREAM
OWNINTEGER MIN=1; !MAIN INPUT STREAM
OWNINTEGER MOUT=1; !MAIN OUTPUT STREAM
OWNINTEGER SIN=2; !SECONDARY INPUT STREAM
OWNINTEGER MON=0; !MONITOR INDIC
OWNINTEGER PRINT1=0,PRINT2=0; !PRINT INDICATORS
OWNINTEGER STOP=-5000; !LOOP STOP (CONST)
INTEGER I,J,K,PP1,SYM
INTEGER CODE; !COMMAND CODE LETTER
INTEGER TEXT; !TEXT POINTER (AD)
INTEGER NUM; !REPETITION NUMBER
OWNINTEGER SEXTRA=0; !EXTRA BUFF FOR SIN
INTEGERNAME MAINFP; ! == FP OR MFP (FOR SIN)
OWNINTEGERARRAY C(0:119); !COMMAND -> <- TEXT
! EACH COMMAND UNIT -- LETTER, PARENTHESIS OR COMMA -- IS
! REPRESENTED BY A TRIO: CODE(+LIM) TEXT NUM
! IN THE CASE OF PARENTHESES AND COMMAS 'TEXT' IS A POINTER
! TO ANOTHER COMMAND UNIT (NOT TO A TEXT STRING)
INTEGER CBASE; CBASE = ADDR(C(0))
INTEGER TBASE; TBASE = CBASE+119
INTEGER CI; !COMMAND INDEX (AD)
INTEGER TI; !TEXT INDEX (AD)
OWNINTEGER CMAX=0; !COMMAND MAX (AD)
INTEGERARRAY STORED(1:192); !DEFS OF X,Y,Z
OWNINTEGER POS1=0, POS2=0, POS3=0
I = FREESTORE-10; !WORK OUT FREE SPACE
CYCLE J = 2,-1,0
SELECT INPUT(J); SELECT OUTPUT(J)
SEXTRA = 122 IF J = SIN AND INDEV # 0
I = I-256 IF INDEV&(¬1) # 0
I = I-256 IF OUTDEV&(¬1) # 0
REPEAT
INTEGERARRAY A(0:I)
INTEGER TOP; TOP = ADDR(A(0))<<1+1; !TOP OF BUFF (BAD)
INTEGER BOT; BOT = TOP+I+I-SEXTRA; !BOTTOM OF BUFF (BAD)
INTEGER LBEG; !LINE START (BAD)
INTEGER PP; !PREVIOUS POINTER (BAD)
OWNINTEGER FP=0; !FILE POINTER (BAD)
INTEGER LEND; !LINE END (BAD)
OWNINTEGER FEND; !END OF FILE IN BUFF (BAD)
OWNINTEGER MS=0; !MATCH START (BAD)
OWNINTEGER ML=0; !MATCH LIMIT (BAD)
! SIGNIFICANCE OF FILE POINTERS:
! [NL] O N E NL T W . . . O NL N E X T NL . . NL L A S T NL [NL]
! ! ! ! ! ! !
! T L P F L F
! O B P P E E
! P E N N
! G D D
INTEGER TYPE,CHAIN; !COMMAND INPUT VARS
OWNINTEGER PEND=0, PR=0; !DITTO
SWITCH T(0:12)
SWITCH S('A':92)
ROUTINE LOAD PP(INTEGER K); !!!ALSO INCREMENTS PP
!BYTE(PP) = K; !PP = PP+1
INTEGER P
LAC PP; OPR 2064; !RCR; DAC P
OPR 768; !SZL; JMP L1
LAC K; OPR 1032; !RTL; OPR 1032
OPR 1032; OPR 1032; DAC K
LAC #-256; OPR 513; !SKP!CMA
L1: LAC #-256; AND* P; XOR K; DAC* P
ISZ PP
END
ROUTINE LOAD FP(INTEGER K)
!BYTE(FP) = K
INTEGER P
LAC FP; OPR 2064; !RCR; DAC P
OPR 768; !SZL; JMP L1
LAC K; OPR 1032; !RTL; OPR 1032
OPR 1032; OPR 1032; DAC K
LAC #-256; OPR 513; !SKP!CMA
L1: LAC #-256; AND* P; XOR K; DAC* P
END
INTEGERFN BYTE(INTEGER P)
OPR 2064; !RCR; DAC P
LAC* P; OPR 768; !SZL; JMP L1
OPR 1040; !RTR; OPR 1040
OPR 1040; OPR 1040
L1: AND #255; JMP* BYTE
STOP
END
ROUTINE LEFT STAR
1: RETURN IF PP = LBEG
FP = FP-1; PP = PP-1
LOAD FP(BYTE(PP))
->1
END
ROUTINE RIGHT STAR
1: RETURN IF FP = LEND
LOAD PP(BYTE(FP))
ISZ FP
->1
END
OWNINTEGERARRAY SYMTYPE(33:95) = C
64, 3, 3, 3, 2, 3, 3,11, 9,64, 3,12, 2, 3, 3,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 1, 3, 3, 3,64,
3, 2,10,18, 5, 8,52,10, 2, 6,10,10,10,56, 2, 2,
10,50,10,22, 5, 5, 6, 2,32,32,32, 3,10, 3, 3, 3
! ! # $ % & ' ( ) * + , - . /
! 0 1 2 3 4 5 6 7 8 9 : < = > ?
! @ A B C D E F G H I J K L M N O
! P Q R S T U V W X Y Z [ ¬ ] _
ROUTINE READ SYM
IF PEND # 0 THEN SYM=PEND AND PEND=0 ELSE START
WHILE POS3 # 0 CYCLE
SYM = STORED(POS3); POS3 = POS3+1
RETURN UNLESS SYM = NL
POS3 = POS2; POS2 = POS1; POS1 = 0
REPEAT
READ CH(SYM)
FINISH
END
ROUTINE READ ITEM
TYPE = 1
1: READ SYM
->1 IF SYM = ' '
RETURN IF SYM < 32; !NL
SYM = SYM-32 IF SYM >= 96; !ENSURE UPPER CASE
TYPE = SYMTYPE(SYM)
RETURN UNLESS TYPE&15 = 0
IF TYPE = 32 START
POS1 = POS2; POS2 = POS3
POS3 = (SYM-'X')<<6+1
->1
FINISH
IF TYPE = 0 START
NUM = SYM-'0'
CYCLE
READ CH(PEND)
EXIT UNLESS '0' <= PEND <= '9'
NUM = (NUM<<2+NUM)<<1-'0'+PEND
REPEAT
FINISH ELSE START
TYPE = 0
NUM = 0; RETURN IF SYM = '*'
NUM = STOP+1; RETURN IF SYM = '?'
NUM = STOP; ! '!'
FINISH
END
ROUTINE UNCHAIN
1: TEXT = CHAIN; RETURN IF TEXT = 0
CHAIN = INTEGER(TEXT+1); INTEGER(TEXT+1) = CI
->1 IF INTEGER(TEXT) # 'X'
END
ROUTINE STACK(INTEGER V)
INTEGER(CI) = V; CI = CI+1
END
ROUTINE MAKE SPACE
INTEGER K,P1,P2
RETURN IF MAINFP-PP-240 > 0
SELECT OUTPUT(MOUT)
P1 = TOP; P2 = (P1+LBEG)>>1; !OUPTUT ABOUT HALF
P2 = LBEG IF CODE = 'C'; !BUT ALL IF CLOSING
MONITOR 20 IF P2 = TOP; !!!LOGICAL ERROR
1: K = BYTE(P1); PRINT CH(K); ISZ P1
->1 UNLESS K = NL AND P1-P2 >= 0
SELECT OUTPUT(0)
LBEG = TOP+LBEG-P1; P2 = PP; PP = TOP
2: RETURN IF P1 = P2
LOAD PP(BYTE(P1)); ISZ P1
->2
END
ROUTINE READ LINE
INTEGER K
IF FP # FEND START
LEND = FP
LEND = LEND+1 WHILE BYTE(LEND) # NL
RETURN
FINISH
SELECT INPUT(IN); FAULT 9 ->EOF
FP = BOT-121
1: IF FP # BOT THEN READ CH(K) ELSE K = NL
LOAD FP(K); ISZ FP
->1 UNLESS K = NL
FEND = FP; LEND = FEND-1
FP = BOT-121
->2
EOF:FP = BOT; LEND = FP; FEND = LEND
LOAD FP(NL)
2: SELECT INPUT(0)
MS = 0; PRINT1 = 0; PRINT2 = 0
END
ROUTINE SWITCH INPUTS
OWNINTEGER MFP,MLEND,MEND,SFP,SEND
IF IN = MIN START
LEFT STAR
IN = SIN
MFP = FP; MLEND = LEND; MEND = FEND
MAINFP == MFP
BOT = BOT+SEXTRA; FP = SFP; FEND = SEND
READ LINE
FINISH ELSE START
PP = LBEG
IN = MIN
BOT = BOT-SEXTRA; SFP = FP; SEND = FEND
FP = MFP; LEND = MLEND; FEND = MEND
MAINFP == FP
FINISH
END
ROUTINE PRINT LINE
INTEGER P
PRINT1 = LEND; PRINT2 = FP+PP
P = LBEG
CYCLE
IF P = PP START
PRINT SYMBOL(94) IF P # LBEG AND NUM = 0
P = FP
FINISH
EXIT IF P = LEND
PRINT SYMBOL(BYTE(P))
P = P+1
REPEAT
PRINTTEXT '**END**' IF P = FEND
NEWLINE
END
INTEGERFN MATCHED
INTEGER I,J,K,L,T1,FP1,LIM
LIM = INTEGER(CI-3)&(¬127); T1 = INTEGER(TEXT)
1: PP1 = PP; FP1 = FP
->3 UNLESS FP = MS AND (CODE='F' OR CODE='U')
K = BYTE(FP)
2: LOAD PP(K); ISZ FP
3: ->10 IF FP = LEND
K = BYTE(FP)
->2 UNLESS K = T1
I = FP; J = TEXT
6: I = I+1; J = J-1
L = INTEGER(J)
->6 IF BYTE(I) = L
->2 IF L # 0
MS = FP; ML = I
RESULT = 1
10: LIM = LIM-128
IF LIM # 0 AND FP # FEND START
IF CODE # 'U' START
LOAD PP(NL); LBEG = PP
FINISH ELSE PP = PP1
FP = FP+1; MAKE SPACE; READ LINE
->1
FINISH
PP = PP1; FP = FP1
RESULT = 0
END
!INITIALISE
PP = TOP-1; LOAD PP(NL); !FOR BOUNCING OFF
LBEG = PP; MAINFP == FP
STORED(1) = NL; STORED(65) = NL; STORED(129) = NL
PROMPT('E'); PROMPT('D'); PROMPT('I'); PROMPT('T')
PROMPT(NL); PROMPT('>'); PROMPT(0)
READ LINE
!READ COMMAND LINE
1: FAULT 9 ->EOF
PROMPT(PR) AND PROMPT(0) IF PR # 0
PR = '>'
READ ITEM; ->1 IF TYPE = 1
CI = CBASE; TI = TBASE; CHAIN = 0
IF TYPE = 0 AND CMAX # 0 START
INTEGER(CMAX+2) = NUM
READ ITEM; ->ER2 IF TYPE # 1
->GO
FINISH
IF SYM = '%' START
READ SYM; SYM = SYM-32 IF SYM >= 96
CODE = SYM; ->ER5 IF CODE<=32
READ ITEM
->T(SYMTYPE(CODE)>>4)
T(2): !%X, %Y, %Z
->ER1 IF SYM # '='
I = (CODE-'X')<<6
CYCLE
READ SYM
I = I+1; STORED(I) = SYM
->1 IF SYM = NL
REPEAT
T(3): !%M, %F, %Q
MON = 'M'-CODE
->1
FINISH
2: I = TYPE&15; ->ER2 IF I < 4
CODE = SYM; TEXT = 0; NUM = 1; !DEFAULT VALUES
READ ITEM
->T(I)
T(4): !FIND
NUM = 0 UNLESS TYPE = 0
T(5): !+DEL,TRAV,UNCOVER
CODE = NUM<<7+CODE; NUM = 1
READ ITEM IF TYPE = 0
T(6): !+INSERT,SUBST,VERIFY
->ER4 IF TYPE # 3
TEXT = TI; I = SYM
61: READ SYM
IF SYM # NL START
IF SYM # I START
->ER6 IF TI <= CI
INTEGER(TI) = SYM; TI = TI-1
->61
FINISH
FINISH ELSE START
PEND = SYM
->ER4 UNLESS CODE = 'S' OR CODE = 'I'
FINISH
->ER4 IF TI = TEXT AND CODE # 'S'
INTEGER(TI) = 0; TI = TI-1
->81
T(8): !MOVE,ERASE
->100 UNLESS SYM = '-'
CODE = CODE+10
81: READ ITEM
->101
T(9): !CLOSE BRACKET
UNCHAIN; ->ER3 IF TEXT = 0
CODE = 'Z'; INTEGER(TEXT+2) = NUM
TEXT = TEXT+3
T(10): !+GET,KILL,ETC.
100:->ER1 IF TYPE = 3
101:READ ITEM IF TYPE = 0
->PUT
T(11): !OPEN BRACKET
CODE = 'X'
->121
T(12): !COMMA
CODE = 'Y'
READ ITEM IF TYPE = 1
121:TEXT = CHAIN; CHAIN = CI
NUM = 0
PUT:STACK(CODE); STACK(TEXT); STACK(NUM)
->ER6 IF CI+4 >= TI
->2 UNLESS TYPE = 1
UNCHAIN; ->ER3 IF TEXT # 0
CMAX = CI
STACK('Z'); STACK(CBASE); STACK(1); !EXTRA CLOSE B
STACK(0)
->GO
!COMMAND INPUT ERROR REPORTS
ER1:SPACE; PRINT SYMBOL(CODE)
ER2:CODE = SYM
->ER5
ER3:PRINTTEXT ' ()'
->ER7
ER4:PRINTTEXT ' TEXT FOR'
T(0):
ER5:SPACE; PRINT SYMBOL(CODE&127)
->ER7
ER6:PRINTTEXT ' SIZE'
ER7:PRINT SYMBOL('?')
NEWLINE; CMAX = 0 IF CI # CBASE
10: ->1 IF INPUT = 0
READ SYM
->10
!EXECUTE COMMAND LINE
GO: CI = CBASE
GET:CODE = INTEGER(CI)&127; ->99 IF CODE = 0
TEXT = INTEGER(CI+1)
NUM = INTEGER(CI+2)
CI = CI+3
REP:NUM = NUM-1
->S(CODE)
OK: ->REP UNLESS NUM = 0 OR NUM = STOP
->GET
S(92): !INVERT
NO: ->GET IF NUM < 0
CI = CI+3 AND ->GET IF INTEGER(CI) = 92
SKP:I = INTEGER(CI); CI = INTEGER(CI+1) IF I = 'X'
CI = CI+3
NUM = INTEGER(CI-1)-1 AND ->NO IF I > 'X'
->SKP IF I # 0
!EXECUTION ERROR REPORT
PRINTTEXT 'FAILURE: '
IF CODE='O' OR CODE='W' START
PRINT SYMBOL(CODE-10); CODE = '-'
FINISH
PRINT SYMBOL(CODE)
IF TEXT # 0 START
PRINT SYMBOL('''')
WHILE INTEGER(TEXT) # 0 CYCLE
PRINT SYMBOL(INTEGER(TEXT))
TEXT = TEXT-1
REPEAT
PRINT SYMBOL('''')
FINISH
NEWLINE
READ CH(SYM) WHILE INPUT # 0
PRINT1 = 0
!END OF COMMAND LINE
99: ->1 IF SYM # NL OR INPUT # 0
->1 UNLESS (MON>=0 AND PRINT1#LEND) OR (MON>0 AND PRINT2#FP+PP)
NUM = 0; PRINT LINE
->1
!INDIVIDUAL COMMANDS
S('X'): !OPEN BRACKET
INTEGER(TEXT+2) = NUM+1
->GET
S('Z'): !CLOSE BRACKET
->GET IF NUM = 0 OR NUM = STOP
INTEGER(CI-1) = NUM
S('Y'): !+COMMA
CI = TEXT
->GET
S('R'): !RIGHT SHIFT
->NO IF FP = LEND
LOAD PP(BYTE(FP)); FP = FP+1
->OK
S('L'): !LEFT SHIFT
->NO IF IN = SIN OR PP = LBEG
FP = FP-1; PP = PP-1; LOAD FP(BYTE(PP))
MS = 0
->OK
S('E'): !ERASE
->NO IF FP = LEND
FP = FP+1
->OK
S('O'): !ERASE BACK
->NO IF PP = LBEG
PP = PP-1
->OK
S('V'): !VERIFY
I = FP-1; J = TEXT+1
V1: I = I+1; J = J-1
K = INTEGER(J)
->V1 IF BYTE(I) = K
->NO IF K # 0
MS = FP; ML = I
->OK
S('F'): !FIND
->NO IF MATCHED = 0
->OK
S('U'): !UNCOVER
->NO IF MATCHED = 0; PP = PP1
->OK
S('D'): !DELETE
->NO IF MATCHED = 0; FP = ML
->OK
S('T'): !TRAVERSE
->NO IF MATCHED = 0
S('S'): !SUBSTITUTE
FP = ML IF FP = MS
S('I'): !INSERT
MAKE SPACE
->NO IF PP-LBEG+LEND-FP > 80
I = TEXT
I1: ->OK IF INTEGER(I) = 0
LOAD PP(INTEGER(I)); I = I-1
->I1
S('G'): !GET (LINE FROM TT)
PROMPT(':'); PROMPT(0)
MAKE SPACE
READ CH(I)
->NO IF I = ':'
LEFT STAR
WHILE I # NL CYCLE
LOAD PP(I)
READ CH(I)
REPEAT
S('B'): !BREAK (INSERT NEWLINE)
LOAD PP(NL); LBEG = PP
->OK
S('P'): !PRINT
PRINT LINE
->GET IF NUM = 0
S('M'): !+MOVE
RIGHT STAR
->NO IF FP = FEND
LOAD PP(NL); LBEG = PP
M1: ISZ FP; MAKE SPACE; READ LINE
->OK
S('K'): !KILL (LINE)
PP = LBEG; FP = LEND
K1: ->NO IF FP = FEND
->M1
S('J'): !JOIN (DELETE NEWLINE)
RIGHT STAR
->NO IF PP-LBEG > 80
->K1
S('W'): !MOVE BACK
->NO IF IN = SIN
MAKE SPACE
->NO IF LBEG = TOP
LEND = FP-PP+LBEG-1
W1: K = BYTE(PP-1)
->W2 IF K = NL AND PP # LBEG
FP = FP-1; PP = PP-1; LOAD FP(K)
->W1
W2: LBEG = PP; MS = 0
->OK
T(1): !%S, %C
->EOF IF CODE = 'C'
SWITCH INPUTS
->99
EOF:CODE = 'C'; !+EOF ON COMMAND STREAM
SWITCH INPUTS IF IN = SIN
CYCLE
RIGHT STAR
EXIT IF FP = FEND
LOAD PP(NL); LBEG = PP
ISZ FP; MAKE SPACE; READ LINE
REPEAT
SELECT OUTPUT(MOUT)
WHILE TOP # PP CYCLE
PRINT CH(BYTE(TOP)); TOP = TOP+1
REPEAT
ENDOFPROGRAM