CONTROL K'101011'
! STACK=60000, STREAMS=3
BEGIN
CONSTBYTEINTEGERNAME INT=K'160060'
RECORDFORMAT STRDF(INTEGER A,B,C,BYTEINTEGER SER,REPLY, C
INTEGER D,E,F,G,H,I,J,K)
PERMRECORD (STRDF)MAPSPEC RECORD(INTEGER X)
RECORDFORMAT STRPF(RECORD (STRDF)NAME STRD)
CONSTRECORD (STRPF)NAME INST1=K'160034', INST2=K'160036', OUTST1=K'160044'
CONSTINTEGERNAME XOUTST1=K'160044'
CONSTRECORD (STRDF)NAME NULL=0
CONSTINTEGER BUFFSIZE = 20000
! Implementation of Edinburgh Compatible Context Editor in IMP
! for PDP-11 under DEIMOS by G. Brebner (Sept 1978) based on that
! for Ferranti SDS (Serial DISC) by K.Adam & R.Thonnes (April 1977)
! based on that for DEC PDP-9/15 by H.Dewar (June 1970)
CONSTINTEGER MIN=1; !MAIN INPUT STREAM
CONSTINTEGER MOUT=1; !MAIN OUTPUT STREAM
CONSTINTEGER SIN=2; !SECONDARY INPUT STREAM
! Secondary input is not a standard feature of ECCE
CONSTINTEGER STOP=-5000; !LOOP STOP VALUE
OWNINTEGER IN=MIN; !CURRENT INPUT STREAM
OWNINTEGER MON; !MONITOR INDICATOR
OWNINTEGER PRINT1, PRINT2; !PRINT INDICATORS
INTEGER I,J,K,PP1,SYM
CONSTINTEGER SEXTRA=122; !EXTRA BUFFER FOR SIN
INTEGERNAME MAINFP; ! == FP OR MFP (FOR SIN)
! The command input phase reads and checks a complete
!command line, forming up an internal representation
!as a sequence of fixed-length command units.
!The basic components of a command unit are:
OWNINTEGER CODE; !COMMAND CODE SYMBOL
OWNINTEGER TEXT; !TEXT POINTER (0 IF NOT RELEVANT)
OWNINTEGER NUM; !REPETITION NUMBER
!Command units are stored sequentially from the start
!of array C (CBASE): text strings are stored backwards
!from the end of the same array (TBASE).
!Parentheses and commas occurring in commands are also
!transformed to command units. The TEXT component of
!open bracket and comma units points to the corresponding
!close bracket: the TEXT component of close bracket
!units points back to the first enclosed unit.
OWNINTEGERARRAY C(0:179)
OWNINTEGER CBASE=0
OWNINTEGER TBASE=179
OWNINTEGER CI; !COMMAND INDEX (AD)
OWNINTEGER TI; !TEXT INDEX (AD)
OWNINTEGER CMAX; !COMMAND MAX (AD)
! Macro definitions (optional feature)
OWNINTEGERARRAY STORED(1:192); !DEFS OF X,Y,Z
OWNINTEGER POS1, POS2, POS3; !DEF POINTERS
BYTEINTEGERARRAY A(0:BUFFSIZE+2)
! The following variables are pointers to the main array A
OWNINTEGER TOP=1; !TOP OF BUFF (CONST)
OWNINTEGER BOT; BOT=BUFFSIZE-121; !BOTTOM OF BUFF (CONST)
OWNINTEGER LBEG; !LINE START
OWNINTEGER PP; !PREVIOUS POINTER
OWNINTEGER FP; !FILE POINTER
OWNINTEGER LEND; !LINE END
OWNINTEGER FEND; !END OF FILE IN BUFF
OWNINTEGER MS; !MATCH START
OWNINTEGER ML; !MATCH LIMIT
! The (part of the) file held in the array A is
!stored as a top half (from TOP inclusive to PP exclusive)
!and a bottom half (from FP inclusive to FEND exclusive).
!The gap corresponds to the position of the file-pointer.
!Text location operations do not therefore simply involve
!moving a pointer: the text passed over is moved across
!the gap. The additional processing overhead is relatively
!small and is outweighed by the simplification of insertion and
!deletion operations that is achieved by this technique.
! Illustration of pointer significance:
! [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
OWNINTEGER TYPE,CHAIN
OWNINTEGER PEND
SWITCH T(0:12)
SWITCH S('(':'¬')
! Symbol classification codes are 16X+Y, where Y
!is the basic code and X is used to sub-classify
!when necessary (eg percent command letters).
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
! Read command symbol
IF PEND # 0 THEN SYM=PEND AND PEND=0 ELSE START
WHILE POS3 # 0 CYCLE ; !MACRO EXPANSION
SYM = STORED(POS3); POS3 = POS3+1
RETURN UNLESS SYM = 0
POS3 = POS2; POS2 = POS1; POS1 = 0
REPEAT
READ SYMBOL(SYM)
FINISH
END
ROUTINE READ ITEM
! Read command item (symbol or number), skipping leading
!spaces, standardising case and detecting macro letters.
!Set up the type (ie SYMTYPE) of the item in TYPE.
!For a 'numeric' item, assemble sequence of digits
!as necessary and return value in NUM.
!Note that NUM is not altered for a non-numeric item.
CYCLE
TYPE = 1; !DEFAULT FOR NL
READ SYM UNTIL SYM # ' '
RETURN IF SYM < ' '; !TREAT ANY CONTROL AS NL
SYM = SYM-32 IF SYM >= 96; !ENSURE UPPER CASE
TYPE = SYMTYPE(SYM)
RETURN UNLESS TYPE&15 = 0; !RETURN UNLESS NUMERIC OR X,Y,Z
EXIT UNLESS TYPE = 32; !X,Y,Z (MACRO LETTERS)
POS1 = POS2; POS2 = POS3
POS3 = (SYM-'X')<<6+1
REPEAT
IF TYPE = 0 START ; !DECIMAL DIGIT
NUM = SYM-'0'
CYCLE
READ SYM
EXIT UNLESS '0' <= SYM <= '9'
NUM = (NUM<<2+NUM)<<1-'0'+SYM;!IE NUM*10+SYM-'0'
REPEAT
PEND = SYM
FINISH ELSE START
TYPE = 0
NUM = 0; RETURN IF SYM = '*'
NUM = STOP+1; RETURN IF SYM = '?'
NUM = STOP; ! '!'
FINISH
END
ROUTINE UNCHAIN
! Use temporary links to locate last unmatched
!open bracket (if any), fixing up any comma
!units en route.
CYCLE
TEXT = CHAIN; RETURN IF TEXT = -1
CHAIN = C(TEXT+1); C(TEXT+1) = CI
RETURN IF C(TEXT) = '('
REPEAT
END
ROUTINE STACK(INTEGER V)
C(CI) = V; CI = CI+1
END
ROUTINE READ LINE
INTEGER K
! Read line from file (if bottom part of buffer empty)
IF FP # FEND START ; !LINE AVAILABLE
LEND = FP
LEND = LEND+1 WHILE A(LEND) # NL
FINISH ELSE START
->EOF IF INST1_STRD==NULL
SELECT INPUT(IN);
FP = BOT-121
UNTIL K=NL CYCLE
IF FP# BOT START
->EOF IF NEXTSYMBOL&K'377'=4
READ SYMBOL(K)
ELSE K=NL
A(FP)=K; FP = FP+1
REPEAT
FEND = FP; LEND = FEND-1
FP = BOT-121
->L1
EOF: FP = BOT; LEND = FP; FEND = LEND
A(FP)=NL
L1: SELECT INPUT(0)
MS = 0; PRINT1 = 0; PRINT2 = 0
FINISH
END
ROUTINE BREAK
A(PP)=NL; PP = PP+1; LBEG = PP
END
!INITIALISE
!
! NASTY BIT TO CHANGE 'E FRED' TO 'E FRED/FRED'
!
IF OUTST1_STRD==NULL START
XOUTST1=K'162602'
OUTST1_STRD=INST1_STRD
FINISH
!
!
PP = TOP-1; BREAK; !FOR BOUNCING OFF
MAINFP == FP
IF INST1_STRD==NULL START
FP=BOT; LEND=FP; FEND=LEND
A(FP)=NL
ELSE
READ LINE
FINISH
PRINT STRING('Edit'); NEWLINE
READ COMMAND:
CI = CBASE; TI = TBASE; CHAIN = -1
IF IN=MIN THEN PROMPT(">") ELSE PROMPT(">>")
READ ITEM; ->READ COMMAND IF TYPE = 1;!IGNORE BLANK LINES
IF TYPE = 0 AND CMAX # 0 START
C(CMAX+2) = NUM
READ ITEM; ->ER2 IF TYPE # 1
->EXECUTE
FINISH
->NEXT UNIT UNLESS SYM = '%'
READ SYM; SYM = SYM-32 IF SYM >= 96
CODE = SYM; ->ER5 IF CODE < 'A'
READ ITEM
->T(SYMTYPE(CODE)>>4); !SWITCH ON EXT TYPE
!T(1) AT END OF PROGRAM
T(2): !%X, %Y, %Z (MACRO DEFINITION)
->ER1 IF SYM # '='
I = (CODE-'X')<<6+1
CYCLE
READ SYM
EXIT IF SYM = NL
STORED(I) = SYM
->ER6 IF I&63 = 0
I = I+1
REPEAT
STORED(I) = 0
->READ COMMAND
T(3): !%M, %F, %Q (MONITOR CONTROL)
MON = 'M'-CODE
->READ COMMAND
NEXT UNIT:
!FIRST ITEM ALREADY READ
I = TYPE&15; ->ER2 IF I < 4
CODE = SYM; TEXT = 0; NUM = 1; !DEFAULT VALUES
READ ITEM
->T(I); !SWITCH ON BASIC TYPE
T(4): !FIND
NUM = 0 UNLESS TYPE = 0
T(5): !+DEL,TRAV,UNCOVER
CODE = NUM<<7+CODE; !PACK LIMIT NUMBER
NUM = 1; !RESET DEFAULT REPETITION
READ ITEM IF TYPE = 0
T(6): !+INSERT,SUBST,VERIFY
->ER4 IF TYPE # 3; !NOT LEGIT QUOTE SYMBOL ->
TEXT = TI; I = SYM
CYCLE
READ SYM
EXIT IF SYM = I
PEND = SYM AND EXIT IF SYM = NL
->ER6 IF TI <= CI
C(TI) = SYM; TI = TI-1
REPEAT
->ER4 IF (SYM=NL OR TI=TEXT) AND CODE # 'I' AND CODE # 'S'
C(TI) = 0; TI = TI-1; !TEXT END MARKER
->RI
T(8): !MOVE,ERASE
->NQ UNLESS SYM = '-'
CODE = CODE+10; !'E'->'O' 'M'->'W'
RI: READ ITEM
->RN
T(9): !CLOSE BRACKET
UNCHAIN; ->ER3 IF TEXT = -1
C(TEXT+2) = NUM
TEXT = TEXT+3
T(10): !+GET,KILL,ETC.
NQ: ->ER1 IF TYPE = 3; !WOULD FAIL LATER BUT WITH LESS HELPFUL R
RN: READ ITEM IF TYPE = 0
->PUT
T(12): !COMMA
READ ITEM IF TYPE = 1; !IGNORE FOLLOWING NL
T(11): !OPEN BRACKET
TEXT = CHAIN; CHAIN = CI
NUM = 0
PUT:STACK(CODE); STACK(TEXT); STACK(NUM)
->ER6 IF CI+2 >= TI
->NEXT UNIT UNLESS TYPE = 1
UNCHAIN; ->ER3 IF TEXT # -1
CMAX = CI
STACK(')'); STACK(CBASE); STACK(1); !EXTRA ')'
STACK(0)
->EXECUTE
!COMMAND INPUT ERROR REPORTS
ER1:SPACE; PRINT SYMBOL(CODE)
ER2:CODE = SYM
->ER5
ER3:PRINT STRING(" ()")
->ER7
ER4:PRINT STRING(" TEXT FOR")
T(0):
ER5:SPACE; PRINT SYMBOL(CODE&127)
->ER7
ER6:PRINT STRING(" SIZE")
ER7:PRINT SYMBOL('?')
NEWLINE; CMAX = 0 IF CI # CBASE
READ SYM WHILE SYM#NL
->READ COMMAND
ROUTINE LEFT STAR
CYCLE
RETURN IF PP = LBEG
FP = FP-1; PP = PP-1
A(FP)=A(PP)
REPEAT
END
ROUTINE RIGHT STAR
CYCLE
RETURN IF FP = LEND
A(PP)=A(FP)
PP = PP+1; FP = FP+1
REPEAT
END
ROUTINE MAKE SPACE
INTEGER K,P1,P2
! Check that sufficient breathing space remains
!in the internal file buffer. If not, expel part
!of the file.
RETURN IF MAINFP-PP > 240
P1 = TOP; P2 = (P1+LBEG)>>1; !OUTPUT ABOUT HALF
P2 = LBEG IF CODE = 'C'; !BUT ALL IF CLOSING
PRINT STRING('EDIT:SIGNAL 20') AND NEWLINE AND STOP IF P2 = TOP;
! LOGICAL ERROR
IF OUTST1_STRD_SER#1 START
SELECT OUTPUT(MOUT)
UNTIL K=NL AND P1>=P2 CYCLE
K = A(P1); PRINT SYMBOL(K); P1 = P1+1
REPEAT
SELECT OUTPUT(0)
ELSE
P1=P2
P1=P1+1 WHILE A(P1)#NL
FINISH
LBEG = TOP+LBEG-P1; P2 = PP; PP = TOP
WHILE P1 # P2 CYCLE ; !COPY UP REMAINDER
A(PP)=A(P1)
PP = PP+1; P1 = P1+1
REPEAT
END
ROUTINE REFRESH
FP = FP+1; MAKE SPACE; READ LINE
END
ROUTINE PRINT LINE
INTEGER P
PRINT1 = LEND; PRINT2 = FP+PP
P = LBEG
CYCLE
IF P = PP START
PRINT SYMBOL('^') IF P # LBEG AND NUM = 0
P = FP
FINISH
EXIT IF P = LEND
PRINT SYMBOL(A(P))
P = P+1
REPEAT
PRINT STRING("**END**") IF P = FEND
NEWLINE
END
INTEGERFN MATCHED
INTEGER I,J,K,L,T1,FP1,LIM
! Used for Find, Uncover, Delete, Traverse
LIM = C(CI-3)&(¬127); !SEARCH LIMIT (<<7)
T1 = C(TEXT); !EXTRACT FIRST CHAR FOR SPEED
CYCLE
PP1 = PP; FP1 = FP
WHILE FP # LEND CYCLE
K = A(FP)
IF K = T1 AND (FP#MS OR CODE='D' OR CODE='T') START
I = FP; J = TEXT
UNTIL A(I)#L CYCLE
I = I+1; J = J-1; L = C(J)
IF L = 0 START ; !COMPLETE STRING MATCHED
MS = FP; ML = I
RESULT = 1
FINISH
REPEAT
FINISH
A(PP)=K
PP = PP+1; FP = FP+1
REPEAT
LIM = LIM-128
EXIT IF LIM = 0 OR FP = FEND
IF CODE # 'U' THEN BREAK ELSE PP = PP1
REFRESH
REPEAT
PP = PP1; FP = FP1
RESULT = 0
YES:MS = FP; ML = I
RESULT = 1
END
EXECUTE:
CI = CBASE
GET:CODE = C(CI)&127; ->MONITOR IF CODE = 0
TEXT = C(CI+1)
NUM = C(CI+2)
CI = CI+3
REP:NUM = NUM-1
->S(CODE)
OK: INT=0 AND ->MONITOR IF INT='A'
->REP UNLESS NUM=0 OR NUM=STOP
->GET
S('¬'): !INVERT
NO: ->GET IF NUM < 0
CI = CI+3 AND ->GET IF C(CI) = '¬'
SKP:I = C(CI); CI = C(CI+1) IF I = '('
CI = CI+3
NUM = C(CI-1)-1 AND ->NO IF I = ',' OR I = ')'
->SKP IF I # 0
!EXECUTION ERROR
PRINT STRING("FAILURE: ")
IF CODE='O' OR CODE='W' START
PRINT SYMBOL(CODE-10); CODE = '-'
FINISH
PRINT SYMBOL(CODE)
IF TEXT # 0 START
PRINT SYMBOL('''')
WHILE C(TEXT) # 0 CYCLE
PRINT SYMBOL(C(TEXT))
TEXT = TEXT-1
REPEAT
PRINT SYMBOL('''')
FINISH
NEWLINE
READ SYMBOL(SYM) WHILE SYM#NL
PRINT1 = 0
MONITOR:
->READ COMMAND IF SYM # NL OR MON < 0
->READ COMMAND IF PRINT1 = LEND AND (MON = 0 OR PRINT2 = FP+PP)
NUM = 0; PRINT LINE
->READ COMMAND
!INDIVIDUAL COMMANDS
S('('): !OPEN BRACKET
!RESET REPETITION NUMBER ON CLOSE BRACKET
C(TEXT+2) = NUM+1
->GET
S(')'): !CLOSE BRACKET
->GET IF NUM = 0 OR NUM = STOP
C(CI-1) = NUM; !UPDATED REPETITION NUMBER
S(','): !+COMMA
CI = TEXT
->GET
S('R'): !RIGHT SHIFT
->NO IF FP = LEND
A(PP)=A(FP)
PP = PP+1; FP = FP+1
->OK
S('L'): !LEFT SHIFT
->NO IF PP = LBEG OR IN = SIN
FP = FP-1; PP = PP-1
A(FP)=A(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 = C(J)
->V1 IF A(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
->NO IF FP # MS
FP = ML
S('I'): !+INSERT
MAKE SPACE
->NO IF PP-LBEG+LEND-FP > 120
I = TEXT
CYCLE
->OK IF C(I) = 0
A(PP)=C(I)
PP = PP+1; I = I-1
REPEAT
S('G'): !GET (LINE FROM TT)
PROMPT(":")
MAKE SPACE
READ SYMBOL(I)
SKIP SYMBOL AND ->NO IF I = ':' AND NEXT SYMBOL=NL
LEFT STAR
WHILE I # NL CYCLE
A(PP)=I; PP = PP+1
READ SYMBOL(I)
REPEAT
S('B'): !+BREAK (INSERT NEWLINE)
BREAK
->OK
S('P'): !PRINT
PRINT LINE
->GET IF NUM = 0
S('M'): !+MOVE
RIGHT STAR
->NO IF FP = FEND
BREAK
M1: REFRESH
->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 > 120
->K1
S('W'): !MOVE BACK
->NO IF IN = SIN
MAKE SPACE
->NO IF LBEG = TOP
LEND = FP-PP+LBEG-1
CYCLE
K = A(PP-1)
EXIT IF K = NL AND PP # LBEG
FP = FP-1; PP = PP-1; A(FP)=K
REPEAT
LBEG = PP; MS = 0
->OK
ROUTINE SWITCH INPUTS
OWNINTEGER MFP,MLEND,MEND,SFP,SEND
IF IN = MIN START
IF INST2_STRD==NULL START
PRINTSTRING('NO ST2'); NEWLINE
RETURN
FINISH
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
T(1): !%C, %S
IF CODE = 'S' START
SWITCH INPUTS
->MONITOR
FINISH
!CLOSE FILE (+EOF ON COMMAND STREAM)
EOF:STOP IF OUTST1_STRD_SER=1
CODE = 'C'
SWITCH INPUTS IF IN = SIN
CYCLE
RIGHT STAR
EXIT IF FP = FEND
BREAK
REFRESH
REPEAT
SELECT OUTPUT(MOUT)
WHILE TOP # PP CYCLE
PRINT SYMBOL(A(TOP)); TOP = TOP+1
REPEAT
ENDOFPROGRAM