%begin
   %option "Noopen"
! Implementation of Edinburgh Compatible Context Editor in IMP
! K.Adam & R. Thonnes (April 1977)
! based on that for DEC PDP-9/15 by H.Dewar (June 1970)
! Updated for Mouses P. Robertson (June 1980)
! with:   Re-implementation of - commands using lower-case controls
!         Plus:  J-  K-  C  C-  L-  R-  O
%OWNINTEGER BUFFER SIZE = 3000
%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=1;                    !MONITOR INDICATOR
%OWNINTEGER PRINT1=0,PRINT2=0;        !PRINT INDICATORS
%OWNINTEGER SYM = NL
%BYTEINTEGERARRAY MAP(0:127);         !UPPER/LOWER CASE MAP
%INTEGER I,J,K,PP1
%CONSTINTEGER SEXTRA=180;             !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:
%externalstring(17) %spec Console int
%INTEGER CODE;                        !COMMAND CODE SYMBOL
%INTEGER TEXT;                     !TEXT POINTER (0 IF NOT RELEVANT)
%INTEGER 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.
%INTEGERARRAY C(0:119)
%INTEGER CBASE;  CBASE = ADDR(C(0));  !(CONST AD)
%INTEGER TBASE;  TBASE = CBASE+119*4;   !(CONST AD)
%INTEGER CI;                       !COMMAND INDEX (AD)
%INTEGER TI;                       !TEXT INDEX (AD)
%OWNINTEGER CMAX=0;                   !COMMAND MAX (AD)

!  Macro definitions (optional feature)
%INTEGERARRAY STORED(1:192);       !DEFS OF X,Y,Z
%OWNINTEGER POS1=0, POS2=0, POS3=0;   !DEF POINTERS
%owninteger null file = 0

%include "sysinc:command.inc"
%begin
   %integer j
   %externalintegerfnspec out type
   %on 9 %start
      select output(0)
      printstring("Edit ".Command_In1." fails -- ".Event_message)
      newline
      %stop
   %finish
   buffer size = freespace-1000
   %signal 1,0 %if buffer size < 1000
   map(j) = j %for j = 0, 1, 127
   map(j+32) = j %for j = 'A', 1, 'Z';    !start with lower=upper (%u)
   command_in1 = "n:" %if command_in1 = ""
   command_in2 = command_in1 %if command_in2 = ""
   command_out1 = command_in1 %if command_out1 = ""
   open input(1, command_in1)
   open input(2, command_in2)
   open output(1, command_out1)
   select output(1);  null file = 1 %if out type = 0
   select output(0)
%end
%BYTEINTEGERARRAY A(0:BUFFER SIZE)
!  The following variables are pointers to the main array A
!Their values are interpreted as byte addresses by
!the machine-code byte-accessing routines LOAD PP, LOAD
!FP and BYTE.
!The addresses of the left and right bytes of a word are
!2W and 2W+1 respectively: hence incrementation and comparison
!properties are preserved.
%OWNINTEGER TOP=1; !TOP OF BUFF (CONST)
%INTEGER BOT;  BOT=BUFFER SIZE-sextra-1;  !BOTTOM OF BUFF (CONST)
%INTEGER LBEG;                        !LINE START
%INTEGER PP;                          !PREVIOUS POINTER
%OWNINTEGER FP=0;                       !FILE POINTER
%INTEGER LEND;                        !LINE END
%OWNINTEGER FEND=0;                  !END OF FILE IN BUFF
%OWNINTEGER MS=0;                     !MATCH START
%OWNINTEGER ML=0;                     !MATCH LIMIT
%OWNINTEGER CASE = 95;                 !%U DEFAULT
%owninteger gprompt = 1;               !zero to inhibit any prompt for G
!  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
%INTEGER TYPE,CHAIN
%OWNINTEGER PEND=0
%SWITCH T(0:14)
%SWITCH S('(':126)
%ROUTINESPEC PRINT LINE

