%CONTROL 0
%EXTERNALROUTINESPEC RIM(%INTEGER CNSL, %STRING (15) MES)
%EXTERNALINTEGERFNSPEC TESTINT(%INTEGER C %STRING(15) S)
%EXTERNALROUTINE EDINNER(%INTEGER INTOP,INSIZE,SINTOP,SINSIZE,TOP %C
%INTEGERNAME SIZE)
%SHORTROUTINE
%OWNINTEGER MON;                        !MONITOR INDIC
%OWNINTEGER PRINT1, PRINT2;             !PRINT INDICS
%OWNINTEGER STOP = -5000;               !LOOP STOP (CONST)
%INTEGER I, J, FP0, FP1, SYM
%BYTEINTEGER K
%OWNINTEGER PFLIP;                      !PROMPT FLIP-FLOP
%OWNSTRING (2) PROM = '>';              !COMMAND PROMPT
%OWNINTEGER CMAX;                       !COMMAND CELL MAX
%INTEGER CI;                            !COMMAND INDEX
%INTEGER TI;                            !TEXT INDEX
%INTEGER CODE;                          !COMMAND CODE
%INTEGER LIM;                           !SEARCH LIM
%INTEGER CODELIM;                       !LIM/CODE
%INTEGER TEXT;                          !TEXT STRING POINTER
%INTEGER NUM;                           !REPETITION NUMBER
%INTEGER LEN;                           !TEXT LENGTH (-1)
%INTEGER LBEG;                          !LINE START (AD)
%INTEGER LEND;                          !LINE END (AD)
%REGISTER FP(5);                        !FILE POINTER (AD)
%REGISTER PP(6);                        !PREVIOUS FILE POINTER
%INTEGER FEND;                          !END OF FILE (AD)
%OWNINTEGER MS;                         !MATCH START (AD)
%OWNINTEGER ML;                         !MATCH LIMIT (AD)
%OWNINTEGER SIN = 0;                    !SECONDARY INPUT IND
%OWNINTEGER MARKER
%INTEGER MFP, SFP, MEND, SEND
%INTEGER CB;                            !COMMAND BASE (CONST AD)
%INTEGER TB;                            !TEXT BASE (CONST AD)
%INTEGERARRAY CC(1 : 164);              !COMMAND SEQUENCE (4*41)
%BYTEINTEGERARRAY TT(1 : 80);           !TEXT STRINGS
%INTEGER TRTLIM;                        !LIM AD FOR TRT
%OWNBYTEINTEGERARRAY TTAB(0 : 255) =     0(10), 2, 0(245)
%INTEGER TYPE, CTYPE, QUOTE, CHAIN;     !COMMAND INPUT VARS
!SYMBOL TYPES:- 0:NUM, 1:TERMIN, 2:ILLEGAL, 3:QUOTE, 4:FIND, ....
!HIGH ORDER 4 BITS RELEVANT FOLLOWING PERCENT
%OWNBYTEINTEGERARRAY SYMTYPE(33 : 95) =     %C
     64, 3, 3, 3, 2, 3, 3,75,73,64, 3,76, 2, 3, 3,
   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 1, 3, 3, 3,64,
   3,202,10,18, 5, 8,116,10, 2, 6,10,10,10,120,202, 2,
  74,50,10,38,69, 5, 6, 2, 2, 2, 2, 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 ITEM
%SHORTROUTINE
%INTEGER I
   TYPE = 1
   READ SYMBOL(SYM) %UNTIL SYM # ' '
   %IF SYM > 32 %START
      SYM = SYM-32 %IF SYM >= 96;       !ENSURE UPPER CASE
      TYPE = SYMTYPE(SYM)
      %IF TYPE&15 = 0 %START
         %IF TYPE = 0 %START
            NUM = SYM-'0'

            %WHILE '0' <= NEXT SYMBOL <= '9' %CYCLE
               READ SYMBOL(I)
                NUM = 10NUM+I-'0'
            %REPEAT

         %FINISH %ELSE %START
            TYPE = 0;  NUM = 0
            NUM = STOP+1 %IF SYM = '?'
            NUM = STOP %IF SYM = '!'
         %FINISH
      %FINISH
   %FINISH
%END

%ROUTINE UNCHAIN
%SHORTROUTINE
1: TEXT = CHAIN
   %IF TEXT # 0 %START
      CHAIN = INTEGER(TEXT+4)
      INTEGER(TEXT+4) = CI
      -> 1 %IF INTEGER(TEXT) # 'X'
   %FINISH
%END

