*
*   EDIT IS A FILE BUILDING/MAINTENANCE UTILITY FOR         CP-V USERS
*
*        PURPOSE  THE EDIT PROCESSOR IS A FILE MANIPULATION
*                 UTILITY AVAILABLE TO         CP-V USERS.
*                 ITS CAPABILITIES INCLUDE THE BUILDING, DELETING
*                 COPYING AND MERGING OF ENTIRE FILES AND EDITING
*                 RECORDS WITHIN FILES AS WELL AS EDITING OF DATA
*                 WITHIN RECORDS.
*
*        REFERENCE: CP-V EDIT REFERENCE CARD (COMMAND STRUCTURE)
*                 THIS CARD CONTAINS THE COMMAND STRUCTURES FOR
*                 ALL THE EDIT FUNCTIONS AND IS VERY
*                 HANDY TO KEEP BY THE USERS TERMINAL.
*
*        REFERENCE: CP-V TIME SHARING REFERENCE MANUAL.
*                 THIS MANUAL HAS AN EDIT SECTION WHICH SHOWS
*                 IN GREAT DETAIL ALL THE EDIT COMMANDS ALONG
*                 WITH EXAMPLES OF USAGE.  IT WOULD BE THE USERS
*                 BEST INITIAL INTRODUCTION TO EDIT.
*
*        REFERENCE: CP-V TIME-SHARING USER'S GUIDE.
*                 THIS MANUAL CONTAINS A SECTION ON EDIT
*                 SIMILAR TO THE TIME-SHARING REFERENCE MANUAL.
*
*
*        DESCRIPTION: EDIT IS ORGINIZED IN A HIGHLY MODULAR FASHON.
*                 UPON ENTRY, 'BEGINEDITOR' PERFORMS INITIALIZATION
*                 AFTER WHICH 'MASTERPARSER' CONTROLS INPUT COMMAND
*                 SCAN OF A LINE OF USER COMMANDS.  FROM A LINE OF
*                 INPUT COMMAND(S) THE COMMAND DESCRIPTION TABLE (CDT)
*                 IS BUILT.  ERROR CHECKS ARE MADE AND WARNINGS GIVEN
*                 TO THE USER IF NECESSARY. 'MASTERPARSER' USES A
*                 NUMBER OF SUBROUTINES TO BUILD THE CDT: 'GETNAME'
*                 AND 'GETNEXTPARAM' TO BREAK DOWN TEXT STRINGS;
*                 'PARSE:I:CMND%INTG' TO PROCESS INTEGER STRINGS;
*                 'PARSE:I:CMND%STRG' TO PROCESS ALPHABETIC STRINGS
*                 IN SLASHES; AND ROUTINES OF THE FORM 'PARSE:CMND'
*                 FOR COMMAND PROCESSING.
*                 ON ENCOUNTERING A CARRIAGE RETURN CHARACTER,
*                 CONTROL IS PASSED TO THE 'MASTEREXECUTIVE' ROUTINE
*                 TO PERFORM THE COMMANDS WHICH THEN RESIDE IN THE CDT.
*                 'MASTEREXECUTIVE' SERVES AS A DRIVER FOR COMMAND
*                 PROCESSING USING 'F:' ROUTINES FOR FILE COMMANDS,
*                 'R:' ROUTINES FOR RECORD COMMANDS AND 'I:' ROUTINES
*                 FOR INTRA-RECORD COMMAND PROCESSING.
*
********************************************************************
*
*  EDIT ENHANCEMENTS
*  *****************
*
*        1. CONTROL INPUT IS READ THRU THE M:SI DCB, WHICH
*           CAN BE ASSIGNED TO A FILE.
*
*        2. LIST OUTPUT IS WRITTEN THRU THE M:LO DCB, WHICH
*           CAN BE ASSIGNED TO A FILE.
*
*        3. EDIT CAN BE EXECUTED IN BATCH MODE.
*
*        4. IMPROVED TAB CHARACTER HANDLING:
*                 TA M  SETS TABS TO COLUMNS 10,19,37 AND 68
*
*                 TA MC SETS THE SAME TABS AND THE READ/WRITTEN
*                 RECORDS ARE SUBJECT OF TAB EXPANSION/COMPRESSION
*
*                 TA MX SETS THE SAME TABS AND THE READ
*                 RECORDS ARE SUBJECT OF TAB EXPANSION
*
*                 TA T  SETS THE TABS TO COLUMN 8,20,30,40,50,60,70
*                 AND 80
*
*        5.  A NEW COMMAND AD (LINENUMBER) ALLOWS TO ADD
*            TEXT TO A LINE.
*
*        6.  BUILD CAN BE CALLED IN EDIT WITH A SINGLE B CHARACTER.
*
*        7.  EDIT CAN BE CALLED IN EDIT WITH A SINGLE E CHARACTER.
*
*        8.  EDIT ACCEPTS ALL COMMANDS IN SMALL LETTERS.
*
*        9.  THE FILE DELETE COMMAND CAN BE CALLED WITH A SINGLE D.
*
*       10.  THE SPEED OF RECORD DELETE OPERATION IS IMPROVED.
*
*       11.  THE DATA AREA WAS REDUCED BY MORE THAN 500 WORDS.
*
*
*
*        DATE: FEBR. 1975, PROGRAMMER: G. ULSCHMID
*
*
********************************************************************
         PAGE
         CSECT    0
         SYSTEM SIG7FD
         SYSTEM   BPM
*
         REF      J:CCBUF,M:UC
         REF      M:EI,M:EO
         REF      M:SI,M:LO
         REF      J:JIT
         REF      J:TELFLGS
*
         DEF      SECT1
         DEF      SECT4,PATCH,START
*
************************************************************
*  REGISTER ALLOCATION
************************************************************
*
*
*  REGISTERS 1-13 MUST BE PRESERVED BY ANY SUBR WHICH USES THEM
*  REGISTERS 0,14-15 ARE NEVER SAVED BY SUBRS
*
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
*
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
*
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
*
*
P3       EQU      10
S1       EQU      11
S2       EQU      12
*
*
*
************************************************************
*  SYSTEM PROCEDURES
************************************************************
*
*
GEN4     COM,8,8,8,8    AF(1),AF(2),AF(3),AF(4)
TAB      COM,8,24,8,24 AF(1),AF(2),AF(3),AF(4)
*
         OPEN     BIL,BOL
BIL      S:SIN,1  X'689'
BOL      S:SIN,1  X'699'
*
*
PUSH     CNAME
         PROC
         LOCAL    I
LF       EQU      %
I        DO       NUM(AF)
         DO       NUM(AF(I))=1
         PSW,AF(I) STACKDW
         ELSE
         LCI      (AF(I,2)-AF(I,1)+1)&X'F'
         PSM,AF(I,1) STACKDW
         FIN
         FIN
         PEND
*
*
PULL     CNAME
         PROC
         LOCAL    I,K
LF       EQU      %
I        DO       NUM(AF)
K        SET      NUM(AF)-I+1
         DO       NUM(AF(K))=1
         PLW,AF(K) STACKDW
         ELSE
         LCI      (AF(K,2)-AF(K,1)+1)&X'F'
         PLM,AF(K,1) STACKDW
         FIN
         FIN
         PEND
*
*
PURGE    CNAME
         PROC
         LOCAL    I,N
N        SET      0
I        DO       NUM(AF)
         DO       NUM(AF(I))=1
N        SET      N+1
         ELSE
N        SET      N+((AF(I,2)-AF(I,1))&X'F')+1
         FIN
         FIN
LF       LI,0     -N
         MSP,0    STACKDW
         PEND
*
*
*        TYPE PROCEDURES
*
M        EQU      0
PE:P     EQU      1
CE       EQU      2
M:D      EQU      3
M:P      EQU      4
CE:P     EQU      5
CI       EQU      6
IM       EQU      7
EM       EQU      8
PE       EQU      9
*
WRITE    CNAME
         PROC
LF       LI,R0    AF(1)
         DO1      CF(2)=0
         BAL,R7   WR:M
         DO1      CF(2)=1
         B        WR:PE:P
         DO1      CF(2)=2
         BAL,R7   WR:CE
         DO1      CF(2)=3
         B        WR:M:D
         DO1      CF(2)=4
         B        WR:M:P
         DO1      CF(2)=5
         B        WR:CE:P
         DO1      CF(2)=6
         BAL,R7   WR:CI
         DO1      CF(2)=7
         BAL,R7   WR:IM
         DO1      CF(2)=8
         BAL,R7   WR:EM
         DO1      CF(2)=9
         BAL,R7   WR:PE
         PEND
*
TYPE     CNAME
         PROC
LF       LI,R0    AF(1)
         BAL,R7   TY:M
         PEND
*
************************************************************
*  PARSER PROCEDURES
************************************************************
*
*
END      EQU      0
NAME     EQU      1
SEQ      EQU      2
SEQ2     EQU      3
INTG     EQU      4
STRG     EQU      5
ALPH     EQU      6
COM      EQU      7
SCOL     EQU      8
LPAR     EQU      9
RPAR     EQU      10
PERIOD   EQU      11                UTS FILE SEPARATOR
BLANK    EQU      12
*
*
NXTNAM   CNAME    GETNEXTNAME
NXTPRM   CNAME    GETNEXTPARAM
         PROC
         LOCAL    I,N
N        SET      NUM(AF)-1
LF       BAL,R7   NAME(1)
         GEN,8,1,23 N,AFA(1),AF(1)
I        DO       N
         ERROR,1,NUM(AF(I+1))~=2 'ILGL SYNTAX'
         DO       AFA(I+1,2)=1
         GEN,8,24 AF(I+1,1),%+N-I+AF(I+1,2)+1
         ELSE
         GEN,8,24 AF(I+1,1),AF(I+1,2)
         FIN
         FIN
         PEND
*
*
*
*
************************************************************
*  ADJUSTABLE PARAMETERS
************************************************************
*
*
MAXCLMN  EQU      140
SEQLIM   EQU      9999999           FOR MAX. SEQ. NO.
STACKSZ  EQU      100               SIZE OF TEMP STACK
*
#I:CMND  EQU      30
#R:CMND  EQU      10
#I:TS    EQU      42
#I:TY    EQU      43
#R:TS    EQU      21
#R:TY    EQU      22
*
*
BL       EQU      ' '
CM       EQU      ','
CR       EQU      X'0D'
EOF      EQU      10000000
LF       EQU      X'15'
PR       EQU      '.'
LP       EQU      '('
RP       EQU      ')'
SC       EQU      ';'
*
         PAGE
************************************************************
*  VARIABLE DATA
************************************************************
*
*
SECT1    EQU      %
ALLFLAG  DATA     -1                GLOBAL: >=0 IF ALL USED ON I:CMND
ALLOK    DATA     0                 GLOBAL: =0 IF 'ALL' IS OK.
BLANKCNT RES      1                 SHFTRGHT: # OF BLANKS TO COMPRESS
BPFLAG   DATA     0                 GLOBAL: BLANK PRESERVATION FLAG,ON=1
CDT      RES      100               GLOBAL: COMMAND DESCRIPTION TABLE
@CDT     RES      1                 GLOBAL: ADR OF CURRENT CMND IN CDT
CHARPSN  RES      1                 PARSER: PSN OF NEXT CHAR TO SCAN
COPYFL   DATA     0                 F:COPY-- FID4=FID2 IF 1
CRFLAG   DATA     0
DFLTINCR DATA     1000              GLOBAL: DEFAULT VALUE FOR INCREMENT
@FID1    DATA     0
@FID2    DATA     0
FIELDCNT RES      1                 SHFTRGHT: # OF FIELDS TO COMPRESS
FFLAG    DATA     -1                GLOBAL: SPECIFIES TYPE OF INP FILE
FRSTCLMN RES      1                 FINDMATCH: FIRST COL. TO START AT
FIRSTFROM         DATA
FIRSTSET RES      1                 GLOBAL: FIRST SEQ. # FOR SET CMND
KBUF     RES      1                 I/O: HOLDS KEY FOR CURRENT I/O
LASTCLMN RES      1                 FINDMATCH: LAST COL. TO STOP IN
LASTFROM RES      1                 F:MOVE: LAST 'FROM' SEQ # READ
LASTKEY  DATA     0                 I/O: HOLDS LAST READ KEY
LASTSET  RES      1                 GLOBAL: LAST SEQ. # FOR SET CMND
MAXSEQ   DATA     SEQLIM            GLOBAL: MAX. SEQ. NO. ALLOWED
NOCHGFLG DATA     0                 GLOBAL: ON(1) IF NO CHANGE CMND READ
PCNT     DATA     0                 PARAMETER COUNT
PSIZ     RES      1                 PARSER: # OF WORDS IN PBUF
RSIZ     DATA     MAXCLMN           GLOBAL: OUTPUT RECORD SIZE.
SETADR   RES      1                 GLOBAL: ADR OF LAST SET CMND IN CDT
SETFLAG  DATA     0                 GLOBAL: ON(1) IF SET CMND ACTIVE
STEPFLAG DATA     0                 GLOBAL: ON(1) IF STEP CMND ACTIVE
STOPCLMN RES      1                 FINDMTCH: COL. # TO STOP MATCHING AT
SV1STSET RES      1                 GLOBAL: INITIAL 1ST SEQ # FOR SET
SVBPFLAG DATA     0                 GLOBAL: HOLDS DFLT VALUE OF BPFLAG
TEXTCADR RES      1                 FINDMTCH: ADR OF TEXTC-STRG TO MATCH
CERI:FL  DATA     0                 COMMAND ERROR REPORT INHIBIT FLAG
DEL:FL   DATA     0                 DELETE FLAG
IBUF     RES      MAXCLMN/4+1       GLOBAL: HOLDS TELETYPE INPUT IMAGE.
IBUFSZ   RES      1                 GLOBAL: HOLDS SIZE OF TELETYPE IMAGE
RBUF     RES      MAXCLMN/4+1       GLOBAL: HOLDS ACTIVE CARD IMAGE.
OBUF     RES      MAXCLMN/4+1       MESSAGE OUTPUT BUFFER
PBUF     RES      MAXCLMN/4+1
*
         BOUND    8
STACKDW  DATA     STACK             GLOBAL: DW FOR HARDWARE PSW/PLW
         DATA,2   STACKSZ,0
STACK    RES      STACKSZ           GLOBAL: STACK USED FOR PUSH/PULL
*
*
MR:CNT   DATA     0                 MOVED RECORD COUNT
CS:CNT   DATA     0                 CHANGED STRING COUNT
BFLAG    DATA     0                 BUILD FLAG
CFLAG    DATA     0                 EDIT COMMAND FLAG
INTFLAG1 DATA     -1                /INTERRUPT SEQ INDICATORS FOR
INTFLAG2 DATA     -1                /THOSE COMMANDS WHICH DISPLAY.
TAB:CF   DATA     0                 COMPRESS RECORD FLAG
TAB:XF   DATA     0                 EXPAND RECORD FLAG
XEQFLAG  DATA     -1                MINUS ONE IF NOT IN EXECUTION.
         PAGE
*
*
FPT:EI   GEN,8,24 X'14',M:EI
         GEN,32   X'65480001'
         DATA     0                 ABN
         DATA     RBUF              BUF
         DATA     2                 KEYED
         DATA     4                 INOUT
         DATA     2                 SAVE
         DATA     3                 MAX KEY LENGTH
         DATA     X'01000808'
EI:NAME  RES      8
         DATA     X'02000202'
EI:ACCT  RES      2                 ACCOUNT
         DATA     X'03010202'
EI:PASS  RES      2
*
*
FPT:EO   GEN,8,24 X'14',M:EO
         GEN,32   X'65480001'       SAME PARAMETERS AS ABOVE
         DATA     0,RBUF,2,4,2,3
         DATA     X'01000808'
EO:NAME  RES      8
         DATA     X'02000202'
EO:ACCT  RES      2
         DATA     X'03010202'
EO:PASS  RES      2
*
PATCH    RES      20
         PAGE
************************************************************
*  ERROR MESSAGES
************************************************************
*
*
ERRM1    TEXTC    '--EOF HIT AFTER '
         RES      2
MSG6     TEXTC   '         RECORDS DELETED'
MSG7     TEXTC     ' 0000000 RECORDS MOVED'
MSG8     TEXTC    '         STRINGS CHANGED'
*
*
IOERRMSG GEN,8,24 23,'-BA'
         TEXT     'D I/O; ABN CODE'
IOERRCOD DATA     '    '            ABN CODE PUT IN LAST TWO BYTES
*
*
MVEMSG1  TEXTC    '--DONE AT '
         RES      3
MVEMSG2  TEXTC    '--CUTOFF AT '
         RES      5
UTSM5    TEXTC    '--COMMAND INTERRUPT AT '
         RES      5
         PAGE
************************************************************
*  ERROR MESSAGES
************************************************************
*
*
         CSECT    1