!  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) =
     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, 18,10,24, 5, 8,52,234, 2, 6, 8, 8,120,56, 2, 13,
  10,50, 8,22, 5,117, 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  [  \  ]  ^  _

   %on %event 9 %start
      ->er7
   %finish


%ROUTINE READ SYM
   %on %event 9 %start
      sym = '%'
      pend = 'C'
      %return
   %finish
!  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)
      %signal 9 %if sym < 0
    %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*10-'0'+SYM
       %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 = 0
       CHAIN = INTEGER(TEXT+4);  INTEGER(TEXT+4) = CI
       %RETURN %IF INTEGER(TEXT) = '('
    %REPEAT
%END

%ROUTINE STACK(%INTEGER V)
    INTEGER(CI) = V;  CI = CI+4
%END

%ROUTINE READ LINE
   %INTEGER K
   %on %event 9 %start
      ->eof
   %finish
!  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
       SELECT INPUT(IN);  
       FP = BOT-181
       %CYCLE
          %IF FP # BOT %THEN%START
             READSYMBOL(K)
          %FINISHELSE K = NL
          A(FP)=K&127;  FP = FP+1
         %exit %if k = nl
      %repeat
       FEND = FP;  LEND = FEND-1
       FP = BOT-181
       ->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
   SELECT INPUT(0); SELECT OUTPUT(0)
   STORED(0<<6+1) = 0
   STORED(1<<6+1) = 0
   STORED(2<<6+1) = 0
    PP = TOP-1;  BREAK;               !FOR BOUNCING OFF
    MAINFP == FP
    READ LINE

   ->MONITOR
READ COMMAND:
   Console int = ""
    CI = CBASE;  TI = TBASE;  CHAIN = 0
   %IF IN#SIN %THEN PROMPT(">") %ELSE PROMPT(">>")
    READ ITEM
   %IF TYPE = 1 %AND SYM = NL %START
      I = NUM
      NUM = 0;  PRINT LINE
      NUM = I
   %FINISH
    ->READ COMMAND %IF TYPE = 1;!IGNORE BLANK LINES
    %IF TYPE = 0 %AND CMAX # 0 %START
       INTEGER(CMAX+8) = 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
T(7):
   CASE = -32
   CASE = 0 %IF CODE = 'L'
   MAP(J) = J+CASE %FOR J = 'a', 1, 'z'
   ->READ COMMAND
t(14):gprompt = 1-gprompt
      ->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(13):!OBSERVE
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
       INTEGER(TI) = SYM;  TI = TI-4
    %REPEAT
    ->ER4 %IF (SYM=NL %OR TI=TEXT) %AND CODE # 'I' %AND CODE # 'S'
    INTEGER(TI) = -1;  TI = TI-4;      !TEXT END MARKER
    ->RI
T(8): !MOVE,ERASE
    ->NQ %UNLESS SYM = '-'
    CODE = CODE+32;                   !to lower case
RI: READ ITEM
    ->RN
T(9): !CLOSE BRACKET
    UNCHAIN;  ->ER3 %IF TEXT = 0
    INTEGER(TEXT+8) = NUM
    TEXT = TEXT+12
T(10): !+GET,KILL,ETC.
NQ: ->ER1 %IF TYPE = 3;               !WOULD FAIL LATER BUT WITH LESS HELPFUL RE
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+8 >= TI
    ->NEXT UNIT %UNLESS TYPE = 1
    UNCHAIN;  ->ER3 %IF TEXT # 0
    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' %OR CODE = 'A';         !BUT ALL IF CLOSING
    %if null file = 0 %start
       select output(mout)
       %CYCLE
          K = A(P1);  PRINT SYMBOL(K);  P1 = P1+1
         %exit %if k = nl %and p1 >= p2
      %repeat
       SELECT OUTPUT(0)
    %else
       p1 = p2;  p1 = p1+1 %while a(p1) # nl
       p1 = p1+1
    %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