%ROUTINE PRINT LINE
%SHORTROUTINE
%INTEGER P, Q
   PRINT1 = LEND;  PRINT2 = PP+FP
   %IF SIN # 0 %START
      P = SFP;  Q = FP
   %FINISH %ELSE %START
      P = LBEG;  Q = PP
   %FINISH
   P = FP %IF P = Q

   %WHILE P # LEND %CYCLE
      PRINT SYMBOL(BYTEINTEGER(P))
      P = P+1
      %IF P = Q %START
         PRINT SYMBOL(94) %IF NUM = 1
         P = FP
      %FINISH
   %REPEAT

   %PRINTTEXT '**END**' %IF P > FEND
   NEWLINE
%END
%SWITCH C(0 : 12)
%SWITCH S('A' : 92)
!INITIALISE
PFLIP = 0
TB = ADDR(TT(1));  CB = ADDR(CC(1))
PP = TOP;  LBEG = PP
MEND = PP+SIZE-64;  FP = MEND-INSIZE+1
*L_1,INSIZE;  *L_2,INTOP;  *LR_3,5
*BAL_15,<MOV>;                          !MOVE(INSIZE,INTOP,FP)
MEND = MEND-1 %WHILE MEND >= FP %AND BYTEINTEGER(MEND) # NL
FEND = MEND
SEND = SINTOP+SINSIZE-1
SEND = SEND-1 %WHILE SEND >= SINTOP %AND BYTEINTEGER(SEND) # NL
SFP = SINTOP
SET:

TRTLIM = FEND-255
LEND = FP
LEND = LEND+1 %WHILE LEND < FEND %AND BYTEINTEGER(LEND) # NL
!READ COMMAND LINE
1:

CI = CB;  TI = TB;  CHAIN = 0
READ ITEM;  -> 1 %IF TYPE = 1;          !(IGNORE NLS)
%IF TYPE = 0 %AND CMAX # 0 %START;      !REPETITION
   INTEGER(CMAX+8) = NUM
   READ ITEM;  -> ER1 %IF TYPE # 1
   -> GO
%FINISH
%IF SYM = '%' %START
   READ ITEM;  CTYPE = TYPE>>4&3
   CODE = SYM
   READ ITEM;  -> ER1 %IF TYPE # 1
   -> C(CTYPE)
%FINISH
2:

CTYPE = TYPE&15;  -> ER2 %IF CTYPE < 4
-> ER0 %IF (\SIN!!TYPE)&192 = 0;        !(WORKS)
CODE = SYM;                             !COMMAND LETTER
TEXT = 0;  NUM = 1;  LEN = 0;           !DEFAULT VALUES
READ ITEM
-> C(CTYPE)
C(4):                                   !FIND
NUM = 0 %UNLESS TYPE = 0
C(5):                                   !+DEL,TRAV,UNCOVER
CODE = NUM<<7+CODE;  NUM = 1
READ ITEM %IF TYPE = 0
C(6):                                   !+INSERT,SUBST,VERIFY
-> ER4 %IF TYPE # 3
QUOTE = SYM;  TEXT = TI
61:

READ SYMBOL(SYM)
%IF SYM # NL %START
   %IF SYM # QUOTE %START
      -> ER6 %IF TI-TB > 78
      BYTEINTEGER(TI) = SYM;  TI = TI+1
      -> 61
   %FINISH
   READ ITEM
%FINISH %ELSE %START
   -> ER4 %UNLESS CODE = 'I' %OR CODE = 'S'
   TYPE = 1
%FINISH
LEN = TI-TEXT-1;                        !LENGTH - 1
-> ER4 %IF LEN < 0 %AND CODE # 'S'
BYTEINTEGER(TI) = 0;  TI = TI+1
-> 101
C(8):                                   !MOVE,ERASE
-> 100 %UNLESS SYM = '-'
CODE = CODE+10;  READ ITEM
-> 101
C(9):                                   !CLOSE BRACKET
UNCHAIN;  -> ER3 %IF TEXT = 0
CODE = 'Z';  INTEGER(TEXT+8) = NUM
C(10):                                  !GET, KILL, ETC.
100:

-> ER1 %IF TYPE = 3
101:

READ ITEM %IF TYPE = 0
-> PUT
C(11):                                  !OPEN BRACKET
CODE = 'X'
-> 121
C(12):                                  !COMMA
CODE = 'Y'
READ ITEM %IF TYPE = 1;                 !IGNORE FOLLOWING NL
121:

TEXT = CHAIN;  CHAIN = CI
NUM = 0
PUT:

INTEGER(CI) = CODE;  INTEGER(CI+4) = TEXT
INTEGER(CI+8) = NUM;  INTEGER(CI+12) = LEN
CI = CI+16;  -> ER6 %IF CI-CB > 640
-> 2 %UNLESS TYPE = 1
UNCHAIN;  -> ER3 %IF TEXT # 0
CMAX = CI
INTEGER(CI) = 'Z';  INTEGER(CI+4) = CB-16
INTEGER(CI+8) = 1;  INTEGER(CI+12) = 0
-> GO
ER0:

%PRINTTEXT ' SIN'
-> ER2
ER1:

SPACE;  PRINT SYMBOL(CODE)
ER2:

CODE = SYM
-> ER5
ER3:

%PRINTTEXT ' BRACKETS'
-> ERQ
ER4:

%PRINTTEXT ' TEXT FOR'
C(0):


ER5:

SPACE;  PRINT SYMBOL(CODE&127)
-> ERQ
ER6:

%PRINTTEXT ' SIZE'
ERQ:

PRINT SYMBOL('?')
NEWLINE;  CMAX = 0 %IF CI # CB
SKP:

-> 1 %IF SYM = NL;  READ SYMBOL(SYM)
-> SKP
!EXECUTE COMMAND LINE
GO:

CI = CB-16
GET:

CI = CI+16
CODELIM = INTEGER(CI);  TEXT = INTEGER(CI+4)
NUM = INTEGER(CI+8);  LEN = INTEGER(CI+12)
CODE = CODELIM&127
-> S(CODE)
!*I* IMP LOCATE LINE END
!LOK:LEND = FP
!    ->OK %IF FP > FEND %OR BYTEINTEGER(FP) = NL
!    %UNTIL BYTEINTEGER(LEND) = NL %CYCLE
!       LEND = LEND+1
!    %REPEAT
!*M* MCODE LOCATE LINE END
LOK:

*L_15,TTAB;                             !R15 = BASE OF TTAB
*LR_1,5;                                !R1 = FP
*C_1,TRTLIM;                            !R1 <= TRTLIM
*BC_12,<LK1>;                           !YES ->
*L_2,FEND;                              !R2 = FEND-R1
*SR_2,1
*BC_12,<LK2>;                           !<= 0 ->
*EX_2,<TRT>;                            !LOCATE NL
*BC_15,<LK2>
TRT:

*TRT_0(0,1),0(15);                      !FOR LOCATE & FIND
LK1:

*TRT_0(256,1),0(15);                    !LOCATE NL
*BC_8,<C1>;                             !NOT FOUND ->
LK2:

*ST_1,LEND;                             !LEND = R1
!*E* LOCATE
OK:

NUM = NUM-1
-> GET %IF NUM = 0 %OR NUM = STOP
-> S(CODE)
S(92):                                  !INVERT
NO:

-> GET %IF NUM <= 0
CI = CI+16
-> GET %IF INTEGER(CI) = 92

%WHILE INTEGER(CI)&127 <= 'X' %CYCLE
   CI = INTEGER(CI+4) %IF INTEGER(CI) = 'X'
   CI = CI+16
%REPEAT