SECT4    EQU      %
ERRC1    TEXTC    'OVERFLOW'
ERRC2    TEXTC    'UNDERFLOW'
ERRC3    TEXTC    'NO SUCH REC'
ERRC4    TEXTC    'CMND ILGL HERE'
ERRC6    TEXTC    'COL>LIMIT'
ERRC7    TEXTC    '''ALL'' IGNORED'
ERRC8    TEXTC    'UNKN CMND'
ERRC9    TEXTC    'ILGL SYNTAX'
ERRC10   TEXTC    'COL<LIMIT'
*
*
ERRP1    EQU      ERRC3
ERRP2    TEXTC    'REC EXISTS'
ERRP3    TEXTC    'BAD FID'
ERRP5    TEXTC    'NOT SEQ #'
ERRP6    TEXTC    'NOT INCR'
ERRP7    TEXTC    'NOT COL #'
ERRP8    TEXTC    'NOT STRG'
ERRP9    TEXTC    'NOT CNT'
ERRP10   TEXTC    'ILGL SEQ #'
ERRP11   TEXTC    'SEQ2<SEQ1'
ERRP12   TEXTC    'NO SUCH FILE'
ERRP13   TEXTC    'FILE EXISTS'
ERRP14   TEXTC    'COL ERROR'
ERRP15   TEXTC    'ILGL STRG'
ERRP16   TEXTC    'FILE NOT KEYED & P3 NULL'
ERRP17   TEXTC    'PARAM MISSING'
ERRP18   TEXTC    'NULL STRG'
*
*
MSG0     GEN4     1,CR
MSG1     TEXTC    '..COPYING'
MSG2     TEXTC    '..COPY DONE'
MSG3     TEXTC    '..DELETED'
MSG4     TEXTC    '..EDIT STOPPED'
MSG5     TEXTC    '..MERGE STARTED'
ERRM3    EQU      ERRC1
ERRM4    TEXTC    '-RNG OVERLAP'
ERRM5    TEXTC    '-NOT ON/OFF'
ERRM6    TEXTC    '--NONE'
ERRM8    TEXTC    '-MISSING SE'
ERRM12   TEXTC    '-FILE NOT KEYED'
ERRM13   TEXTC    '-NO FILE NAMED'
ERRM15   TEXTC    '-FILE EXISTS'
ERRM16   TEXTC    '-NOTHING TO MOVE'
ERRM17   TEXTC   '-MERGE SOURCE NOT KEYED'
ERRM18   TEXTC  '-MERGE DESTINATION NOT KEYED'
ERRM19   TEXTC    '-NO PASSWORD ALLOWED HERE.'
ERRM20   TEXTC    '-SEQ# > LIMIT'
ERRM21   TEXTC     '-CAN NOT DELETE ALL BLANKS.'
ERRM22   TEXTC    '-BAD COL# PAIR'
*
*
UTSM2    TEXTC    '*'
UTSM3    TEXTC    '-NOT F/M/S'
UTSM6   TEXTC    '-- X TO ABORT.  '
UTSM7    TEXTC    'WHILE DELETING)  '
*
************************************************************
*  CONSTANT DATA
************************************************************
*
*
K1       DATA     1
K10      DATA     10
KPE      DATA     '.'
*
XF       DATA     X'F'
XFF00    DATA     X'FF00'
XFFFF    DATA     X'FFFF'
XFFFFFF  DATA     X'FFFFFF'
X800000  DATA     X'800000'
*
4BLANK   DATA     '    '
*
         BOUND    8
DMYSTKDW DATA     STACK
         DATA,2   STACKSZ,0
HEXCHAR  TEXT     '0123456789ABCDEF'
X:ON     TEXTC    'ON'
X:OVER   GEN4     4,'O','V','E'
X:INTO   GEN4     4,'I','N','T'
X:TO     TEXTC     'TO'
*
*
*  SPECIAL LIMITS
*
         BOUND    8
DIGITS   DATA     '0','9'
LETTERS  DATA     'A','Z'
LCLETTERS DATA    X'81',X'A9'
*                                            *****
BDISPTBL EQU      %-1               THESE COMMANDS REQUIRE DISPLAY
         GEN,8,24 4,'COP'           OF SEQ. NUMBERS SET UP IN
         GEN,8,24 5,'MER'           INTFLAG1 AND INTFLAG2, WHEN
         TEXTC    'MK'              INTERRUPTED BY THE BREAK KEY
         TEXTC    'MD'
         TEXTC    'DE'
         TEXTC    'FD'
         TEXTC    'FT'                       *****
*
*
RELATIVE DATA,1      6,32,0,0       THIS IS AN FPT FOR
         DATA        1**29          SETTING RELATIVE TABS.
         DATA,2       X'80',X'80'
FPT:P:A  GEN,8,24 X'2C','*'
FPT:P:C  GEN,8,24  X'2C','.'
FPT:P:N  GEN,8,24 X'2C',0
*
BR%FPT   GEN,8,24 X'10',M:UC
         DATA     X'34000010',CFLAG,1,0
*
FPT:WR   GEN,8,24 X'11',M:LO
         DATA     X'34000010'
         PZE      OBUF
         PZE      *R4
         DATA      1
*
*
FPT:TY   GEN,8,24 X'11',M:UC
         DATA     X'34000010'
         PZE      *R0
         PZE      *R4
         DATA      1
*
FPTHERE  GEN,8,7,17      X'11',0,M:UC
         DATA     X'34000000'
         DATA     %+3
         DATA     14
         DATA     0
         TEXT    'EDIT'
         TEXT     ' C01'
         TEXT     ' HERE
'
*
FPT:SI   GEN,8,7,17      X'10',0,M:SI
         DATA     X'34000010'
         PZE      IBUF
         DATA     140               SIZE
         DATA     0                 NO BYTE DISPLACEMENT
*
*
FPT:L1   GEN,8,7,17      X'11',0,M:LO
         DATA     X'34000010'
         PZE      IBUF              BUFFER
         PZE      *R2               SIZE
         DATA     0                 NO BYTE OFF SET
*
FPT:C2   GEN,8,24 X'2B',M:UC
         DATA     M:SI
*
FPT:L2   GEN,8,24 X'11',M:UC
         DATA     X'34000010'
         PZE      IBUF
         PZE      *R4
         DATA     0
*
FPT:L3   GEN,8,24 X'11',M:UC
         DATA     X'34000010'
         DATA     FPT:P:A
         DATA     1
         DATA     3
         PAGE
************************************************************
*
*     B E G I N   E D I T O R
*
************************************************************
*
*
*
START    EQU      %
*
         CAL1,8   RELATIVE          TABING
         M:INT    BRK%KEY
         MTW,0    J:JIT             ON LINE
         BGE      START3            NO: BYPASS EDIT HERE MSG
         CAL1,1   FPTHERE           PRINT 'EDIT HERE'
         B        START3            BYPASS TEL CALL CHECK
*        ***************            *********************
         LW,R7    J:TELFLGS
         CI,R7    X'10000'
         BANZ     START3
*
         LW,R3    M:UC+4            GET BYTE COUNT FROM M:UC,
         SLS,R3   -17
         LW,S1    R3                SAVE BYTE COUNT
         LB,R0    J:CCBUF,R3        MOVE RECORD INTO APPROPRIATE
         STB,R0   IBUF,R3           BUFFER
         BDR,R3   %-2
*
         LB,R0    J:CCBUF
         STB,R0   IBUF,R3
         CI,R0    'B'               CHECK FOR TEL COMMAND B
         BE       START0
         MTW,1    BFLAG             SET BUILD FLAG
         CI,R0    'E'               IS COMMAND A VARIETY OF EDIT.
         BE       START0
         B        START3
START0   EQU      %
*
         AI,S1    -1
         LI,R3    4                 START LOOKING IN BYTE 5.
         LI,R0    ' '
START1   CW,R3    S1                CHECK FOR END OF RECORD
         BGE      START3            IF SO, GET NEXT COMMAND. OTHERWISE,
         CB,R0    IBUF,R3           IF NON-BLANK ENCOUNTERED, ACCEPT
         BNE      START2
         AI,R3    1                 INCREMENT TO NEXT BYTE.
         B        START1
START2   EQU      %                 EXECUTE COMMAND
         B        MPARS
*
*
START3   EQU      %
         MTW,1    CFLAG             NO FURTHER DATA IN IBUF
         MTW,1    BFLAG             SET BUILD FLAG
         PAGE
************************************************************
*
*     M A S T E R   P A R S E R
*
************************************************************
*
*
*
MPARS    EQU          %
         CAL1,1   FPT:P:A
         LI,R7    -1
         STW,R7   INTFLAG1
         STW,R7   INTFLAG2
         STW,R7    ALLFLAG          RESET ALL FLAG
         STW,R7   XEQFLAG
         LD,R8    DMYSTKDW          PURGE STACK
         STD,R8   STACKDW
         LI,R7    0
         STW,R7   DEL:FL            RESET DELETE FLAG
         STW,R7   CDT               SET # OF CMNDS = 0
         STW,R7   CHARPSN           SET NEXT CHAR TO SCAN = 0
         STW,R7    MR:CNT           SET MVD:REC:CNT = 0
         STW,R7    CS:CNT           SET CHANGED STRING COUNT TO 0
         LI,R7    X'0100'           PUT 'END OF CDT' MARKER IN CDT
         STW,R7   CDT+1
         LI,R7    CDT+1             INIT @CDT=1ST   CMND ADDR
         STW,R7   @CDT
         MTW,0    CFLAG
         BEZ      MPAR2
         MTW,0    STEPFLAG          IS SYSTEM IN STEP MODE
         BEZ      %+3
         TYPE     UTSM2
         BAL,R7   RD:SI             READ IN COMMANDS
MPAR2    EQU      %
         STW,R7   CFLAG             SET CFLAG
         STW,S1   IBUFSZ             LESS C/R
*
*
*
R:PARS   EQU          %             (ENTER HERE AFTER SEMI-COLON FOUND)
         LB,R8    *@CDT             INCR @CDT   TO NEXT ENTRY
         AWM,R8   @CDT
         LI,R8    1                 SET PARAMETER COUNT TO 1
         STW,R8   PCNT
         MTW,1    CDT               INCR OCUNT OF # OF ENTRIES
         NXTPRM   ERRC9,;
                  (INTG,P:INTG),;
                  (STRG,P:STRG),;
                  (ALPH,*),;
                  (END,MEXEC)
         LW,D1    PBUF              GET CONTENTS OF BUFFER
         OR,D1    =X'404040'          AND CONVERT TO UPPER CASE
         LI,R3    CTABSZ            GET TABLE SIZE
         LD,R8    CTAB,R3           GET TABLE ENTRY
         CW,R8    D1                COMPARE TEXTC STRING
         BE       PRS10             FOUND
         BDR,R3   %-3               LOOP
         WRITE,CE:P ERRC8           WR:   '-CN:CMND ILGL HERE'
*
*  COMMAND FOUND: GO PROCESS ITS PARAMETERS
*
PRS10    LB,R5    R9                GET COMMAND NUMBER
         B        *R9               BRANCH TO PROCESS COMMAND PARAMETERS
*
*
*  COMMAND NAME TABLE
*
         BOUND    8
CTAB     EQU      %-2
         TAB      2,'BP ',1,P:BP
         TAB      5,'BUI',2,P:BUILD
         TAB      1,'B  ',2,P:BUILD
         TAB      4,'COP',3,P:COPY
         TAB      6,'DEL',4,P:DELETE
         TAB      1,'D  ',4,P:DELETE
         TAB      4,'EDI',5,P:EDIT
         TAB      1,'E  ',5,P:EDIT
         TAB      3,'END',6,P:END
         TAB      2,'TA ',7,P:TA
         TAB      2,'CR ',8,P:CR
         TAB      5,'MER',9,P:MERGE
         TAB      2,'CM ',10,P:CM
         TAB      2,'DE ',11,P:DE
         TAB      2,'FD ',12,P:FD
         TAB      2,'FT ',13,P:FT
         TAB      2,'IN ',14,P:IN
         TAB      2,'IS ',15,P:IS
         TAB      2,'MD ',16,P:MD
         TAB      2,'MK ',17,P:MK
         TAB      2,'RN ',18,P:RN
         TAB      2,'SS ',19,P:SS
         TAB      2,'ST ',20,P:ST
         TAB      2,'TS ',21,P:TS
         TAB      2,'TY ',22,P:TY
         TAB      2,'TC ',23,P:TC
         TAB      2,'FS ',24,P:FS
         TAB      2,'AD ',25,P:AD
         TAB      2,'SE ',30,P:SE
         TAB      2,'JU ',39,P:JU
         TAB      2,'NO ',40,P:NO
         TAB      2,'RF ',41,P:RF
CTABSZ   EQU      (%-CTAB-2)/2
*
*
************************************************************
*  PARSE FORM:  BP ON(OFF)
*  PARSE FORM:  TA F(M,S)
************************************************************
*
*
P:BP     EQU      %
P:CR     EQU      %
P:TA     EQU      %
         BAL,R7   NEW:CDT           BUILD NEW CDT ENTRY
         DATA     1
         BAL,R7   CHECK             MAKE SURE 'BP' IS FIRST CMND
         NXTPRM   ERRC9,;
                  (ALPH,*)
         LW,R8    PBUF              GET BUFFER CONTENTS
         OR,R8    =X'404040'          AND CONVERT TO UPPER CASE
         STW,R8   PBUF                 LETTERS AND SAVE
         LI,R5    ALPH              PUT ALPHA TEXT IN CDT
         BAL,R7   ADD:CDT
         B        P%END             PARSE END (END OF PARAM EXPECTED)
*
************************************************************
*  PARSE FORM:  BUILD FID(,N(,I))
************************************************************
*
*
P:BUILD  EQU          %
         BAL,R7   NEW:CDT           BUILD NEW CDT ENTRY
         DATA     3
         BAL,R7   CHECK             MAKE SURE 'BUILD' IS FIRST CMND
         BAL,R7   P%FID             PARSE FILE ID
         BAL,R7   P%COM:E           PARSE COMMA (END POSSIBLE)
*
*
*
P%SEQ:INCR        EQU %             (ENTER HERE FOR FORM:  N(,I) )
         BAL,R7   P%SEQ             PARSE SEQUENCE NUMBER
*
P%INCR   EQU          %             (ENTER HERE FOR FORM:  (,I) )
         BAL,R7   P%COM:E           PARSE COMMA (END POSSIBLE)
         BAL,R7   P%SEQ             PARSE SEQUENCE NUMBER
         MTW,0    PBUF              MAY NOT BE ZERO.
         BEZ      I%SEQ2
         B        P%END             PARSE END (END OF PARAM EXPECTED)
*
*
*
I%SEQ2   EQU          %
         MTW,-1   PCNT              ADJUST PARAMETER COUNT
         WRITE,PE:P ERRP10          WR:   '-PN:ILGL SEQ#'
*
************************************************************
*  PARSE FORM:  COPY FID4 TO FID2(,N(,I))
************************************************************
*
*
P:COPY   EQU          %
         BAL,R7   NEW:CDT           BUILD NEW CDT ENTRY
         DATA     5
         BAL,R7   CHECK             MAKE SURE 'COPY' IS FIRST CMND
         BAL,R7   P%FID             PARSE FILE ID
         NXTPRM   ERRC9,;
                  (ALPH,*)
         LW,R8    PBUF              GET BUFFER CONTENTS
         OR,R8    =X'404040'          AND CONVERT TO UPPER CASE
         STW,R8   PBUF                 LETTERS AND SAVE
         CW,R8    X:ON              DOES PARAM2='ON' OR 'OVER'
         BE       PCO3
         CW,R8    X:OVER
         BE       PCO3
         CW,R8     X:TO
         BNE       PCO5
         LW,R8     X:ON
         STW,R8    PBUF
PCO3     EQU       %
         LI,R5    ALPH              PUT 'ON(OVER)' IN CDT
         BAL,R7   ADD:CDT
         BAL,R7   P%FID             PARSE FILE ID
         BAL,R7   P%COM:E           PARSE COMMA (END POSSIBLE)
         B        P%SEQ:INCR        PARSE SEQ# AND INCREMENT#
*
PCO5     EQU      %
         WRITE,CE:P ERRC9           WR:   '-CN:ILGL SYNTAX'
*
*
*****************************************************************
*  PARSE FORM:    MERGE FID4(,N1(-N2)) INTO FID2,N3(-N4)(,I)
*****************************************************************
*
*
P:MERGE  EQU          %
         BAL,R7   NEW:CDT           SET UP NEW ENTRY.
         DATA     6
         BAL,R7   CHECK             MUST BE FIRST.
         BAL,R7   P%FID             PARSE FILE ID
*
         NXTPRM   ERRC9,;
                  (COM,*),;
                  (ALPH,PME20),;
                  (SCOL,I%SCOL)
*
         BAL,R7   P%SEQ2            PARSE SEQUENCE # PAIR
*
         NXTPRM   ERRC9,;           VERIFY 'INTO' NEXT.
                  (ALPH,*)
PME20    EQU      %
         LW,R8    PBUF              MAKE SURE OF PARAMETER.
         OR,R8    =X'00404040'      CONVERT COMMAND TO UPPER CASE
         CW,R8    X:INTO
         BNE      PCO5              BRANCH ON ERROR.
         LI,R5    ALPH              ADD STRING TO CDT.
         BAL,R7   ADD:CDT
         BAL,R7   P%FID             PARSE FILE ID
         BAL,R7   P%COM             PARSE COMMA (MORE PARAM EXPECTED)
         BAL,R7   P%SEQ2            PARSE SEQUENCE # PAIR
         B        P%INCR            GO PROCESS POSSIBLE INCREMENT.
*
*
************************************************************
*  PARSE FORMS:  DELETE FID
*                EDIT   FID
************************************************************
*
*
P:DELETE EQU          %
P:EDIT   EQU          %
         BAL,R7   NEW:CDT           BUILD NEW CDT ENTRY
         DATA     1
         BAL,R7   CHECK             MAKE SURE 'DELETE(EDIT)' IS 1ST CMND
         BAL,R7   P%FID             PARSE FILE ID
         B        P%END             PARSE END (END OF PARAM EXPECTED)
*
************************************************************
*  PARSE FORMS:  END
*                NO
************************************************************
*
*
P:END    EQU          %
P:NO     EQU          %
         BAL,R7   NEW:CDT           BUILD NEW CDT ENTRY
         DATA     0
         BAL,R7   CHECK             MAKE SURE 'END(NO)' IS FIRST CMND
         B        P%END             PARSE END (END OF PARAM EXPECTED)
*
*
************************************************************
*  PARSE FORM:  AD N
************************************************************
*
*
P:AD     EQU      %
         BAL,R7   NEW:CDT
         DATA     1
         BAL,R7   CHECK
         BAL,R7   P%SEQ             PARSE SEQUENCE NUMBER
         B        P%END             PARSE END (END OF PARAM EXPECTED)
*
*
*
************************************************************
*  PARSE FORM:  CM N,C
************************************************************
*
*
P:CM     EQU      %
         BAL,R7   NEW:CDT           BUILD NEW CDT ENTRY
         DATA     2
         BAL,R7   CHECK
         BAL,R7   P%SEQ             PARSE SEQUENCE NUMBER
         BAL,R7   P%COM             PARSE COMMA (MORE PARAM EXPECTED)
         BAL,R7   P%INT             PARSE INTEGER
         B        P%END             PARSE END (END OF PARAM EXPECTED)
*
*
************************************************************
*  PARSE FORMS:  DE N(-M)
************************************************************
*
*
P:DE     EQU      %
         BAL,R7   NEW:CDT           BUILD NEW CDT ENTRY
         DATA     1
         BAL,R7   CHECK
         BAL,R7   P%SEQ2
         B        P%END             PARSE END (END OF PARAM EXPECTED)
*
************************************************************
*  PARSE FORM:   SE N(-M)(,C(,D))
************************************************************
*
P:SE     EQU      %
         BAL,R7   NEW:CDT           BUILD NEW CDT ENTRY
         DATA     3
         BAL,R7   CHECK
         BAL,R7   P%SEQ2            PARSE SEQUENCE # PAIR
         BAL,R7   P%COM:P           PARSE COMMA (END AND SCOL OK)
         BAL,R7   P%INT             PARSE INTEGER
         BAL,R7   P%COM:P           PARSE COMMA (END AND SCOL OK)
         BAL,R7   P%INT             PARSE INTEGER
         B        P%END:P
*
************************************************************
*  PARSE FORMS:  FD N(-M),/STRG/(,C(,D))
*                FT N(-M),/STRG/(,C(,D))
*                FS N(-M),/STRG/(,C(,D))
************************************************************
*
*
P:FD     EQU      %
P:FS     EQU      %
P:FT     EQU      %
         BAL,R7   NEW:CDT           BUILD NEW CDT ENTRY
         DATA     4
         BAL,R7   CHECK             MAKE SURE 'FD(FT)' IS FIRST CMND
         BAL,R7   P%SEQ2            PARSE SEQUENCE # PAIR
         BAL,R7   P%COM             PARSE COMMA (MORE PARAM EXPECTED)
         NXTPRM   ERRP8,;
                  (STRG,*)
         LI,R5    STRG              PUT 'STRING' PARAM IN CDT
         BAL,R7   ADD:CDT
*
*
P%COL:P  EQU      %                 PARSE COLUMN PAIR
         BAL,R7   P%COM:E           PARSE COMMA (END POSSIBLE)
         BAL,R7   P%INT             PARSE INTEGER
         BAL,R7   P%COM:E           PARSE COMMA (END POSSIBLE)
         BAL,R7   P%INT             PARSE INTEGER
         B        P%END             PARSE END (END OF PARAM EXPECTED)
*
*
************************************************************
*  PARSE FORM:  IN N(,I)
************************************************************
*
*
P:IN     EQU      %
P:IS     EQU      %
         BAL,R7   NEW:CDT           BUILD NEW CDT ENTRY
         DATA     2
         BAL,R7   CHECK             MAKE SURE 'IN' IS FIRST CMND
         B        P%SEQ:INCR        GO PROCESS FORM:  N(,I)
*
************************************************************
*  PARSE FORMS:  MD N(-M),K(-L)(,I)
*                MK N(-M),K(-L)(,I)
************************************************************
*
*
P:MD     EQU      %
P:MK     EQU      %
         BAL,R7   NEW:CDT           BUILD NEW CDT ENTRY
         DATA     3
         BAL,R7   CHECK             MAKE SURE 'MD(MK)' IS FIRST CMND
         BAL,R7   P%SEQ2            PARSE SEQUENCE # PAIR
         BAL,R7   P%COM             PARSE COMMA (MORE PARAM EXPECTED)
         BAL,R7   P%SEQ2            PARSE SEQUENCE # PAIR
         B        P%INCR            GO PROCESS INCR
*
************************************************************
*  PARSE FORM:  RN N,K
************************************************************
*
*
P:RN     EQU      %
         BAL,R7   NEW:CDT           BUILD NEW CDT ENTRY
         DATA     2
         BAL,R7   CHECK             MAKE SURE 'RN' IS FIRST CMND
         BAL,R7   P%SEQ             PARSE SEQUENCE NUMBER
         BAL,R7   P%COM             PARSE COMMA (MORE PARAM EXPECTED)
         BAL,R7   P%SEQ             PARSE SEQUENCE NUMBER
         B        P%END             PARSE END (END OF PARAM EXPECTED)
*
*
************************************************************
*  PARSE FORMS:  SS N(,C(,D))
*                ST N(,C(,D))
************************************************************
*
*
P:SS     EQU      %
P:ST     EQU      %
         BAL,R7   NEW:CDT           BUILD NEW CDT ENTRY
         DATA     3
         BAL,R7   CHECK             NO - MAKE SURE 'SS(ST)' IS 1ST CMND
         BAL,R7   P%SEQ             PARSE SEQUENCE NUMBER
         B        P%COL:P           PARSE COLUMN PAIR
*
************************************************************
*  PARSE FORM:   JU N
************************************************************
*
*
P:JU     EQU      %
         BAL,R7   NEW:CDT           BUILD NEW CDT ENTRY
         DATA     1
         BAL,R7   P%SEQ             PARSE SEQUENCE NUMBER
         B        P%END             PARSE END (END OF PARAM EXPECTED)
*
************************************************************
*  PARSE FORM:  RF
************************************************************
*
*
P:RF     EQU      %
         BAL,R7   NEW:CDT
         DATA     0
         B        P%END             PARSE END (END OF PARAM EXPECTED)
*
************************************************************
*  PARSE FORM:   TC N(-M)(,C(,D))
************************************************************
*
*
P:TC     EQU      %
         BAL,R7   NEW:CDT           BUILD NEW CDT ENTRY
         DATA     3
         BAL,R7   CHECK
         BAL,R7   P%SEQ2
         B        P%COL:P
*
************************************************************
*  PARSE FORMS:  TS N(-M)  &  TS
*                TY N(-M)  &  TN
************************************************************
*
P:TS     EQU      %
P:TY     EQU      %
         BAL,R7   NEW:CDT           BUILD NEW CDT ENTRY
        DATA     3
         NXTPRM   ERRC9,;
                  (INTG,PTY5),;
                  (SEQ,PTY10),;
                  (SEQ2,PTY15),;
                  (SCOL,PTY20),;
                  (END,PTY20)
PTY5     BAL,R7   ADJINT            SCALE INTEGER TO SEQ #.
PTY10    BAL,R7   REPSEQ            REPLICATE SINGLE SEQ #.
PTY15    BAL,R7   CHECK             INSURE TY(TS) IS FIRST COMMAND.
         LI,R5    SEQ2              ADD SEQ # PAIR TO COMMAND TABLE.
         BAL,R7   ADD:CDT
         B        P%COL:P           PARSE COLUMN PAIR
*
PTY20    EQU      %
         MTW,-1   CHARPSN           SET TO RESCAN LAST CHAR
         LW,R8    *@CDT             MUST BE INTRALINE 'TS' OR 'TY' SO
         AND,R8   XFF00              WIPE OUT CDT ENTRY JUST BUILT
         STW,R8   *@CDT
         LI,R8    #I:TS             GET NUMBER OF I:TS
         CI,R5    #R:TS             IS COMMAND A TS COMMAND
         BE       %+2
         LI,R8    #I:TY             GET NUMBER OF I:TY
         LW,R5    R8                BUILD ENTRY IN CDT FOR THIS CMND
         BAL,R7   NEW:CDT
         DATA     0
         B        P%END:P           PARSE END (END OF PARAM EXPECTED)
*
*
*
************************************************************
*  PROCESS INTRALINE COMMANDS
************************************************************
*
*
P:STRG   EQU          %
         LI,R5    0
         BAL,R7   NEW:CDT           BUILD NEW CDT ENTRY WITH CMND=0
         DATA     2
         B        ICS02
*
*
P:INTG   EQU          %
         LI,R5    0
         LW,R8    PBUF              SAVE INTEGER
         NXTPRM   ERRC9,;
                  (ALPH,ICS50),;
                  (STRG,*)
         BAL,R7   NEW:CDT           BUILD NEW CDT ENTRY WITH CMND=0
         DATA     3
         XW,R8    PBUF              SAVE STRING AND PUT INTG IN PARAMBUF
         LI,R9    1                 SAVE PBUF     SIZE FOR STRING AND
         XW,R9    PSIZ               SET IT = 1
         LI,R5    INTG              PUT INTG IN CDT
         BAL,R7   ADD:CDT
         STW,R8   PBUF              RESTORE STRING
         STW,R9   PSIZ              RESTORE PBUF     SIZE
ICS02    EQU      %
         LI,R5    STRG              PUT STRING IN CDT
         BAL,R7   ADD:CDT
         NXTPRM   ERRC9,;
                  (ALPH,*)
*
*  COMMAND NAME FOUND: IDENTIFY IT
*
ICS05    EQU      %
         LW,R8    PBUF
         OR,R8    =X'404040'
         STW,R8   PBUF
         LI,R3    ICTABSZ           GET TABLE SIZE
         LD,R8    ICTAB,R3          GET TABLE ENTRY
         CW,R8    PBUF              COMPARE TEXTC STRING
         BE       ICS10             FOUND
         BDR,R3   %-3               LOOP
         WRITE,CE:P ERRC8           WR:   '-CN:CMND ILGL HERE'
*
*  COMMAND FOUND: GO PROCESS ITS PARAMETERS
*
ICS10    LB,R5    R9                GET COMMAND NUMBER
         LI,R4    1
         STB,R5   *@CDT,R4          SAVE COMMAND NUMBER
         B        *R9               BRANCH TO PROCESS COMMAND PARAMETERS
*
*  FORM FOUND IS:  C X -  , PROCESS THIS
*
ICS50    BAL,R7   NEW:CDT           BUILD NEW CDT ENTRY WITH CMND=0
         DATA     2
         XW,R8    PBUF              PUT INTG IN PARAMBUF AND SAVE NAME
         LI,R5    INTG              PUT INTG IN CDT
         BAL,R7   ADD:CDT
         STW,R8   PBUF              RESTORE CMND NAME
         B        ICS05             GO IDENTIFY CMND
*
*  INTRALINE COMMAND NAME TABLE
*
         BOUND    8
ICTAB    EQU      %-2
         TAB      1,'D  ',31,T%D    31: D
         TAB      1,'E  ',32,T%A    32: E
         TAB      1,'F  ',33,T%A    33: F
         TAB      1,'L  ',34,T%B    34: L
         TAB      1,'O  ',35,T%A    35: O
         TAB      1,'P  ',36,T%A    36: P
         TAB      1,'R  ',37,T%B    37: R
         TAB      1,'S  ',38,T%S    38: S
ICTABSZ  EQU      (%-ICTAB-2)/2
*
*
*  FINISH TYPE ALPHA:  - X /STS2/
*
T%A      EQU          %
         NXTPRM   ERRP8,;
                  (STRG,*)
         LI,R5    STRG              PUT STRING IN CDT
         BAL,R7   ADD:CDT
         B        P%END:P           PARSE END (END OR SCOL OK)
*
*  FINISH TYPE BETA:  - X N
*
T%B      EQU          %
         NXTPRM   ERRP9,;
                  (INTG,*)
         LI,R5    INTG              PUT COUNT IN CDT
         BAL,R7   ADD:CDT
         B        P%END:P           PARSE END (END OR SCOL OK)
*
*  INTRALINE COMMANDS 'D' OR 'S' FOUND: CHECK THAT FORM IS: /STS1/ D(S)
*
T%D      EQU          %
         LI,R2    1                 USE R2=1 FOR 'D'
         B        T%S+1
*
*
T%S      EQU          %
         LI,R2    0                 USE R2=0 FOR 'S'
         LI,R3    3
         LB,R8    *@CDT,R3          GET # OF PARAMS IN CDT
         CI,R8    3                 IS # OF PARAMS = 3
         BE       ICS90             YES - FORM MUST BE: N /SR8/ D(S) -
         LI,R3    4
         LB,R8    *@CDT,R3          NO - GET TYPE OF PARAM1
         CI,R8    STRG              IS TYPE='STRING'
         BE       ICS90             YES - FORM MUST BE: /SR8/ D(S) -
         MTW,-1   PCNT              ADJUST PARAMETER COUNT
         WRITE,PE:P ERRP8           WR:   '-P1:NOT STRNG'
*
*  FORM OF 'D' OR 'S' IS OK: GO PARSE FURTHER
*
ICS90    B        %+1,R2
         B        T%A
         B        P%END:P           PARSE END (END OR SCOL OK)
*
*
I%SCOL   EQU          %             (ENTER HERE IF ; AFTER F: OR R:CMND)
         LI,R8    X'0100'           INCR TO TYPE # OF NEXT CMND
         AWM,R8   CDT
         WRITE,CE:P ERRC4           WR:   '-CN:CMND ILGL HERE'
*
*
*
************************************************************
*  PARSER UTILITY ROUTINES
************************************************************
*
*                 FORM SEQUENCE NUMBER AS INTEGER*1000.
*
ADJINT   LW,D4    PBUF
         MI,D4    1000
         STW,D4   PBUF
         B        *R7
*
*                 REPLICATE SINGLE SEQUENCE NUMBER IN PBUF+1.
*
REPSEQ   LW,R8    PBUF
         STW,R8   PBUF+1
         MTW,1    PSIZ
         B        *R7
*
*
************************************************************
*  ADD NEW PARAMETER TO CDT
*    R5 = TYPE OF PARAMETER
************************************************************
*
*
ADD:CDT  EQU          %
         PUSH     (R3,R5)           SAVE REGS
         MTW,1    PCNT              INCREMENT PARAMETER COUNT
         LW,R3    PCNT              GET PCNT
         AW,R3    R3                  AND CALCULATE DISPLACEMENT VAL.
         STB,R5   *@CDT,R3            BYTE 0: PARAM TYPE
         AI,R3    1                   BYTE 1: LOC OF PARAM VALUE RELA-
         LB,R5    *@CDT                        TIVE TO CURRENT @CDT
         STB,R5   *@CDT,R3
         AW,R5    PSIZ              ADJUST COUNT OF # OF WORDS IN ENTRY
         STB,R5   *@CDT              BY SIZE OF PARAM
         SW,R5    PSIZ
         AW,R5    @CDT              SET R5=ABSOLUTE ADR TO PUT VALUE AT
         LW,R3    PSIZ
         LI,R4    0
         LW,D3    PBUF,R4           MOVE PARAM VALUE TO CDT ENTRY
         STW,D3   *R5,R4
         AI,R4    1
         BDR,R3   %-3
         LW,R3    *@CDT             BUILD 'END OF CDT' MARKER USING
         AND,R3   XFF00              NUMBER OF NEXT CMND IN CDT
         AI,R3    X'0100'
         STW,R3   *R5,R4            SET 'END OF CDT' MARKER
         PULL     (R3,R5)           RESTORE REGS
         B        0,R7              EXIT
*
*
************************************************************
*  PARSE INTEGER NUMBER
************************************************************
*
*
P%INT    EQU      %
         PUSH     R7
         NXTPRM   ERRP7,;           '-PN:NOT COL #'
                  (INTG,*)
         LI,R5    INTG
         BAL,R7   ADD:CDT           ADD INTEGER TO COMMAND TABLE
         PULL     R7
         B        *R7
*
*
************************************************************
* PARSE SEQUENCE NUMBER:  E.G:  1(.999)
************************************************************
*
P%SEQ    EQU      %
         PUSH     R7
         NXTPRM   ERRP5,;           '-PN:NOT SEQ#'
                  (INTG,*),;
                  (SEQ,P%SEQ10),;
                  (SEQ2,I%SEQ2)
         BAL,R7   ADJINT            ADJUST INTEGER TO SEQ# FORM
P%SEQ10  LI,R5    SEQ               LOAD SEQ# CODE
         BAL,R7   ADD:CDT             AND STORE SEQ# IN CDT TABLE
         PULL     R7
         B        *R7               RETURN
*
*
************************************************************
* PARSE SEQUENCE NUMBER PAIR: E.G: 1(.22)(-3(.34))
************************************************************
*
*
P%SEQ2   EQU      %
         PUSH     R7
         NXTPRM   ERRP5,;
                  (INTG,*),;
                  (SEQ,P%SEQ20),;
                  (SEQ2,P%SEQ22)
         BAL,R7   ADJINT            ADJUST INTEGER TO SEQ# FORM
P%SEQ20  BAL,R7   REPSEQ            DUPLICATE SEQ#
P%SEQ22  LI,R5    SEQ2              LOAD SEQ2 # CODE
         BAL,R7   ADD:CDT             AND STORE SEQ# PAIR IN CDT
         PULL     R7
         B        *R7
*
*
*
************************************************************
*  PARSE FILE ID
************************************************************
*
P%FID    EQU      %
         PUSH     R7
         BAL,R7   GETFILEID         PARSE FILE ID
         LI,R5    NAME              GET FID NAME CODE
         BAL,R7   ADD:CDT             AND STORE NAME IN CDT TABLE
         PULL     R7
         B        *R7
*
*
************************************************************
*  PARSE COMMA
************************************************************
*
P%COM    EQU      %
         PUSH     R7
         NXTPRM   ERRC9,;           '-CN:ILGL SYNTAX'
                  (COM,*),;
                  (END,P%COM11),;
                  (SCOL,I%SCOL)
         PULL     R7
         B        *R7
*
P%COM11  WRITE,PE:P ERRP17          '-PN:PARAM MISSING'
*
P%COM:E  EQU      %
         PUSH     R7
         NXTPRM   ERRC9,;           '-CN:ILGL SYNTAX'
                  (COM,*),;
                  (SCOL,I%SCOL),;
                  (END,MEXEC)
         PULL     R7
         B        *R7
*
P%COM:P  EQU      %
         PUSH     R7
         NXTPRM   ERRC9,;           '-CN:ILGL SYNTAX'
                  (COM,*),;
                  (SCOL,R:PARS),;
                  (END,MEXEC)
         PULL     R7
         B        *R7
*
**************************************************************
*  PARSE END
**************************************************************
*
P%END    EQU      %                 '-CN:ILGL SYNTAX'
         NXTPRM   ERRC9,;
                  (SCOL,I%SCOL),;
                  (END,MEXEC)
*
P%END:P  EQU      %
         NXTPRM   ERRC9,;
                  (SCOL,R:PARS),;
                  (END,MEXEC)
*
*
*
*
*
************************************************************
*  CHECK IF ONLY ONE ENTRY IN CDT
************************************************************
*
*
CHECK    EQU          %
         LW,D3    CDT               CHECK IF ONLY ONE ENTRY IN CDT
         CI,D3    1
         BE       0,R7              YES - EXIT
         WRITE,CE:P ERRC4           NO - WR:   '-CN: CMND ILGL HERE'
         PAGE
************************************************************
*  GET FILE IDENTIFICATION
************************************************************
*
*
GETFILEID EQU         %
         PUSH     (R3,R8)           SAVE REGS
         LI,R3    0                 USE R3 AS COUNT OF # OF WDS PUSHED
         NXTNAM   ERRP3,;
                  (NAME,*)
         LB,R8    PBUF              ALLOW ONLY <= 31 BYTES IN FILE
         CI,R8    31                NAME.
         BLE      %+3
GF5      LI,R0    L(ERRP3)
         B        WR:PE:P
         BAL,R7   GF%PUSH%SUBR      PUSH 'FILE NAME' PARAM
         LW,R8    CHARPSN           SAVE NEXT SCAN PSN
         NXTNAM   ERRC9,;
                  (NAME,*),;
                  (PERIOD,GF10),;
                  (SCOL,I%SCOL),;
                  (COM,*),;
                  (END,*)
         STW,R8   CHARPSN           RESTORE TO SCAN , OR C/R AGAIN
         LI,R6    0
         PUSH     R6                SET 'ACCT #' & 'PASSWORD' PARAMS =0
         PUSH     R6
         AI,R3    2                 ADJ PUSH COUNT
         B        GF30              GO FINISH UP
*
*  LEFT PARENTHESIS FOUND: GET ACCOUNT NUMBER AND PASSWORD
*
GF10     NXTNAM   ERRP3,;
                  (NAME,GF15),;
                  (PERIOD,*)
         LI,R6    0
         PUSH     R6                SET 'ACCT #' PARAM = 0
         AI,R3    1
         B        GF18              GO PROCESS 'PASSWORD'
*
*  ACCOUNT NUMBER FOUND: PROCESS IT
*
GF15     LB,R8    PBUF              8 CHARACTERS MAX.
         CI,R8    8
         BG       GF5
         BAL,R7   GF%PUSH%SUBR
         LW,R8    CHARPSN
         NXTNAM   ERRP3,;
                  (PERIOD,GF18),;
                  (NAME,GF20),;
                  (COM,GF20),;
                  (END,GF20)
*
*  PASSWORD PRESENT: GET AND PROCESS IT
*
GF18     NXTNAM   ERRP3,;
                  (NAME,*)
         LB,R8    PBUF              8 CHARACTERS MAX.
         CI,R8    8
         BG       GF5
         BAL,R7   GF%PUSH%SUBR      PUSH 'PASSWORD' PARAM
         LW,R8    CHARPSN
         NXTNAM   ERRP3,;
                  (NAME,GF30),;
                  (COM,GF30),;
                  (END,GF30)
*
*  NO PASSWORD PRESENT
*
GF20     LI,R6    0
         PUSH     R6                SET 'PASSWORD' PARAM = 0
         AI,R3    1
*
*  RECONSTRUCT FILE ID IN 'PBUF'
*
GF30     STW,R3   PSIZ              SET # OF PARAMS = R3
         STW,R8   CHARPSN           SET TO RE-SCAN LAST POSITION
         PULL     R6                RECONSTRUCT FID IN PBUF
         STW,R6   PBUF-1,R3
         BDR,R3   %-2
         PULL     (R3,R8)           RESTORE REGS
         B        0,R7              EXIT
*
*  SUBR TO PUSH A NAME ONTO THE STACK
*
GF%PUSH%SUBR      EQU %
         LB,R5    PBUF              SET R5=LENGTH OF NAME IN BYTES
         AI,R5    4                 ADD 1 AND ROUND SO R5=LENGTH OF
         SLS,R5   -2                 TEXTC-STRING IN WDS
         AW,R3    R5                ADJ PUSH COUNT
         LI,R4    0
         LW,R6    PBUF,R4           PUSH TEXTC-STRING ONTO STACK
         PUSH     R6                 BACKWARDS
         AI,R4    1
         BDR,R5   %-3               LOOP
         B        0,R7              EXIT
         PAGE
************************************************************
*  GET NEXT NAME FROM TELETYPE INPUT BUFFER
*    GEN,8,24  # OF BRANCHES,ADDR OF ERROR MSG
*    GEN,8,24  TYPE 1,BRANCH ADDR 1
*      ...        ...  ...  ...
*    GEN,8,24  TYPE N,BRANCH ADDR N
************************************************************
*
*
GETNEXTNAME       EQU %
         PUSH     (R3,R6)           SAVE REGS
         LW,R6    CHARPSN           SET R6=PSN OF NEXT INPUT CHAR
         LB,R5    IBUF,R6           GET INPUT CHAR
         AI,R6    1                 INCR CHAR PSN
         CI,R5    ' '               SKIP LEADING BLANKS
         BE       %-3
         LI,R3    GNTBL1SZ          CHECK IF CHAR CORRESPONDS TO ONE
         CB,R5    GNTBL1,R3          OF THE 'GETNEXTNAME' TYPES
         BNE      %+3               NO: LOOP
         LB,R5    GNTYTBL1,R3       SET R5=TYPE OF MATCH FOUND
         B        GP80              GO FINISH UP
         BDR,R3   %-4               LOOP
         LI,R4    1                 USE R4 AS INDEX INTO PBUF
*
*  TEST IF CHAR CAN BELONG TO A FILE ID 'NAME'; IF SO, BUILD NAME
*  IN PBUF
*
GN10     CLM,R5   LETTERS           IS CHAR A LETTER OR DIGIT
         BIL      GN30
         CLM,R5   DIGITS
         BIL      GN30
         CLM,R5   LCLETTERS
         BIL      GN30
         LI,R3    GNTBL2SZ          NO - IS CHAR ONE OF THE OTHER LEGAL
         CB,R5    GNTBL2,R3          'NAME' CHARS
         BE       GN30              YES - GO PUT CHAR IN PBUF
         BDR,R3   %-2               LOOP
         CI,R4    1                 NOT A 'NAME' CHAR - WERE ANY SUCH
         BG       GN35               CHARS FOUND (IF NO, ERROR)
         B        GP90              ERROR EXIT
*
*  A LEGAL 'NAME' CHAR FOUND: PROCESS THIS
*
GN30     STB,R5   PBUF,R4           PUT CHAR IN PARAMBUF
         AI,R4    1                 INCR PBUF     INDEX
         LB,R5    IBUF,R6           GET NEXT INPUT CHAR
         AI,R6    1                 INCR CHAR PSN
         CI,R5    ' '               IS CHAR=BLANK
         BNE      GN10              NO - GO GET NEXT CHAR
GN35     EQU      %
         LI,R5    NAME              SET TYPE= NAME
         B        GP40              FINISH UP
*
*
*  TABLE OF LEGAL 'GETNEXTNAME' MATCH CHARS
*
GNTBL1   EQU      %
         DATA,1   0                 (FILLER)
         DATA,1   CR                 0: C/R HIT
         DATA,1   CM                7: COMMA
         DATA,1   PR                11: PERIOD
         DATA,1   LF                0 : LINE FEED
GNTBL1SZ EQU      BA(%)-BA(GNTBL1)-1
         BOUND    4
*
*  TABLE OF TYPES CORRESPONDING TO LEGAL CHARS
*
GNTYTBL1 EQU      %
         DATA,1   0                 (FILLER
         DATA,1   0                  0: C/R HIT
         DATA,1   7                 7: COMMA
         DATA,1   11                11: PERIOD
         DATA,1   0                 0 : LINE FEED
         BOUND    4
*
*  TABLE OF LEGAL SPECIAL CHARS IN A 'NAME'
*
GNTBL2   EQU      %
         DATA,1   0
         DATA,1   ''
         DATA,1   '%'
         DATA,1   '*'
         DATA,1   '-'
         DATA,1   '%'
         DATA,1   ':'
         DATA,1   '#'
         DATA,1   '@'
GNTBL2SZ EQU      BA(%)-BA(GNTBL2)-1
         BOUND    4
         PAGE
************************************************************
*  GET NEXT PARAMETER FROM TELETYPE INPUT BUFFER
*    GEN,8,24  # OF BRANCHES,ADDR OF ERROR MSG
*    GEN,8,24  TYPE 1,BRANCH ADDR 1
*      ...        ...  ...  ...
*    GEN,8,24  TYPE N,BRANCH ADDR N
************************************************************
*
*
GETNEXTPARAM      EQU %
         PUSH     (R3,R6)           SAVE REGS
         LW,R6    CHARPSN           SET R6=PSN OF NEXT INPUT CHAR
         LB,R5    IBUF,R6           GET INPUT CHAR
         AI,R6    1                 INCR CHAR PSN
         CI,R5    ' '               SKIP LEADING BLANKS
         BE       %-3
         LI,R3    GPTBLSZ           CHECK IF CHAR CORRESPONDS TO ONE
         CB,R5    GPTBL,R3           OF THE 'GETNEXTPARAM' TYPES
         BNE      %+3               NO: LOOP
         LB,R5    GPTYTBL,R3        SET R5=TYPE OF MATCH FOUND
         B        GP80              GO FINISH UP
         BDR,R3   %-4               LOOP
         CLM,R5   DIGITS            CHECK IF CHAR IS A DIGIT
         BIL      GP50
         CI,R5    '.'               CHECK IF CHAR IS A '.'
         BE       GP50
         LI,R4    1                 NO - USE R4 AS INDEX INTO PBUF
         CI,R5    '/'               CHECK IF A STRING FOUND
         BE       GP30
         CLM,R5   LCLETTERS
         BIL      GP10
         CLM,R5   LETTERS           NO - CHECK IF ALPHA TEXT FOUND
         BOL      GP90              NO - ERROR
*
*  ALPHABETIC TEXT FOUND: BUILD TEXTC-STRING IN PBUF
*
GP10     STB,R5   PBUF,R4           PUT CHAR IN PARAMBUF
         AI,R4    1                 INCR PBUF     INDEX
         LB,R5    IBUF,R6           GET NEXT CHAR
         AI,R6    1                 INCR CHAR PSN
         CLM,R5   LCLETTERS
         BIL      GP10
         CLM,R5   LETTERS           IS CHAR A LETTER
         BIL      GP10              YES - LOOP
         LI,R5    ALPH              NO - SET TYPE='ALPH'
         B        GP40              GO FINISH UP
*
*
*  STRING FOUND: BUILD TEXTC-STRING IN PBUF
*
GP30     LB,R5    IBUF,R6           GET NEXT INPUT CHAR
         AI,R6    1                 INCR CHAR PSN
         CW,R6    IBUFSZ            CHECK IF END OF CMND HIT
         BG       GP45              YES - ERROR
         CI,R5    '/'               IS CHAR='/'
         BE       GP35
GP30A    STB,R5   PBUF,R4           NO - PUT CHAR IN PARAMBUF
         AI,R4    1                 INCR PBUF     INDEX
         B        GP30              LOOP
*
*  '/' FOUND: DETERMINE IF IT IS END OF STRING OR '//'
*
GP35     LB,R5    IBUF,R6           GET NEXT INPUT CHAR
         AI,R6    1                 INCR CHAR PSN
         CI,R5    '/'               IS IT A '/' ALSO
         BE       GP30A             YES - PUT ONE '/' IN PBUF
         LI,R5    STRG              NO - SET TYPE='STRG'
*
*  END OF ALPHA TEST OR STRING FOUND: ADD TRAILING BLANKS AND FINISH
*  BUILDING PBUF
*
GP40     LI,R3    3
         LI,D4    ' '
         STB,D4   PBUF,R4           PUT 3 TRAILING BLANKS ON TEXT OR
         AI,R4    1                  STRING
         BDR,R3   %-2
         AI,R4    -4                CALC LENGTH OF STRING
         BEZ      GP43              IS LENGTH=0
         STB,R4   PBUF              NO - BUILD TEXTC-STRING WITH LENGTH
         AI,R4    4                 SET PBUF     SIZE = # OF WDS OF TEXT
         SLS,R4   -2
         AI,R6    -1                SET CHAR PSN TO RESCAN LAST CHAR
         B        GP80              GO FINISH UP
*
*  ERROR: STRING IS NULL
*
GP43     WRITE,M:P   ERRP18         WR:   '-PN:NULL STRNG'
*
*  ERROR: STRING TOO LONG TO FIT IN BUFFER
*
GP45     WRITE,PE:P ERRP15          WR:   '-PN:ILGL STRG'
*
*  DIGIT OR DECIMAL POINT FOUND: INITIALIZE
*
GP50     LI,R3    0                 USE R3 TO INDICATE 1ST OR 2ND SEQ #
         LI,R4    -1                USE R4 TO SHOW INTG(-1) OR SEQ(>=0)
         LI,D4    0                 USE D4 AS ACCUMULATOR
*
*  DETERMINE WHAT WAS FOUND: IF DIGIT, ACCUMULATE DIGITS AS A BINARY
*  NUMBER
*
GP52     CLM,R5   DIGITS            IS CHAR A DIGIT
         BIL      GP52A             YES - GO ACCUMULATE IT
         CI,R5    '.'               IS CHAR A '.'
         BNE      GP60
         LI,R4    3                 YES - USE R1 TO CNT DIGITS AFTER '.'
         B        GP53              GO PROCESS '.'
GP52A    MI,D4    10                ACCUMULATE DIGIT
         AI,R5    -'0'
         AW,D4    R5
         CW,D4    L(10000)
         BGE      GP53A
         LB,R5    IBUF,R6           GET NEXT INPUT CHAR
         AI,R6    1                 INCR CHAR PSN
         B        GP52              LOOP
*
*  DECIMAL POINT FOUND: ACCUMULATE DIGITS AFTER IT
*
GP53     LB,R5    IBUF,R6           GET NEXT INPUT CHAR
         AI,R6    1                 INCR CHAR PSN
         CLM,R5   DIGITS            IS CHAR A DIGIT
         BOL      GP55
         MI,D4    10                YES - ACCUMULATE IT
         AI,R5    -'0'
         AW,D4    R5
         AI,R4    -1                CHECK IF >3 DIGITS FOUND
         BGEZ     GP53              NO - LOOP
GP53A    WRITE,PE:P ERRP10          YES - WR:   '-PN:ILGL SEQ #'
*
*  END OF DIGITS AFTER DECIMAL POINT
*
GP55     CI,R4    0                 WERE EXACTLY 3 DIGITS FOUND
         BE       GP60
         MI,D4    10                NO - ADJ SEQ # FOR MISSING DIGITS
         BDR,R4   %-1
*
*  END OF INTEGER OR SEQ #: SEE IF SEQ # PAIR PRESENT
*
GP60     CI,R3    1                 WAS THIS 2ND SEQ # OF PAIR
         BE       GP63
         CI,R5    '-'               NO - DOES A '-' FOLLOW FIRST
         BNE      GP66
         CI,R4    -1                YES - WAS FIRST AN INTEGER
         BNE      %+2
         MI,D4    1000              YES - CONVERT TO A SEQ #
         STW,D4   PBUF              PUT VALUE IN PARAMBUF
         LI,R3    1                 SET R3=2ND SEQ #
         LI,R4    -1                RESET R4 & D4
         LI,D4    0
         LB,R5    IBUF,R6           GET NEXT INPUT CHAR
         AI,R6    1                 INCR CHAR PSN
         CLM,R5   DIGITS            IS CHAR A DIGIT
         BIL      GP52A             YES - GO ACCUMULATE IT
         CI,R5    '.'               IS CHAR A '.'
         BNE      GP53A             NO - ERROR
         LI,R4    3                 YES - USER R1 TO CNT DIGITS AFTER '.'
         B        GP53              GO PROCESS '.'
*
*  DONE WITH SECOND SEQ # OF PAIR: FINISH UP
*
GP63     CI,R4    -1                WAS SECOND AN INTEGER
         BNE      %+2
         MI,D4    1000              YES - CONVERT TO A SEQ #
         STW,D4   PBUF+1            PUT VALUE IN PARAMBUF
         LI,R5    SEQ2              SET TYPE='SEQ2'
         LI,R4    2                 SET PBUF     SIZE = 2
         AI,R6    -1                SET CHAR PSN TO RESCAN LAST CHAR
         CW,D4    PBUF              IS SEQ # 2 >= SEQ # 1
         BGE      GP80              YES - GO FINISH UP
         WRITE,PE:P  ERRP11         NO - WR:   '-PN:SEQ2<SEQ1'
*
*  NO '-' FOLLOWS FIRST: FINISH UP
*
GP66     LI,R5    SEQ               SET TYPE='INTG' OR 'SEQ' AS APPRO
         CI,R4    -1
         BNE      %+2
         LI,R5    INTG
         STW,D4   PBUF              PUT VALUE IN PARAMBUF
         LI,R4    1                 SET PBUF     SIZE = 1
         AI,R6    -1                SET CHAR PSN TO RESCAN LAST CHAR
         B        GP80              GO FINISH UP
*
*  TABLE OF LEGAL 'GETNEXTPARAM' MATCH CHARS
*
GPTBL    EQU      %
         DATA,1   0                 (FILLER)
         DATA,1   CR                 0: C/R HIT
         DATA,1   LF                 0: LINE FEED HIT.
         DATA,1   CM                 7: COMMA
         DATA,1   SC                 8: SEMI-COLON
GPTBLSZ  EQU      BA(%)-BA(GPTBL)-1
         BOUND    4
*
*  TABLE OF TYPES CORRESPONDING TO LEGAL CHARS
*
GPTYTBL  EQU      %
         DATA,1   0                 (FILLER)
         DATA,1   0                  0: C/R HIT
         DATA,1   0                  0: LINE FEED HIT.
         DATA,1   7                  7: COMMA
         DATA,1   8                  8: SEMI-COLON
         BOUND    4
*
*
*
GP80     EQU          %             (ENTER HERE IF LEGAL TYPE FOUND)
         STW,R4   PSIZ              SET PBUF     SIZE
         LB,R3    *R7               SET R3=# OF BRANCHES
         LI,R4    4                 SET R4=INDEX INTO PARAM LIST
         CB,R5    *R7,R4            SEARCH FOR CORRES TYPE IN LIST
         BE       GP85
         AI,R4    4                 INCR INDEX
         BDR,R3   %-3               LOOP
         B        GP90              NONE FOUND - ERROR
*
*  MATCHING BRANCH FOUND: GO EXECUTE IT
*
GP85     SLS,R4   -2                SET D4=BRANCH ADDR
         LW,D4    *R7,R4
         STW,R6   CHARPSN           RESET CHAR PSN
         PULL     (R3,R6)           RESTORE REGS
         B        *D4               GO TO BRANCH ADDR
*
*
GP90     EQU          %             (ENTER HERE IF NO LEGAL TYPE FOUND)
         LW,R0    0,R7              GET ADDR OF ERROR MSG
         AND,R0   =X'1FFFF'
         CI,R0    ERRC10            IS IT A 'P' ERROR
         BLE      GP95              NO - IT IS A 'C' ERROR
         B        WR:PE:P
*
*  ERROR TYPE 'C': GO TO PRINT MESSAGE
*
GP95     EQU      %
         B        WR:CE:P           PRINT COMMAND ERROR
         PAGE
************************************************************
*  CREATE NEW ENTRY IN CDT
*    R5 = NUMBER OF COMMAND TO ADD
*    WORD AFTER BAL = NUMBER OF PARAMETERS
************************************************************
*
*
NEW:CDT  EQU          %
         PUSH     (R5,R6)           SAVE REGS
         SLS,R5   8                 BUILD CONTROL WORD OF ENTRY:
         OR,R5    CDT                 BYTE 0: LENGTH OF ENTRY (=0)
         SLS,R5   8                   BYTE 1: COMMAND #
         OR,R5    0,R7                BYTE 2: # OF ENTRY IN CDT
         STW,R5   *@CDT               BYTE 3: # OF PARAMETERS
         LW,R6    0,R7              COMPUTE LENGTH OF ENTRY =
         AI,R6    3                   (# OF PARAMETERS)/2+1
         SLS,R6   -1
         STB,R6   *@CDT             PUT THIS IN BYTE 0
         AND,R5   XFF00             BUILD 'END OF CDT' MARKER USING
         AI,R5    X'0100'            NUMBER OF NEXT CMND IN CDT
         STW,R5   *@CDT,R6          PUT IT AFTER PARAM CONTROL HW'S
         LI,R5    0
         B        %+2
         STW,R5   *@CDT,R6          SET ALL PARAM CONTROL HW'S TO ZERO
         BDR,R6   %-1
         PULL     (R5,R6)           RESTORE REGS
         B        1,R7              EXIT
         PAGE
************************************************************
*
*  BREAK-KEY INTERRUPT HANDLER
*
************************************************************
*
BRK%KEY  PUSH      R1               SAVE POINTER OF PSD IN STACK
         TYPE     MSG0
         MTW,0    XEQFLAG           IF NOT EXECUTING, GET NEXT COMMAND.
         BLZ       BRK99
         MTW,0    STEPFLAG          IF STEPPING, SKIP DISPLAY CHECK.
         BNEZ     BRK80
         MTW,0    SETFLAG           IS SYSTEM IN SET MODE-
         BEZ      BRK30             ZERO SAYS NO.
         B        BRK45
*
BRK30    LI,R3    1                 EXECUTING FILE OR EDIT COMMAND.
         LB,R4    *@CDT,R3          GET COMMAND NUMBER AND RETRIEVE
         BEZ       BRK99            ORIGINAL EBCDIC.
         LD,R3    CTAB,R4           NOW CHECK DISPLAY TABLE FOR
         LI,R4    7                 PRESENCE OF THIS COMMAND.
         CW,R3    BDISPTBL,R4
         BE       BRK40
         BDR,R4   %-2               IF NOT FOUND,
         B        BRK80             ASK TO CONTINUE.
*
BRK40    CI,R4    4
         BLE      BRK50
BRK45    EQU      %
         LW,R5    INTFLAG1          THESE COMMANDS TAKE SINGLE SEQUENCE
         BLZ      BRK80             NUMBER -  DE,FD,FT
         LI,R6    BA(UTSM5)+24
         BAL,R7   MOVESEQ
         GEN4     0,0,0,0
         AI,R0    23
         STB,R0   UTSM5
         TYPE     UTSM5
         B        BRK80
*
BRK50    LW,R5    INTFLAG1          THESE COMMANDS TAKE A DOUBLE SEQ. #
         BLZ      BRK80             DISPLAY
         LI,R6    BA(UTSM5)+24
         BAL,R7   MOVESEQ           SET UP DDD.DD (
         GEN4     BL,LP,0,0
         AW,R6    R0                INCR MSG BYTE ADDR
         AI,R0    23                AND MSG LENGTH
         LW,R5    INTFLAG2          IF SECOND SEQ. # NOT SET UP,
         BGEZ     BRK60             WE MUST BE DELETING.
         LB,R3    UTSM7
         AW,R0    R3                THEREFORE, INSERT DELETING
         LI,R4    1                 MESSAGE.
BRK53    LB,R5    UTSM7,R4
         STB,R5   0,R6
         AI,R6    1
         AI,R4    1
         BDR,R3   BRK53
BRK55    STB,R0   UTSM5             ADJUST BYTE COUNT OF TOTAL
         TYPE     UTSM5
         B        BRK80             THEN ASK ABOUT CONTINUE.
*
BRK60    LW,R8    R0                SAVE MSG LENGTH
         BAL,R7   MOVESEQ           MOVE SECOND SEQ # NUMBER INTO
         GEN4     RP,0,0,0          MESSAGE.
         AW,R0    R8                INCREMENT MSG LENGTH
         B        BRK55
*
BRK80    EQU   %
         TYPE     UTSM6             -- X TO ABORT
         CAL1,1   BR%FPT            READ IT.
         TYPE     MSG0
         LB,R3    CFLAG             IF CHARACTER IS NOT X
         CI,R3    'X'               CONTINUE COMMAND.
         BE        STOPLASTCMD
         PULL      R1               STRAIGHTEN OUT STACK
M:TRTN   M:TRTN                     CONTINUE
BRK90    LI,R8     0                START CLEAN UP
         STW,R8   LASTKEY
         STW,R8   NOCHGFLG
         STW,R8   SETFLAG
         STW,R8   STEPFLAG
         LI,R8    -1
         STW,R8   ALLFLAG
         LW,S1    L(X'00200000')    IF OPEN FOR OUTPUT,
         CW,S1    M:EO
         BAZ      %+2
         BAL,R7   CLOSE2            CLOSE ANY COPY OR MERGE FILE.
         MTW,0    FFLAG             CLOSE INPUT FILE, UNLESS OPEN
         BGZ      MPARS             FOR EDIT.
         CW,S1    M:EI
         BAZ      %+2
         BAL,R7   CLOSE
         B        MPARS
STOPLASTCMD PULL   R1               POINTER OF PSD IN STACK.
         LI,R9     X'1FFFF'         SET A MASK
         LI,R8     BRK90            RETURN ADR. WANTED.
         STS,R8    0,R1
         B         M:TRTN
BRK99     EQU     %              PREPARE A CLEAN EXIT.
         PULL      R1               GET THE STACK POINTER.
         LI,R9     X'1FFFF'         MASK
         LI,R8     MPARS            ADR. OF RETURN.
         STS,R8    0,R1
         B         M:TRTN
         PAGE
************************************************************
*
*     M A S T E R   P R O G R A M
*
*         T O   E X E C U T E
*
*      E D I T   C O M M A N D S
*
************************************************************
*
*
MEXEC    EQU          %
         LI,R8    CDT+1             SET @CDT=FIRST   COMMAND IN CDT
         STW,R8   @CDT
         LW,R8    SVBPFLAG          RESTORE LAST DFLT VALUE OF BPFLAG
         STW,R8   BPFLAG
         LI,R8    1
         STW,R8   XEQFLAG
         LI,R8    0
         STW,R8   CERI:FL           RESET COMMAND ER. REP INH. FLAG
*
*
*
R:EXEC   EQU          %             (INTRALINE CMND LOOP ENTERS HERE)
         LI,R3    0                 INDICATE 'ALL' MODE IS
         STW,R3   ALLOK             POTENTIALLY LEGAL
         LI,R3    1                 GET NUMBER OF COMMAND
         STW,R3   PCNT              RESET PARAMETER COUNT FOR ERR. MESG
         LB,R4    *@CDT,R3
         BEZ      EXC50             IS CMND=0 (END OF CDT)
         CI,R4    #R:CMND           NO - IS IT A FILE COMMAND
         BL       EXC5              YES - SKIP TEST
         MTW,0    FFLAG             NO - IS INP FILE PRESENT AND KEYED
         BLZ      EXC40             NO - ERROR
         CI,R4    #I:CMND           IS IT AN I:CMND (EXCEPT 'SE')
         BLE      EXC5
         MTW,0    SETFLAG           YES - IS SYSTEM IN SET MODE
         BNEZ     EXC20             YES - GO CHECK ON CMND
         WRITE,M:P ERRM8            MISSING SE
*
*  F:CMND, R:CMND, OR 'SE': CHECK TO SEE THAT SYSTEM IS NOT IN STEP MODE
*
EXC5     MTW,0    STEPFLAG          IS SYSTEM IN STEP MODE
         BNEZ     EXC30             YES - ERROR
         LI,R8    0                 TURN OFF 'SET MODE' FLAG
         STW,R8   SETFLAG
*
*  EXECUTE CURRENT COMMAND IN CDT
*
EXC10    EXU      CMNDTBL,R4        EXECUTE COMMAND
         MTW,0    ALLFLAG           WAS CMND AN I:CMND WITH PARAM1=ALL
         BLZ      %+4               OFF: GO TO NEXT COMMAND
         LI,R3    1                 GET NUMBER OF COMMAND
         LB,R4    *@CDT,R3            AND REEXECUTE UNTIL FLAG GOES OFF
         B        EXC10             GO EXECUTE COMMAND
*
         LB,R8    *@CDT             INCR @CDT   TO NEXT COMMAND
         AWM,R8   @CDT
         B        R:EXEC            GO PROCESS NEW COMMAND
*
*
*  COMMAND IS INTRALINE (EXCEPT 'SE'): TURN ON 'I:CMND EXECUTED' FLAG;
*  IF COMMAND IS FIRST IN CDT DO A DUMMY I:SET USING PARAMETERS FROM
*  LAST ACTUAL I:SET
*
EXC20    MTW,0    STEPFLAG          IS SYSTEM IN STEP MODE
         BNEZ     EXC10
         MTW,0    SETFLAG           NO - MUST SET LOOP BE INITIALIZED
         BLZ      EXC10             NO - GO EXECUTE I:CMND
         LI,R8    -1                SET SETFLAG=-1 TO INDICATE THAT SET
         STW,R8   SETFLAG            LOOP HAS BEEN INITIALIZED
         LW,R8    @CDT              SAVE ADDR OF CMND IN CDT (IN
         STW,R8   SETADR             SETADR) FOR LATER I:CMND LOOP
         LW,R5    SV1STSET
         STW,R5   FIRSTSET          INITIALIZE LOOP PER LAST I:SET
         BAL,R7   RD:RANDOM         READ FIRST RECORD TO ALTER
         B        EXC10             GO EXECUTE COMMAND
*
*  ERROR: GIVEN COMMAND IS ILLEGAL WHEN SYSTEM IS IN STEP MODE
*
EXC30    WRITE,CE:P ERRC4           WR:   '-CN:CMND ILGL HERE'
*
*  ERROR: NO SOURCE FILE NAMED
*
EXC40    WRITE,M:P ERRM13           WR:   '-NO FILE NAMED'
*  END OF CDT: IF IN SET OR STEP MODES, GO TO APPROPRIATE LOOP
*
EXC50    MTW,0    STEPFLAG          IS SYSTEM IN STEP MODE
         BNEZ     EXC60             GO TO ST/SS LOOP
         MTW,0    IBUFSZ            WAS INPUT LINE NULL
         BEZ      MPARS             NULL COMMAND
         MTW,0    SETFLAG           IS SYSTEM IN SET MODE
         BNEZ     EXC80             GO TO SE LOOP
         B        MPARS             EXIT TO PARSER
*
*        EXECUTION OF ST/SS LOOP
*
*
EXC60    EQU      %
         MTW,-1   NOCHGFLG          WAS INPUT A 'NO' COMMAND
         BEZ      EXC62             YES - SKIP WRITE
         LW,R5    FIRSTSET          WRITE CURRENT RECORD
         BAL,R7   WRITERANDOM
         MTW,0    IBUFSZ            WAS INPUT A NULL COMMAND
         BEZ      EXC68             YES - GO EXIT
*
*  READ  NEXT INPUT RECORD AND TYPE AS REQUIRED
*
EXC62    BAL,R7   RD:SEQUEN         READ NEXT RECORD
         STW,S1   FIRSTSET          NO - SAVE NEW SEQ #
         LW,R5    FIRSTSET
*
*
*
F:EX     EQU      %
         CW,S1    L(EOF)            WAS IT AN EOF
         BE       EXC66             YES - ERROR
         BAL,R7   SETEOD            SET EOD MARKER
         MTW,0    STEPFLAG
         BGZ      EXC64             WAS 'ST' CMND USED
         BAL,R7   WR:SR
         B        MPARS             EXIT TO PARSER
*
*  'SS' COMMAND USED: JUST TYPE SEQ #
*
EXC64    BAL,R7   WR:S              TYPE: 'DDDD.DDD:'
         B        MPARS             EXIT TO PARSER
*
*  ERROR: EOF HIT
*
EXC66    WRITE,M  ERRM1             WR:   '--EOF HIT'
*
*  NULL COMMAND OR ERROR: TURN OFF 'SET MODE' AND 'STEP MODE' FLAGS
*
EXC68    LI,R8    0                 TURN OFF MODE FLAGS
         STW,R8   SETFLAG
         STW,R8   STEPFLAG
         B        MPARS             EXIT TO PARSER
*
*
*        EXECUTION OF SE LOOP
*
EXC80    EQU      %
         MTW,0    SETFLAG           HAS ANY INTRALINE CMND BUT 'SE'
         BGZ      MPARS              BEEN EXECUTED
         LW,R5    FIRSTSET          YES - HAS LAST RECORD IN RANGE OF
         CW,R5    LASTSET            I:SET BEEN PROCESSED
         BNE      EXC86             NO - GO PROCESS MORE
         BAL,R7   WRITERANDOM       YES - WRITE LAST RECORD
         STW,R5   INTFLAG1
*
*  AT END OF SET LOOP: MARK SETFLAG SO LOOP WILL BE RESTARTED IF
*  ANOTHER I:CMND IS GIVEN
*
EXC82    LI,R8    1                 MARK SETFLAG TO RESTART RANGE ON
         LW,R5     CS:CNT           GET THE NO. OF STRINGS CHANGED
         CI,R5     1                CHECK FOR ONLY 1 HIT.
         BE        EXC84            GO MAKE FURTHER CHECKS.
         LI,R6     BA(MSG8)+1
         BAL,R7    DEC#
         WRITE,M  MSG8
EXC84    EQU       %
         LI,R5     0                CLEAR THE CHANGED STRING COUNT
         STW,R5    CS:CNT
         STW,R8   SETFLAG            NEXT I:CMND
         B        MPARS             EXIT TO PARSER
*
*  MORE RECORDS ARE LEFT IN RANGE OF LAST I:SET TO BE PROCESSED
*
EXC86    BAL,R7   WRITERANDOM       WRITE CURRENT RECORD
         STW,R5   INTFLAG1
         BAL,R7   RD:SEQUEN         READ NEXT RECORD
         CW,S1    L(EOF)            WAS IT AN EOF
         BE       EXC88             YES - ERROR
         CW,S1    LASTSET           IS INPUT SEQ # > SEQ # TO STOP AT
         BG       EXC82             YES - GO EXIT
         STW,S1   FIRSTSET          NO - SAVE NEW SEQ #
         LW,R8    SETADR            SET @CDT   BACK TO BEGINNING OF LOOP
         STW,R8   @CDT
         LW,R8    SVBPFLAG           REATORE LAST DFLT VALUE
         STW,R8   BPFLAG            OF BPFLAG FOR NEXT ITRATION
         MTW,1    CERI:FL           SET INHIBIT FLAG
         B        R:EXEC            GO RESTART I:CMND LOOP
*
*  ERROR: EOF HIT
*
EXC88    WRITE,M  ERRM1             WR:   '--EOF HIT'
         B        EXC82             GO EXIT
*
*  FILE COMMANDS CAN ONLY APPEAR ONE PER LINE
*
CMNDTBL  EQU       %-1
         BAL,D2    F:BP              1: BP
         BAL,D2    F:BUILD           2: BUILD
         BAL,D2    F:COPY            3: COPY
         BAL,D2    F:DELETE          4: DELETE
         BAL,D2    F:EDIT            5: EDIT
         BAL,D2    F:END             6: END
         BAL,D2    F:TA              7: TA
         BAL,D2    F:CR              8: CR
         BAL,D2    F:MERGE           9: MERGE
*
*  RECORD COMMANDS CAN ONLY APPEAR ONE PER LINE
*
         BAL,D2    R:CM             10: CM
         BAL,D2    R:DE             11: DE
         BAL,D2    R:FD             12: FD
         BAL,D2    R:FT             13: FT
         BAL,D2    R:IN             14: IN
         BAL,D2    R:IS             15: IS
         BAL,D2    R:MD             16: MD
         BAL,D2    R:MK             17: MK
         BAL,D2    R:RN             18: RN
         BAL,D2    R:SS             19: SS
         BAL,D2    R:ST             20: ST
         BAL,D2    R:TS             21: TS
         BAL,D2    R:TY             22: TY
         BAL,D2    R:TC              23: TC
         BAL,D2    R:FS             24: FS
         BAL,D2   R:AD              25: AD
         RES      4
*
*  INTRALINE COMMANDS MAY BE COMPOUNDED ON ONE LINE
*
         BAL,D2    I:SE             30: SE (MUST BE FIRST I:CMND)
         BAL,D2    I:D              31: D
         BAL,D2    I:E              32: E
         BAL,D2    I:F              33: F
         BAL,D2    I:L              34: L
         BAL,D2    I:O              35: O
         BAL,D2    I:P              36: P
         BAL,D2    I:R              37: R
         BAL,D2    I:S              38: S
         BAL,D2    I:JU             39: JU
         BAL,D2    I:NO             40: NO
         BAL,D2    I:RF             41: RF
         BAL,D2    I:TS             42: TS
         BAL,D2    I:TY             43: TY
         PAGE
************************************************************
*  FILE COMMAND: SET BLANK PRESERVATION
*  FILE COMMAND: SET TERMINATOR (X'15') MODE
************************************************************
*
F:CR     EQU      %
         LI,R2    1
         B        F:BP+1
*
F:BP     EQU      %
         LI,R2    0
         LI,R3    5                 SET TO GET PARAMETER FROM CDT
         LB,R4    *@CDT,R3
         LW,R8    *@CDT,R4          GET 'ON' OR 'OFF' AS A TEXTC-STRING
         CW,R8    BPVON
         BNE      BPV5              IS STRING='ON'
         LI,R8    1                 YES - SET BPFLAG=1
F:BP1    EXU      BP@CR,R2
         B        *D2               EXIT
*
BPV5     CW,R8    BPVOFF
         BNE      BPV10             IS STRING='OFF'
         LI,R8    0                 YES - SET BPFLAG=0
         B        F:BP1
*
BPV10    WRITE,M:D ERRM5            WR:   '-NOT ON/OFF'
*
BPVON    TEXTC    'ON'
BPVOFF   TEXTC    'OFF'
BP@CR    STW,R8   SVBPFLAG          SET BP FLAG
         STW,R8   CRFLAG            SET CR FLAG
*
*
************************************************************
*  FILE COMMAND: BUILD
************************************************************
*
*
F:BUILD  EQU      %
         BAL,R7   TEST              CHECK IF EDIT FILE ACTIVE
         LI,R3    5
         LB,R5    *@CDT,R3          SET R5=ADR OF FID IN CDT
         AW,R5    @CDT
         LW,S2    R5                SAVE FID ADDRESS
         BAL,R7   OPENNEW           OPEN OUTPUT ONLY FILE
         BCR,8    BLD40             DOES FILE ALREADY EXIST
         CAL1,1   FPT:P:N
         LI,R5    1000              NO - SET R5=DEFAULT SEQ #
         LI,R8    1000                       R8=1 (DEFAULT INCR)
         LI,R3    6
         LB,S1    *@CDT,R3          GET PARAM2 TYPE
         BEZ      BLD5              TEST IF PARAM2 PRESENT
         AI,R3    1
         LB,R4    *@CDT,R3          YES - SET R5=SEQ # FROM CDT
         LW,R5    *@CDT,R4
*
*  PROCESS INCREMENT PARAMETER
*
BLD5     LI,R3    8
         LB,S1    *@CDT,R3          GET PARAM3 TYPE
         BEZ      BLD38             TEST IF PARAM3 PRESENT
         AI,R3    1
         LB,R4    *@CDT,R3          YES - SET R8=INCR FROM CDT
         LW,R8    *@CDT,R4
*
BLD38   MTW,0    BFLAG
        BEZ      BLD42
BLD10    CI,S2    0                 HAVE WE BUILT FIRST LINE
         BEZ      BLD42               YES--BYPASS RE-OPEN
         BAL,R7   CLOSE               CLOSE AND SAVE BUILD FILE
         XW,R5    S2                POSITION FID FOR OPENING
         BAL,R7   OPEN              REOPEN IN INOUT SO ESC LEAVES INTACT
         LW,R5    S2                RESET R5 TO SEQ. #
         LI,S2    1                 NOW MARK FILE AS IF WE ARE IN
         STW,S2   FFLAG               EDIT MODE - RECORD COMM 0.K.
         LI,S2    0
*
BLD42    BAL,R7   WR:S     TYPE 'DDDD.DDD'
         LI,D4    9
         BAL,R7   RD::R             READ INPUT LINE
         B        BLD30             NULL RECORD RETURN
*
*  WRITE INPUT LINE AND INCREMENT SEQ. #
*
         BAL,R7   WRITERANDOM       WRITE CARD IMAGE; R5 CONTAINS SEQ. #
         AW,R5    R8                INCREMENT SEQ. #
         CW,R5    MAXSEQ            IS SEQ. NO. TOO BIG
         BLE      BLD10             NO.  GO READ MORE INPUT
         WRITE,M  ERRM20
*                                     BUILD DONT SAVE THE FILE.
         BAL,R7   CLOSE
*
*  NULL INPUT LINE: EXIT
*
BLD30    EQU      %
         MTW,0    BFLAG             IF ENTERED BY BUILD COMMAND, EXIT
         BEZ      F:END             TO TEL.
         B        *D2               EXIT
*
*  ERROR: NAMED FILE ALRD:Y  EXISTS
*
BLD40    WRITE,M  ERRM15            WR:   '-FILE EXISTS; CAN'T BUILD'
         BAL,R7   CLOSE             CLOSE M:EI
         B        BLD30
*
************************************************************
*  FILE COMMAND: COPY
************************************************************
*
*
F:COPY   EQU      %
         BAL,R7   TEST              CHECK IF EDIT FILE ACTIVE
         LI,R1    0                 INITIALIZE FLAG FOR
         STW,R1   COPYFL              FID1=FID2
         LI,R3    5                 OBTAIN FID 1 AND FID 2
         LB,R5    *@CDT,R3            AS
         AW,R5    @CDT              BYTE
         STW,R5   @FID1             SAVE FILE 1 ADDRESS
         LI,R3    9                   ADDRESSES
         LB,R6    *@CDT,R3            IN
         AW,R6    @CDT                REGISTERS
         STW,R6   @FID2             SAVE FILE 2 ADDRESS
         SLS,R5   2                   R5 AND
         SLS,R6   2                   R6
*
*  SEARCH LOOP TO DETERMINE IF FID1 = FID2
*
CPY1     AI,R5    1
*                 (OK TO BYPASS TEXTC BYTE IN COMPR)
         AI,R6    1
         LB,R3    0,R5              GET FID 1 BYTE
         BEZ      CPY1A               QUIT WHEN END OF FID
         CB,R3    0,R6
         BNE      CPY1B               OR WHEN NOT EQUAL
         B        CPY1              LOOP
*
*  FINISH FID COMPARISON - FID STRING HAS ENDED
*
CPY1A    CB,R3    0,R6              CHECK LAST BYTE
         BE       CPY32
CPY1B    LI,R3    7                 FIND OUT WHETHER ON
         LB,R4    *@CDT,R3          OR OVER SPECIFIED
         LW,R8    *@CDT,R4          R8='ON' OR 'OVER'
         CW,R8    X:OVER
         BNE      CPY30             NOT EQUAL --> ON
*
*  OPEN FOR COPY A OVER B
*
         LW,R5    @FID1             GET FILE 1 ADDRESS
         LI,R2    0                 SET R2=0 TO SHOW FILE UNKEYED
         BAL,R7   OPEN1             OPEN INPUT FILE WITH THIS FID
         BCS,8    CPY40             DOES FILE EXIST
         BCS,4    %+2               YES - IS FILE KEYED
         LI,R2    1                 YES - SET R2=1 TO SHOW FILE KEYED
         LW,R5    @FID2             GET FILE 2 ADDRESS
         BAL,R7   OPEN2             OPEN COPY FILE WITH THIS FID
         BCS,8    CPY3              FILE 2 NO EXIST YET
         BAL,R7   CLOSE3            .. EXISTS-RELEASE GRANS
         BAL,R7   OPEN3             OPEN FOR OUTPUT
*
*  FINISH INITIALIZATION AND PROCESS PARAMETER 4
*
CPY3     WRITE,M  MSG1              WR:   '..COPYING'
         LI,R3    10
         LB,S2    *@CDT,R3          IS 'STARTING SEQ #' PARAM PRESENT
         BNEZ     CPY10             YES - GO COPY AND RESEQ
*
*  COPY SOURCE FILE THROUGH EOF
*
CPY5     BAL,R7   RD:SEQUEN         READ SOURCE RECORD
         CW,S1    L(EOF)            IS IT AN EOF
         BE       CPY20             YES - GO FINISH UP
         CI,R2    1
         BNE      CPY50
         LW,R5    S1                GET SEQ # IN R5
         BAL,R7   WRITE2            WRITE RECORD IN COPY FILE
         STW,S1   INTFLAG1
         STW,S1   INTFLAG2
         B        CPY5              NO - LOOP
*
*  PROCESS STARTING SEQ. # AND INCREMENT PARAMETERS
*
CPY10    LI,R3    11
         LB,R4    *@CDT,R3
         LW,R5    *@CDT,R4          SET R5=STARTING SEQ #
         LI,R8    1000                  R8=1 (DEFAULT INCR)
         LI,R3    12
         LB,S2    *@CDT,R3          GET PARAM4 TYPE
         BEZ      CPY15             TEST IF PARAM4 PRESENT
         AI,R3    1
         LB,R4    *@CDT,R3          YES - SET R8=INCR FROM CDT
         LW,R8    *@CDT,R4
*
*  COPY AND RESEQUENCE SOURCE FILE THROUGH EOF
*
CPY15    BAL,R7   RD:SEQUEN         READ SOURCE RECORD
         CW,S1    L(EOF)            IS IT AN EOF
         BE       CPY20             YES - GO FINISH UP
         BAL,R7   WRITE2            WRITE RECORD IN COPY FILE
         BCS,8    CPY50             DOES RECORD ALREADY EXIST
         STW,S1   INTFLAG1
         STW,R5   INTFLAG2
         AW,R5    R8                NO - INCR SEQ #
         CW,R5    MAXSEQ            IS SEQ. NO. TOO BIG
         BLE      CPY15             NO.
         WRITE,M  ERRM20
*
*  EOF FOUND: CLOSE COPY FILE AND EXIT
*
CPY20    BAL,R7   CLOSE             CLOSE INPUT FILE
         BAL,R7   CLOSE2            CLOSE COPY FILE
         WRITE,M:D MSG2             WR:   '..COPY DONE'
*
*  OPEN FOR COPY A ON B
*
CPY30    EQU      %
         LW,R5    @FID2             GET FILE 2 ADDRESS
         BAL,R7   OPEN2             OPEN INOUT-CHNGD TO OUT
         BCR,8    CPY35             ERROR IF FILE 2 EXISTS
         LW,R5    @FID1             GET FILE 1 ADDRESS
         LI,R2    0                 R2=4 MEANS NOT KEYED
         BAL,R7   OPEN1
         BCS,8    CPY36             IF FILE DOES NOT EXIST
         BCS,4    CPY3              IS FILE KEYED
         LI,R2    1                   MARK AS KEYED
         B        CPY3              GO TO BODY OF COPY
*
*  OPEN FOR COPY A OVER A  OR  A ON A
*
CPY32    EQU      %
         MTW,1    COPYFL            SET TO SHOW FID1=FID2
         LW,R5    @FID1             GET FILE 1 ADDRESS
         LB,R3    *R5               BYTE CNT OF FILE NAME
         SLS,R3   -2                BYTE TO WORD COUNT
         AI,R3    1                 GET NEXT WORD
         AW,R5    R3
         LB,R3    *R5               BYTE CNT OF ACCOUNT
         SLS,R3   -2
         AI,R3    1                 POINT TO PASSWORD
         AW,R5    R3
         LW,R3    *R5               FETCH PASSWORD
         BNEZ     CPY60             PASSWORD GIVEN - ERROR
         LW,R5    @FID2             GET FILE 2 ADDRESS
         LB,R3    *R5               BYTE CNT OF FILE NAME
         SLS,R3   -2                BYTE TO WORD COUNT
         AI,R3    1                 GET NEXT WORD
         AW,R5    R3
         LB,R3    *R5               BYTE CNT OF ACCOUNT
         SLS,R3   -2
         AI,R3    1                 POINT TO PASSWORD
         AW,R5    R3
         LW,R3    *R5               FETCH PASSWORD
         BNEZ     CPY60             PASSWORD GIVEN - ERROR
*
         LW,R5    @FID1             GET FILE 1 ADDRESS
         BAL,R7   OPEN3             OPEN FOR OUTPUT
         LW,R5    @FID1             GET FILE 1 ADDRESS
         LI,R2    0                 R2=4 MEANS NOT KEYED
         BAL,R7   OPEN1             OPEN1 OPEN1 IN. CONTINUE
         BCS,8    CPY36             IF FILE DOES NOT EXIST
         BCS,4    CPY3              IS FILE KEYED
         LI,R2    1                   MARK AS KEYED
         B        CPY3              GO TO BODY OF COPY
*
*  ERROR: COPY FILE EXISTS AND PARAMETER 2 IS 'ON'
*
CPY35    EQU      %
         BAL,R7   CLOSE2
         MTW,1    PCNT              ADJUST PARAM. COUNT
         WRITE,PE:P ERRP13          WR:   '-P2:FILE EXISTS'
*
*  ERROR: SOURCE FILE NAMED DOESN'T EXIST
*
CPY36    BAL,R7   CLOSE3
CPY40    WRITE,PE:P ERRP12          WR:   '-P1:NO SUCH FILE'
*
*  ERROR: DUPLICATE RECORD COPIED
*
CPY50    WRITE,PE ERRP16            WR:   '-P1:FILE NOT SEQD & P3 NULL'
         BAL,R7   CLOSE             CLOSE INPUT FILE
         MTW,0    COPYFL            DON'T DELETE INPUT FILE IF
         BNEZ     CPY56               FID1=FID2
         BAL,R7   CLOSE2            CLOSE COPY FILE
         LW,R5    @FID2             GET FILE 2 ADDRESS
         BAL,R7   DEL:FILE          DELETE COPY FILE
         B        CPY58             EXIT IF FID1 NOT= FID2
CPY56    BAL,R7   CLOSE3            DELETE COPY FILE, FID1=FID2
CPY58    B        *D2               EXIT
CPY60    WRITE,M:D ERRM19           WR:   'PASSWORD ERROR'
*
************************************************************
*  FILE COMMAND: DELETE
************************************************************
*
*
F:DELETE EQU      %
         BAL,R7   TEST
         LI,R3    5
         LB,R5    *@CDT,R3          SET R5=ADR OF FID IN CDT
         AW,R5    @CDT
         BAL,R7   DEL:FILE          DELETE FILE
         BCS,8    DLT10             DID FILE EXIST
*
*  TYPE MESSAGE AND EXIT
*
         WRITE,M:D MSG3             WR:   '..DELETED'
*
*  ERROR: FILE TO DELETE DOESN'T EXIST
*
DLT10    WRITE,EM  ERRP12           WR:   '-NO SUCH FILE'
         B        *D2               RETURN
*
************************************************************
*  FILE COMMAND: EDIT
************************************************************
*
*
F:EDIT   EQU      %
         MTW,0    FFLAG             FILETYPE=-1 NEVER OPENED
         BLZ      EDT5                       +1 OPENED AS INOUT, KEYED
         BAL,R7   CLOSE             CLOSE FILE IF EVER OPENED
*
*  OPEN FILE AND SET FILE TYPE
*
EDT5     LI,R3    5
         LB,R5    *@CDT,R3          SET R5=ADR OF FID IN CDT
         AW,R5    @CDT
         BAL,R7   OPEN              OPEN FILE
         BCS,8    EDT10             DOES FILE EXIST
         BCS,4    EDT20             YES - IS IT KEYED
         LI,R8    1                 YES - SET FFLAG=1
         STW,R8   FFLAG
         B        *D2               EXIT
*
*  ERROR: SOURCE FILE DOESN'T EXIST
*
EDT10    WRITE,EM  ERRP12           WR:   '-NO SUCH FILE'
EDT15    LI,R8    -1                SHOW UNSUCCESSFUL OPEN
         STW,R8   FFLAG
         B        *D2
*
*  FILE EXISTS BUT IS NOT KEYED
*
EDT20    BAL,R7   CLOSE             CLOSE FILE
         WRITE,M ERRM12             WR:   '-FILE NOT KEYED
         B        EDT15             EXIT.
*
************************************************************
*  FILE COMMAND: END
************************************************************
*
*
F:END    EQU      %
         MTW,0    FFLAG             WAS INPUT FILE EVER NAMED
         BLZ      %+2               NO - SKIP CLOSE
         BAL,R7   CLOSE             CLOSE INPUT FILE
         M:CLOSE  M:LO,(SAVE)
         M:EXIT                     EXIT TO UTS.
*
************************************************************
*  FILE COMMAND: MERGE
************************************************************
*
*
F:MERGE  BAL,R7   TEST
         LI,R3     0                RESET THE RECORD CNT.
         STW,R3    MR:CNT
         LI,R3    5                 SET R5 TO ADDRESS OF FID4 IN CDT.
         LB,R5    *@CDT,R3
         AW,R5    @CDT
         STW,R5   @FID1
         BAL,R7   OPEN1             OPEN MERGE SOURCE IN INPUT MODE.
         BCS,8    CPY40             ERROR IF NON-EXISTENT
         BCS,4    MRG80             OR NOT HEYED.
*
         LI,R5    0
         STW,R5   FIRSTFROM         SET UP INPUT RANGE AS DEFALT
         LW,R5    L(EOF)            ENTIRE FILE.
         STW,R5   LASTFROM
*
         AI,R3    1
         LB,R5    *@CDT,R3          BUT READJUST IF SPECIFIL RANGE
         AI,R3    1                 GIVEN
         CI,R5    SEQ2
         BNE      MRG10
*
         LB,R5    *@CDT,R3          COMPUTE ADDRESS OF SEQUENCE PAIR
         AW,R5    @CDT
         LW,R6    *R5               AND STORE THEM AWAY.
         STW,R6   FIRSTFROM
         AI,R5    1
         LW,R6    *R5
         STW,R6   LASTFROM
         AI,R3    2                 STEP AROUND 'INTO'
*
MRG10    LW,R5    FIRSTFROM         VERIFY EXISTENCE OF RECORDS TO
         BAL,R7   RD:NXTRANDOM      MOVE.
         CW,S1    L(EOF)            IF RECORD READ WAS 'EOF',
         BGE      MRG70             OR GREATER THAN LAST FROM, THEN
         CW,S1    LASTFROM
         BG       MRG70             'NOTHING TO MOVE'
*
         BAL,R7   CLOSE             YES. CLOSE FILE SO WE CAN
*                                   USE M:EI ROUTINES TO DELETE
         AI,R3    2                 'TO' RANGE.
         LB,R5    *@CDT,R3          STEP TO FID2 AND OPEN
         AW,R5    @CDT
         STW,R5   @FID2
         BAL,R7   OPEN
         BCS,8    MRG30             IF NON-EXISTENT,CREATE NEW FILE.
         BCS,4    MRG82             ERROR IF NOT KEYED
*
         AI,R3    2                 NOW GET SEQUENCE NUMERS OF 'TO'
         LB,R8    *@CDT,R3          RANGE
         AW,R8    @CDT
         LW,R5    *R8               IN R5,PL - TEMPORARILY.
         AI,R8    1
         LW,R6    *R8
*
         BAL,R7   DELETE            DELETE'TO' RANGE
         LW,R1    S1                'STOP' SEQ # TO R1
         STW,R5   R8
         STW,R6   R9
*
        BAL,R7   CLOSE             CLOSE FID2 AS M:EI
MRG14    LI,P3    1000              DEFAULT INCREMENT
         AI,R3    1
         LB,R5    *@CDT,R3
         BEZ      MRG15
         AI,R3    1                 INCREMENT GIVEN.
         LB,P3    *@CDT,R3
         AW,P3    @CDT
         LW,P3    *P3
         STW,P3   DFLTINCR
*
MRG15    LW,R5    @FID1             R-OPEN FILES IN PROPER MODE.
         BAL,R7   OPEN1             SOURCE IN INPUT.
         LW,R5    @FID2
         BAL,R7   OPEN2
*
         WRITE,M  MSG5
         LW,R5    FIRSTFROM         GET FIRST 'FROM' RECORD IN FILE 1.
         BAL,R7   RD:NXTRANDOM
         LW,R5    R8                FIRST 'TO' SEG # TO R5.
MRG20    CW,S1    L(EOF)            IF EOF READ,
         BGE      MRG55             WE'RE DONE.
         CW,S1    LASTFROM          IF SEQ # READ GREATER TRAN LAST
         BG       MRG55             'FROM' WE'RE DONE.
         STW,S1    R9
         SW,R9    LASTFROM
*
         BAL,R7   WRITE2            WRITE RECORD INTO FILE2.
         MTW,1     MR:CNT           COUNT REC.S MOVED.
         STW,S1   INTFLAG1
         STW,R5   INTFLAG2
         AI,R9    0
         BEZ      MRG56
         AW,R5    P3                INCREMENT WRITE SEQ #.
         CW,R5    MAXSEQ            IS SEQ. NO. TOO BIG
         BLE      MRG25             NO.
         WRITE,M  ERRM20
         B        MRG55
MRG25    CW,R5    R1                IF CURRENT WRITE SE # MEETS
         BGE      MRG65             'STOP' SEQ # WE'RE CUT OFF.
         BAL,R7   RD:SEQUEN         GET NEXT 'FROM' RECORD.
         B        MRG20
*
*
*
MRG30   EQU      %                 OUTPUT FILE DOESN'T EXIST.
         AI,R3    2                 GET STARTING OUTPUT SEQUENCE.
         LB,R8    *@CDT,R3
         AW,R8    @CDT
         LW,R8    *R8
         LW,R1    L(EOF)            SET 'STOP' SEQUENCE TO EOF.
         B        MRG14
*                                                                     BL
*
*
MRG55    SW,R5    P3                SUCCESSFUL MERGE, MOVE DEST SEQ #
*                                  BACK TO LAST USED.  THEN USE
MRG56    BAL,R7   CLOSE             'MK' CODE AFTER CLOSING.
         BAL,R7   CLOSE2
         B        MVE40
*
MRG65    STW,S1   LASTFROM          SET LAST SEQ # READ.
         BAL,R7   CLOSE
         BAL,R7   CLOSE2
         B        MVE56             THEN USE 'MK' CODE.
*
MRG70    BAL,R7   CLOSE             CLOSE INPUT FILE
         B        MVE58             THEN USE 'MK' ROUTINE
MRG80   BAL,R7   CLOSE
         WRITE,M:D ERRM17           'SOURCE NOT KEYED'
*
MRG82   BAL,R7   CLOSE
        WRITE,M:D ERRM18           DEST. NOT KEYED
*
*
************************************************************
*  FILE COMMAND: TA
************************************************************
*
*
F:TA     EQU      %
         LI,R3    0
         STW,R3   TAB:XF            RESET TAB EXPANSION
         STW,R3   TAB:CF               AND TAB COMPRESSION
         LI,R3    5                 COMPUTE ADDRESS OF TAB SPECIFIER
         LB,R5    *@CDT,R3          IN CDT.
         AW,R5    @CDT
*
         LW,R5    *R5               GET SPECIFIER
         LI,R3    6                 AND CHECK VALIDITY.
         CW,R5    TABTYP-1,R3
         BE       TA2
         BDR,R3   %-2
*
         WRITE,M:P UTSM3            ERROR: NOT F,M,S.
*
TA2      EQU      %
         CI,R3    5
         BL       TA5
         BE       %+2
         MTW,1    TAB:CF            SET COMPRESS RECORD FLAG
         LI,R3    2
         MTW,1    TAB:XF            SET TAB EXPANSION
*
TA5      EXU      TABSET-1,R3       CHANGE MUC TABS FOR F,M OR S
*
         B        *D2               RETURN
*
TABTYP   TEXTC    'F'
         TEXTC    'M'
         TEXTC    'S'
         TEXTC    'T'
         TEXTC    'MX'
         TEXTC    'MC'
TABSET   M:DEVICE M:UC,(TAB,7,0,0,0)      FTABS
         M:DEVICE M:UC,(TAB,10,19,37,68,0) MTABS
         M:DEVICE M:UC,(TAB,8,16,30,0)    STABS
         M:DEVICE M:UC,(TAB,8,20,30,40,50,60,70,80,0) TEXT TABS
*
************************************************************
*  RECORD COMMAND: ADD COMMENTARY
************************************************************
*
R:CM     EQU      %
         LI,R3    5
         LB,R4    *@CDT,R3          SET R5=STARTING SEQ #
         LW,R5    *@CDT,R4
         LI,R3    7
         LB,R4    *@CDT,R3          SET R8=STARTING COLUMN #
         LW,R8    *@CDT,R4
         AI,R8    -1                ADJ TO INTERNAL COL. #
         BLZ      CMT40
         CI,R8    MAXCLMN           IS COL. # >= MAX COL. #
         BGE      CMT40             YES - ERROR
         BAL,R7   RD:RANDOM         READ FIRST RECORD
         BCS,8    CMT50             DOES IT EXIST (IF NO, ERROR)
*
*  TYPE SEQ. # AND READ  IN COMMENTARY
*
CMT10    BAL,R7   WR:S              TYPE: 'DDDD.DDD'
         BAL,R7   RD:SI             READ COMMENTARY
         MTW,0    S1                SET S1=# OF CHARS READ, LESS C/R
         BEZ      *D2               IF ONLY  C/R READ - EXIT
         LI,R3    0
         LW,R4    R8
         LI,R9    ' '
*
*  MOVE COMMENTARY INTO SPECIFIED COLUMN OF CARD
*
CMT15    LB,D3    IBUF,R3           MOVE COMMENTARY INTO SPECIFIED
         STB,D3   RBUF,R4            COLUMN
         AI,R3    1
         AI,R4    1
         BDR,S1   %+2               TEST IF ANY MORE CHARS LEFT TO MOVE
         B        CMT30             NO - GO FINISH UP
         CI,R4    MAXCLMN           YES - TEST IF ANY ROOM LEFT ON CARD
         BL       CMT15             YES - LOOP
         CB,R9    IBUF,R3           NO - TEST IF REMAINING CHARS ARE ALL
         BNE      CMT70              BLANKS (IF NOT, ERROR)
         AI,R3    1
         BDR,S1   %-3               LOOP
*
*
*  WRITE NEW RECORD AND THEN GET NEXT RECORD TO PROCESS
*
CMT30    EQU      %
         STW,R4   RSIZ
         BAL,R7   WRITERANDOM
         BAL,R7   RD:SEQUEN         READ NEXT RECORD
         CW,S1    L(EOF)            WAS IT AN EOF
         BE       CMT60             YES - ERROR
         LW,R5    S1                SET R5=SEQ # OF RECORD
         B        CMT10             GO GET MORE COMMENTARY
*
*  ERROR: SPECIFIED COLUMN NUMBER > MAX COLUMN NUMBER
*
CMT40    EQU      %
         MTW,1    PCNT              ADJUST PARAM. COUNT
         WRITE,PE:P ERRP14          WR:   '-P2:COLUNM ERROR
*
*  ERROR: INITIAL SEQ. # DOESN'T EXIST
*
CMT50    WRITE,PE:P ERRP1           WR:   '-P1:NO SUCH REC'
*
*  ERROR: EOF HIT
*
CMT60    WRITE,M:P ERRM1            WR:   '--EOF HIT'
*
*  ERROR: COMMENTARY OVERFLOWS CARD
*
CMT70    WRITE,IM ERRM3             WR:   '--OVERFLOW'
         B        CMT30             GO CONTINUE WITH NEXT RECORD
*
************************************************************
*   DELETE RECORD
************************************************************
*
*
R:DE     EQU      %
         LI,R3    5
         LB,R4    *@CDT,R3          GET ADDR OF FIRST SEQ # IN CDT
         LW,R5    *@CDT,R4          SET R5=FIRST SEQ #
         AI,R4    1                     R6=LAST SEQ #
         LW,R6    *@CDT,R4
         BAL,R7   DELETE            DELETE ALL BETWEEN THESE SEQ #'S
         B        *D2               EXIT
*
************************************************************
*  RECORD COMMANDS: FIND AND DELETE(TYPE)
************************************************************
*
*
R:FS     EQU      %
         LI,R2    2                 USE R2=2 FOR 'FS'.
         B        R:FT+1
*
*
R:FD     EQU      %
         LI,R2    0                 USE R2=0 FOR 'FD'
         B        R:FT+1
*
*
R:FT     EQU      %
         LI,R2    1                 USE R2=1 FOR 'FT'
         LI,P3    0                 USE P3 TO COUNT # OF MATCHES FOUND
         LI,R3    5
         LB,R4    *@CDT,R3
         LW,R5    *@CDT,R4          SET R5=FIRST SEQ # IN CDT
         STW,R5   FIRSTSET              FIRSTSET=1ST SEQ # IN CDT
         STW,R8   FIRSTSET          SET FIRSTSET=1ST SEQ # IN CDT
         AI,R4    1                     LASTSET=2ND SEQ # IN CDT
         LW,R8    *@CDT,R4
         STW,R8   LASTSET
         LI,R3    7
         LB,R6    *@CDT,R3          SET R6=ABSOLUTE ADDR OF STRING TO
         AW,R6    @CDT               MATCH
         LI,R3    8
         BAL,R7   PROCESSCOL#PAIR   PROCESS COL # PARAMS
         BAL,R7   RD:NXTRANDOM      READ FIRST SEQ # OR NEXT HIGHEST
*
*  READ  EACH RECORD AND SEE IF IT CONTAINS THE SPECIFIED STRING
*
FND20    CW,S1    L(EOF)            WAS IT AN EOF
         BE       FND70             YES - ERROR
         CW,S1    LASTSET           WAS INPUT SEQ # > LAST SEQ #
         BG       FND50             YES - FINISH UP
         STW,S1   FIRSTSET          NO - SAVE NEW SEQ #
         LW,R5    FRSTCLMN          CHECK IF REC CONTAINS STRING
         BAL,R7    FINDMATCH        STARTING AT SPECIFIED COL. #
         BCS,8    FND40
         AI,P3    1                 YES - INCR MATCH COUNT
         EXU      FNDTBL1,R2        GO PERFORM APPRO ACTION
*
*  'FD' USED: DELETE RECORD
*
FND30    BAL,R7   DEL:REC           DELETE RECORD
         B        FND40             GO ON TO NEXT RECORD
*
*  'FT' USED: TYPE SEQ #, AND RECORD
*
FND32    LW,R5    FIRSTSET
         BAL,R7   WR:SR
         B        FND40
*
*  'FS' USED: TYPE SEQ #
*
FND35    LW,R5    FIRSTSET          GET SEQ #
         BAL,7    FSEQ#             FORM SEQUENCE NUMBER
         WRITE,M  OBUF              WRITE SEQUENCE NUMBER
*
*  TEST IF LAST RECORD HIT: IF YES, GO FINISH UP
*
FND40    LW,S1    FIRSTSET          TEST IF LAST SEQ # = SEQ # TO STOP
         STW,S1   INTFLAG1
         CW,S1    LASTSET            AT
         BE       FND50
         BAL,R7   RD:SEQUEN         NO - READ NEXT RECORD
         B        FND20             LOOP
*
*  SEQ. # TO STOP AT HIT OR PASSED: FINISH UP
*
FND50    EXU      FNDTBL2,R2        GO FINISH UP
*
*  'FD' USED: TYPE '--NNN RECS DLTED'
*
FND60    LW,D4    P3
         BEZ      FND65A            WERE ANY MATCHES FOUND
         LW,R5     P3               GET RECORD COUNT IN R5
         LI,R6     BA(MSG6)+1       GET BYTE ADR. OF PLACE TO PUT CNT.
         BAL,R7    DEC#
         WRITE,M:D MSG6
*
*  'FT' USED: TYPE '--NONE' IF NO MATCHES FOUND
*
FND65    CI,P3    0                 WERE ANY MATCHES FOUND
         BNE      *D2               YES - EXIT
FND65A   WRITE,M:D ERRM6            NO - WR:   '--NONE'
*
*  ERROR: EOF HIT
*
FND70    WRITE,M ERRM1              WR:   '--EOF HIT'
         B        FND50             GO FINISH UP
*
*
FNDTBL1  EQU      %
         B        FND30
         B        FND32
         B        FND35
*
*
FNDTBL2  EQU      %
         B        FND60
         B        FND65
         B        FND65
*
************************************************************
*  RECORD COMMANDS: INSERT(SUPPRESSING SEQ. NUMBERS)
************************************************************
*
*
R:IS     EQU      %
         LI,R2    1                 USE R2=1 FOR 'IS'
         CAL1,1   FPT:P:C
         B        R:IN+2
*
*
R:IN     EQU      %
         CAL1,1   FPT:P:N
         LI,R2    0                 USE R2=0 FOR 'IN'
         LI,R3    5
         LB,R4    *@CDT,R3          SET R5=STARTING SEQ #
         LW,R5    *@CDT,R4
         LW,R8    DFLTINCR          SET R8=LAST INCR USED
         LI,R3    6
         LB,S1    *@CDT,R3          GET PARAM2 TYPE
         BEZ      INS10             TEST IF PARAM2 PRESENT
         AI,R3    1
         LB,R4    *@CDT,R3          YES - SET R8=INCR FROM CDT
         LW,R8    *@CDT,R4
         STW,R8   DFLTINCR          SET NEW DEFAULT INCR
*
*  GET SEQ. # AT WHICH TO STOP INSERTING
*
INS10    BAL,R7   RD:NXTRANDOM      READ 1ST SEQ # OR NEXT HIGHEST
         BCS,8    %+2               WAS NEXT HIGHEST READ
         BAL,R7   RD:SEQUEN         NO - SO READ NEXT HIGHEST
         LW,R9    S1                SET R9=SEQ # AT WHICH TO STOP INSERT
*
*  TYPE NEXT SEQ. # AND READ  INPUT LINE
*
INS20    B        %+1,R2            TYPE 'DDDD.DDD' AS REQD
         BAL,R7   WR:S
         BAL,R7   RD::R             READ INSERT
         B        *D2               NULL RECORD RETURN
*
*  WRITE INPUT IMAGE, INCREMENT SEQ. #, AND CHECK AGAINST # TO STOP AT
*
         BAL,R7   WRITERANDOM       WRITE CARD IMAGE
         AW,R5    R8                INCR SEQ #
         CW,R5    R9
         BL       INS20             IS NEW SEQ # > SEQ # TO STOP AT
         CW,R5    MAXSEQ            IS SEQ. NO. TOO BIG
         BLE      INS38             NO.
         WRITE,M  ERRM20
INS38    TYPE     INSMSG            RING BELL TWICE
         B        *D2               RETURN
*
*
INSMSG   TEXTC    '   '             X'07'+X'07'+EOM
*
************************************************************
*  READ AND TRANSFER DATA IN R BUFFER
************************************************************
*
*
RD::R    EQU      %
         PUSH     (R4,R7)
         BAL,R7   RD:SI
         LW,R4    S1
         BEZ      RD::R3            RETURN
         CI,R4    MAXCLMN-1         COMPARE WITH MAX. LENGTH
         BLE      RD::R2
         WRITE,IM ERRM3             TYPE : '--OVERFLOW'
         LI,R4    MAXCLMN-1
RD::R2   EQU      %
         STW,R4   RSIZ              SAVE BYTE COUNT
         LB,D4    IBUF,R4
         STB,D4   RBUF,R4           TRANSFER DATA
         BDR,R4   %-2
         LB,D4    IBUF                AND BYTE 0
         STB,D4   RBUF
         PULL     (R4,R7)
         B        1,R7
RD::R3   PULL     (R4,R7)
         B        0,R7
*
*
*
*
************************************************************
*  RECORD COMMANDS: MOVE AND DELETE(KEEP)
************************************************************
*
*
R:MD     EQU      %
         LI,R2    0                 USE R2=0 TO SIGNAL MD
         B        R:MK+1
*
*
R:MK     EQU      %
         LI,R2    1                 USE R2=1 TO SIGNAL MK
*
*  GET 'FROM' SEQ. # PAIR IN R8-2, 'TO' SEQ # PAIR IN R5-2, AND
*  INCREMENT IN P3
*
         LI,R3     0
         STW,R3    MR:CNT           ZERO OUT MOVED REC. COUNT.
         LI,R3    5
         LB,R4    *@CDT,R3          GET ADDR OF 1ST 'FROM' SEQ # IN CDT
         LW,R8    *@CDT,R4          SET R5=FIRST 'FROM' SEQ #
         AI,R4    1                     R6=LAST 'FROM' SEQ #
         LW,R9    *@CDT,R4
         LI,R3    7
         LB,R4    *@CDT,R3          GET ADDR OF 1ST 'TO' SEQ # IN CDT
         LW,R5    *@CDT,R4          SET R5=FIRST 'TO' SEQ #
         AI,R4    1                     R6=LAST 'TO' SEQ #
         LW,R6    *@CDT,R4
         LW,P3    DFLTINCR          SET P3=LAST INCR USED
         LI,R3    8
         LB,S1    *@CDT,R3          GET PARAM3 TYPE
         BEZ      MVE20             TEST IF PARAM3 PRESENT
         AI,R3    1
         LB,R4    *@CDT,R3          YES - SET P3=INCR FROM CDT
         LW,P3    *@CDT,R4
         STW,P3   DFLTINCR          SET NEW DEFAULT INCR
*
*  CHECK FOR OVERLAPPING SEQ #'S AND SET UP MOVE
*
MVE20    LW,D3    R8                PUT 'FROM' SEQ #'S IN DW
         LW,D4    R9
         CLM,R5   D3                MAKE SURE 'TO' AND 'FROM' RANGES
         BIL      MVE50              ARE MUTUALLY EXCLUSIVE
         CLM,R6   D3
         BIL      MVE50
         LW,D3     R5
         LW,D4     R6
       CLM,R8    D3
       BIL       MVE50
       CLM,R9    D3
       BIL       MVE50
         XW,R8    R5                EXCHANGE FIRST 'FROM' AND 'TO'
       BAL,R7     RD:NXTRANDOM      CHECK 'FROM' RANGE
         XW,R8    R5               RESTORE
         CW,S1    L(EOF)       M    IF RECORD READ WAS AN EOF,
         BE       MVE58
         CW,S1    R9                OR SEQUENCE GREATER THAN SECOND
         BG       MVE58             'FROM', NOTHING TO MOVE
         BAL,R7   DELETE            DELETE 'TO' RECORDS
         LW,R1    S1                SET R1=SEQ # AT WHICH TO STOP MOVE
         XW,R5    R8
         BAL,R7   RD:NXTRANDOM      READ 1ST 'FROM' REC OR NEXT HIGHEST
         LW,R5    R8                SET R5=NEW 'TO' SEQ # - INCR
         SW,R5    P3
*
*  READ  EACH 'FROM' RECORD AND WRITE UNDER 'TO' SEQ #
*
MVE30    CW,S1    L(EOF)            WAS AN EOF READ
         BE       MVE53             YES - GO TYPE ERROR MESSAGE
         CW,R9    S1                WAS 'FROM' SEQ # >= LAST 'FROM' SEQ
         BLE      MVE35             YES - GO FINISH UP
         AW,R5    P3                INCR 'TO' SEQ #
         CW,R5    R1                IS NEW 'TO' SEQ # > SEQ # TO STOP AT
         BGE      MVE56             YES - GO TYPE ERROR MESSAGE
         STW,S1   LASTFROM
         B        %+1,R2            DELETE 'FROM' RECORD AS REQD
         BAL,R7   DEL:REC
         MTW,1     MR:CNT           INCERMENT REC. COUT
         BAL,R7   WRITERANDOM       WRITE RECORD WITH NEW 'TO' SEQ #
         STW,S1   INTFLAG1
         STW,R5   INTFLAG2
         XW,R5    LASTFROM          MUST REREAD LAST 'FROM' RECORD TO
         BAL,R7   RD:RANDOM          GET DCB BACK IN SEQ
         XW,R5    LASTFROM          RESTORE R5 AND LASTFROM
         BAL,R7   RD:SEQUEN         READ NEXT 'FROM' RECORD
         B        MVE30             LOOP
*
*  LAST 'FROM' SEQ # HIT OR PASSED: FINISH UP
*
MVE35    BL       MVE40             WAS LAST 'FROM' SEQ # PASSED
         AW,R5    P3                NO, WAS HIT - INCR 'TO' SEQ #
         CW,R5    R1                IS NEW 'TO' SEQ # > SEQ # TO STOP AT
         BGE      MVE56             YES - GO TYPE ERROR MESSAGE
         B        %+1,R2            DELETE 'FROM' REC AS REQD
         BAL,R7   DEL:REC
         MTW,1     MR:CNT           INCERMENT RECORD COUNT.
         BAL,R7   WRITERANDOM       WRITE REC WITH NEW 'TO' SEQ #
*
*  TYPE OUT LAST 'TO' SEQ # AND EXIT
*
MVE40    LI,R6    BA(MVEMSG1)+11    BUILD MSG: '--DONE AT DD.D' + NL
         BAL,R7   MOVESEQ            FROM LAST 'TO' SEQ #
         GEN4     0,0,0,0
         AI,R0    10                ADJ CNT OF TEXTC-STRING
         STB,R0   MVEMSG1
         WRITE,M  MVEMSG1
         LI,R6     BA(MSG7)+1
         LW,R5     MR:CNT           GET THE NUMBER OF REC.S MOVED
         BAL,R7    DEC#
         WRITE,M:D MSG7
*
*  ERROR: SEQ #'S OVERLAP
*
MVE50    WRITE,M:D ERRM4            TYPE; '-RNG OVERLAP'
*
*  ERROR: EOF HIT
*
MVE53    WRITE,M ERRM1  G           WR:   '--EOF HIT'
         B        MVE40             GO EXIT
*
*  ERROR: 'TO' SEQ # HIT NEXT UNDELETED RECORD
*
MVE56    SW,R5    P3                ADJ R5 TO LAST 'TO' SEQ #
         LI,R6    BA(MVEMSG2)+13    BUILD MSG: '--CUTOFF AT DDD.D ('
         BAL,R7   MOVESEQ            WITH LAST 'TO' SEQ #
         GEN4     BL,LP,0,0
         AW,R6    R0                INCR MSG BYTE ADDR
         AI,R0    12                CALC AND SAVE MSG LENGTH
         LW,R8    R0
         LW,R5    LASTFROM          BUILD: 'DD.DD)' + NL  FROM LAST
         BAL,R7   MOVESEQ            'FROM' SEQ #
         GEN4     RP,0,0,0
         AW,R8    R0                ADJ CNT OF TEXTC-STRING
         STB,R8   MVEMSG2
         WRITE,M:D MVEMSG2          WR:   '--CUTOFF AT DDD.D (DD.DD)' +
*
MVE58    WRITE,M:D ERRM16
*
************************************************************
*  RECORD COMMAND: RENUMBER
************************************************************
*
*
R:RN     EQU      %
         LI,R3    5
         LB,R4    *@CDT,R3          SET R5=OLD SEQ #
         LW,R5    *@CDT,R4
         LI,R3    7
         LB,R4    *@CDT,R3          SET R8=NEW SEQ #
         LW,R8    *@CDT,R4
         BAL,R7   RD:RANDOM         READ OLD RECORD
         BCS,8    RNM10             DID IT EXIST
         LW,R5    R8                YES - SET R5=NEW SEQ #
         BAL,R7   WRITENEWRANDOM    WRITE RECORD UNDER NEW SEQ #
         BCS,8    RNM13             DID THIS SEQ # ALREADY EXIST
         BAL,R7   DEL:REC           NO - DELETE OLD RECORD
         B        *D2               EXIT
*
*  ERROR: OLD RECORD DOESN'T EXIST
*
RNM10    WRITE,PE:P ERRP1           WR:   '-P1:NO SUCH REC'
*
RNM13    EQU      %
         MTW,1    PCNT              ADJUST PARAM. COUNT
         WRITE,PE:P ERRP2           WR:   '-P2:REC EXISTS'
*
************************************************************
*  RECORD COMMANDS: SET AND STEP (AND TYPE)
************************************************************
*
*
R:SS     EQU      %
         LI,R3    1                 USE STEPFLAG=1 FOR 'SS'
         B        R:ST+1
*
*
R:ST     EQU      %
         LI,R3    -1                USE STEPFLAG=-1 FOR 'ST'
         STW,R3   STEPFLAG          TURN ON 'SET AND STEP MODE' FLAGS
         STW,R3   SETFLAG
         LI,R3    5                 GET STARTING SEQ # FROM CDT
         LB,R4    *@CDT,R3
         LW,R5    *@CDT,R4
         LI,R3    6
         BAL,R7   PROCESSCOL#PAIR   PROCESS COL # PARAMS
         BAL,R7    RD:NXTRANDOM
         STW,S1    R5               PUT FIRST REC. NO. IN R5.
         STW,S1    FIRSTSET         NO , SO USE THE FIRST RECORD
         B        F:EX              FINISH : NUMBER HIGHER
*                                   THAN THE INPUT RECORD NO.
*
************************************************************
*  RECORD COMMANDS: TYPE(SUPPRESSING SEQ. NUMBERS)
************************************************************
*
R:TC     EQU      %
*
R:TY     EQU      %
         LI,R2    1                 USE R2=1 FOR 'TY'
         B        R:TS+1
*
*
R:TS     EQU      %
         LI,R2    0                 USE R2=0 FOR 'TS'
         LI,R3     1
         STW,R3    SETFLAG          SET THE SETFLAG TO ONE
*                                   THE RANGE FROM TY IS USED FOR
*                                   AN SE COMMAND.
         LI,S2    0                 START COUNT OF RECORDS OUTPUT.
         LI,R3    5
         LB,R4    *@CDT,R3          GET ADDR OF FIRST SEQ % IN CDT
         LW,R5    *@CDT,R4          SET R5=FIRST SEQ #
         AI,R4    1                     R6=LAST SEQ #
         LW,R6    *@CDT,R4
         STW,R6    LASTSET          SAVE ENDING SEQ #
         AI,R3    1                 SET UP COL. NUMBERS
         BAL,R7   PROCESSCOL#PAIR
         BAL,R7   RD:NXTRANDOM      READ FIRST SEQ # OR NEXT HIGHEST
         STW,S1    SV1STSET         SET UP FIRST RECORD NO.
         STW,S1    FIRSTSET         AS IF A SET COMMAND WERE GIVIN.
*
*  READ AND TYPE UNTIL LAST SEQ # READ OR PASSED
*
TYP10    CW,S1    L(EOF)            WAS IT AN EOF
         BE       TYP20             YES - GO TYPE ERROR MESSAGE
         CW,R6    S1                WAS INPUT SEQ # >= LAST SEQ #
         BL       TYP15             YES - FINISH UP
         LW,R5    S1
         BAL,R7   TYP40
         EXU      TS@TY,R2          WRITE RECORD
         AI,S2    1
TYP15    EQU      %
         MTW,0    S2
         BEZ      TYP25
         CW,R6    S1
         BE       *D2
         BAL,R7   RD:SEQUEN         READ NEXT RECORD
         B        TYP10             LOOP
*
*
*  ERROR: EOF HIT
*
TYP20    WRITE,M:D ERRM1            WR:   '--EOF HIT'
*
TYP25    WRITE,M:D ERRM6            WR:   '--NONE'
*
TS@TY    BAL,R7   WR:R
         BAL,R7   WR:SR             RECORD WITH SEQUENCE NUMBER
*
*
TYP40    LW,R3    FRSTCLMN          ADJUST THE IMAGE FOR COLUMN BOUNDS
         BEZ      TYP50             OR COMPRESSION.
         LI,R4    0                 MOVE (FIRSTCLMN,LASTCLMN-1), DOWN TO
TYP42    LB,R0    RBUF,R3           ZERO.
         STB,R0   RBUF,R4
         AI,R4    1                 INCREMENT DEST. COL. #
         AI,R3    1                 INCREMENT TO NEXT BYTE.
         CW,R3    LASTCLMN          CHECK IF DONE.
         BL       TYP42
         STW,R4   RSIZ
         B        TYP60
TYP50    EQU      %
         LW,R3    LASTCLMN          GET LAST COLUMN NUMBER
         AI,R3    1                 ADJUST FOR RECORD SIZE
         STW,R3   RSIZ                AND SAVE
*
TYP60    LI,R3    1                 FINALLY CHECK FOR COMPRESSION .
         LB,R4    *@CDT,R3
         CI,R4    #R:TY
         BG       TYP70             YES.  OTHERWISE,
*
         B        0,R7              EXIT
*
*
TYP70    LI,R3    0                 IN RANGE (0,LASTCLMN) COMPRESS
         LI,R0    ' '               BLANK STRINGS TO LENGTH ONE.
         LI,R4    0
TYP72    CB,R0    RBUF,R4           CHECK FOR BLANK IN CURRENT POSITION-
         BE       TYP80             IF NOT,
TYP75    LB,D4    RBUF,R4           MOVE NON-BLANK STRING DOWN.
         STB,R0   RBUF,R4           CLEAR POSITION
         STB,D4   RBUF,R3
         AI,R3    1                 INCREMENT TO AND
         AI,R4    1                 FROM BYTE POINTERS.
         CW,R4    LASTCLMN          IF AT UPPRR LIMIT-
         BL       TYP72
TYP78    EQU      %
         STW,R3   RSIZ
         B        0,R7              THEN RETURN
*
*
TYP80    AI,R3    1                 INCREMENT 'TO' POINTER TO LEAVE THIS
TYP82    AI,R4    1                 BLANK.  SKIP TO NON-BLANK.
         CW,R4    LASTCLMN
         BGE      TYP78
         CB,R0    RBUF,R4
         BE       TYP82
         B        TYP75             MOVE NEXT STRING DOWN.
*
************************************************************
*  RECORD COMMAND: ADD TEXT
************************************************************
*
R:AD     EQU      %
         CAL1,1   FPT:P:N           NO PROMT
         LI,R3    5
         LB,R4    *@CDT,R3          SET R5=STARTING SEQ #
         LW,R5    *@CDT,R4
         BAL,R7   RD:RANDOM         READ FIRST RECORD
         BCS,8    R:AD5             DOES IT EXIST (IF NO, ERROR)
*
*  TYPE RECORD AND READ  IN TEXT
*
R:AD1    EQU      %
         LW,R4    RSIZ              GET COLUMN NUMBER
         BAL,R7   WR:SRN            TYPE RECORD WITHOUT LINE FEED
         BAL,R7   RD:SI             READ TEXT
         MTW,0    S1                SET S1=# OF CHARS READ, LESS C/R
         BEZ      *D2               IF ONLY  C/R READ - EXIT
         LI,R3    0
*
R:AD2    LB,D3    IBUF,R3           MOVE TEXT       INTO SPECIFIED
         STB,D3   RBUF,R4            COLUMN
         AI,R3    1
         AI,R4    1
         BDR,S1   %+2               TEST IF ANY MORE CHARS LEFT TO MOVE
         B        R:AD3             NO - GO FINISH UP
         CI,R4    MAXCLMN           YES - TEST IF ANY ROOM LEFT ON CARD
         BL       R:AD2             YES - LOOP
         B        R:AD7
*
*  WRITE NEW RECORD AND THEN GET NEXT RECORD TO PROCESS
*
R:AD3    EQU      %
         STW,R4   RSIZ
         BAL,R7   WRITERANDOM
         BAL,R7   RD:SEQUEN         READ NEXT RECORD
         CW,S1    L(EOF)            WAS IT AN EOF
         BE       R:AD6             YES - ERROR
         LW,R5    S1                SET R5=SEQ # OF RECORD
         B        R:AD1             GO GET MORE TEXT
*
*  ERROR: INITIAL SEQ. # DOESN'T EXIST
*
R:AD5    WRITE,PE:P ERRP1           WR:   '-P1:NO SUCH REC'
*
*  ERROR: EOF HIT
*
R:AD6    WRITE,M:P ERRM1            WR:   '--EOF HIT'
*
*  ERROR: TEXT       OVERFLOWS CARD
*
R:AD7    WRITE,IM ERRM3             WR:   '--OVERFLOW'
         B        R:AD3             GO CONTINUE WITH NEXT RECORD
*
************************************************************
*  INTRALINE COMMAND: SET
************************************************************
*
*
I:SE     EQU      %
         LI,R8    1                 TURN 'SET MODE' FLAG ON
         STW,R8   SETFLAG
         LI,R3    5
         LB,R4    *@CDT,R3          GET ADDR OF FIRST SEQ # IN CDT
         LW,R5    *@CDT,R4          SET R5=FIRST SEQ #
         AI,R4    1                     R6=LAST SEQ #
         LW,R6    *@CDT,R4
         STW,R6   LASTSET
         LI,R3    6
         BAL,R7   PROCESSCOL#PAIR   PROCESS COL # PARAMS
         LW,R3    @CDT              CALC R3=ADDR IN CDT OF NEXT COMMAND
         LB,S1    *@CDT              AFTER 'SE'
         AW,R3    S1
         STW,R3   SETADR            PUT THIS IN SETADR FOR I:CMND LOOP
         BAL,R7    RD:NXTRANDOM  READ FIRST RECORD IN RANGE.
         STW,S1    SV1STSET         SET FIRST SEQ NO.
         STW,S1    FIRSTSET         SET LOOP CONTROL
         STW,S1    R5
         CW,S1     LASTSET          MAKE SURE THAT THE FIRST RECORD IS
         BLE       *D2              IN TH P1-P2 RANGE.
         LI,R8    0                 TURN OFF 'SET MODE' FLAG
         STW,R8   SETFLAG
         WRITE,PE:P ERRP1           NO - WR:   '-P1:NO SUCH REC'
*
*
************************************************************
*  INTRALINE COMMAND: 'DELETE' X
************************************************************
*
*
I:D      EQU      %
         MTW,0     ALLFLAG          SEE IF ALL FLAG IS SET.
         BLZ       I:D01
         LB,R3     *TEXTCADR        GET THE CHARACTER COUNT.
I:D02      LB,R6   *TEXTCADR,R3     SERACH THE STRING FOR ANY
         CI,R6     X'40'            NON BLANK CHARACTER.
         BNE       I:D01            CONTINUE
         BDR,R3    I:D02
         WRITE,M:P ERRM21           ALL BLANKS MESSAGE
I:D01         EQU  %
         BAL,R7   FINDCOLUMN        FIND COLUMN CORRES TO FIRST PARAM
         BCS,8    *D2               NONE FOUND - EXIT
         AW,R5    R6                SET R5=CHAR AFTER PARAM STRING
         LW,P3    R6                    R6=0 (FIELD WIDTH)
         LI,R6    0                     P3=# TO SHIFT (=LENGTH OF STRG)
         BAL,R7   SHIFTLEFT         SHIFT LEFT TO D      STRING
         SW,R5    P3                IF ALLFLAG IS ON, SET TO RESUME
         BAL,R7   ADJUSTALLFLAG      MATCHING AFTER X AS DD
         BAL,R7   SETEOD            RESET EOD MARKER
         B        *D2               EXIT
*
************************************************************
*  INTRALINE COMMAND: 'OVERWRITE AND EXTEND' X BY Y
************************************************************
*
*
I:E      EQU      %
         STW,D2    ALLOK
         BAL,R7   FINDCOLUMN        FIND COLUMN CORRES TO FIRST PARAM
         BCS,8    *D2
         AI,R3    1
         LB,R6    *@CDT,R3          GET ADDR OF 2ND STRING IN CDT
         AW,R6    @CDT              SET R6=ABSOLUTE ADDR OF STRING
         BAL,R7   MOVESTRING        OVERWRITE WITH NEW STRING
         LB,R8    *R6               SET R5=COL. AFTER LAST NEW CHAR
         AW,R5    R8
         LI,R8    ' '
*
*  BLANK OUT REST OF CARD IMAGE
*
OER30    CW,R5    LASTCLMN          BLANK OUT BUFFER FROM CHAR AFTER
         BGE      I:E8               LAST NEW CHAR TO COL. TO STOP AT
         STB,R8   RBUF,R5
         AI,R5    1
         B        OER30
*
I:E8     EQU      %
         BAL,R7   SETEOD            SET RSIZ
         B        *D2               RETURN
*
************************************************************
*  INTRALINE COMMAND: 'FOLLOW' X BY Y
************************************************************
*
*
I:F      EQU      %
         BAL,R7   FINDCOLUMN        FIND COLUMN CORRES TO FIRST PARAM
         BCS,8    *D2               NONE FOUND - EXIT
         AW,R5    R6                SET R5=CHAR AFTER PARAM STRING
         LI,R6    0                     R6=0 (FIELD WIDTH)
         AI,R3    1
         LB,R4    *@CDT,R3          GET ADDR OF 2ND STRING IN CDT
         AW,R4    @CDT              SET R4=ABSOLUTE ADDR OF STRING
         LB,P3    *R4                   P3=LENGTH OF STRING
         BAL,R7   SHIFTRIGHT        SHIFT RIGHT TO MAKE ROOM FOR 2ND
         LW,R6    R4                 STRING
         BAL,R7   MOVESTRING        MOVE STRING INTO HOLE
         AW,R5    P3                IF ALLFLAG IS ON, SET TO RESUME
         BAL,R7   ADJUSTALLFLAG      MATCHING AFTER Y AS ADDED
         BAL,R7   SETEOD            RESET EOD MARKER
         B        *D2               EXIT
*
************************************************************
*  INTRALINE COMMAND: SHIFT X 'LEFT' BY N
************************************************************
*
*
I:L      EQU      %
         STW,D2    ALLOK
         BAL,R7   FINDCOLUMN        FIND COLUMN CORRES TO FIRST PARAM
         BCS,8    *D2               NONE FOUND - EXIT
         AI,R3    1
         LB,R4    *@CDT,R3          GET ADDR OF N IN CDT
         LW,P3    *@CDT,R4          SET P3=NUMBER TO SHIFT (N)
         BEZ      *D2               IF N=0 - EXIT
         BAL,R7   SHIFTLEFT         SHIFT LEFT N SPACES
         BAL,R7   SETEOD            RESET EOD MARKER
         B        *D2               EXIT
*
************************************************************
*  INTRALINE COMMAND: 'OVERWRITE' X BY Y
************************************************************
*
*
I:O      EQU      %
         BAL,R7   FINDCOLUMN        FIND COLUMN CORRES TO FIRST PARAM
         BCS,8    *D2               NONE FOUND - EXIT
         AI,R3    1
         LB,R6    *@CDT,R3          GET ADR OF 2ND STRING IN CDT
         AW,R6    @CDT              CALC R6=ABSOLUTE ADDR OF STRING
         BAL,R7   MOVESTRING        OVERWRITE WITH NEW STRING
         LB,R3    *R6               IF ALLFLAG IS ON, SET TO RESUME
         AW,R5    R3                 MATCHING AFTER Y AS OVERWRITTEN
         BAL,R7   ADJUSTALLFLAG
         BAL,R7   SETEOD            RESET EOD MARKER
         B        *D2               EXIT
*
************************************************************
*  INTRALINE COMMAND: 'PRECEDE' X BY Y
************************************************************
*
*
I:P      EQU      %
         BAL,R7   FINDCOLUMN        FIND COLUMN CORRES TO FIRST PARAM
         BCS,8    *D2               NONE FOUND - EXIT
         AI,R3    1
         LB,R4    *@CDT,R3          GET ADDR OF 2ND STRING IN CDT
         AW,R4    @CDT              SET R4=ABSOLUTE ADDR OF STRING
         LB,P3    *R4                   P3=LENGTH OF STRING
         BAL,R7   SHIFTRIGHT        SHIFT RIGHT TO MAKE ROOM FOR 2ND
         XW,R6    R4                 STRING
         BAL,R7   MOVESTRING        MOVE STRING INTO HOLE
         AW,R5    R4                IF ALLFLAG IS ON, SET TO RESUME
         AW,R5    P3                 MATCHING AFTER X AS PRECEDED BY Y
         BAL,R7   ADJUSTALLFLAG
         BAL,R7   SETEOD            RESET EOD MARKER
         B        *D2               EXIT
*
************************************************************
*  INTRALINE COMMAND: SHIFT X 'RIGHT' BY N
************************************************************
*
*
I:R      EQU      %
         STW,D2    ALLOK
         BAL,R7   FINDCOLUMN        FIND COLUMN CORRES TO FIRST PARAM
         BCS,8    *D2               NONE - FOUND ERROR
         AI,R3    1
         LB,R4    *@CDT,R3          GET ADDR OF N IN CDT
         LW,P3    *@CDT,R4          SET P3=NUMBER TO SHIFT (N)
         BEZ      *D2               IF N=0 - EXIT
         BAL,R7   SHIFTRIGHT        SHIFT RIGHT N SPACES
         BAL,R7   SETEOD            RESET EOD MARKER
         B        *D2               EXIT
*
************************************************************
*  INTRALINE COMMAND: FOR X 'SUBSTITUTE' Y
************************************************************
*
*
I:S      EQU      %
         BAL,R7   FINDCOLUMN        FIND COLUMN CORRES TO FIRST PARAM
         BCS,8    *D2               NONE FOUND - EXIT
         AI,R3    1
         LB,R4    *@CDT,R3          GET ADDR OF 2ND STRING IN CDT
         AW,R4    @CDT              SET R4=ABSOLUTE ADDR OF STRING
         LB,P3    *R4                   P3=LENGTH OF STRING
         LW,R8    R5                SAVE R5
         AW,R5    R6                SET R5=CHAR AFTER PARAM1 STRING
         SW,P3    R6                CALC NUMBER TO SHIFT IN P3
         BLEZ     SBS10             IS NEW STRING LONGER THAN OLD STRING
         LI,R6    0                 YES - SET R6=0 (FIELD WIDTH)
         BAL,R7   SHIFTRIGHT        SHIFT RIGHT AMOUNT OF DIFFERENCE
         B        SBS15             GO TO MOVE IN NEW STRING
*
*  NEW STRING SHORTER OR EQUAL THAN OLD ONE
*
SBS10    BE       SBS15             ARE NEW AND OLD STRINGS OF = LENGTH
         LCW,P3   P3                NO - NEW SHORTER
         LI,R6    0                 SET R6=0 (FIELD WIDTH)
         BAL,R7   SHIFTLEFT         SHIFT LEFT AMOUNT OF DIFFERENCE
*
*  MOVE NEW STRING INTO POSITION
*
SBS15    LW,R5    R8                SET R5=COL. OF PARAM1 STRING
         LW,R6    R4                    R6=ADDR OF NEW STRING
         BAL,R7   MOVESTRING        MOVE NEW STRING IN PLACE
         LB,R8    *R6               IF ALLFLAG IS ON, SET TO RESUME
         AW,R5    R8                 MATCHING AFTER Y AS SUBSTITUTED
         BAL,R7   ADJUSTALLFLAG
         BAL,R7   SETEOD            RESET EOD MARKER
         B        *D2               EXIT
*
************************************************************
*  INTRALINE COMMAND: JUMP
************************************************************
*
*
I:JU     EQU      %
         MTW,0    STEPFLAG          IS SYSTEM IN 'STEP MODE'
         BEZ      JMR50             NO - ERROR
         LW,R5    FIRSTSET
         BAL,R7   WRITERANDOM       WRITE CURRENT RECORD
         LI,R3    5                 GET SEQ # FOR JUMP FROM CDT
         LB,R4    *@CDT,R3
         LW,R5    *@CDT,R4
         BAL,R7   RD:RANDOM         READ THIS RECORD
         BCS,8    JMR55             DID IT EXIST
         STW,R5   FIRSTSET          SAVE NEW SEQ #
         B        F:EX              FINISH UP
*
*  ERROR: 'JU' ILLEGAL AT THIS POINT
*
JMR50    WRITE,CE  ERRC4            WR:   '-CN:CMND ILGL HERE'
         B        *D2
*
*  ERROR: RECORD TO JUMP TO DOESN'T EXIST
*
JMR55    WRITE,CE   ERRC3            WR:   '-CN:NO SUCH REC'
         LW,R5    FIRSTSET
         BAL,R7   RD:RANDOM         RESTORE OLD RECORD
         B        *D2               EXIT
*
************************************************************
*  INTRALINE COMMAND: NO CHANGE
************************************************************
*
*
I:NO     EQU      %
         MTW,0    STEPFLAG          IS SYSTEM IN STEP MODE
         BEZ      NCG10             NO - ERROR
         LI,R8    1
         STW,R8   NOCHGFLG          TURN ON 'NO CHANGE' FLAG
         B        *D2               EXIT
*
*  ERROR: 'NO' ILLEGAL AT THIS POINT
*
NCG10    WRITE,CE  ERRC4            WR:   '-CN:CMND ILGL HERE'
         B        *D2
*
************************************************************
*  INTRALINE COMMAND: REVERSE BLANK PRESERVATION FLAG
************************************************************
*
*
I:RF     EQU      %
         LW,R8    BPFLAG            REVERSE BPFLAG
         EOR,R8   K1
         STW,R8   BPFLAG
         B        *D2               EXIT
*
************************************************************
*  INTRALINE COMMANDS: TYPE(SUPPRESSING SEQ. NUMBERS)
************************************************************
*
*
I:TY     EQU      %
         LW,R5    FIRSTSET          GET SEQ #
         BAL,R7   WR:SR
         B        *D2               EXIT
*
*
I:TS     EQU      %
         BAL,R7   WR:R
         B        *D2               EXIT
         PAGE
************************************************************
*  ADJUST ALL FLAG
*    R5 = COLUMN NUMBER TO RESUME MATCHING AT
************************************************************
*
*
ADJUSTALLFLAG     EQU %
         MTW,0    ALLFLAG           IS ALLFLAG ON
         BLZ      0,R7              NO - EXIT
         STW,R5   ALLFLAG           YES - SET IT TO COL. TO RESUME MATCH
         B        0,R7              EXIT
*
******************************************************************
*  ANALYZE COMPOSITION OF FIELD TO RIGHT
*    R5 = COLUMN AT WHICH TO START ANALYZE
*    S1 (BP OFF) = NUMBER OF NON-BLANKS TO 1ST BLANK
*    S1 (BP ON)  = NUMBER OF CHARS TO LAST NON-BLANK ON CARD
*    S2 (BP OFF) = NUMBER OF BLANKS (-1) FROM 1ST BLANK TO NEXT
*                   NON-BLANK
*    S2 (BP ON)  = NUMBER OF TRAILING BLANKS ON CARD
*    CC1=1 IF INITIAL R5>END OF BUFFER, CC1=0 OTHERWISE
******************************************************************
*
*
ANLZRIGHT EQU         %
         PUSH     (R5,R6)           SAVE REGS
         LW,D3    RSIZ              GET RECORD LENGTH
         AI,D3    -1                 AND FORM LAST COLUMN
         LI,S1    0                 SET S1=S2=0
         LI,S2    0
         CI,R5    MAXCLMN           IS START OF FIELD PAST END OF BUFFER
         BL       AS10              NO - GO ON
         PURGE    (R5,R6)           YES - CLEAR STACK
         LCI      8                 SET CC1=1
         B        0,R7              EXIT
*
*  TEST BP FLAG, IF OFF CALC S1=NUMBER OF NON-BLANKS
*
AS10     EQU      %
         CW,R5    D3                IS START OF FIELD PAST LAST NON-BR7
         BG       AS12
         MTW,0    BPFLAG            NO - IS BLANK PRES. ON
         BNEZ     AS20
         LI,R6    ' '
AS10A    CB,R6    RBUF,R5           IS CHAR AT R5=BLANK
         BE       AS15+1            YES - GO COUNT BLANKS
         AI,S1    1                 NO - INCR S1 & R5
         AI,R5    1
         CW,R5    D3                IS R5 PAST LAST NON-BLANK
         BLE      AS10A             NO - CONTINUE SCAN
*
*  NOW PAST LAST NON-BLANK, CALC S2=NUMBER OF BLANKS TO END
*
AS12     LI,S2    MAXCLMN           CALC S2=DISTANCE FROM R5 TO END OF
         SW,S2    R5                 BUFFER
         B        AS18              GO EXIT
*
*  AT END OF NON-BLANKS, COUNT BLANK FIELD
*
AS15     AI,S2    1                 INCR S2 & R5
         AI,R5    1
         CB,R6    RBUF,R5           IS CHAR AT R5=BLANK
         BE       AS15              YES - KEEP COUNTING BLANKS
*
*  EXIT WITH CC1=0
*
AS18     PULL     (R5,R6)           RESTORE REGS
         LCI      0                 SET CC1=0
         B        0,R7              EXIT
*
*  BP FLAG ON, CALC S1 & S2
*
AS20     LW,S1    D3                CALC S1=DISTANCE FROM R5 TO LAST
         SW,S1    R5                 NON-BLANK
         AI,S1    1
         LI,S2    MAXCLMN-1         CALC S2=NUMBER OF TRAILING BLANKS
         SW,S2    D3
         B        AS18              GO EXIT
*
************************************************************
*  EVALUATE FIRST PARAMETERS FOR INTRALINE COMMANDS
*    @CDT   = ADDR OF CURRENT COMMAND IN CDT
*    RESULTS: R5 = COLUMN COMPUTED FROM PARAMETERS
*             R6 = WIDTH OF FIELD AT THIS COLUMN
*             R3 = POSITION OF NEXT CDT CONTROL BYTE
*    CC1=1 IF NO COLUMN FOUND; CC1=0 OTHERWISE
************************************************************
*
FINDCOLUMN        EQU %
         PUSH     R4,(R7,R8)        SAVE REGS
         LI,R8    0                 SET R8=ALL OCCURRENCES
         LW,R5    ALLFLAG               R5=COL. TO START MATCHING AT
         BGEZ     FC15              IS SYSTEM IN 'ALL' MODE
         LW,R5    FRSTCLMN          NO - SET R5=COL. TO START AT
         LI,R3    3                 GET NUMBER OF PARAMS IN CDT
         LB,R8    *@CDT,R3
         CI,R8    2                 ARE THERE > 2 PARAMS
         BG       FC10
         LI,R3    4
         LI,R8    1
         LB,R4    *@CDT,R3          NO - GET PARAM1 TYPE
         LI,R3    5
         CI,R4    STRG              IS IT A STRING
         BE       FC15A             YES - FORM IS: /ST/ X -
         LB,R4    *@CDT,R3          NO - FORM IS: C X -
         LW,R5    *@CDT,R4          GET COL. # FROM CDT
         AI,R5    -1                ADJUST TO INTERNAL COL. #
         CW,R5    FRSTCLMN          IS IT BELOW COL. TO START AT
         BL       FC45              YES - ERROR
         CW,R5    LASTCLMN          IS TO BEYOND COL. TO STOP AT
         BGE      FC40              YES - ERROR
         LI,R6    1                 NO - SET FIELD WIDTH = 1
         LI,R3    6                 SET NEXT CDT CTRL BYTE = 6
         MTW,1    CS:CNT            INC. CHANGED STRING COUNT
         B        FC20              GO EXIT
*
*  THERE ARE 3 PARAMETERS: GET 'OCCURRENCE' COUNT
*
FC10     LI,R3    5
         LB,R4    *@CDT,R3          SET R8=OCCURRENCE CNT IN CDT
         LW,R8    *@CDT,R4
         CI,R8    0                 CHECK IF ALL IS LEGAL FOR THIS
         BG       FC15              COMMAND
         MTW,0    ALLOK
         BEZ      FC15
         WRITE,CI ERRC7
         LI,R8    1                 SUBSTITUTE 1
*
*  FIND CORRECT OCCURRENCE OF STRING IF IT EXISTS
*
FC15     LI,R3    7
FC15A    LB,R6    *@CDT,R3          SET R6=ABSOLUTE ADDR OF PARAM2
         AW,R6    @CDT               STRING
         BAL,R7   FINDMATCH         FIND MATCH FOR STRING
         BCS,8    FC30              IF NONE - ERROR
         LW,R5    S1                SET R5=COL. TO RESUME MATCHING
         AI,R5    1
         BDR,R8    %-4              LOOP IF NOT ON CORRECT OCCURRENCE
         MTW,1     CS:CNT           INCREMENT COUNT HERE
         CI,R8    0                 IF R8<0, 'ALL' MODE IS ACTIVE; IN
         BGE      %+2                THIS MODE ALLFLAG>=0
         STW,R5   ALLFLAG
         AI,R5    -1                SET R5=COLUMN OF MATCH
         LB,R6    *R6                   R6=LENGTH OF STRING
         AI,R3    1                     R3=NEXT CDT CONTROL BYTE
*
*  EXIT WITH CC1=0
*
FC20     PULL     R4,(R7,R8)        RESTORE REGS
         LCI      0
         B        0,R7              EXIT WITH CC1=0
*
*  NO MATCH FOUND: IF IN 'ALL' MODE, EXIT 'ALL' MODE; OTHERWISE, ERROR
*
FC30     LI,R8     -1               TURN OFF ALL MODE.
         STW,R8   ALLFLAG
*
*  EXIT WITH CC1=1
*
FC35     PULL     R4,(R7,R8)        RESTORE REGS
         LCI      8
         B        0,R7              EXIT WITH CC1=1
*
*  ERROR: COLUMN NUMBER BEYOND COLUMN TO STOP AT
*
FC40     WRITE,CE ERRC6             WR:   '-CN:COL>LIMIT'
         B        FC35              GO TO EXIT
*
*  ERROR: COLUMN NUMBER BELOW COLUMN TO START AT
*
FC45     WRITE,CE ERRC10            WR:   '-CN:COL<LIMIT'
         B        FC35              GO TO EXIT
*
************************************************************
*  FIND MATCHING STRING ON CARD
*    R5 = COLUMN AT WHICH TO START SEARCH
*    R6 = ADDR OF TEXTC-STRING TO MATCH
*    S1 = COLUMN AT WHICH MATCH OCCURRED
*    CC1=0 IF MATCH FOUND, CC1=1 IF NO MATCH
************************************************************
*
*
FINDMATCH EQU         %
         PUSH     (R3,R9)           SAVE REGS
         STW,R6   TEXTCADR          SAVE ADDR OF TEXTC-STRING
         LW,S1    LASTCLMN          CALC: STOPCLMN=LAST COL. # AT WHICH
         LB,R6    *TEXTCADR          MATCH CAN TAKE PLACE
         SW,S1    R6
         STW,S1   STOPCLMN
         CW,R5    STOPCLMN          IS INITIAL COL.=STOPCLMN
         BLE      FM10
         PURGE    (R3,R9)           YES - CLEAR STACK
         B        FM15              GO EXIT WITH CC1=1
*
*  GET 1ST CHAR OF TEXTC-STRING AND SEARCH FOR IT IN CARD
*
FM10     LI,R3    1                 SET R8=1ST CHAR OF TEXTC-STRING
         LB,R8    *TEXTCADR,R3
FM10A    CB,R8    RBUF,R5           DOES 1ST CHAR MATCH CHAR ON CARD
         BE       FM20              YES - GO COMPARE REST
FM10B    AI,R5    1                 NO - INCR TO NEXT COLUMN
         CW,R5    STOPCLMN          IS NEW COLMN>STOPCLMN
         BLE      FM10A             NO - GO COMPARE MORE
         PULL     (R3,R9)           YES - RESTORE REGS
*
*  EXIT WITH NO MATCH FOUND (CC1=1)
*
FM15     LCI      8
         B        0,R7              EXIT WITH CC1=1
*
*  1ST CHAR MATCH FOUND, NOW COMPARE CARD WITH REST OF TEXTC-STRING
*
FM20     LI,R3    1                 SET R3=POSITION IN TEXTC-STRING
         LW,R4    R5                    R4=COL. # ON CARD
         LB,R6    *TEXTCADR             R6=# OF CHARS TO COMPARE
         AI,R6    -1
         BEZ      FM30              IF STRING IS 1 CHAR LONG - EXIT
FM20A    AI,R3    1                 INCR R3 & R4
         AI,R4    1
         LB,R9    *TEXTCADR,R3      DO 2 CHARS MATCH
         CB,R9    RBUF,R4
         BNE      FM10B             NO - GO START 1ST CHAR SEARCH AGAIN
         BDR,R6   FM20A             YES - LOOP UNTIL CORRECT # MATCH
*
*  EXIT WITH MATCH FOUND (CC1=0)
*
FM30     LW,S1    R5                MATCH FOUND - SET S1=COL. # OF MATCH
         PULL     (R3,R9)           RESTORE REGS
         LCI      0
         B        0,R7              EXIT WITH CC1=0
*
************************************************************
*  MOVE STRING TO CARD
*    R5 = COLUMN AT WHICH TO PUT STRING
*    R6 = ADDR OF TEXTC-STRING TO MOVE
************************************************************
*
*
MOVESTRING        EQU %
         PUSH     (R3,R7)           SAVE REGS
         SLS,R6   2                 CONVERT R6 TO A BYTE ADDR
         LB,R3    0,R6              SET R3=# OF CHARS TO MOVE
MS5      EQU      %
         CI,R5    MAXCLMN           IS STARTING COL. BEYOND END OF CARD
         BGE      MS20B             OVERFLOW ERROR
*
*  MOVE CHAR FROM TEXTC-STRING TO CARD
*
         AI,R6    1                 INCR TO NEXT TEXTC-STRING CHAR
         LB,R4    0,R6              MOVE CHAR TO CARD
         STB,R4   RBUF,R5
         AI,R5    1                 INCR COLUMN
         BDR,R3   MS5               NO - LOOP UNTIL ALL CHARS MOVED
*
MS10     PULL     (R3,R7)           RESTORE REGS
         B        0,R7              EXIT
*
MS20B    WRITE,CE ERRC1  R          WR:   '--CN:OVERFLOW'
         B        MS10              GO EXIT
*
************************************************************
*  PROCESS COLUMN NUMBER PAIR
*    R3 = LOC OF NEXT PARAMETER CONTROL BYTE IN CDT
************************************************************
*
*
PROCESSCOL#PAIR   EQU %
         PUSH     (R3,R6)           SAVE REGS
         LI,R5    0                 SET R5=DFLT STARTING COL. #
         LI,R6    MAXCLMN               R6=DFLT STOPPING COL. #
         LB,R4    *@CDT,R3          GET NEXT PARAM TYPE
         BEZ      PR50              IS PARAM PRESENT
         AI,R3    1
         LB,R4    *@CDT,R3          YES - SET R5=STARTING COL #
         LW,R5    *@CDT,R4
         AI,R5    -1                ADJUST TO INTERNAL COL #
         AI,R3    -1
*
*  PROCESS SECOND COLUMN NUMBER PARAMETER
*
PR50     AI,R3    2
         LB,R4    *@CDT,R3          GET NEX PARAM TYPE
         BEZ      PR60              IS PARAM PRESENT
         AI,R3    1
         LB,R4    *@CDT,R3          YES - SET R6=STOPPING COL # + 1
         LW,R6    *@CDT,R4
*
*  FINISH INITIALIZATION AND EXIT
*
PR60     STW,R5   FRSTCLMN          SET STARTING AND STOPPING COL #'S
         STW,R6   LASTCLMN
         CW,R5    R6
         BGE      PR65
         CI,R5    0
         BL       PR65
         CI,R6    MAXCLMN
         BG       PR65
         PULL     (R3,R6)           RESTORE REGS
         B        0,R7              EXIT
*
PR65     WRITE,M   ERRM22           WR:   '-BAD COL. NO. PAIR'
         LI,R7    0
         STW,R7   SETFLAG
         STW,R7   STEPFLAG
         B        MPARS
*
************************************************************
*  FIND COLUMN OF LAST NON-BLANK
************************************************************
*
*
SETEOD   EQU      %
         PUSH     (R3,R4)           SAVE REGS
         LI,R3    MAXCLMN/4-1
         LW,R4    4BLANK
         CW,R4    RBUF,R3           MAKE GROSS COMPARISON FOR ALL
         BNE      SRS10             BLANK WORDS.
         BDR,R3   %-2
*
*
         LI,R3    3                 CHECK FIRST WORD BY BYTE.
SRS5     CB,R4    RBUF,R3           ITERATE THROUGH BYTES OF
         BNE      SRS15             TARGET WORD.
         BDR,R3   %-2
*
         CB,R4    RBUF              CHECK FIRST BYTE OF FIRST WORD,
         BNE      SRS15             FOR BLANK.
         LI,R3    -1                IF BLANK, RECORD SIZE =0.
         B        SRS15
SRS10    SLS,R3   2                 REVERT TO BYTE INDEXING, TO GET
         AI,R3    3                 BYTE WITHIN WORD.
         B        SRS5
*
SRS15    EQU      %                 SAVE RECORD SIZE
         AI,R3    1
         STW,R3   RSIZ              AND RECORD SIZE (TRUE BYTE COUNT)
         PULL     (R3,R4)
         B        0,R7              EXIT
*
************************************************************
*  SHIFT STRING LEFT
*    R5 = COLUMN AT WHICH TO START SHIFT
*    R6 = WIDTH OF FIELD STARTING AT THIS COLUMN
*    P3 = NUMBER TO SHIFT LEFT
************************************************************
*
*
SHIFTLEFT EQU         %
         PUSH     (R5,S2)           SAVE REGS
         AW,R5    R6                START ANLZ AFTER ORIG FIELD
         BAL,R7   ANLZRIGHT         ANLZ FIELD AT R5
         BCS,8    SL30              OOPS - FIELD IS BEYOND END OF CARD
         SW,R5    R6                RESTORE R5
*
*  COMPUTE WHERE TO SHIFT TO, COMPENSATING IF SHIFT PUSHES DATA OFF
*  LEFT END OF CARD
*
SL3      AW,S1    R6                SET S1=WIDTH OF FIELD AT R5 TO SHIFT
         LW,R6    R5                CALC: R5=BEGINNING OF 'FROM' FIELD
         SW,R6    P3                      R6=BEGINNING OF 'TO' FIELD
         BGEZ     SL5               DOES THIS SHIFT OFF LEFT END OF CARD
         WRITE,CI ERRC2             YES - WR:   '--CN:UNDERFLOW'
         SW,R5    R6                FIX UP 'FROM' COL. AND WIDTH SO AS
         AW,S1    R6                 TO SHIFT ONLY TO COL. 0
         BLEZ     SL20              DOES SHIFT PUSH ENTIRE FIELD OFF CRD
         LI,R6    0                 NO - SET 'TO'=COL. 0
*
*  SHIFT FIELD AT R5 LEFT
*
SL5      CI,S1    0                 IS WIDTH OF FIELD TO SHIFT = 0
         BE       SL10              YES - SKIP SHIFT
SL5A     LB,R8    RBUF,R5           SHIFT LEFT
         STB,R8   RBUF,R6
         AI,R5    1
         AI,R6    1
         BDR,S1   SL5A
*
*  BLANK OUT CLEARED CHARS ON RIGHT
*
SL10     LI,R8    ' '               BLANK OUT
         STB,R8   RBUF,R6
         AI,R6    1
         BDR,P3   %-2
         PULL     (R5,S2)           RESTORE REGS
         B        0,R7              EXIT
*
*  SHIFT PUSHES EVERYTHING, INCLUDING FIELD AT R5, OFF CARD, SO BLANK
*  OUT AND EXIT
*
SL20     AW,P3    R6                CALC P3=# OF COLUMNS WIPED OUT
         SW,S1    R6
         AW,P3    S1
         LI,R6    0                 SET 'TO' FOR BLANKING=0
         B        SL10              GO BLANK OUT
*
*  FIELD TO SHIFT IS BEYOND END OF CAREAD SET UP TO SHIFT IN BLANKS
*
SL30     SW,R5    R6                RESTORE S1
         CI,R5    MAXCLMN           IS FIELD BEYOND END OF CARD
         BL       SL3               NO - CONTINUE NORMALLY
         LW,R6    R5                SET R6=COL. AT WHICH TO START
         SW,R6    P3                 BLANKING OUT
         B        SL10              GO BLANK OUT
*
************************************************************
*  SHIFT STRING RIGHT
*    R5 = COLUMN AT WHICH TO START SHIFT
*    R6 = WIDTH OF FIELD STARTING AT THIS COLUMN
*    P3 = NUMBER TO SHIFT RIGHT
************************************************************
*
*
SHIFTRIGHT        EQU %
         CI,R5    MAXCLMN           IS FIELD BEYOND END OF CARD
         BGE      0,R7              YES - EXIT
         PUSH     (R3,S2)           SAVE REGS
         LI,R8    0                 SET CNTS=0
         STW,R8   FIELDCNT
         STW,R8   BLANKCNT
         AW,R5    R6                START ANLZ AFTER ORIG FIELD
         CI,R5    MAXCLMN           DOES FIELD ABUTT END OF CARD
         BE       SHR70             YES - GO PROCESS
*
*  BUILD 2-WD DATA BLOCK FOR EACH FIELD TO BE COMPRESSED AND PUSH
*  ON STACK
*
SHR5     BAL,R7   ANLZRIGHT         ANLZ FIELD AT R5
         BCS,8    SHR50             OOPS - END OF CARD
         AWM,S2   BLANKCNT          CNT BR7S  TO COMPRESS
         STH,S1   S2
         AW,S1    R5                BUILD: S1=COLUMN AT END OF NON-BR7S
         AI,S1    -1                       S2=(# OF NON-BR7S,#  TO SHFT)
         MTW,1    FIELDCNT          CNT FIELDS COMPRESSED
         CW,P3    BLANKCNT          ARE ENOUGH BR7S  COMPRESSED YET
         BLE      SHR8              YES
         PUSH     (S1,S2)           NO - SAVE FIELD DATA BLOCK
         LW,R5    S1                INCR R5 TO NEXT FIELD
         AND,S2   XFFFF
         AW,R5    S2
         AI,R5    2
         B        SHR5              ANLZ NEXT FIELD
*
*  INITIALIZE TO DO ACTUAL SHIFTS (I.E., COMPRESSING)
*
SHR8     SW,P3    BLANKCNT          ADJUST (# TO SHIFT) SPEC IN S2 TO
         AW,S2    P3                 PRESERVE EXCESS BR7S  IN LAST FIELD
SHR8A    LW,R3    S1                AVOID: PUSH S1,S2
         LW,R4    S2                       PULL S1,S2
         LI,R8    0
         STW,R8   BLANKCNT          CLEAR BR7  CNT
         MTW,-1   FIELDCNT          DECR FIELD CNT
         BGZ      SS12              >0 - 1 OR MORE FIELDS ON STK
         BEZ      SS10              =0 - AT 1ST FIELD (STK EMPTY)
         LH,R8    R4                <0 - SHIFT WIPES ALL BUT ORIG FIELD
         B        SS12A                   AT R5
*
*  RD:Y  TO SHIFT 1ST FIELD, BUT FIRST ADD ON ORIG FIELD AT R5
*
SS10     AH,R6    R4                ADD LENGTH OF ORIG FIELD TO (# OF
         AI,R6    -1                 NON-BR7S)  SPEC IN S2
         STH,R6   R4
*
*  SET UP PARAMETERS FOR CURRENT SHIFT
*
SS12     LH,R8    R4                SET R8=# OF CHARS IN FIELD TO SHIFT
         AI,R8    1                  (INCLUDING PRECEDING BLANK)
SS12A    AND,R4   XFFFF             KEEP CUMULATIVE CNT OF BR7S
         AWM,R4   BLANKCNT           COMPRESSED OUT
         LW,R4    R3                CALC: R3=END OF 'FROM' FIELD
         AW,R4    BLANKCNT                R4=END OF 'TO' FIELD
         CI,R8    0                 IS # OF CHARS TO SHIFT = 0
         BE       SS15A             YES - SKIP SHIFT
*
*  DO CURRENT SHIFT, THEN CHECK NUMBER LEFT TO DO
*
SS15     LB,R9    RBUF,R3           COMPRESS FIELDS
         STB,R9   RBUF,R4
         AI,R3    -1
         AI,R4    -1
         BDR,R8   SS15
SS15A    MTW,-1   FIELDCNT          DECR FIELD CNT
         BLZ      SS20              <0 - ALL SHIFTS DONE
         PULL     (R3,R4)           >=0 - GET NEXT FIELD DATA BLOCK
         MTW,0    FIELDCNT          TEST FIELD CNT
         BGZ      SS12              >0 - 1 OR MORE FIELDS LEFT
         B        SS10              =0 - AT 1ST FIELD
*
*  ALL SHIFTS DONE, SO BLANK OUT CLEARED CHARS ON LEFT
*
SS20     LW,R8    BLANKCNT
SS20A    LI,R9    ' '               BLANK OUT
         STB,R9   RBUF,R4
         AI,R4    -1
         BDR,R8   %-2
         PULL     (R3,S2)           RESTORE REGS
         B        0,R7              EXIT
*
*  END-OF-BUFFER HIT: NOT ENOUGH BLANKS TO ABSORB SHIFT
*
SHR50    WRITE,CI  ERRC1            WR:   '--CN:OVERFLOW'
         LI,R8    0                 CLEAR BR7  CNT
         XW,R8    BLANKCNT          SET R8=(# OF NON-BR7S  TO DESTROY)
         SW,R8    P3
         PULL     (S1,S2)           START ON LAST FIELD
*
*  PULL FIELD DATA BLOCKS FROM STACK AND DESTROY NON-BLANKS UNTIL
*  ENOUGH ROOM FOUND, WHEN FOUND BUILD APPROPRIATE DATA BLOCK
*
SHR52    AH,R8    S2                IS CURRENT FIELD (+OTHERS ALREADY
         BLEZ     SHR55              WIPED OUT) LONG ENOUGH FOR OVERFLOW
SHR52A   SH,S1    S2                YES -BUILD S1 & S2 AS BEFORE:
         AW,S1    R8                  S1=COLUMN AT END OF NON-BR7S
         AH,S2    S2                      NOT DESTROYED
         AND,S2   XFFFF               S2=(# OF NON-BR7S  NOT DESTROYED,
         SW,S2    R8                      ,# TO SHIFT)
         AW,S2    BLANKCNT
         STH,R8   S2
         B        SHR8A             GO SHIFT
*
*  NOT ENOUGH ROOM FOUND YET, GET NEXT FIELD DOWN AND DESTROY PART OF IT
*
SHR55    LH,R9    S2                KEEP CUMULATIVE CNT OF CHARS
         AW,R9    S2                 DESTROYED
         AND,R9   XFFFF
         AWM,R9   BLANKCNT
         MTW,-1   FIELDCNT          DECR FIELD CNT
         BEZ      SHR58             =0 - AT 1ST FIELD
         PULL     (S1,S2)           >0 - GET NEXT FIELD DATA BLOCK
         AI,S1    1                 INC. FOLLOWING BLANK IN FIELD
         AI,S2    X'10000'
         B        SHR52
*
*  AT 1ST FIELD AND STILL NOT ENOUGH ROOM
*
SHR58    AW,R8    R6                ADD IN ORIG FIELD AT R5 AND CHK ROOM
         BLEZ     SHR60
         SH,S1    S2                ENOUGH FOUND - FIX S1 & S2 TO
         LI,S2    0                  DESTROY PART OF ORIG FIELD AT R5
         STH,R6   S2
         B        SHR52A
*
*  SHIFT PUSHS ALL FIELDS OFF CARD, SO BLANK OUT AND EXIT
*
SHR60    AWM,R6   BLANKCNT          SET UP TO BLANK FROM ORIG R5
         LW,R4    R5
         AI,R4    -2
         B        SS20              GO BLANK OUT
*
*  FIELD TO SHIFT ABUTTS END OF CARD: SET UP TO PERFORM THIS SHIFT
*
SHR70    WRITE,CI  ERRC1            WR:   '--CN:OVERFLOW'
         SW,R6    P3                DOES SHIFT PUSH ORIG FIELD OFF CARD
         BLEZ     SHR72
         STW,P3   BLANKCNT          NO - SET BLANKCNT=# OF CHARS TO
         LI,R3    MAXCLMN-1          BLANK OUT
         SW,R3    P3                SET R3=END OF 'FROM' FIELD
         LI,R4    MAXCLMN-1             R4=LAST COLUMN ON CARD
         LW,R8    R6                    R8=# OF CHARS TO SHIFT
         B        SS15              GO SHIFT THIS FIELD
*
*  ABUTTING FIELD IS SHIFTED OFF CARD, SO SET UP TO BLANK OUT
*
SHR72    AW,R6    P3                SET R8=# OF CHARS TO BLANK OUT
         LW,R8    R6                        (=ORIG FIELD WIDTH)
         LI,R4    MAXCLMN-1             R4=LAST COLUMN ON CARD
         B        SS20A             GO BLANK OUT
*
************************************************************
*  CLOSE UPDATE FILE
************************************************************
*
*
CLOSE    EQU      %
         M:CLOSE  M:EI,(SAVE)
         B        0,R7
************************************************************
*  CLOSE COPY FILE
************************************************************
*
*
CLOSE2   EQU      %
         M:CLOSE  M:EO,(SAVE)
         B        0,R7
*
*
CLOSE3   M:CLOSE  M:EO,(REL)
         B        0,R7
*
************************************************************
*  DELETE SPECIFIED RECORDS
*    R5 = FIRST SEQ. NUMBER TO DELETE
*    R6 = LAST SEQ. NUMBER TO DELETE
*    S1 = SEQ. NUMBER OF LAST RECORD READ
*    S2 = NUMBER OF RECORDS DELETED
************************************************************
*
*
DELETE   EQU      %
         PUSH     (R5,R8)           SAVE REGS
         LI,R8    0                 USE R8 TO COUNT # OF RECS DELETED
         MTW,1    DEL:FL            SET DELETE FLAG
*
DL05     BAL,R7   RD:NXTRANDOM      READ 1ST SEQ # OR NEXT HIGHEST #
*
         CW,S1    L(EOF)
         BE       DL30
         CW,S1    R6                SEQUENCE# > LAST TO DELETE
         BG       DL20              FINISH
         BAL,R7   DEL:REC           DELETE RECORD
         STW,S1   INTFLAG1          SAVE FOR BREAK INT.
         AI,R5    1                 INCR. SEQUENCE #
         AI,R8    1                 INCR. DELETED REC. COUNT
         B        DL05              LOOP
*
*
DL20    LW,R5    R8
         CI,R5     1                DON'T SAY ANYTHING IF ITS ONLY 1
         BLE       DL25
        LI,R6    BA(MSG6)+1
        BAL,R7   DEC#
        WRITE,M    MSG6
DL25     EQU       %
         LW,S2    R8
         LI,R8    0                 CLEAR DELETE FLAG
         STW,R8   DEL:FL
         PULL     (R5,R8)           RESTORE REGS
         B        0,R7              EXIT
*
*  ERROR: EOF HIT
*
DL30     EQU      %
         CI,R8    0                 CHECK IF RECORDS DELETED
         BE       DL25
         LW,R5    INTFLAG1          GET SAVED LAST RECORD #
         LI,R6    BA(ERRM1)+17
         BAL,R7   MOVESEQ
         GEN4     0,0,0,0
         AI,R0    16                CALCULATE TOTAL BYTE COUNT
         STB,R0   ERRM1               AND STORE AS TEXTC COUNT
         WRITE,M  ERRM1             WR:   '--EOF HIT'
         B        DL20              GO EXIT
*
************************************************************
*  DELETE FILE
*    R5 = ADDR OF FILE ID IN CDT
*    CC1=1 IF FILE DOES NOT EXIST; CC1=0 OTHERWISE
************************************************************
*
*
DEL:FILE EQU          %
         PUSH     (R3,P3)
         LI,R6    DF%ABN
         STW,R6   FPT:EO+2
         LI,R6    4                 INOUT
         STW,R6   FPT:EO+5
         LI,R8    EO:NAME
         LI,R9    EO:ACCT
         LI,P3    EO:PASS
         BAL,R7   OPENINIT
         CAL1,1   FPT:EO
         M:CLOSE  M:EO,(REL)        FILE EXISTS, SO CLOSE AND RELEASE
         PULL     (R3,P3)
         LCI      0
         B        0,R7
*
*
*
DF%ABN   EQU      %
         LB,R3    P3
         CI,R3    3
         BNE      BADIO1
         PULL     (R3,P3)
         LCI      8
         B        0,R7
*
*  ERROR: BAD I/O
*
BADIO    EQU      %
         LW,R3    D4                MOVE CODE TO R3.
BADIO1   EQU      %                 ENTER HERE IF CODE IN R3.
         SCS,R3   -4                BUILD ERROR CODE
         LB,R4    HEXCHAR,R3
         STB,R4   IOERRCOD
         SLS,R3   -28
         LB,R4    HEXCHAR,R3
         LI,R1    1
         STB,R4   IOERRCOD,R1
         WRITE,M  IOERRMSG
         M:ERR                      ERROR TO UTS.
*
************************************************************
*  DELETE LAST RECORD READ
************************************************************
*
*
DEL:REC  EQU          %
         M:DELREC M:EI,(KEY,LASTKEY)
         B        0,R7
*
************************************************************
*  MOVE SEQUENCE NUMBER
*    R5 = SEQ. NUMBER TO CONVERT
*    R6 = BYTE ADDR AT WHICH TO PUT STRING
*    WORD AFTER BAL = 4 CHARS TO APPEND TO STRING
*    R0 = NUMBER OF CHARS IN RESULTANT STRING
************************************************************
*
*
MOVESEQ  EQU      %
         PUSH     (R2,R7)           SAVE REGS
         LW,R2    R7                SAVE REG. VALUE
         BAL,R7   SEQ#B             GET SEQUENCE NUMBER
         LW,R6    R0                GET ADDRESS POINTER
*
*  APPEND 4 SPECIFIED CHARS
*
         LI,R3    0
         LI,R4    4
MQ30A    LB,D3    *R2,R3            MOVE 4 CHARS SPECIFIED TO END OF
         BEZ      %+3                THIS STRING, SKIPPING 0 CHARS
         STB,D3   0,R6
         AI,R6    1
         AI,R3    1
         BDR,R4   MQ30A
         LW,R0    R6
         PULL     (R2,R7)           RESTORE REGS
         SW,R0    R6                CALC S1=NUMBER OF CHARS IN STRING
         B        1,R7              EXIT
*
************************************************************
*  OPEN UPDATE FILE
*  OPEN UPDATE FILE (OPEN1 OPENS COPY INPUT FILE)
*    R5 = ADDR OF FILE ID IN CDT
*    CC1=1 IF FILE DOES NOT EXIST; CC1=0 OTHERWISE
*    CC2=1 IF FILE IS NOT KEYED; CC2=0 OTHERWISE
************************************************************
*
*
         LOCAL    %20,%90
OPEN     EQU      %
         PUSH     (R3,P3)
         LI,R6    4                 INOUT
         B        %20
*
*
OPEN1    EQU      %
         PUSH     (R3,P3)
         LI,R6    1                 INPUT
*
*
%20      EQU      %
         STW,R6   FPT:EI+5
         LI,R6    EI:ABN
         STW,R6   FPT:EI+2
         LI,R8    EI:NAME           SET ADDRESS REGISTERS FOR
         LI,R9    EI:ACCT               STORING PARAMETERS INTO
         LI,P3    EI:PASS               FPT.
         BAL,R7   OPENINIT
         CAL1,1   FPT:EI            OPEN FILE
         LW,R3    M:EI+5            FILE EXISTS.
         SLS,R3   -4                ORGANIZATION SHOULD BE KEYED.
         AND,R3   XF
         CI,R3    2
         BNE      %90
         PULL     (R3,P3)           IT IS.
         LCI      0
         B        0,R7
*
*
%90      EQU      %
         PULL     (R3,P3)
         LCI      4
         B        0,R7
*
*
*
EI:ABN   EQU      %
         LB,R3    P3
         CI,R3    3
         BNE      BADIO1
         PULL     (R3,P3)           NO FILE.
         LCI      8
         B        0,R7
*
************************************************************
*  OPEN (OUTPUT) FILE FOR COPYING
*    R5 = ADDR OF FILE ID IN CDT
*    CC1=1 IF FILE DOES NOT EXIST; CC1=0 OTHERWISE
************************************************************
*
*
         LOCAL    %20
OPEN3    PUSH     (R3,P3)
         LI,R6    2                 OUTPUT
         B        %20
*
*
OPEN2    EQU      %
         PUSH     (R3,P3)
         LI,R6    4                 INOUT
%20      STW,R6   FPT:EO+5
         LI,R6    EO:ABN
         STW,R6   FPT:EO+2
*
         LI,R8    EO:NAME           SAME.
         LI,R9    EO:ACCT
         LI,P3    EO:PASS
         BAL,R7   OPENINIT
         CAL1,1   FPT:EO
         PULL     (R3,P3)
         LCI      0
         B        0,R7
*
*
*
EO:ABN   EQU      %
         LB,R3    P3
         CI,R3    3
         BNE      BADIO1
         LI,R3    2                 NO PREVIOUS FILE, OPEN FOR OUTPUT.
         STW,R3   FPT:EO+5
         CAL1,1   FPT:EO
         PULL     (R3,P3)
         LCI      8
         B        0,R7
*
************************************************************
*  INITIALIZE OPEN FPT
*    R5 = ADDR OF FILE ID IN CDT
*    R8 = FPT ENTRY TO PUT FILE NAME IN
*    R9 = FPT ENTRY TO PUT ACCOUNT NUMBER IN
*    P3 = FPT ENTRY TO PUT PASSWORD IN
************************************************************
*
*
         LOCAL    %50,%60,%65,%70,%80
OPENINIT EQU      %
         LW,R3    4BLANK
         STW,R3   *R9
         STW,R3   *P3
         LI,R4    1
         STW,R3   *R9,R4
         STW,R3   *P3,R4
         LI,R4    -1
         LW,R3    L(X'02000202')    INITIALIZE ACCOUNT AND PASS CONTROLS
         STW,R3   *R9,R4
         LW,R3    L(X'03010202')
         STW,R3   *P3,R4
         LB,R4    *R5               MOVE FILE NAME TO BUFFER.
         STB,R4   *R8                   R5 POINTS TO IT.
         LB,R3    *R5,R4
         STB,R3   *R8,R4
         BDR,R4   %-2
         LB,R4    *R8               SKIP TO ACCOUNT. BYTE COUNT FROM FPT
         AI,R4    4
         SLS,R4   -2
         AW,R5    R4                R5 NOW AT ACCOUNT
         LB,R4    *R5
         BEZ      %50               NO ACCOUNT
         LB,R3    *R5,R4            MOVE ACCOUNT TO BUFFER
         AI,R4    -1                THIS LOOP PUTS NO BYTE COUNT INTO
         STB,R3   *R9,R4            FPT.
         AI,R4    0
         BGZ      %-4
         LB,R4    *R5               SKIP TO PASS               &
         AI,R4    4
         SLS,R4   -2
         AW,R5    R4                R5 NOW POINTS TO PASS
         B        %60
*
*
%50      EQU      %
         AI,R5    1                 STEP TO PASS
         LI,R3    -2                SET FPT FOR NO ACCOUNT, BY SAYING
         STB,R4   *R9,R3                NO USABLE WORDS.
*
*
%60      EQU      %
         LB,R4    *R5
         BEZ      %70               NO PASS
*
*
%65      EQU      %
         LB,R3    *R5,R4            MOVE PASSWORD WITH BYTE COUNT
         AI,R4    -1
         STB,R3   *P3,R4
         AI,R4    0
         BGZ      %65
         B        %80
*                                            &
*
%70      EQU      %
         LI,R3    -2                SET FPT FOR NO PASS, BY SAYING
         STB,R4   *P3,R3                NO USABLE WORDS.
*
*
%80      EQU      %
         B        0,R7
*
************************************************************
*  OPEN NEW (OUTPUT ONLY) FILE
*    R5 = ADDR OF FILE ID IN CDT
*    CC1=1 IF FILE DOES NOT EXIST; CC1=0 OTHERWISE
************************************************************
*
*
OPENNEW  EQU      %
         PUSH     (R3,P3)
         LI,R6    ON%ABN
         STW,R6   FPT:EI+2
         LI,R6    4                 INOUT
         STW,R6   FPT:EI+5
         LI,R8    EI:NAME
         LI,R9    EI:ACCT
         LI,P3    EI:PASS
         BAL,R7   OPENINIT
         CAL1,1   FPT:EI
         PULL     (R3,P3)           FILE EXISTS.
         LCI      0                 NOTE.
         B        0,R7
*
*
*
ON%ABN   EQU      %
         LB,R3    P3
         CI,R3    3
         BNE      BADIO1
         LI,R3    2                 OPEN FOR OUTPUT.
         STW,R3   FPT:EI+5
         CAL1,1   FPT:EI
         PULL     (R3,P3)
         LCI      8
         B        0,R7
*
*
************************************************************
*        VERIFY CARRIAGE RETURN EXISTS ON OUTPUT RECORD.
************************************************************
*
PUTCR    PUSH     R7
         BAL,R7   TABCOMPRESS
         LW,R7    CRFLAG            DO NOT INSERT CR WHEN FLAG IS
         BEZ      PUTCS2            ZERO
         LW,R7    RSIZ
         AI,R7    -1
         LI,D4    X'0D'
         CB,D4    RBUF,R7
         BE       PUTCS2
*
         AI,R7    1                 IF NO CR
         CI,R7    MAXCLMN
         BL       %+3
         LI,R7    MAXCLMN-1         (DO NOT GO BEYOND COL. 140)
         STW,R7   RSIZ
         STB,D4   RBUF,R7           INSERT ONE
         MTW,1    RSIZ
*
PUTCS2   PULL     R7
         B        0,R7
*
************************************************************
*  READ RANDOM RECORD OR NEXT HIGHEST ONE
*    R5 = SEQ. NUMBER TO READ
*    S1 = SEQ. NUMBER ACTUALLY READ
*    CC1=0 IF RECORD EXISTS; CC1=1 OTHERWISE
************************************************************
*
*
         LOCAL    %20
RD:NXTRANDOM      EQU %
         PUSH     R7
         BAL,R7   RD:RANDOM
         BCS,8    %20
         LW,S1    LASTKEY           GOT IT, RETURN KEY.
         AND,S1   XFFFFFF
         PULL     R7
         LCI      0
         B        0,R7
*
*
%20      EQU      %
         BAL,R7   RD:SEQUEN         NOW GET NEXT KEY, IN S1.
         PULL     R7
         LCI      8
         B        0,R7
*
************************************************************
*  READ RANDOM RECORD
*    R5 = SEQ. NUMBER TO READ
*    CC1=0 IF RECORD EXISTS; CC1=1 OTHERWISE
************************************************************
*
*
RD:RANDOM EQU         %
         PUSH     (R7,P3)
         BAL,R7   SETKEY            (R5) ARE KEY,I.E. SEQUENCE
         M:SETDCB M:EI,(ERR,RD:ERR)
         M:READ   M:EI,;
                  (ERR,RD:ERR),;
                  (WAIT),;
                  (SIZE,MAXCLMN),;
                  (KEY,KBUF)
         BAL,R7   SETLASTKEY
         PULL     (R7,P3)
         LCI      0
         B        0,R7
*
*
*
RD:ERR   EQU      %
         LB,D4    P3
         CI,D4    X'43'
         BNE      BADIO
         PULL     (R7,P3)
         LCI      8
         B        0,R7
*
************************************************************
*  READ SEQUENTIAL RECORD
*    S1 = SEQ. NUMBER READ IN
************************************************************
*
         LOCAL    %10,%20
*
RD:SEQUEN EQU         %
         PUSH     (R7,P3)
         M:SETDCB M:EI,(ABN,RS%ABN)
         M:READ   M:EI,;
                  (WAIT),;
                  (SIZE,MAXCLMN),;
                  (ABN,RS%ABN)
         BAL,R7   SETLASTKEY
         LW,D4    M:EI+5            CHECK ORGANIZATION
         SLS,D4   -4
         AND,D4   XF
         LW,S1    *M:EI+10          RETURN SEQUENCE
         AND,S1   XFFFFFF
         CI,D4    2
         BE       %+2
         LI,S1    0                 ZERO IF NOT KEYED.
         PULL     (R7,P3)
         B        0,R7
*
*
*
RS%ABN   EQU      %
         LB,D4    P3
         CI,D4    6
         BNE      BADIO
         LW,S1    L(EOF)
*                                   PUT LAST SEQ # IN EOF MESG
         PUSH     (R5,S1)
         LI,R5    0                 INITIALIZE LASTKEY IN CASE SEQ
         STW,R5   LASTKEY           BELOW TAKES ABN EXIT
         M:PRECORD M:EI,(ABN,RS%ABNABN),(REV)  POSN BEFORE LAST REC
         M:READ   M:EI,(ERR,RS%ABNABN),(SIZE,MAXCLMN)  AND GET KEY
         BAL,R7   SETLASTKEY        IN CORE LOC LASTKEY
RS%ABNABN EQU         %               OR BYPASS SETTING IF TROUBLES
         LW,R5    LASTKEY           LAST SEQ # READ
         AND,R5   XFFFFFF           ZAP TEXTC BYTE IN KEY
         LI,R6    BA(ERRM1)+17
         BAL,R7   MOVESEQ
         GEN4     0,0,0,0
         AI,R0    16                CALCULATE TOTAL BYTE COUNT
         STB,R0   ERRM1               AND STORE AS TEXTC COUNT
         PULL     (R5,S1)
         PULL     (R7,P3)
         B        0,R7
*
************************************************************
*  READ CONTROL RECORD
*    S1 = NUMBER OF CHARS READ
************************************************************
*
*
RD:SI    EQU          %
         PUSH     (R2,P3)           SAVE REGS
         CAL1,1   FPT:SI            READ COMMAND
         LW,R2    M:SI+4
         SLS,R2   -17
         AI,R2    -1
         BL       RD:SI2
RD:SI0   EQU      %
         LB,R3    IBUF,R2           GET LAST CHARACTER
         CI,R3    ' '               IS IT A BLANK
         BNE      RD:SI1            NO
         MTW,-1   R2
         BGE      RD:SI0
         B        RD:SI2            BLANK LINE: ADD LF
RD:SI1   EQU      %
         CI,R3    X'15'             TEST IF LAST CHAR IS CR
         BE       RD:SI3            YES
         CI,R3    X'0D'
         BE       RD:SI3            YES
RD:SI2   EQU      %
         AI,R2    1
         LI,R3    X'15'
         STB,R3   IBUF,R2           SET CARRIAGE RETURN IN LINE
RD:SI3   EQU      %
         MTW,0    J:JIT             BATCH MODE
         BLZ      RD:SI5            NO
         CAL1,1   FPT:L1            NO-PRINT COMMAND AGAIN ON M:LO
         B        RD:SI8
*
RD:SI5   EQU      %
         CAL1,1   FPT:C2            COMPARE M:UC AND M:SI
         CI,SR1   1
         BE       RD:SI8            SAME DEVICE
         LW,R4    R2
         AI,R4    1
         CAL1,1   FPT:L3            WRITE PROMPT
         CAL1,1   FPT:L2            PRINT COMMAND TO UC
RD:SI8   EQU      %
         LW,S1    R2                S1 = RECORD SIZE LESS CR/LF CHARACTER
         PULL     (R2,P3)           RESTORE REGS.
         B        0,R7              EXIT
*
*
*
************************************************************
*  SET KEY FOR READ  OR WRITE
*    R5 = SEQ. NUMBER TO PUT IN KEY
************************************************************
*
*
SETKEY   EQU      %
         STW,R5   KBUF
         LI,D4    3
         STB,D4   KBUF
         B        0,R7
*
*  SAVE KEY FROM LAST READ
*
SETLASTKEY        EQU %
         PUSH     R7
         LW,D4    *M:EI+10
         STW,D4   LASTKEY
         MTW,0    DEL:FL            CHECK DELETE FLAG
         BNEZ     SETK9             IF SET BYPASS CLEANUP
         LW,R7    M:EI+4            SET RECORD SIZE RECEIVED
         SLS,R7   -17
         STW,R7   RSIZ
         AI,R7    -1                DELETE CR FROMIMAGE.  CHECKBOTH
         LB,D4    RBUF,R7
         CI,D4    X'15'             IS IT A NEW LINE CHARACTER
         BE       SETK2
         CI,D4    X'0D'               OR A CARRIAGE RETURN CHAR.
         BE       SETK2
         B        %+2               NO
SETK2    MTW,-1   RSIZ              DECREMENT RECORD SIZE
         LW,R7    RSIZ              GET RECORD SIZE
         LI,D4    ' '
         STB,D4   RBUF,R7
         AI,R7    1
         CI,R7    MAXCLMN           CLEAR REST OF BUFFER WITH BLANKS
         BL       %-3
         LW,R7    RSIZ              SET RSIZ TO LAST NON BLANK
         CB,D4    RBUF,R7             WHICH IS IN BUFFER
         BNE      %+2               FOUND
         BDR,R7   %-2
         AI,R7    1
         STW,R7   RSIZ                   AND RECORD SIZE
         BAL,R7   TABEXPAND
SETK9    PULL     R7
*
*
         B        0,R7
*
************************************************************
*                  EACH RECORD SUBJECT TO
*  EDITING WILL HAVE EMBEDDED TAB CHARACTERS
*  EXPANDED ACCORDING TO THE CURRENT TAB
*  STOPS CONTAINED IN THE M:UC DCB.
************************************************************
*
TABEXPAND EQU         %
         MTW,0    TAB:XF
        BEZ      0,R7
         PUSH     (R1,R7)
         LI,R1    0                 START AT FIRST TAB IN DCB.
         LI,R2    0                 RESET R2
TABR2    LI,R5    X'05'
TABX5    CB,R5    RBUF,R2
         BE       TABR30
         AI,R2    1
         CW,R2    RSIZ
         BL       TABX5             WHEN OUT OF CHARACTERS,
*
TABX7    PULL     (R1,R7)           EXIT
         B        0,R7
*
TABR30   LB,R3    M:UC+15,R1
         BEZ      TABX7             EXIT
         AI,R3    -1                ADJUST TO COLUMN #
         CW,R3    R2                POSITION OF TAB CODE.
         BG       TABR37
         AI,R1    1                 IF NOT, TRY NEXT TAB POSITION,
         CI,R1    16                IF NOT AT MAX NBR OF TABS.
         BL       TABR30
         B        TABX7
*
TABR37   LI,R5    ' '               PUT A BLANK OVER ACTUAL TAB CODE.
         STB,R5   RBUF,R2
         AI,R2    1                 INCREMENT TO NEXT BYTE.
         LW,R4    RSIZ
         AI,R4    -1                DETERMINE LAST BYTE POSITION.
         SW,R3    R2                COMPUTE NUMBER OF BLANKS TO INSERT.
         BEZ      TABR2             IF ZERO, ITERATE.
         AW,R3    RSIZ              INCREMENT TO NEW LAST BYTE.
         STW,R3   RSIZ              SET NEW RECORD SIZE.
         AI,R3    -1                NEW LAST COLUMN
TABR39   LB,R6    RBUF,R4           MOVE BYTES UP, STARTING AT TOP,
         STB,R5   RBUF,R4           BLANKING AS WE GO.
         STB,R6   RBUF,R3
         AI,R3    -1
         AI,R4    -1
         CW,R4    R2                GO DOWN ONLY TO BYTE JUST ABOVE
         BGE      TABR39            TAB BLANK.
*
         LW,R2    R3                INCREMENT BYTE POSITION TO LAST
         AI,R1    1
         B        TABR2             MOVED, AND LOOK FOR MORE TAB CODES.
*
*
*
************************************************************
*  ACCORDINGLY, EACH RECORD WRITTEN MUST BE
*  RE-COMPRESSED IN ORDER TO MINIMIZE RAD
*  STORAGE PER RECORD.
************************************************************
*
*
TABCOMPRESS       EQU %
         MTW,0    TAB:CF            IF NO COMPRESSION NEEDED, EXIT.
         BEZ      0,R7
         PUSH     (R1,R6)
         LI,R1    0
         LB,R3    M:UC+15,R1
         BNEZ     TABC13
TABC5    PULL     (R1,R6)           EXIT.
         B        0,R7
TABC10   LB,R3    M:UC+15,R1        SKIP TO LAST TAB POSITION+1
         BEZ      TABC15            IN DCB.
TABC13   AI,R1    1
         CI,R1    16
         BL       TABC10
TABC15   AI,R1    -1                MOVE DOWN TO NEXT LOWER TAB
         BLZ      TABC5             POSITION. IF ALL GONE, EXIT.
         LB,R3    M:UC+15,R1
         CW,R3    RSIZ              DONT PUT ANY TAB CHARACTERS
         BG       TABC15            PAST END OF RECORD
         AI,R3    -2                MAKE INDEX TO NEXT LOWER BYTE.
         LI,R5    ' '               IS NEXT LOWER BYTE A BLANK.
         CB,R5    RBUF,R3
         BNE      TABC15            IF NOT, WE CAN'T COMPRESS IMAGE.
         LW,R2    R1                IF BLANK, WE CAN COMPRESS DOWN
         AI,R2    -1
         BLZ      TABC17            TO NEXT LOWER TAB POSITION.
         LB,R2    M:UC+15,R2
         AI,R2    -2                TAB POSITION,
TABC17   LW,R4    R3                CREATE NEW INDEX,
TABC18   CB,R5    RBUF,R4           MOVE IT DOWN TO
         BNE      TABC20            A NON-BLANK,
         AI,R4    -1
         CW,R4    R2                OR TAB BOUNDARY.
         BG       TABC18
*
TABC20   AI,R4    1                 MOVE BACK UP TO BLANK.
         AI,R3    1                 MOVE BACK UP TO TAB COLUMN.
         LI,R6    X'05'             PUT TAB CHARACTER OVER BLANK,
         STB,R6   RBUF,R4
         AI,R4    1                 INCREMENT, AND CHECK IF MORE SPACE
         CW,R4    R3                EXISTS BETWEEN INDICES.
         BE       TABC15            IF NOT, TRY NEXT LOWER TAB.
*
TABC25   LB,R6    RBUF,R3           MOVE BYTES DOWN, STARTING AT TAB
         STB,R6   RBUF,R4           COLUMN, AND CONTINUING UP TO END
         AI,R4    1                 OF RECORD.
         AI,R3    1
         CW,R3    RSIZ
         BL       TABC25
*
         STW,R4   RSIZ              SET NEW, SMALLER RECORD SIZE,
         B        TABC15            AND GET NEXT TAB.
*
************************************************************
*  TEST IF EDIT FILE IS ACTIVE
************************************************************
*
*        FFLAG = -1                 M:EI FILE CLOSED
*        FFLAG = +1                 M:EI FILE OPEN
*
TEST     EQU      %
         MTW,0    FFLAG             TEST IF EDIT FILE ACTIVE
         BLZ      0,R7              NO - EXIT
         PUSH     R7                SAVE REG
         BAL,R7   CLOSE             CLOSE IT
         WRITE,M MSG4               WR:   '..EDIT STOPPED'
         LI,D4    -1                SET FFLAG=-1    (NOT OPEN)
         STW,D4   FFLAG
         PULL     R7                RESTORE REG
         B        0,R7              EXIT
*
************************************************************
*  TYPE CARD IMAGE
*    R5 = SEQ. NUMBER TO TYPE
************************************************************
*
*
*
*
WR:R     EQU      %                 WRITE RECORD
         PUSH     (R4,R7),SR1
         LI,R6    0
         LI,R4    0
         B        WR:SR2
*
*
WR:SRN   EQU      %
         PUSH     (R4,R7),SR1
         LI,R6    1
         B        WR:SR1
*
WR:SR    EQU      %                 WRITE SEQUENCE # AND RECORD
         PUSH     (R4,R7),SR1
         LI,R6    0
WR:SR1   BAL,R7   FSEQ#             GET SEQUENCE#
         LB,R4    OBUF              GET BYTE COUNT
         MTW,0    J:JIT             CHECK FOR BATCH
         BGE      WR:SR2            YES: PRINT SEQ# + RECORD
         LI,R0    OBUF              ELSE PRINT SEPARATE
         CAL1,1   FPT:TY
         LI,R4    0                 RESET INDEX
WR:SR2   EQU      %
         LI,R5    0
         AI,R4    1
         LB,D4    RBUF,R5           GET BYTE FROM RECORD BUFFER
         STB,D4   OBUF,R4             AND STORE IT IN OUTPUT BUFFER
         AI,R5    1                 INCR. INDEX
         CW,R5    RSIZ
         BL       %-5
         MTW,0    R6
         BEZ      WR:SR4
         AI,R4    1                 INCR. BYTE COUNT
         LI,D4    X'16'             GET SYN CHARACTER
         STB,D4   OBUF,R4           STORE IN OUTPUT BUFFER
WR:SR4   CAL1,1   FPT:WR            WRITE OUTPUT
         PULL     (R4,R7),SR1
         B        *R7
*
WR:S     EQU      %                 WRITE SEQUENCE #
         PUSH     (R4,R7),SR1
         BAL,R7   FSEQ#             GET SEQUENCE NUMBER
         MTW,0    J:JIT             CHECK FOR ON LINE
         BGE      WR:S2             NO: SKIP MESSAGE
         CAL1,1   FPT:C2            COMPARE M:UC = M:SI
         CI,SR1   1
         BNE      WR:S2             NOT EQUAL: SKIP
         LI,R0    OBUF              LOAD REG.0 WITH ADDRESS
         LB,R4    OBUF                AND REG. 4 WITH COUNT
         CAL1,1   FPT:TY            WRITE MESSAGE
WR:S2    EQU      %
         PULL     (R4,R7),SR1
         B        *R7
*
*
************************************************************
*  WRITE COMMAND OR PARAMETER ERROR
************************************************************
*
         BOUND    8
CITX     TEXTC    '--CX:'
CETX     TEXTC    '-CX:'
PETX1    TEXTC    '-PY:'
PETX2    TEXTC    '-CXPY:'
EMTX     TEXTC    '-'
IMTX     TEXTC    '--'
*
*
*        WRITE ROUTINES
*        **************
*
*        R0 = TEXTC STRING ADDRESS
*
WR:CI    LD,D3    CITX
         B        WR:CF1
*
WR:CE    LD,D3    CETX
WR:CF1   MTW,0    CERI:FL           CHECK COMMAND ERROR PRINT INHIBIT
         BNEZ     *R7                 FLAG, AND RETURN IF SET
         B        WR:ALL
*
WR:PE    MTW,-1   CDT
         BLEZ     %+3
         LD,D3    PETX2
         B        WR:ALL
*
         LD,D3    PETX1
         B        WR:ALL
*
WR:EM    LW,D3    EMTX
         B        WR:ALL
*
WR:IM    LW,D3    IMTX
*
WR:ALL   STW,D3   OBUF
         STW,D4   OBUF+1
         PUSH     (R3,R4),R7
         LI,R3    2
         LB,D3    *@CDT,R3          GET COMMAND NUMBER
         AI,D3    '0'               FORM EBCDIC BYTE
         LI,D4    'X'               ID CHARACTER
         BAL,R7   REP:B             REPLACE X BY CD.# IN OBUF
         LW,D3    PCNT              GET PARAMETER COUNT
         AI,D3    '0'
         LI,D4    'Y'               REPLACE Y BY PA. # IN OBUF
         BAL,R7   REP:B
         LB,R4    OBUF              GET BYTE COUNT
         LI,R3    0
         AI,R3    1
         AI,R4    1
         LB,D3    *R0,R3            GET BYTES FROM TEXTC STRING
         STB,D3   OBUF,R4             IN OUTPUT BUFFER
         CB,R3    *R0               CHECK
         BL       %-5
         CAL1,1   FPT:WR            WRITE OBUF
         PULL     (R3,R4),R7
         B        *R7
*
************************************************************
*        REPLACE BYTE IN OBUF
************************************************************
*
*        D3 = VALUE TO STORE IN OBUF
*        D4 = ID BYTE IN OBUF
*        OBUF = TEXTC STRING
*
REP:B    EQU      %
         PUSH     (R3,R4)
         LB,R3    OBUF
         LB,R4    OBUF,R3
         CW,R4    D4
         BE       %+3
         BDR,R3   %-3
         B        %+2
         STB,D3   OBUF,R3
         PULL     (R3,R4)
         B        *R7
*
*
*
************************************************************
* WRITE ERROR MESSAGE AND RETURN
************************************************************
*
*
WR:CE:P   EQU     %
         BAL,R7   WR:CE
         B        MPARS
*
WR:M:D   EQU      %
         BAL,R7   WR:M
         B        *D2
*
WR:M:P   EQU      %
         BAL,R7   WR:M
         B        MPARS
*
WR:PE:P   EQU     %
         BAL,R7   WR:PE
         B        MPARS
*
*
************************************************************
*  WRITE MESSAGE
*    (D4)           = WORD ADDR OF TEXTC-STRING
************************************************************
*
*
WR:M     EQU      %
         PUSH     (R4,R7)
         LI,R4    0
WR:M2    EQU      %
         AI,R4    1
         LB,D3    *R0,R4
         STB,D3   OBUF,R4
         CB,R4    *R0
         BL       WR:M2
         CAL1,1    FPT:WR
         PULL     (R4,R7)
         B        *R7               EXIT
*
*
TY:M     EQU      %
         MTW,0    J:JIT             ON LINE
         BGE      *R7               NO: SKIP MESSAGE
         PUSH     (R4,R7)
         LB,R4    *R0               GET BYTE COUNT
         CAL1,1    FPT:TY
         PULL     (R4,R7)
         B        *R7               EXIT
*
************************************************************
*  WRITE RECORD IN COPY FILE
*    R5 = SEQ. NUMBER TO WRITE
*    CC1=1 IF RECORD EXISTS; CC1=0 OTHERWISE
************************************************************
*
*
WRITE2   EQU      %
         PUSH     (R7,P3)
         BAL,R7   SETKEY
         BAL,R7   PUTCR
         M:SETDCB M:EO,(ABN,W2%ABN)
         M:WRITE  M:EO,;
                  (WAIT),;
                  (KEY,KBUF),;
                  (NEWKEY),;
                  (ABN,W2%ABN),;
                  (SIZE,*RSIZ)
         PULL     (R7,P3)
         LCI      0                 NON-EXISTENT
         B        0,R7
*
*
W2%ABN   EQU      %
         LB,D4    P3
         CI,D4    X'16'
         BNE      BADIO
*
         PULL     (R7,P3)
         LCI      8                 RECORD EXISTED
         B        0,R7
*
************************************************************
*  WRITE NEW RANDOM RECORD
*    R5 = SEQ. NUMBER TO WRITE
*    CC1=0 IF RECORD EXISTS; CC1=1 OTHERWISE
************************************************************
*
*
WRITENEWRANDOM    EQU %
         PUSH     (R7,P3)
         BAL,R7   SETKEY
         BAL,R7   PUTCR
         M:SETDCB M:EI,(ABN,WNR%ABN)
         M:WRITE  M:EI,;
                  (WAIT),;
                  (KEY,KBUF),;
                  (NEWKEY),;
                  (SIZE,*RSIZ),;
                  (ABN,WNR%ABN)
         PULL     (R7,P3)
         LCI      0
         B        0,R7
*
*
*
WNR%ABN  EQU      %
         LB,D4    P3
         CI,D4    X'16'
         BNE      BADIO
         PULL     (R7,P3)
         LCI      8
         B        0,R7
*
************************************************************
*  WRITE RANDOM RECORD
*    R5 = SEQ. NUMBER TO WRITE
************************************************************
*
*
WRITERANDOM       EQU %
         PUSH     R7
         BAL,R7   SETKEY
         BAL,R7   PUTCR
         M:WRITE  M:EI,;
                  (WAIT),;
                  (KEY,KBUF),;
                  (ONEWKEY),;
                  (SIZE,*RSIZ)
         PULL     R7
         B        0,R7
*
*
************************************************************
*        *** CONVERSION TO EBCDIC DECIMAL ***
************************************************************
*
*        REGISTER INPUT:
*
*        R5 = BINARY NUMBER
*
*        REGISTERS USAGE:
*
*        R5 = INDEX REG.
*        R6 = POINTER TO RESULT BUFFER
*        R7 = RETURN ADDRESS
*        D1,D2 = RESULT BUFFER
*        D3,D4 = CALCULATION BUFFER
*
*        REGISTER OUTPUT:
*
*        D1,D2 = EBCDIC NUMBER LEFT ALIGNED
*
*
DEC      EQU      %
         PUSH     (R5,R6)
         LW,D2    4BLANK            CLEAR REG. D2
         LI,R6    54
         LW,D4    R5                GET BINARY NUMBER
         LI,R5    7                 SET INDEX FOR LOOPING
DEC2     LI,D3    0                 CLEAR D3
         DW,D3    K10               DIVIDE NUMBER BY 10
         AI,D3    '0'               FORM EBCDIC NUMBER FROM REMAINDER
         STB,D3   0,R6                AND SAVE IN RESULT BUFFER
         AI,R6    -1                DECREMENT POINTER
         BDR,R5   DEC2              LOOP
         PULL     (R5,R6)           RESTORE REGISTERS
         B        *R7
*
*
*
************************************************************
*        *** FORM EBCDIC DECIMAL NUMBER ***
************************************************************
*
*
DEC#     EQU      %
         PUSH     (R3,R7),(D1,D2)
         BAL,R7   DEC               CONVERT BINARY NUMBER
         LI,D4    ' '               SET 1ST BYTE = BLANK
         STB,D4   0,R6
         AI,R6      1                GET PAST THE BLANK
         LI,R3     6                NUMBER OF FIELDS TO CHECK.
         LI,R5    48
DEC#2    EQU       %
         LB,D4    0,R5
         CI,D4    '0'
         BNE      %+2
         LI,D4    ' '
         STB,D4   0,R6
         AI,R6     1                INCREMENT BYTE ADR.
         AI,R5    1
         BDR,R3    DEC#2            GO FIND ANOTHER
         LB,D4    0,R5
         STB,D4   0,R6
         PULL     (R3,R7),(D1,D2)
         B        *R7
*
*
************************************************************
*        *** FORM SEQUENCE NUMBER ***
************************************************************
* THIS SUBROUTINE FORMS A EBCDIC DECIMAL SEQUENCE NUMBER WITH
* LEADING ZEROS AND TRAILING ZEROS REPLACED BY BLANKS.
*
*
*
*
SEQ#B    EQU      %
         PUSH     (R3,R7),(D1,D2)
         BAL,R7   DEC               CONVERT BINARY NUMBER
         SLS,D2   -8
         LI,D3    '.'               ADD COLON
         STB,D3   D2                  INTO SEQUENCE  NUMBER
         LI,R3    -4
         LB,D3    D1+1,R3           REMOVE LEADING
         CI,D3    '0'                 ZEROS
         BNE      %+2
         BIR,R3   %-3
         AI,R3    -4                ADJUST INDEX
         LB,D3    D1+2,R3           GET FOLLOWING NUMBERS
         STB,D3   0,R6              AND STORE THEM IN MESSAGE
         AI,R6    1                 INCR. ADDRESS POINTER
         BIR,R3   %-3               LOOP
         LI,D3    '0'
         LI,D4    ' '               BLANK
         AI,R6    -1                DECR. ADDRESS POINTER
         CB,D3    0,R6              CHECK IF TRAILING ZERO
         BNE      %+3               NO
         STB,D4   0,R6              YES: BLANK OUT
         B        %-4               LOOP
         AI,R6    1                 INCR. POINTER
         STW,R6   R0                SAVE POINTER
         PULL     (R3,R7),(D1,D2)
         B        *R7
*
*
************************************************************
*        *** FORM SEQUENCE NUMBER ***
************************************************************
*
FSEQ#    EQU      %
         PUSH     (R3,R7),(D1,D2)
         BAL,R7   DEC
         SLS,D2   -8
         LI,D3    '.'
         STB,D3   D2
         LI,D4    ' '
         LI,R3    -4
         LI,R6    BA(OBUF)+1
         LB,D3    D1+1,R3
         CI,D3    '0'
         BNE      %+4
         STB,D4   0,R6
         AI,R6    1
         BIR,R3   %-5
         AI,R3    -4
         LB,D3    D1+2,R3
         STB,D3   0,R6
         AI,R6    1
         BIR,R3   %-3
         STB,D4   0,R6              BLANK AFTER NUMBER
         LI,R3    9
         STB,R3   OBUF
         PULL     (R3,R7),(D1,D2)
         B        *R7
*
*
*
*
ENDEDITOR EQU            %+15
         END      START