%PREDICATE MATCHED
%INTEGER I,J,K,L,T1,FP1,LIM
!  Used for Find, Uncover, Delete, Traverse
    LIM = INTEGER(CI-12)>>7;       !SEARCH LIMIT
    T1 = MAP(INTEGER(TEXT));               !EXTRACT FIRST CHAR FOR SPEED
    %CYCLE
       PP1 = PP;  FP1 = FP
       %WHILE FP # LEND %CYCLE
          K = A(FP)
          %IF MAP(K) = T1 %AND (FP#MS %OR CODE='D' %OR CODE='T') %START
             I = FP;  J = TEXT
             %CYCLE
                I = I+1;  J = J-4;  L = INTEGER(J)
                %IF L < 0 %START;     !COMPLETE STRING MATCHED
                   MS = FP;  ML = I
                   PRINT LINE %IF CODE = 'O'
                   %TRUE
                %FINISH
             %REPEAT %UNTIL MAP(L) # MAP(A(I))
          %FINISH
          A(PP)=K
          PP = PP+1;  FP = FP+1
       %REPEAT
       LIM = LIM-1
       %EXIT %IF LIM = 0 %OR FP = FEND %OR Console int # ""
       %IF CODE = 'O' %START
          J = NUM;  NUM = 1;  PRINT LINE;  NUM = J
       %FINISH
       %IF CODE # 'U' %THEN BREAK %ELSE PP = PP1
       REFRESH
    %REPEAT
    PP = PP1;  FP = FP1
    %FALSE
%END


EXECUTE:
    Console int = ""
    CI = CBASE
GET:CODE = INTEGER(CI)&127;  ->MONITOR %IF CODE = 0
    TEXT = INTEGER(CI+4)
    NUM = INTEGER(CI+8)
    CI = CI+12
REP:NUM = NUM-1
    ->HALT %UNLESS Console int = ""
    ->S(CODE)
OK: ->REP %UNLESS NUM = 0 %OR NUM = STOP
    ->GET
S('\'): !INVERT
NO: ->GET %IF NUM < 0
    CI = CI+12 %AND ->GET %IF INTEGER(CI) = '\'
SKP:I = INTEGER(CI);  CI = INTEGER(CI+4) %IF I = '('
    CI = CI+12
    NUM = INTEGER(CI-4)-1 %AND ->NO %IF I = ',' %OR I = ')'
    ->SKP %IF I # 0

!EXECUTION ERROR
HALT:
    PRINT STRING("FAILURE: ")
    %if code >= 'a' %start
       PRINT SYMBOL(CODE-32);  CODE = '-'
    %FINISH
    PRINT SYMBOL(CODE)
    %IF TEXT # 0 %and code # ')' %START
       PRINT SYMBOL('''')
       %WHILE INTEGER(TEXT) >= 0 %CYCLE
          PRINT SYMBOL(INTEGER(TEXT))
          TEXT = TEXT-4
       %REPEAT
       PRINT SYMBOL('''')
    %FINISH
    NEWLINE
    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
    INTEGER(TEXT+8) = NUM+1
    ->GET
S(')'): !CLOSE BRACKET
    ->GET %IF NUM = 0 %OR NUM = STOP
    INTEGER(CI-4) = NUM;              !UPDATED REPETITION NUMBER
S(','): !+COMMA
    CI = TEXT
    ->GET
S('C'):!CASE SHIFT
      J = A(FP)
      J = J!!32 %IF 'A' <= J&95 <= 'Z'
      A(FP) = J
s('l'):!left minus
S('R'): !RIGHT SHIFT
    ->NO %IF FP = LEND
    A(PP)=A(FP)
    PP = PP+1;  FP = FP+1
    ->OK
s('c'):!c-
s('r'):!R-
S('L'): !LEFT SHIFT
    ->NO %IF PP = LBEG %OR IN = SIN
    FP = FP-1;  PP = PP-1
    j = a(pp)
    j = j!!32 %if code = 'c' %and 'A' <= j&95 <= 'Z'
    a(fp) = j
    MS = 0
    ->OK
S('E'): !ERASE
    ->NO %IF FP = LEND
    FP = FP+1
    ->OK
S('e'): !ERASE BACK
    ->NO %IF PP = LBEG
    PP = PP-1
    ->OK
S('V'): !VERIFY
    I = FP-1;  J = TEXT+4
V1: I = I+1;  J = J-4
    K = MAP(INTEGER(J))
    ->V1 %IF MAP(A(I)) = K
    ->NO %IF K >= 0
    MS = FP;  ML = I
    ->OK
S('O'):!OBSERVE
S('F'): !+FIND
    ->NO %UNLESS MATCHED
    ->OK
S('U'): !UNCOVER
    ->NO %UNLESS MATCHED;  PP = PP1
    ->OK
S('D'): !DELETE
    ->NO %UNLESS MATCHED;  FP = ML
    ->OK
S('T'): !TRAVERSE
    ->NO %UNLESS MATCHED
   FP = ML
   I = MS
   %CYCLE
      ->OK %IF I = FP
      A(PP) = A(I)
      PP = PP+1;  I = I+1
   %REPEAT
S('S'): !SUBSTITUTE
    ->NO %IF FP # MS
     FP = ML
S('I'): !+INSERT
    MAKE SPACE
    ->NO %IF PP-LBEG+LEND-FP > 160
    I = TEXT
    %CYCLE
       ->OK %IF INTEGER(I) < 0
       A(PP)=INTEGER(I)
       PP = PP+1;  I = I-4
    %REPEAT
S('G'): !GET (LINE FROM TT)
    %if gprompt = 0 %then prompt("") %else PROMPT(":")
    MAKE SPACE
    READ SYMBOL(I)
    %IF I = ':' %START
       SYM = NEXTSYMBOL
       SKIPSYMBOL %IF SYM = NL
       ->NO
    %FINISH
    LEFT STAR
    %WHILE I # NL %CYCLE
       A(PP)=I;  PP = PP+1
       READ SYMBOL(I)
    %REPEAT
S('B'): !+BREAK (INSERT NEWLINE)
    BREAK
    MAKE SPACE
    ->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)
k0: PP = LBEG;  FP = LEND
K1: ->NO %IF FP = FEND
    ->M1
S('J'): !JOIN (DELETE NEWLINE)
j0: RIGHT STAR
    ->NO %IF PP-LBEG > 160
    ->K1
s('k'):!K-
s('j'):!J-
S('m'): !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
    ->K0 %if code = 'k'
    ->J0 %if code = 'j'
    ->OK
s(*):->NO

%ROUTINE SWITCH INPUTS
    %OWNINTEGER MFP,MLEND,MEND,SFP=0,SEND=0
    %string(63) file
    %on 9 %start
       printstring("*Cannot open ".file." -- ".event_message)
       newline
       %return
    %finish
    %IF IN = MIN %START
       %if sym = '=' %start;   !redefine secondary input
          file = ""
          %cycle
             readsym
             %exit %if sym = nl
             file = file.tostring(sym)
          %repeat
          open input(sin, file)
          sfp = 0;  send = 0
       %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, %A
    %if type # 1 %start
       ->er2 %if sym # '=' %or in=sin %or code # 'S'
    %finish
    %IF CODE = 'S' %START
       SWITCH INPUTS
       ->MONITOR
    %FINISH
!CLOSE FILE (+EOF ON COMMAND STREAM)
    %if null file = 0 %start
       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
    %finish
    %SIGNAL 0, 1 %IF CODE = 'A'
    select output(0)
    printstring(command_out1. " complete") %and newline %if null file = 0
%endofprogram