NUM = INTEGER(CI+8)
-> NO %UNLESS CI = CMAX
-> 99 %IF NUM <= 0
%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 LEN >= 0 %CYCLE
      PRINT SYMBOL(BYTEINTEGER(TEXT))
      TEXT = TEXT+1;  LEN = LEN-1
   %REPEAT

   PRINT SYMBOL('''')
%FINISH
NEWLINE
PRINT1 = 0
READ SYMBOL(SYM) %WHILE SYM # NL
99:

%IF SYM = NL %AND ((MON >= 0 %AND PRINT1 # LEND) %OR (MON > 0 %C
   %AND PRINT2 # PP+FP)) %START
   NUM = 1;  PRINT LINE
%FINISH
-> 1 %IF PFLIP > 0
RIM(0,PROM);  PFLIP = 1
-> 1
!INDIVIDUAL COMMANDS
S('X'):                                 !OPEN BRACKET
INTEGER(TEXT+8) = NUM
-> GET
S('Z'):                                 !CLOSE BRACKET
NUM = NUM-1
%IF NUM = 0 %OR NUM = STOP %START
   -> GET %UNLESS CI = CMAX
   -> 99
%FINISH
INTEGER(CI+8) = NUM
CI = TEXT
-> GET
S('Y'):                                 !COMMA
CI = TEXT-16
-> GET
S('R'):                                 !RIGHT-SHIFT
-> NO %IF FP = LEND
BYTEINTEGER(PP) = BYTEINTEGER(FP)
PP = PP+1;  FP = FP+1
-> OK
S('L'):                                 !LEFT-SHIFT
-> NO %IF PP = LBEG
FP = FP-1;  PP = PP-1
BYTEINTEGER(FP) = BYTEINTEGER(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* VERIFY
!    ->NO %IF BYTEINTEGER(FP) # BYTEINTEGER(TEXT)
!    I = FP
!    J = TEXT
!    %UNTIL BYTEINTEGER(I) # BYTEINTEGER(J) %CYCLE
!       I = I+1
!       J = J+1
!    %REPEAT
!    ->NO %IF BYTEINTEGER(J) # 0
!    MS = FP
!    ML = I
!    ->GET
!*M* VERIFY
*L_3,TEXT;                              !R3 = TEXT
*L_1,LEN;                               !R1 = LENGTH (-1)
*EX_1,<VC>;                             !COMPARE
*BC_7,<NO>;                             !NO MATCH ->
*ST_5,MS;                               !MS = FP
*LA_1,1(1,5);                           !R1 = FP+R1+1 (AD)
*ST_1,ML;                               !ML = R1
-> GET
VC:

*CLC_0(0,5),0(3);                       !CLC FOR VERIFY
!*E* VERIFY
S('D'):                                 !DELETE
S('T'):                                 !+TRAVERSE
J = 0
-> F0
S('F'):                                 !FIND
S('U'):                                 !+UNCOVER
J = MS
F0:

LIM = CODELIM>>7;  K = BYTEINTEGER(TEXT)
FP1 = FP
!*I* FIND
!    FP0 = FP
!    FP = FP+1 %IF FP = J
!    ->F2 %IF FP > FEND
!F1: %WHILE BYTEINTEGER(FP) # NL %CYCLE
!       %IF BYTEINTEGER(FP) = K %START
!          I = FP
!          J = TEXT
!          I=I+1 %AND J=J+1 %UNTIL BYTEINTEGER(I)#BYTEINTEGER(J)
!          ->F5 %IF BYTEINTEGER(J) = 0
!       %FINISH
!       FP = FP+1
!    %REPEAT
!    LIM = LIM-1
!    ->F2 %IF LIM = 0
!    FP = FP+1
!    FP1 = FP
!    SFP = FP %IF SIN # 0
!    ->F1 %UNLESS FP > FEND
!F2: LEND = FP
!    FP = FP1
!    ->NO %IF SIN # 0 %OR CODE = 'U'
!    J = FP1-FP0
!    K = 0
!    ->F6
!F5: MS = FP
!    ML = I
!    FP = ML %IF CODE = 'T'
!    ->F7 %IF SIN # 0 %OR CODE = 'U'
!    J = FP-FP0
!F6: LBEG = PP+FP1-FP0 %IF FP1 # FP0
!    MOVE(J,FP0,PP)
!    PP = PP+J
!    ->NO %IF K = 0
!    FP = ML %IF CODE = 'D'
!F7: ->OK %IF FP1 = FP0
!    ->LOK
!*M* FIND
I = ADDR(TTAB(K));                      !SET SLOT IN TRANS TABLE
BYTEINTEGER(I) = 1
*L_0,LIM;                               !R0 = LIM
*LR_1,5;                                !R1 = FP
*SLR_2,2;                               !R2 = 0 (FOR TRT)
*L_3,TEXT;                              !R3 = TEXT
*L_15,TTAB;                             !R15 = BASE OF TTAB
*C_1,J;                                 !R1 = MS?
*BC_7,<F2>;                             !NO ->
F1:

*LA_1,1(0,1);                           !R1 = R1+1 (AD)
F2:

*C_1,TRTLIM;                            !R1 > TRTLIM?
*BC_2,<F21>;                            !YES ->
*TRT_0(256,1),0(15);                    !LOCATE K OR NL
*BC_7,<F3>;                             !FOUND ->
*LA_1,256(0,1);                         !R1 = R1+256 (AD)
*BC_15,<F2>
FC:

*CLC_0(0,1),0(3);                       !CLC FOR FIND
F21:

*L_2,FEND;                              !R2 = FEND-R1
*SR_2,1
*BC_4,<F7>;                             !< 0 ->
*EX_2,<TRT>;                            !(MUST FIND)
F3:

*BCT_2,<F5>;                            !R2-1 # 0 (NL) ->
*L_2,LEN;                               !R2 = LENGTH (-1)
*EX_2,<FC>;                             !COMPARE
*BC_7,<F1>;                             !NO MATCH ->
*ST_1,MS;                               !MS = R1
*LA_2,1(2,1);                           !R2 = R1+R2+1 (AD)
*ST_2,ML;                               !UPDATE ML
*LA_0,84(0,0);                          !CODE = 'T'?
*C_0,CODE
*BC_7,<F4>;                             !NO ->
*LR_1,2;                                !R1 = ML
F4:

*BAL_15,<FMV>;                          !MOVE
FP = ML %IF CODE = 'D'
-> OK %IF FP1 = 0
-> LOK
F5:

*SR_0,2;                                !DEC R0 (R2=1)
*BC_8,<F7>;                             !ZERO ->
*AR_1,2;                                !R1 = R1+1 (R2=1)
*ST_1,FP1;                              !FP1 = R1
*BC_15,<F2>
F7:

*ST_1,LEND;                             !LEND = R1
*L_1,FP1;                               !R1 = FP1
*BAL_15,<FMV>;                          !MOVE
-> NO
!*** MCODE BULK MOVE SUBROUTINE
!*** CALL: BAL 15,<FMV> -- FOR FIND
!*** R1:NEW FP
!*** CALL: BAL 15,<MOV>
!*** R1:LENGTH  R2:SOURCE  R3:DEST
FMV:

*SLR_0,0;                               !R0 = 0
*L_3,I;                                 !R3 = I
*STC_0,0(0,3);                          !CLEAR TTAB SLOT
*LR_2,5;                                !R2 = OLD FP
*LR_5,1;                                !FP = R1
*L_3,FP1;                               !R3 = FP1 - OLD FP
*SR_3,2
*ST_3,FP1;                              !STORE AS INDIC
*C_0,SIN;                               !SIN # 0?
*BC_8,<MV0>;                            !NO ->
*LTR_3,3;                               !FP1 CHANGED?
*BCR_8,15;                              !NO =>
*AR_3,2
*ST_3,SFP;                              !UPDATE SFP
*BCR_15,15
MV0:

*LA_0,85(0,0);                          !CODE = 'U'?
*C_0,CODE
*BCR_8,15;                              !YES =>
*LTR_3,3;                               !TEST FP1 - OLD FP
*BC_8,<MV1>;                            !ZERO ->
*AR_3,6;                                !UPDATE LBEG
*ST_3,LBEG
MV1:

*SR_1,2;                                !NEW FP - OLD FP (LENGTH)
*LR_3,6;                                !R3 = OLD PP (DEST)
*AR_6,1;                                !UPDATE PP
MOV:

*LA_0,256(0,0);                         !R0 = 256
MV2:

*CR_1,0;                                !R1 <= 256?
*BC_12,<MV3>;                           !YES ->
*MVC_0(256,3),0(2);                     !MOVE 256
*AR_2,0;                                !R2 = R2+256
*AR_3,0;                                !R3 = R3+256
*SR_1,0;                                !R1 = R1-256
*BC_15,<MV2>
MV3:

*LTR_1,1
*BCR_8,15;                              !ZERO =>
*BCTR_1,0;                              !R1 = R1-1
*EX_1,<MV>;                             !MOVE REST
*BCR_15,15;                             !EXIT
MV:

*MVC_0(0,3),0(2)
!*E* FIND
S('S'):                                 !SUBSTITUTE
-> NO %IF FP # MS
FP = ML
-> OK %IF LEN < 0
S('I'):                                 !+INSERT
-> NO %IF PP-LBEG > 160 %OR FP > FEND
!*I* INSERT
!    J = TEXT
!    %UNTIL BYTEINTEGER(J) = 0 %CYCLE
!       BYTEINTEGER(PP) = BYTEINTEGER(J)
!       PP = PP+1
!       J = J+1
!    %REPEAT
!I1: ->OK %UNLESS PP+256 >= FP
!    ->C1
!*M* INSERT
*L_3,TEXT;                              !R3 = TEXT
*L_1,LEN;                               !R1 = LENGTH (-1)
*EX_1,<IM>;                             !MOVE
*LA_6,1(1,6);                           !UPDATE PP (AD)
I1:

-> OK %UNLESS PP+256 >= FP
-> C1
IM:

*MVC_0(0,6),0(3);                       !MVC FOR INSERT
!*E* INSERT
S('G'):                                 !GET (LINE FROM TT)
RIM(0,':') %AND PFLIP = -1 %IF PFLIP >= 0
READ SYMBOL(K)
-> NO %IF K = ':'

%WHILE PP # LBEG %CYCLE
   FP = FP-1;  PP = PP-1
   BYTEINTEGER(FP) = BYTEINTEGER(PP)
%REPEAT

%WHILE K # NL %CYCLE
   BYTEINTEGER(PP) = K;  PP = PP+1
   READ SYMBOL(K)
%REPEAT

S('B'):                                 !+BREAK
BYTEINTEGER(PP) = NL;  PP = PP+1
LBEG = PP
-> I1
S('P'):                                 !PRINT
PRINT LINE
-> 1 %IF TESTINT(0,'ENOUGH') # 0
-> OK %IF NUM = 1
S('M'):                                 !MOVE
-> NO %IF FP > FEND
-> M5 %IF SIN # 0
!*I* MOVE
!    J = LEND-FP+1
!    MOVE(J,FP,PP)
!    PP = PP+J
!    LBEG = PP
!    FP = LEND+1
!    ->LOK
!*M* MOVE
*L_1,LEND;                              !R1 = LEND-FP
*SR_1,5
*LA_0,256(0,0);                         !R0 = 256
*CR_1,0;                                !R1 >= R0?
*BC_10,<NO>;                            !YES ->
*EX_1,<MM>;                             !MOVE (+1)
*LA_6,1(1,6);                           !UPDATE PP,LBEG
*ST_6,LBEG
*LA_5,1(1,5);                           !UPDATE FP
-> LOK
MM:

*MVC_0(0,6),0(5)
!*E* MOVE
M5:

FP = LEND+1
SFP = FP
-> LOK
S('K'):                                 !KILL
-> NO %IF FP > FEND
PP = LBEG
K1:

FP = LEND+1
-> LOK
S('J'):                                 !JOIN
-> NO %IF LEND >= FEND

%WHILE FP # LEND %CYCLE
   BYTEINTEGER(PP) = BYTEINTEGER(FP)
   PP = PP+1;  FP = FP+1
%REPEAT

-> NO %IF PP-LBEG > 120
-> K1
S('W'):                                 !MOVE BACK
MS = 0
-> W10 %IF SIN # 0
!*I* MOVE BACK
!    ->NO %IF LBEG = TOP
!    LEND = FP-PP+LBEG-1
!    %UNTIL LBEG=TOP %OR BYTEINTEGER(LBEG-1)=NL %CYCLE
!       LBEG = LBEG-1
!    %REPEAT
!    J = PP-LBEG
!    FP = FP-J
!    PP = LBEG
!    MOVE(J,PP,FP)
!    ->OK
!*M* MOVE BACK
*L_2,LBEG;                              !R2 = LBEG
*L_1,TOP;                               !R1 = TOP
*CR_2,1;                                !EQUAL?
*BC_8,<NO>;                             !YES ->
*SLR_0,0;                               !R0 = 0
*C_0,NUM;                               !NUM = 0?
*BC_8,<W5>;                             !YES ->
*BCTR_0,0;                              !R0 = -1
*AR_1,0;                                !R1 = TOP-1
*AR_2,0;                                !R2 = R2-1
*LR_3,5;                                !LBEG = FP-PP+LBEG-1
*SR_3,6
*AR_3,2
*ST_3,LEND
*CNOP_0,4;                              !WORD BOUNDARY
W1:

*BXLE_2,0,<W2>;                         !DEC R2
*CLI_0(2),10;                           !BYTE(R2) = NL?
*BC_7,<W1>;                             !NO ->
W2:

*SR_2,0;                                !R2 = R2+1
*LR_1,6;                                !R1 = LENGTH
*SR_1,2
*LR_6,2;                                !UPDATE PP
*SR_5,1;                                !UPDATE FP
*LR_3,5;                                !R3 = FP (DEST)
*BAL_15,<MOV>;                          !MOVE
LBEG = PP
-> OK
W5:

*LA_0,256(0,0);                         !R0 = 256
*LR_2,6;                                !R2 = PP-TOP
*SR_2,1
W6:

*CR_2,0;                                !R2 <= 256
*BC_12,<W7>;                            !YES ->
*SR_6,0;                                !PP = PP-256
*SR_5,0;                                !FP = FP-256
*MVC_0(256,5),0(6);                     !MOVE DOWN 256
*SR_2,0;                                !R2 = R2-256
*BC_7,<W6>;                             !NON-ZERO ->
*BC_15,<W8>
W7:

*SR_6,2;                                !PP = PP-R2
*SR_5,2;                                !FP = FP-R2
*BCTR_2,0;                              !R2 = R2-1
*EX_2,<WM>;                             !MOVE DOWN REST
W8:

LBEG = PP
-> LOK
WM:

*MVC_0(0,5),0(6);                       !MVC FOR MOVE BACK
!*E* MOVE BACK
W10:

-> NO %IF SFP = SINTOP;                 !SECONDARY INPUT
FP = SFP;  LEND = FP-1

%UNTIL FP = SINTOP %OR BYTEINTEGER(FP-1) = NL %CYCLE
   FP = FP-1
%REPEAT

SFP = FP
-> OK
S('N'):                                 !NOTE
MARKER = FP
-> OK
S('A'):                                 !ABSTRACT
-> NO %UNLESS SINTOP <= MARKER <= SFP
J = SFP-MARKER
-> C1 %IF PP+J+256 >= MFP
*L_1,J;  *L_2,MARKER;  *LR_3,6
*BAL_15,<MOV>;                          !MOVE(J,MARKER,PP)
PP = PP+J;  LBEG = PP
-> OK
!SPECIAL COMMANDS
C(3):                                   !%F, %M, %Q
MON = 'M'-CODE
-> 1
C(2):                                   !%S: SWITCH INPUTS
%IF SIN = 0 %START
   MFP = FP;  FP = SFP;  FEND = SEND
   SIN = -1;  PROM = '>>'
%FINISH %ELSE %START
   FP = MFP;  FEND = MEND
   SIN = 0;  PROM = '>'
%FINISH
PFLIP = -1
-> SET
C(1):                                   !%C: CLOSE
C1:

FP = MFP %IF SIN # 0
J = MEND-FP+1
*L_1,J;  *LR_2,5;  *LR_3,6
*BAL_15,<MOV>;                          !MOVE(J,FP,PP)
SIZE = PP-TOP+J
%END
%SYSTEMROUTINESPEC AGENCY(%INTEGER P1, P2)
%DYNAMICROUTINESPEC RENAME(%STRING (63) S)
%DYNAMICROUTINESPEC CHERISH(%STRING (63) S)

%ROUTINE FDP(%INTEGER EP, %STRING (17) S, %INTEGER P1, P2,  %C
   %INTEGERNAME FLAG)
   *OI_4(13),5
   AGENCY(1,ADDR(EP))
   *XI_4(13),5
%END

%EXTERNALROUTINE E(%STRING (63) IN)
%STRING (63) SEC, OUT
%INTEGER INHEAD, SECHEAD, OUTHEAD;      !HEADER ADS
%INTEGER INSIZE, SECSIZE, OUTSIZE
%INTEGER I, J, F

   %ROUTINE NEWGENS
   %RECORDFORMAT RFM(%INTEGER X, Y, Z, REPLY)
   %RECORDFORMAT NFM( %C
         %SHORTINTEGER DSNO, DACT, SSNO, SACT, X1, X2, FLAG,  %C
         %STRING (8) OLD FILE, NEW FILE)
   %RECORDNAME R(RFM)
   %LONGREAL ONTO DOUBLE WORD BOUNDARY
   %RECORD P(NFM)
   %INTEGER FLAG
      FDP(2,'SS#ETEMP',0,0,FLAG);       ! DISCON. WORK FILE
      R == P;                           ! FOR REPLIES

      %CYCLE
         P = 0;                         ! CLEAR THE RECORD
         P_DSNO = 164
         P_OLD FILE = 'SS#ETEMP';       ! OLF FILE NAME
         P_NEW FILE = OUT;              ! NEW FILE NAME
!        SVC(P);                        ! CALL THE SERVICE
          **1,@P;!  ADDRESS OF P TO R1
          *LD_0,0(1)
          *LD_2,8(1)
          *LD_4,16(1)
          *LD_6,24(1)
          *SVC_254
          **1,@P
          *STD_0,0(1)
          *STD_2,8(1)
          *STD_4,16(1)
          *STD_6,24(1)
!
         %EXIT %UNLESS R_REPLY = 6 %AND FLAG = 0; ! FILE2 STILL CONNECTED
         FDP(2,OUT,0,0,FLAG)
         FLAG = 1
      %REPEAT

      %IF R_REPLY = 5 %START;           ! FILE2 DOES NOT EXIST
         R_REPLY = 0
         RENAME('SS#ETEMP,'.OUT)
      %FINISH
      %IF R_REPLY # 0 %START
         PRINTSTRING('RENAME SS#ETEMP FAILS ')
         WRITE(R_REPLY,1)
         NEWLINE
      %FINISH %ELSE CHERISH(OUT);       ! CHERISH OUTPUT FILE
      FDP(2,IN,0,0,FLAG);               ! DISCONNECT INPUT FILE
   %END

   %ROUTINE REPORT FLAG
      %PRINTTEXT ' FDP FLAG ='
      WRITE(F,1);  NEWLINE
   %END

   %ROUTINE WRITE HEX(%INTEGER V)
   %INTEGER I, J
      SPACE;  SPACE

      %CYCLE I = 28,-4,0
         J = V>>I&15
         %IF J <= 9 %THEN J = J+'0' %ELSE J = J-10+'A'
         PRINT SYMBOL(J)
      %REPEAT

   %END
%ROUTINE CONNECT INPUT(%STRING(15) FILE %INTEGERNAME H,SIZE)
%INTEGER I
   H = 0;  SIZE = 0;  F = 0
   %RETURN %IF FILE = '.N' %OR FILE = '.NULL'
   FDP(7,FILE,0,ADDR(H),F);             !CONNECT READ SHARED
   %IF F = 0 %START
      %IF 16 <= INTEGER(H) %AND 16 <= INTEGER(H+4) <= 256 %C
         %AND INTEGER(H+12) = 0 %START
         SIZE = INTEGER(H)-16
      %FINISH %ELSE %START
         PRINTSTRING(' '.FILE.' HEADER FAULTY: ')

         %CYCLE I = H,4,H+12
            WRITE HEX(INTEGER(I))
         %REPEAT

         NEWLINE
         F = 1;                         ! INDICATE FAILURE
         %RETURN
      %FINISH
   %FINISH %ELSE %START
      %IF F = 3 %OR F = 13 %START
         PRINTSTRING(' '.FILE.' NOT AVAILABLE')
         NEWLINE
      %FINISH %ELSE REPORT FLAG
   %FINISH
%END
%ROUTINE CONNECT OUTPUT(%STRING(8) FILE %INTEGERNAME H,SIZE)
%INTEGER PAGES
H = 0
PAGES = (SIZE+4095)//4096
FDP(162,FILE,PAGES,0,F);                !CREATE OUTPUT FILE
%IF F = 3 %START
   FDP(3,FILE,0,0,F);                   !DESTROY
   -> ER %IF F # 0
   FDP(162,FILE,PAGES,0,F);             !CREATE
%FINISH
-> ER %IF F # 0
FDP(1,FILE,3,ADDR(H),F);                !CONNECT
-> ER %IF F # 0
INTEGER(H) = 16
INTEGER(H+4) = 16
INTEGER(H+8) = PAGES*4096;  SIZE = INTEGER(H+8)-16
INTEGER(H+12) = 0
%RETURN
ER:

PRINTSTRING(' CANNOT CREATE '.FILE);  NEWLINE
%END
%IF IN -> IN.('/').OUT %START
   SEC = '.N' %UNLESS IN -> IN.(',').SEC
%FINISH %ELSE %START
   -> ER1 %IF IN -> IN.(',').SEC
   OUT = IN;  SEC = '.N'
%FINISH
-> ER2 %UNLESS 1 <= LENGTH(IN) <= 15 %AND 1 <= LENGTH(OUT) <= 8 %C
   %AND LENGTH(SEC) <= 15
%IF OUT # '.N' %AND OUT # '.NULL' %AND OUT # IN %START

   %CYCLE I = 1,1,LENGTH(OUT)
      J = CHARNO(OUT,I)
      -> ER3 %UNLESS 'A' <= J <= 'Z' %OR (I # 1 %C
         %AND '0' <= J <= '9')
   %REPEAT

%FINISH
CONNECT INPUT(IN,INHEAD,INSIZE)
-> ER %IF F # 0
CONNECT INPUT(SEC,SECHEAD,SECSIZE)
-> ER %IF F # 0
OUTSIZE = INSIZE+16384;                 !PREDICTED
CONNECT OUTPUT('SS#ETEMP',OUTHEAD,OUTSIZE)
-> ER %IF F # 0
RIM(0,'EDIT'.TOSTRING(13).TOSTRING(NL).'>')
EDINNER(INHEAD+16,INSIZE,SECHEAD+16,SECSIZE,OUTHEAD+16,OUTSIZE)
INTEGER(OUTHEAD) = OUTSIZE+16
%RETURN %IF OUT = '.N' %OR OUT = '.NULL'
NEWGENS
%RETURN
ER3:


ER2:


ER1:

PRINTSTRING('FAULTY PARAMETERS')
NEWLINE
ER:

WRITE(INSIZE,1);  WRITE(OUTSIZE,1)
WRITE(F,1)
NEWLINE
%END
%ENDOFFILE