*                 MODE = 1 FOR BTM VERSION
*                      = 2 FOR UTS VERSION
*
MODE     EQU      2
*
EDITBASE CSECT    0
         SYSTEM SIG7FD
         SYSTEM   BPM
*
S        FNAME                      THIS FUNCTION SIMPLY SELECTS
         PROC                       THE FIRST OR SECOND PARAMETER
         LOCAL    A                 DEPENDING ON THE ASSEMBLY MODE
A        SET      AF(MODE)
         PEND     A
*
*
         DEF      EDITBASE
         DEF      BEGINEDITOR
         DO       MODE=2
         REF      J:CCBUF,M:UC
         REF      M:EI,M:EO
         ELSE
         DEF      F:EI,F:EO
         FIN
*
         PAGE
*************************
*  REGISTER ALLOCATION  *
*************************
*
*
*  REGISTERS 1-13 MUST BE PRESERVED BY ANY SUBR WHICH USES THEM
*
X3       EQU      1
X4       EQU      2
X1       EQU      3
X2       EQU      4
P1       EQU      5
P2       EQU      6
LNK      EQU      7
T1       EQU      8
T2       EQU      9
P3       EQU      10
R1       EQU      11
R2       EQU      12
F:LNK    EQU      13
R:LNK    EQU      13
I:LNK    EQU      13
*
*  REGISTERS 0,14-15 ARE NEVER SAVED BY SUBRS
*
R0       EQU      0
D0       EQU      14
D1       EQU      15
         PAGE
***********************
*  SYSTEM PROCEDURES  *
***********************
*
*
GEN4     COM,8,8,8,8    AF(1),AF(2),AF(3),AF(4)
*
*
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
         PAGE
***********************
*  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,LNK  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
         PAGE
***************************
*  ADJUSTABLE PARAMETERS  *
***************************
*
*
DFLTSEQ  EQU      1000              DEFAULT STARTING SEQ. #
MAXCLMN  EQU      140
SEQLIM   EQU      9999999           FOR MAX. SEQ. NO.
STACKSZ  EQU      125               SIZE OF TEMP STACK
*
FIRST%F:CMND      EQU 1
FIRST%I:CMND      EQU 30
FIRST%R:CMND      EQU 10
I:TS%CMND%NMR     EQU 42
I:TY%CMND%NMR     EQU 43
R:TS%CMND%NMR     EQU 21
R:TY%CMND%NMR     EQU 22
*
*
BL       EQU      ' '
CM       EQU      ','
CR       EQU      S(X'15',X'0D')
EOF      EQU      10000000
EOM      EQU      X'08'
LF       EQU      S(X'25',X'15')
PR       EQU      '.'
LP       EQU      '('
RP       EQU      ')'
SC       EQU      ';'
         PAGE
**************************************
*  EDIT/BTM INTERFACE CONTROL BLOCK  *
**************************************
*
*
         DO       MODE=1
         ORG      EDITBASE
         DATA     EDIT%TCB
         DATA,16  0,0
         DATA     BEGINEDITOR
         DO1      X'40'-10
         DATA     0
         FIN
         PAGE
*******************
*  CONSTANT DATA  *
*******************
*
*
K1       DATA     1
K10      DATA     10
KPE      DATA     '.'
*
XF       DATA     X'F'
XF0      DATA     X'F0'
XFF00    DATA     X'FF00'
XFFFF    DATA     X'FFFF'
X1FFFF   DATA     X'1FFFF'
XFFFFFF  DATA     X'FFFFFF'
X800000  DATA     X'800000'
*
4BLNKS   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'
         DO       MODE=2
X:F      TEXTC    'F'
X:M      TEXTC    'M'
X:S      TEXTC    'S'
*
         FIN
*
*  SPECIAL LIMITS
*
         BOUND    8
DIGITS   DATA     '0','9'
LETTERS  DATA     'A','Z'
         DO       MODE=2
LCLETTERS DATA    X'81',X'A9'
         FIN
         PAGE
*******************
*  VARIABLE DATA  *
*******************
*
*
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
CARDIMG  RES      MAXCLMN/4+1       GLOBAL: HOLDS ACTIVE CARD IMAGE.
CDT      RES      100               GLOBAL: COMMAND DESCRIPTION TABLE
CDTADR   RES      1                 GLOBAL: ADR OF CURRENT CMND IN CDT
CHARPSN  RES      1                 PARSER: PSN OF NEXT CHAR TO SCAN
COPYFL   DATA     0                 F:COPY-- FID1=FID2 IF 1
CRFLAG   DATA     1                 GLOBAL: 0= INCLUDE TERM. IN OUTPUT
DFLTINCR DATA     1000              GLOBAL: DEFAULT VALUE FOR INCREMENT
EODCLMN  RES      1                 GLOBAL: COL.# OF LAST NON-BLANK
ERRORCNT RES      1                 GLOBAL: # OF ERROR MSGS TO PRINT
FID1ADR           DATA
FID2ADR           DATA
FIELDCNT RES      1                 SHFTRGHT: # OF FIELDS TO COMPRESS
FILETYPE 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
PARAMBUF RES      MAXCLMN/4+1
PARAMPSN RES      1                 ADD&NEWCDT-: PSN OF NXT PARAM IN CDT
PRMBUFSZ RES      1                 PARSER: # OF WORDS IN PARAMBUF
RECSIZE  DATA     140               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
STACK    RES      STACKSZ           GLOBAL: STACK USED FOR PUSH/PULL
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
TEMPBLCK RES      10                GLOBAL: HOLDS EBCDIC TEXT FOR TYPMSG
TEXTCADR RES      1                 FINDMTCH: ADR OF TEXTC-STRG TO MATCH
TTYIMG   RES      MAXCLMN/4+1       GLOBAL: HOLDS TELETYPE INPUT IMAGE.
TTYIMGSZ RES      1                 GLOBAL: HOLDS SIZE OF TELETYPE IMAGE
*
DELNXT   DATA     0                 DELETE TEMP
*
         BOUND    8
STACKDW  DATA     STACK             GLOBAL: DW FOR HARDWARE PSW/PLW
         DATA,2   STACKSZ,0
         PAGE
********************
*  ERROR MESSAGES  *
********************
*
*
ERRC1    TEXTC    '--C1:OVERFLOW'
ERRC2    TEXTC    '--C1:UNDERFLOW'
ERRC3    TEXTC    '-C1:NO SUCH REC'
ERRC4    TEXTC    '-C1:CMND ILGL HERE'
ERRC5    TEXTC    '--C1:NO SUCH STRG'
ERRC6    TEXTC    '--C1:COL>LIMIT'
ERRC7    TEXTC    '--C1:''ALL'' IGNORED'
ERRC8    TEXTC    '-C1:UNKN CMND'
ERRC9    TEXTC    '-C1:ILGL SYNTAX'
ERRC10   TEXTC    '--C1:COL<LIMIT'
ERRC11   TEXTC    '-BAD COL. NO. PAIR'
*
*
ERRM1    TEXTC    '--EOF HIT AFTER YYYY.YYY'
ERRM3    TEXTC    '--OVERFLOW'
ERRM4    TEXTC    '-RNG OVERLAP'
ERRM5    TEXTC    '-NOT ON/OFF'
ERRM6    TEXTC    '--NONE'
ERRM8    TEXTC    '-MISSING SE'
ERRM12   TEXTC    '-FILE NOT KEYED; MUST COPY'
ERRM13   TEXTC    '-NO FILE NAMED'
ERRM14   TEXTC    '-NO SUCH FILE'
ERRM15   TEXTC    '-FILE EXISTS; CAN''T BUILD'
*
ERRM16   TEXTC    '-NOTHING TO MOVE'
ERRM17   TEXTC   '-MERGE SOURCE NOT KEYED'
ERRM18   TEXTC  '-MERGE DESTINATION NOT KEYED'
ERRM19   TEXTC    '-SORRY... NO PASSWORD ALLOWED HERE.'
ERRM20   TEXTC    '-MAX. SEQ. NO. EXCEEDED'
ERRM21   TEXTC     '-CAN NOT DELETE ALL OCCRRENCES OF BLANKS.'
*
ERRP1    TEXTC    '-P1:NO SUCH REC'
ERRP2    TEXTC    '-P2:REC EXISTS'
ERRP3    TEXTC    '-P1:BAD FID'
ERRP4    TEXTC    '-P1:ILGL SYNTAX'
ERRP5    TEXTC    '-P1:NOT SEQ #'
ERRP6    TEXTC    '-P1:NOT INCR'
ERRP7    TEXTC    '-P1:NOT COL #'
ERRP8    TEXTC    '-P1:NOT STRG'
ERRP9    TEXTC    '-P1:NOT CNT'
ERRP10   TEXTC    '-P1:ILGL SEQ #'
ERRP11   TEXTC    '-P1:SEQ2<SEQ1'
ERRP12   TEXTC    '-P1:NO SUCH FILE'
ERRP13   TEXTC    '-P2:FILE EXISTS'
ERRP14   TEXTC    '-P2:COL ERROR'
ERRP14A  EQU      ERRP14
ERRP15   TEXTC    '-P1:ILGL STRG'
ERRP16   TEXTC    '-P1:FILE NOT KEYED & P3 NULL'
ERRP17   TEXTC    '-P1:PARAM MISSING'
ERRP18   TEXTC    '-P1:NULL STRG'
*
*
MSG0     GEN4     3,S(CR,LF),S(LF,EOM),S(EOM,0)
MSG1     TEXTC    '..COPYING'
MSG2     TEXTC    '..COPY DONE'
MSG3     TEXTC    '..DELETED'
MSG4     TEXTC    '..EDIT STOPPED'
MSG5     TEXTC    '..MERGE STARTED'
MSG6     TEXTC   '         RECORDS DELETED'
MSG7     TEXTC     ' 0000000 RECORDS MOVED'
MSG8     TEXTC    '         STRINGS CHANGED'
*
*
IOERRMSG DATA     X'0060C2C1'+((IOERRCOD+1-IOERRMSG)*4-1)**24
         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
*
*  DUMMY CALLS FOR TYPECERR AND TYPEPERR
*
DMY%TYPECERR      EQU %
         BAL,LNK  TYPECERR          TYPE ERRCN
         DATA     0
         B        MASTERPARSER      GO TO PARSER
*
*
DMY%TYPEPERR      EQU %
         BAL,LNK  TYPEPERR          TYPE ERRPN
         DATA     0
         B        MASTERPARSER      GO TO PARSER
*
*
DMY%TPM  BAL,LNK  TYPEMSG           TYPE ERRP(C)N
         DATA     0
         B        0,X1              RETURN
*
         PAGE
***********************************
*  EDIT TASK CONTROL BLOCK, ETC.  *
***********************************
*
*
         DO       MODE=1
         BOUND    8
EDIT%TCB EQU      %
         DATA     EDIT%TSTK
         DATA,2   20,0
         DATA,16  0
         DATA,16  0
         DATA     EDIT%DCBT
         DATA,16  0
         DATA     0
*
*  USER'S TEMPORARY STACK
*
EDIT%TSTK         EQU %
         DO1      5
         DATA,16  0
*
*  DCB NAME TABLE
*
EDIT%DCBT         EQU %
         DATA     LINK1
         TEXTC    'F:EI'
         DATA     F:EI
         TEXTC    'F:EO'
         DATA     F:EO
LINK1    DATA     0
         ELSE
*
**************************************************
*        UTS INTERFACE PARAMETERS AND MESSAGES.  *
**************************************************
*
MVD:REC:CNT DATA   0
CHG:STG:CNT  DATA  0
BUILDFLAG DATA    0                 IF ZERO, ENTERED BY !BUILD
CFLAG    DATA
INTFLAG1 DATA     -1                /INTERRUPT SEQ INDICATORS FOR
INTFLAG2 DATA     -1                /THOSE COMMANDS WHICH DISPLAY.
TABERRFLAG        DATA
TABCFLAG          DATA   1
TABMFLAG DATA     0                 1 INDICATES MUC TABS OFFSET BY EDIT
TABXFLAG         DATA 1
TSADDR   DATA     0                 TEMP STACK ADDRESS
XEQFLAG  DATA     -1                MINUS ONE IF NOT IN EXECUTION.
PROMPT%FPT        EQU %
         GEN,8,24 X'2C','*'
PROMPT2%FPT        EQU   %
         GEN,8,24  X'2C','.'
NOPROMPT%FPT      EQU %
         GEN,8,24 X'2C',0
BR%FPT   GEN,8,24 X'10',M:UC
         DATA     X'34000010',CFLAG,1,0
TPC%FPT  GEN,8,24 X'11',M:UC
         DATA     X'34000010'
         DATA     CARDIMG
         PZE      *RECSIZE
         DATA     0
TYPM%FPT GEN,8,24 X'11',M:UC
         DATA     X'34000010'
         PZE      *LNK
         PZE      *X2
         DATA      1
RT%FPT   GEN,8,24 X'10',M:UC
         DATA     X'34000010'
         PZE      *X1
         DATA     MAXCLMN
         DATA     0
TABSAVEA RES      5
TABM%FPT GEN,8,24 X'28',M:UC
         GEN,4,28 8,0
         RES      5
*
*
*
UTSM1    TEXTC    'EDIT HERE'
UTSM2    TEXTC    '* '              * + EOM
UTSM3    TEXTC    '-NOT F/M/S'
UTSM4    TEXTC    '--INTRA-RECORD COMMAND INTERRUPT AT '
         RES      3
UTSM5    TEXTC    '--COMMAND INTERRUPT AT '
         RES      7
UTSM6   TEXTC    '-- X TO ABORT.'
UTSM7    TEXTC    'WHILE DELETING)'
UTSM8    TEXTC   '--TAB CHAR. FOUND; ''TA'' NEEDED FOR COL. SIMULATION'
*                                            *****
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'                       *****
PATCH    RES      50
*
         FIN
         PAGE
***********************************************
*  OPEN FPT'S (HAND-CODED TO AVOID PROBLEMS)  *
***********************************************
*
*
O%FPT    GEN,8,24 X'14',F:EI
         GEN,32   X'65480001'
         DATA     O%ABN             ABN
         DATA     CARDIMG           BUF
         DATA     2                 KEYED
         DATA     4                 INOUT
         DATA     2                 SAVE
         DATA     3                 MAX KEY LENGTH
         DATA     X'01000808'
O%NAME   RES      8
         DATA     X'02000202'
O%ACCT   RES      2                 ACCOUNT
         DATA     X'03010202'
O%PASS   RES      2
*
*  OPEN FPT FOR COPY FILE
*
O2%FPT   GEN,8,24 X'14',F:EO
         GEN,32   X'65480001'       SAME PARAMETERS AS ABOVE
         DATA     O2%ABN,CARDIMG,2,4,2,3
         DATA     X'01000808'
O2%NAME  RES      8
         DATA     X'02000202'
O2%ACCT  RES      2
         DATA     X'03010202'
O2%PASS  RES      2
RELATIVE DATA,1      6,32,0,0       THIS IS AN FPT FOR
         DATA        1**29          SETTING RELATIVE TABS.
         DATA,2       X'80',X'80'
         PAGE
*************************************
*  DCB'S FOR UPDATE AND COPY FILES  *
*************************************
*
*
         DO       MODE=1
F:EI     CSECT    0
F:EI     M:DCB    (FILE),;
                  (KEYED),;
                  (INOUT),;
                  (PASS,'SECRET'),;
                  (SAVE),;
                  (KEYM,3),;
                  (BUF,CARDIMG)
         ELSE
F:EI     EQU      M:EI
         FIN
*
*  COPY FILE DCB
*
         DO       MODE=1
F:EO     CSECT    0
F:EO     M:DCB    (FILE),;
                  (KEYED),;
                  (OUT),;
                  (SAVE),;
                  (KEYM,3),;
                  (BUF,CARDIMG),;
                  (PASS,'SECRET')
         ELSE
F:EO     EQU      M:EO
         FIN
         PAGE
***********************************
*                                 *
*     B E G I N   E D I T O R     *
*                                 *
***********************************
*
*
*
         CSECT    S(0,1)
BEGINEDITOR       EQU %
         B        BGD10           :::ENTER HERE AT NORMAL START
         DO       MODE=1
         MTW,0    FILETYPE        :::ENTER HERE AT BREAK
         BLZ      %+2               RE-OPEN FILE IF ONE WAS OPEN
         BAL,LNK  REOPEN
         LI,T1    0                 RESET ASSORTED FLAGS, ETC.
         STW,T1   LASTKEY
         STW,T1   NOCHGFLG
         STW,T1   SETFLAG
         STW,T1   STEPFLAG
         LI,T1    -1
         STW,T1   ALLFLAG
*
*  FINISH INITIALIZATION
*
BGD10    LI,R0    4                 SET ACTIVATION TYPE = 4
         CAL3,2   0
         BAL,LNK  TYPEMSG           TYPE: L/F + C/R
         DATA     MSG0
*
         LI,T1    EDITBASE          CONVERT BASE TO
         SLS,T1   -9                PAGES.
*
         LI,LNK   BEGINEDITOR       CONVERT PROGRAM TO NEXT
         AI,LNK   X'1FF'            HIGHER PAGE, PUT
         SLS,LNK  -9
         STW,LNK  R0                IN R0.
*
         SW,R0    T1                CONVERT R0 TO PROGRAM DATA
         STB,LNK  R0                PAGE COUNT.
*
         LI,T1    ENDEDITOR         COMPUTE PURE PROCEDURE PAGE COUNT
         AI,T1    X'1FF'
         SLS,T1   -9
         SW,T1    LNK               END-BEGIN
*
         LI,X3    0                 SET UP REGISTER 1,
         STB,T1   X3
         CAL3,11  0                 SET SWAP SIZE
         ELSE
BGD10    EQU      %
         STW,R0   TSADDR
*
         CAL1,8      RELATIVE       TABING
         M:INT    BRK%KEY
         FIN
         PAGE
*************************************
*                                   *
*     M A S T E R   P A R S E R     *
*                                   *
*************************************
*
*
*
MASTERPARSER      EQU %
         DO       MODE=2
         CAL1,1    PROMPT%FPT
         LI,T1    -1
         STW,T1   INTFLAG1
         STW,T1   INTFLAG2
         STW,T1    ALLFLAG          RESET ALL FLAG
         STW,T1   XEQFLAG
         FIN
         LD,T1    DMYSTKDW          PURGE STACK
         STD,T1   STACKDW
         LI,T1    0
         STW,T1   CDT               SET # OF CMNDS = 0
         STW,T1   CHARPSN           SET NEXT CHAR TO SCAN = 0
         STW,T1    MVD:REC:CNT      SET MVD:REC:CNT = 0
         STW,T1    CHG:STG:CNT      SET CHG:STG:CNT = 0
         LI,T1    X'0100'           PUT 'END OF CDT' MARKER IN CDT
         STW,T1   CDT+1
         LI,T1    CDT+1             INIT CDTADR=1ST CMND ADDR
         STW,T1   CDTADR
         LI,T1    500000            SET TO PRINT ALL ERROR MSGS
         STW,T1   ERRORCNT
         MTW,0    STEPFLAG          IS SYSTEM IN STEP MODE
         BEZ      %+3
         DO       MODE=1
         LI,R0    '*'               YES - TYPE: '*'
         CAL3,1   0
         LI,R0    '*'               TYPE PROMPT: '*'
         CAL3,1   0
         ELSE
         BAL,LNK  TYPEMSG           YES - TYPE '*'
         DATA     UTSM2
         FIN
         BAL,LNK  READTELETYPE2     READ IN COMMANDS
         AI,R1    -1                SAVE CNT OF # OF CHARS INPUT,
         STW,R1   TTYIMGSZ           LESS C/R
*
*
*
RESUME%PARSING    EQU %             (ENTER HERE AFTER SEMI-COLON FOUND)
         LB,T1    *CDTADR           INCR CDTADR TO NEXT ENTRY
         AWM,T1   CDTADR
         LI,T1    4                 SET PSN OF NEXT PARAM = 1
         STW,T1   PARAMPSN
         MTW,1    CDT               INCR OCUNT OF # OF ENTRIES
         NXTPRM   ERRC9,;
                  (INTG,PARSE:I:CMND%INTG),;
                  (STRG,PARSE:I:CMND%STRG),;
                  (ALPH,*),;
                  (END,MASTEREXECUTIVE)
         LI,X1    CTBLSZ
         LW,T1    PARAMBUF          SEARCH FOR COMMAND NAME IN TABLE
         CW,T1    CNAMETBL,X1
         BE       PRS10             FOUND - GO PROCESS
         BDR,X1   %-2               LOOP
         BAL,LNK  TYPECERR          NOT IN TBL - TYPE: '-CN:UNKN CMND'
         DATA     ERRC8
         B        MASTERPARSER      GO TO PARSER
*
*  COMMAND FOUND: GO PROCESS ITS PARAMETERS
*
PRS10    LB,P1    CNMRTBL,X1        SET P1=CMND NUMBER
         EXU      CBRCHTBL,X1       GO PROCESS CMND PARAMS
*
*
*
ILGL%SEMICOLON    EQU %             (ENTER HERE IF ; AFTER F: OR R:CMND)
         LI,T1    X'0100'           INCR TO TYPE # OF NEXT CMND
         AWM,T1   CDT
         BAL,LNK  TYPECERR          TYPE: '-CN:CMND ILGL HERE'
         DATA     ERRC4
         B        MASTERPARSER
*
*  COMMAND NAME TABLE
*
CNAMETBL EQU      %-1
         TEXTC    'BP'               1: BP
         GEN,8,24 5,'BUI'            2: BUILD
         GEN,8,24 4,'COP'            3: COPY
         GEN,8,24 6,'DEL'            4: DELETE
         GEN,8,24 4,'EDI'            5: EDIT
         TEXTC    'END'              6: END
         TEXTC    'TA'               7: TAB
         TEXTC    'CR'               8: CR
         GEN,8,24 5,'MER'            9: MERGE
         TEXTC    'CM'              10: CM
         TEXTC    'DE'              11: DE
         TEXTC    'FD'              12: FD
         TEXTC    'FT'              13: FT
         TEXTC    'IN'              14: IN
         TEXTC    'IS'              15: IS
         TEXTC    'MD'              16: MD
         TEXTC    'MK'              17: MK
         TEXTC    'RN'              18: RN
         TEXTC    'SS'              19: SS
         TEXTC    'ST'              20: ST
         TEXTC    'TS'              21: TS
         TEXTC    'TY'              22: TY
         TEXTC    'TC'              23: TC
         TEXTC    'FS'              24: FS
         TEXTC    'SE'              30: SE
         TEXTC    'JU'              39: JU
         TEXTC    'NO'              40: NO
         TEXTC    'RF'              41: RF
CTBLSZ   EQU      %-CNAMETBL-1
*
*  COMMAND BRANCH TABLE
*
CBRCHTBL EQU      %-1
         B        PARSE:BP           1: BP
         B        PARSE:BUILD        2: BUILD
         B        PARSE:COPY         3: COPY
         B        PARSE:DELETE       4: DELETE
         B        PARSE:EDIT         5: EDIT
         B        PARSE:END          6: END
         B        PARSE:TA           7: TAB
         B        PARSE:CR           8: CR
         B        PARSE:MERGE        9: MERGE
         B        PARSE:CM          10: CM
         B        PARSE:DE          11: DE
         B        PARSE:FD          12: FD
         B        PARSE:FT          13: FT
         B        PARSE:IN          14: IN
         B        PARSE:IS          15: IS
         B        PARSE:MD          16: MD
         B        PARSE:MK          17: MK
         B        PARSE:RN          18: RN
         B        PARSE:SS          19: SS
         B        PARSE:ST          20: ST
         B        PARSE:TS          21: TS
         B        PARSE:TY          22: TY
         B        PARSE:TC          23: TC
         B        PARSE:FS          24: FS
         B        PARSE:SE          30: SE
         B        PARSE:JU          39: JU
         B        PARSE:NO          40: NO
         B        PARSE:RF          41: RF
*
*  COMMAND NUMBER TABLE
*
CNMRTBL  EQU      %
         DATA,1   0                 (FILLER)
         DATA,1   1                  1: BP
         DATA,1   2                  2: BUILD
         DATA,1   3                  3: COPY
         DATA,1   4                  4: DELETE
         DATA,1   5                  5: EDIT
         DATA,1   6                  6: END
         DATA,1   7                  7: TAB
         DATA,1   8                  8: CR
         DATA,1   9                  9: MERGE
         DATA,1   10                10: CM
         DATA,1   11                11: DE
         DATA,1   12                12: FD
         DATA,1   13                13: FT
         DATA,1   14                14: IN
         DATA,1   15                15: IS
         DATA,1   16                16: MD
         DATA,1   17                17: MK
         DATA,1   18                18: RN
         DATA,1   19                19: SS
         DATA,1   20                20: ST
         DATA,1   21                21: TS
         DATA,1   22                22: TY
         DATA,1   23                23: TC
         DATA,1   24                24: FS
         DATA,1   30                30: SE
         DATA,1   39                39: JU
         DATA,1   40                40: NO
         DATA,1   41                41: RF
         BOUND    4
         PAGE
********************************
*  PROCESS INTRALINE COMMANDS  *
********************************
*
*
PARSE:I:CMND%STRG EQU %
         LI,P1    0
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY WITH CMND=0
         DATA     2
         LI,P1    STRG
         BAL,LNK  ADDCDTPARAM       PUT STRING IN CDT
         NXTPRM   ERRC9,;
                  (ALPH,ICS10)
*
*
PARSE:I:CMND%INTG EQU %
         LI,P1    0
         LW,T1    PARAMBUF          SAVE INTEGER
         NXTPRM   ERRC9,;
                  (ALPH,ICS50),;
                  (STRG,*)
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY WITH CMND=0
         DATA     3
         XW,T1    PARAMBUF          SAVE STRING AND PUT INTG IN PARAMBUF
         LI,T2    1                 SAVE PARAMBUF SIZE FOR STRING AND
         XW,T2    PRMBUFSZ           SET IT = 1
         LI,P1    INTG              PUT INTG IN CDT
         BAL,LNK  ADDCDTPARAM
         STW,T1   PARAMBUF          RESTORE STRING
         STW,T2   PRMBUFSZ          RESTORE PARAMBUF SIZE
         LI,P1    STRG              PUT STRING IN CDT
         BAL,LNK  ADDCDTPARAM
         NXTPRM   ERRC9,;
                  (ALPH,*)
*
*  COMMAND NAME FOUND: IDENTIFY IT
*
ICS10    LI,X1    ICTBLSZ
         LW,T1    PARAMBUF          SEARCH TABLE FOR CMND NAME
         CW,T1    ICNAMETBL,X1
         BE       ICS20             FOUND - GO PROCESS
         BDR,X1   %-2               LOOP
         BAL,LNK  TYPECERR          TYPE: '-CN:UNKN CMND'
         DATA     ERRC8
         B        MASTERPARSER      GO TO PARSER
*
*  COMMAND IDENTIFIED: GO PROCESS LAST PARAMETER
*
ICS20    LI,X2    1                 PUT CMND NUMBER IN CDT
         LB,P1    ICNMRTBL,X1
         STB,P1   *CDTADR,X2
         EXU      ICBRCHTBL,X1      GO PROCESS LAST PARAM
*
*  FORM FOUND IS:  C X -  , PROCESS THIS
*
ICS50    BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY WITH CMND=0
         DATA     2
         XW,T1    PARAMBUF          PUT INTG IN PARAMBUF AND SAVE NAME
         LI,P1    INTG              PUT INTG IN CDT
         BAL,LNK  ADDCDTPARAM
         STW,T1   PARAMBUF          RESTORE CMND NAME
         B        ICS10             GO IDENTIFY CMND
*
*  FINISH TYPE ALPHA:  - X /STR2/
*
TYPE%ALPHA        EQU %
         NXTPRM   ERRP8,;
                  (STRG,*)
         LI,P1    STRG              PUT STRING IN CDT
         BAL,LNK  ADDCDTPARAM
         NXTPRM   *ERRP4,;
                  (SCOL,RESUME%PARSING),;
                  (END,MASTEREXECUTIVE)
*
*  FINISH TYPE BETA:  - X N
*
TYPE%BETA         EQU %
         NXTPRM   ERRP9,;
                  (INTG,*)
         LI,P1    INTG              PUT COUNT IN CDT
         BAL,LNK  ADDCDTPARAM
         NXTPRM   *ERRP4,;
                  (SCOL,RESUME%PARSING),;
                  (END,MASTEREXECUTIVE)
*
*  INTRALINE COMMANDS 'D' OR 'S' FOUND: CHECK THAT FORM IS: /STR1/ D(S)
*
TYPE%I:CMND%D     EQU %
         LI,X4    1                 USE X4=1 FOR 'D'
         B        TYPE%I:CMND%S+1
*
*
TYPE%I:CMND%S     EQU %
         LI,X4    0                 USE X4=0 FOR 'S'
         LI,X1    3
         LB,T1    *CDTADR,X1        GET # OF PARAMS IN CDT
         CI,T1    3                 IS # OF PARAMS = 3
         BE       ICS90             YES - FORM MUST BE: N /ST1/ D(S) -
         LI,X1    4
         LB,T1    *CDTADR,X1        NO - GET TYPE OF PARAM1
         CI,T1    STRG              IS TYPE='STRING'
         BE       ICS90             YES - FORM MUST BE: /ST1/ D(S) -
         MTW,-2   PARAMPSN          NO - ADJ PARAM PSN FOR ERROR MSG
         BAL,LNK  TYPEPERR          TYPE: '-P1:NOT STRNG'
         DATA     ERRP8
         B        MASTERPARSER      GO TO PARSER
*
*  FORM OF 'D' OR 'S' IS OK: GO PARSE FURTHER
*
ICS90    B        %+1,X4
         B        TYPE%ALPHA
         NXTPRM   *ERRP4,;
                  (SCOL,RESUME%PARSING),;
                  (END,MASTEREXECUTIVE)
*
*  INTRALINE COMMAND NAME TABLE
*
ICNAMETBL         EQU %-1
         TEXTC    'D'               31: D
         TEXTC    'E'               32: E
         TEXTC    'F'               33: F
         TEXTC    'L'               34: L
         TEXTC    'O'               35: O
         TEXTC    'P'               36: P
         TEXTC    'R'               37: R
         TEXTC    'S'               38: S
ICTBLSZ  EQU      %-ICNAMETBL-1
*
*  INTRALINE COMMAND NUMBER TABLE
*
ICNMRTBL EQU      %
         DATA,1   0                 (FILLER)
         DATA,1   31                31: D
         DATA,1   32                32: E
         DATA,1   33                33: F
         DATA,1   34                34: L
         DATA,1   35                35: O
         DATA,1   36                36: P
         DATA,1   37                37: R
         DATA,1   38                38: S
         BOUND    4
*
*  INTRALINE COMMAND BRANCH TABLE
*
ICBRCHTBL         EQU %-1
         B        TYPE%I:CMND%D     31: D
         B        TYPE%ALPHA        32: E
         B        TYPE%ALPHA        33: F
         B        TYPE%BETA         34: L
         B        TYPE%ALPHA        35: O
         B        TYPE%ALPHA        36: P
         B        TYPE%BETA         37: R
         B        TYPE%I:CMND%S     38: S
         PAGE
*****************************
*  PARSE FORM:  BP ON(OFF)  *
*  PARSE FORM:  TA F(M,S)   *
*****************************
*
*
PARSE:BP EQU      %
PARSE:CR EQU      %
PARSE:TA EQU      %
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY
         DATA     1
         BAL,LNK  CHECK1CDTENTRY    MAKE SURE 'BP' IS FIRST CMND
         NXTPRM   ERRP4,;
                  (ALPH,*)
         LI,P1    ALPH              PUT ALPHA TEXT IN CDT
         BAL,LNK  ADDCDTPARAM
         NXTPRM   *ERRP4,;
                  (SCOL,ILGL%SEMICOLON),;
                  (END,MASTEREXECUTIVE)
         PAGE
************************************
*  PARSE FORM:  BUILD FID(,N(,I))  *
************************************
*
*
PARSE:BUILD       EQU %
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY
         DATA     3
         BAL,LNK  CHECK1CDTENTRY    MAKE SURE 'BUILD' IS FIRST CMND
         BAL,LNK  GETFILEID         GET FILE ID
         LI,P1    NAME              PUT IT IN CDT
         BAL,LNK  ADDCDTPARAM
         NXTPRM   *ERRP4,;
                  (COM,*),;
                  (SCOL,ILGL%SEMICOLON),;
                  (END,MASTEREXECUTIVE)
*
*
*
GET%SEQ%INCR      EQU %             (ENTER HERE FOR FORM:  N(,I) )
         NXTPRM   ERRP5,;
                  (INTG,*),;
                  (SEQ,PBU10),;
                  (SEQ2,ILGL%SEQ2)
         BAL,LNK  ADJINT
*
*  PUT SEQ # IN CDT
*
PBU10    LI,P1    SEQ               PUT SEQ # IN CDT
         BAL,LNK  ADDCDTPARAM
*
*
*
GET%INCREMENT     EQU %             (ENTER HERE FOR FORM:  (,I) )
         NXTPRM   *ERRP4,;
                  (COM,*),;
                  (SCOL,ILGL%SEMICOLON),;
                  (END,MASTEREXECUTIVE)
         NXTPRM   ERRP6,;
                  (INTG,*),;
                  (SEQ,PBU20)
         BAL,LNK  ADJINT
*
*  PUT INCREMENT IN CDT
*
PBU20    LI,P1    SEQ               PUT INCR IN CDT
         MTW,0    PARAMBUF          MAY NOT BE ZERO.
         BEZ      ILGL%SEQ2
         BAL,LNK  ADDCDTPARAM
         NXTPRM   *ERRP4,;
                  (SCOL,ILGL%SEMICOLON),;
                  (END,MASTEREXECUTIVE)
*
*
*
ILGL%SEQ2         EQU %
         BAL,LNK  TYPEPERR          TYPE: 'PN:ILGL SEQ #'
         DATA     ERRP10
         B        MASTERPARSER      GO TO PARSER
         PAGE
********************************************
*  PARSE FORM:  COPY FID1 TO FID2(,N(,I))  *
********************************************
*
*
PARSE:COPY        EQU %
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY
         DATA     5
         BAL,LNK  CHECK1CDTENTRY    MAKE SURE 'COPY' IS FIRST CMND
         BAL,LNK  GETFILEID         GET FILE ID 1
         LI,P1    NAME              PUT IT IN CDT
         BAL,LNK  ADDCDTPARAM
         NXTPRM   ERRC9,;
                  (ALPH,*)
         LW,T1     PARAMBUF
         CW,T1     X:TO
         BNE       PCO3
         LW,T1     X:ON
         STW,T1    PARAMBUF
PCO3     EQU       %
         LI,P1    ALPH              PUT 'ON(OVER)' IN CDT
         BAL,LNK  ADDCDTPARAM
         LW,T1    PARAMBUF
         CW,T1    X:ON              DOES PARAM2='ON' OR 'OVER'
         BE       PCO10
         CW,T1    X:OVER
         BE       PCO10
PCO5     EQU      %
         BAL,LNK  TYPECERR          NO - TYPE: '-CN:ILGL SYNTAX'
         DATA     ERRC9
         B        MASTERPARSER      EXIT TO PARSER
*
*  GET 2ND FID AND THEN GO PROCESS FORM: (,N(,I))
*
PCO10    BAL,LNK  GETFILEID         GET FILE ID 2
         BAL,LNK  ADDCDTPARAM       PUT IT IN CDT
         NXTPRM   *ERRP4,;
                  (COM,GET%SEQ%INCR),;
                  (SCOL,ILGL%SEMICOLON),;
                  (END,MASTEREXECUTIVE)
*
         PAGE
*****************************************************************
*  PARSE FORM:    MERGE FID1(,N1(-N2)) INTO FID2,N3(-N4)(,I)    *
*****************************************************************
*
*
PARSE:MERGE       EQU %
         BAL,LNK  NEWCDTENTRY       SET UP NEW ENTRY.
         DATA     6
         BAL,LNK  CHECK1CDTENTRY    MUST BE FIRST.
         BAL,LNK  GETFILEID         GET THE FID,
         LI,P1    NAME              AND ADD IT TO THE CDT.
         BAL,LNK  ADDCDTPARAM
*
         NXTPRM   *ERRP4,;          CHECK FOR SPECIFIC RECORD RANGE.
                  (COM,*),;
                  (ALPH,PME20),;
                  (SCOL,ILGL%SEMICOLON)
*
         NXTPRM   ERRP5,;           CONVERT SEQUENCE SPECIFICATION.
                  (INTG,*),;
                  (SEQ,PME5),;
                  (SEQ2,PME15)
*
         BAL,LNK  ADJINT            ADJUST INTEGER,
PME5     BAL,LNK  REPSEQ            DUPLICATE SINGLE VALUE.
PME15    LI,P1    SEQ2
         BAL,LNK  ADDCDTPARAM       PUT SEQ # PAIR IN CDT.
*
         NXTPRM   ERRC9,;           VERIFY 'INTO' NEXT.
                  (ALPH,*)
PME20    LI,P1    ALPH              ADD STRING TO CDT.
         BAL,LNK  ADDCDTPARAM
*
         LW,T1    PARAMBUF          MAKE SURE OF PARAMETER.
         CW,T1    X:INTO
         BNE      PCO5              BRANCH ON ERROR.
*
         BAL,LNK  GETFILEID         COLLECT FID2
         LI,P1    NAME              AND ADD TO CDT.
         BAL,LNK  ADDCDTPARAM
*
         NXTPRM   ERRC9,;           VERIFY PRESENCE OF DESTINATION
                  (COM,*),;         SEQ #.
                  (END,PME40),;
                  (SCOL,ILGL%SEMICOLON)
*
         NXTPRM   ERRP5,;           CONVERT SPECIFICATION.
                  (INTG,*),;
                  (SEQ,PME30),;
                  (SEQ2,PME35)
*
         BAL,LNK  ADJINT
PME30    BAL,LNK  REPSEQ
PME35    LI,P1    SEQ2              ADD TO CDT.
         BAL,LNK  ADDCDTPARAM
*
         B        GET%INCREMENT     GO PROCESS POSSIBLE INCREMENT.
*
PME40    BAL,LNK  TYPEPERR
        DATA     ERRP17
         B        MASTERPARSER
         PAGE
******************************
*  PARSE FORMS:  DELETE FID  *
*                EDIT   FID  *
******************************
*
*
PARSE:DELETE      EQU %
PARSE:EDIT        EQU %
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY
         DATA     1
         BAL,LNK  CHECK1CDTENTRY    MAKE SURE 'DELETE(EDIT)' IS 1ST CMND
         BAL,LNK  GETFILEID         GET FILE ID
         LI,P1    NAME              PUT IT IN CDT
         BAL,LNK  ADDCDTPARAM
         NXTPRM   *ERRP4,;
                  (SCOL,ILGL%SEMICOLON),;
                  (END,MASTEREXECUTIVE)
         PAGE
***********************
*  PARSE FORMS:  END  *
*                NO   *
***********************
*
*
PARSE:END         EQU %
PARSE:NO          EQU %
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY
         DATA     0
         BAL,LNK  CHECK1CDTENTRY    MAKE SURE 'END(NO)' IS FIRST CMND
         NXTPRM   ERRC9,;
                  (SCOL,ILGL%SEMICOLON),;
                  (END,MASTEREXECUTIVE)
*
         PAGE
*************************
*  PARSE FORM:  CM N,C  *
*************************
*
*
PARSE:CM EQU      %
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY
         DATA     2
         BAL,LNK  CHECK1CDTENTRY    MAKE SURE 'CM' IS FIRST CMND
         NXTPRM   ERRP5,;
                  (INTG,*),;
                  (SEQ,PCM10),;
                  (SEQ2,ILGL%SEQ2)
         BAL,LNK  ADJINT
*
*  SEQ # GIVEN: PUT IT IN CDT AND PROCESS COLUMN NUMBER
*
PCM10    LI,P1    SEQ               PUT SEQ # IN CDT
         BAL,LNK  ADDCDTPARAM
         NXTPRM   *ERRP4,;
                  (COM,*),;
                  (SCOL,PCM20),;
                  (END,PCM20)
         NXTPRM   ERRP7,;
                  (INTG,*)
         LI,P1    INTG              PUT COL, # IN CDT
         BAL,LNK  ADDCDTPARAM
         NXTPRM   *ERRP4,;
                  (SCOL,ILGL%SEMICOLON),;
                  (END,MASTEREXECUTIVE)
*
*  ERROR: SECOND PARAMETER MISSING
*
PCM20    BAL,LNK  TYPEPERR          TYPE: '-PN:PARAM MISSING'
         DATA     ERRP17
         B        MASTERPARSER      GO TO PARSER
         PAGE
************************************
*  PARSE FORMS:  DE N(-M)          *
*                SE N(-M)(,C(,D))  *
************************************
*
*
PARSE:DE EQU      %
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY
         DATA     1
         B        PARSE:SE+2
*
*
PARSE:SE EQU      %
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY
         DATA     3
         NXTPRM   ERRP5,;
                  (INTG,PDE5),;
                  (SEQ,PDE10),;
                  (SEQ2,PDE15)
*
*  SEQ. # IS AN INTEGER: ADJUST IT
*
PDE5     BAL,LNK  ADJINT
*
*  ONLY ONE SEQ. # GIVEN: DUPLICATE IT
*
PDE10    BAL,LNK  REPSEQ
*
*  PUT SEQ. # PAIR IN CDT AND CHECK IF COMMAND IS FIRST FOR 'DE'
*
PDE15    BAL,LNK  CHECK1CDTENTRY    MAKE SURE 'DE(SE)' IF FIRST CMND
         LW,T1    P1                SAVE CMND #
         LI,P1    SEQ2              PUT SEQ # PAIR IN CDT
         BAL,LNK  ADDCDTPARAM
         CI,T1    FIRST%I:CMND      IS CMND='DE'
         BGE      PDE20             NO - CMND='SE'
         NXTPRM   *ERRP4,;
                  (SCOL,ILGL%SEMICOLON),;
                  (END,MASTEREXECUTIVE)
*
*  FINISH UP 'SE'
*
PDE20    NXTPRM   *ERRP4,;
                  (COM,*),;
                  (SCOL,RESUME%PARSING),;
                  (END,MASTEREXECUTIVE)
         NXTPRM   ERRP7,;
                  (INTG,*)
         LI,P1    INTG
         BAL,LNK  ADDCDTPARAM       PUT 1ST COL # IN CDT
         NXTPRM   *ERRP4,;
                  (COM,*),;
                  (SCOL,RESUME%PARSING),;
                  (END,MASTEREXECUTIVE)
         NXTPRM   ERRP7,;
                  (INTG,*)
         BAL,LNK  ADDCDTPARAM       PUT 2ND COL # IN CDT
         NXTPRM   *ERRP4,;
                  (SCOL,RESUME%PARSING),;
                  (END,MASTEREXECUTIVE)
         PAGE
*******************************************
*  PARSE FORMS:  FD N(-M),/STRG/(,C(,D))  *
*                FT N(-M),/STRG/(,C(,D))  *
*******************************************
*
*
PARSE:FD EQU      %
PARSE:FS EQU      %
PARSE:FT EQU      %
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY
         DATA     4
         BAL,LNK  CHECK1CDTENTRY    MAKE SURE 'FD(FT)' IS FIRST CMND
         NXTPRM   ERRP5,;
                  (INTG,*),;
                  (SEQ,PFD10),;
                  (SEQ2,PFD15)
         BAL,LNK  ADJINT
*
*  ONLY ONE SEQ # GIVEN: DUPLICATE IT
*
PFD10    BAL,LNK  REPSEQ
*
*  PUT SEQ # PAIR IN CDT AND GET 2ND PARAMETER
*
PFD15    LI,P1    SEQ2              PUT 'SEQ # PAIR' PARAM IN CDT
         BAL,LNK  ADDCDTPARAM
         NXTPRM   *ERRP4,;
                  (COM,*),;
                  (SCOL,PFD20),;
                  (END,PFD20)
         NXTPRM   ERRP8,;
                  (STRG,*)
         LI,P1    STRG              PUT 'STRING' PARAM IN CDT
         BAL,LNK  ADDCDTPARAM
*
*
GET%COL#%PAIR     EQU %
         NXTPRM   *ERRP4,;
                  (COM,*),;
                  (SCOL,ILGL%SEMICOLON),;
                  (END,MASTEREXECUTIVE)
         NXTPRM   ERRP7,;
                  (INTG,*)
         LI,P1    INTG              PUT 1ST 'COL #' IN CDT
         BAL,LNK  ADDCDTPARAM
         NXTPRM   *ERRP4,;
                  (COM,*),;
                  (SCOL,ILGL%SEMICOLON),;
                  (END,MASTEREXECUTIVE)
         NXTPRM    ERRP7,;
                   (INTG,*)
         BAL,LNK  ADDCDTPARAM       PUT 2ND 'COL #' IN CDT
         NXTPRM   *ERRP4,;
                  (SCOL,ILGL%SEMICOLON),;
                  (END,MASTEREXECUTIVE)
*
*  ERROR: SECOND PARAMETER MISSING
*
PFD20    BAL,LNK  TYPEPERR          TYPE: '-PN:PARAM MISSING'
         DATA     ERRP17
         B        MASTERPARSER      GO TO PARSER
         PAGE
***************************
*  PARSE FORM:  IN N(,I)  *
***************************
*
*
PARSE:IN EQU      %
PARSE:IS EQU      %
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY
         DATA     2
         BAL,LNK  CHECK1CDTENTRY    MAKE SURE 'IN' IS FIRST CMND
         B        GET%SEQ%INCR      GO PROCESS FORM:  N(,I)
         PAGE
**************************************
*  PARSE FORMS:  MD N(-M),K(-L)(,I)  *
*                MK N(-M),K(-L)(,I)  *
**************************************
*
*
PARSE:MD EQU      %
PARSE:MK EQU      %
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY
         DATA     3
         BAL,LNK  CHECK1CDTENTRY    MAKE SURE 'MD(MK)' IS FIRST CMND
         NXTPRM   ERRP5,;
                  (INTG,*),;
                  (SEQ,PMD10),;
                  (SEQ2,PMD15)
         BAL,LNK  ADJINT
*
*  ONLY ONE SEQ. # GIVEN: DUPLICATE IT
*
PMD10    BAL,LNK  REPSEQ
*
*  PUT FIRST SEQ # PAIR IN CDT AND GET 2ND PARAMETER
*
PMD15    LI,P1    SEQ2              PUT 'SEQ # PAIR' PARAM IN CDT
         BAL,LNK  ADDCDTPARAM
         NXTPRM   *ERRP4,;
                  (COM,*)
         NXTPRM   ERRP5,;
                  (INTG,*),;
                  (SEQ,PMD20),;
                  (SEQ2,PMD25)
         BAL,LNK  ADJINT
*
*  ONLY ONE SEQ. # GIVEN: DUPLICATE IT
*
PMD20    BAL,LNK  REPSEQ
*
*  PUT 2ND SEQ # PAIR IN CDT AND GO PROCESS INCREMENT
*
PMD25    BAL,LNK  ADDCDTPARAM       PUT 'SEQ # PAIR' IN CDT
         B        GET%INCREMENT     GO PROCESS INCR
         PAGE
*************************
*  PARSE FORM:  RN N,K  *
*************************
*
*
PARSE:RN EQU      %
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY
         DATA     2
         BAL,LNK  CHECK1CDTENTRY    MAKE SURE 'RN' IS FIRST CMND
         NXTPRM   ERRP5,;
                  (INTG,*),;
                  (SEQ,PRN10),;
                  (SEQ2,ILGL%SEQ2)
         BAL,LNK  ADJINT
*
*  PUT SEQ # IN CDT AND GET 2ND SEQ #
*
PRN10    LI,P1    SEQ               PUT SEQ # IN CDT
         BAL,LNK  ADDCDTPARAM
         NXTPRM   *ERRP4,;
                  (COM,*),;
                  (SCOL,PRN30),;
                  (END,PRN30)
         NXTPRM   ERRP5,;
                  (INTG,*),;
                  (SEQ,PRN20)
         BAL,LNK  ADJINT
*
*  PUT 2ND SEQ # IN CDT AND FINISH UP
*
PRN20    BAL,LNK  ADDCDTPARAM       PUT 2ND SEQ # IN CDT
         NXTPRM   *ERRP4,;
                  (SCOL,ILGL%SEMICOLON),;
                  (END,MASTEREXECUTIVE)
*
*  ERROR: SECOND PARAMETER MISSING
*
PRN30    BAL,LNK  TYPEPERR          TYPE: '-PN:PARAM MISSING'
         DATA     ERRP17
         B        MASTERPARSER      GO TO PARSER
         PAGE
********************************
*  PARSE FORMS:  SS N(,C(,D))  *
*                ST N(,C(,D))  *
*                JU N          *
********************************
*
*
PARSE:SS EQU      %
PARSE:ST EQU      %
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY
         DATA     3
         B        PARSE:JU+2
*
*
PARSE:JU EQU      %
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY
         DATA     1
         NXTPRM   ERRP5,;
                  (INTG,*),;
                  (SEQ,PSS10),;
                  (SEQ2,ILGL%SEQ2)
         BAL,LNK  ADJINT
*
*  PUT SEQ # IN CDT AND MAKE SURE CMND IS FIRST FOR 'SS' AND 'ST'
*
PSS10    CI,P1    FIRST%I:CMND      IS CMND='JU'
         BGE      PSS20
         BAL,LNK  CHECK1CDTENTRY    NO - MAKE SURE 'SS(ST)' IS 1ST CMND
         LI,P1    SEQ               PUT SEQ # IN CDT
         BAL,LNK  ADDCDTPARAM
         B        GET%COL#%PAIR
*
*  PUT SEQ # FOR 'JU' IN CDT, BUT IT NEED NOT BE FIRST
*
PSS20    LI,P1    SEQ               PUT SEQ # IN CDT
         BAL,LNK  ADDCDTPARAM
         NXTPRM   *ERRP4,;
                  (SCOL,ILGL%SEMICOLON),;
                  (END,MASTEREXECUTIVE)
         PAGE
*********************
*  PARSE FORM:  RF  *
*********************
*
*
PARSE:RF EQU      %
         BAL,LNK  NEWCDTENTRY
         DATA     0
         NXTPRM   ERRC9,;
                  (SCOL,RESUME%PARSING),;
                  (END,MASTEREXECUTIVE)
         PAGE
***********************************
*  PARSE FORMS:  TS N(-M)  &  TS  *
*                TY N(-M)  &  TN  *
*                TC N(-M)         *
***********************************
*
*
PARSE:TC EQU      %
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY
         DATA     3
         NXTPRM   ERRP5,;           'TC' MUST SPECIFY RECORD.
                  (INTG,PTY5),;
                  (SEQ,PTY10),;
                  (SEQ2,PTY15)
*
PARSE:TS EQU      %
PARSE:TY EQU      %
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY
        DATA     3
         NXTPRM   ERRC9,;
                  (INTG,PTY5),;
                  (SEQ,PTY10),;
                  (SEQ2,PTY15),;
                  (SCOL,*),;
                  (END,*)
         MTW,-1   CHARPSN           SET TO RESCAN LAST CHAR
         LW,T1    *CDTADR           MUST BE INTRALINE 'TS' OR 'TY' SO
         AND,T1   XFF00              WIPE OUT CDT ENTRY JUST BUILT
         STW,T1   *CDTADR
         LI,T1    I:TS%CMND%NMR
         CI,P1    R:TS%CMND%NMR     IS CMND 'TS'
         BE       %+2
         LI,T1    I:TY%CMND%NMR     NO - MUST BE 'TY'
         LW,P1    T1                BUILD ENTRY IN CDT FOR THIS CMND
         BAL,LNK  NEWCDTENTRY
         DATA     0
         NXTPRM   ERRC9,;
                  (SCOL,RESUME%PARSING),;
                  (END,MASTEREXECUTIVE)
*
*
PTY5     BAL,LNK  ADJINT            SCALE INTEGER TO SEQ #.
PTY10    BAL,LNK  REPSEQ            REPLICATE SINGLE SEQ #.
PTY15    BAL,LNK  CHECK1CDTENTRY    INSURE TY(TS) IS FIRST COMMAND.
*
         LI,P1    SEQ2              ADD SEQ # PAIR TO COMMAND TABLE.
         BAL,LNK  ADDCDTPARAM
*
         B        GET%COL#%PAIR     NOW GET OPTIONAL COLUMN NUMBERS.
         PAGE
******************************
*  PARSER UTILITY ROUTINES   *
******************************
*
*                 FORM SEQUENCE NUMBER AS INTEGER*1000.
*
ADJINT   LW,D1    PARAMBUF
         MI,D1    1000
         STW,D1   PARAMBUF
         B        *LNK
*
*                 REPLICATE SINGLE SEQUENCE NUMBER IN PARAMBUF+1.
*
REPSEQ   LW,T1    PARAMBUF
         STW,T1   PARAMBUF+1
         MTW,1    PRMBUFSZ
         B        *LNK
*
*
         PAGE
***********************************
*                                 *
*  BREAK-KEY INTERRUPT HANDLER    *
*  UTS ONLY.                      *
*                                 *
***********************************
*
         DO       MODE=2
BRK%KEY  PUSH      X3               SAVE POINTER OF PSD IN STACK
         BAL,LNK   TYPEMSG          MOVE TO A CLEAN LINE ON USER
         DATA     MSG0              TERMINAL.
         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.
*
         LW,P1    INTFLAG1          IF DISPLAY FLAG SET,
         BLZ      BRK80
         LI,P2    BA(UTSM4)+37      BUILD SEQ # INTO MESSAGE AND
         BAL,LNK  MOVESEQ           SEND IT OUT.
         GEN4     0,0,0,0
         AI,R1    36                ADJUST COUNT OF FULL STRING
         STB,R1   UTSM4
         BAL,LNK  TYPEMSG
         DATA     UTSM4
         B        BRK80             NOW ASK ABOUT CONTINUE.
*
*
BRK30    LI,X1    1                 EXECUTING FILE OR EDIT COMMAND.
         LB,X2    *CDTADR,X1        GET COMMAND NUMBER AND RETRIEVE
         BEZ       BRK99            ORIGINAL EBCDIC.
         LW,X1    CNAMETBL,X2       NOW CHECK DISPLAY TABLE FOR
         LI,X2    7                 PRESENCE OF THIS COMMAND.
         CW,X1    BDISPTBL,X2
         BE       BRK40
         BDR,X2   %-2               IF NOT FOUND,
         B        BRK80             ASK TO CONTINUE.
*
BRK40    CI,X2    4
         BLE      BRK50
         LW,P1    INTFLAG1          THESE COMMANDS TAKE SINGLE SEQUENCE
         BLZ      BRK80             NUMBER -  DE,FD,FT
         LI,P2    BA(UTSM5)+24
         BAL,LNK  MOVESEQ
         GEN4     0,0,0,0
         AI,R1    23
         STB,R1   UTSM5
         BAL,LNK  TYPEMSG
         DATA     UTSM5
         B        BRK80
*
BRK50    LW,P1    INTFLAG1          THESE COMMANDS TAKE A DOUBLE SEQ. #
         BLZ      BRK80             DISPLAY
         LI,P2    BA(UTSM5)+24
         BAL,LNK  MOVESEQ           SET UP DDD.DD (
         GEN4     BL,LP,0,0
         AW,P2    R1                INCR MSG BYTE ADDR
         AI,R1    23                AND MSG LENGTH
         LW,P1    INTFLAG2          IF SECOND SEQ. # NOT SET UP,
         BGEZ     BRK60             WE MUST BE DELETING.
         LB,X1    UTSM7
         AW,R1    X1                THEREFORE, INSERT DELETING
         LI,X2    1                 MESSAGE.
BRK53    LB,P1    UTSM7,X2
         STB,P1   0,P2
         AI,P2    1
         AI,X2    1
         BDR,X1   BRK53
BRK55    STB,R1   UTSM5             ADJUST BYTE COUNT OF TOTAL
         BAL,LNK  TYPEMSG           MESSAGE.
         DATA     UTSM5
         B        BRK80             THEN ASK ABOUT CONTINUE.
*
BRK60    LW,T1    R1                SAVE MSG LENGTH
         BAL,LNK  MOVESEQ           MOVE SECOND SEQ # NUMBER INTO
         GEN4     RP,0,0,0          MESSAGE.
         AW,R1    T1                INCREMENT MSG LENGTH
         B        BRK55
*
BRK80    BAL,LNK  TYPEMSG           ASK FOR A CHARACTER.
         DATA     UTSM6
         CAL1,1   BR%FPT            READ IT.
         BAL,LNK  TYPEMSG           RETURN CARRIAGE.
         DATA     MSG0
         LB,X1    CFLAG             IF CHARACTER IS NOT X
         CI,X1    'X'               CONTINUE COMMAND.
         BE        STOPLASTCMD
         PULL      X3               STRAIGHTEN OUT STACK
M:TRTN   M:TRTN                     CONTINUE
BRK90    LI,T1     0                START CLEAN UP
         STW,T1   LASTKEY
         STW,T1   NOCHGFLG
         STW,T1   SETFLAG
         STW,T1   STEPFLAG
         LI,T1    -1
         STW,T1   ALLFLAG
         DO1      MODE=2
         LW,R1    L(X'00200000')    IF OPEN FOR OUTPUT,
         CW,R1    F:EO
         BAZ      %+2
         BAL,LNK  CLOSE2            CLOSE ANY COPY OR MERGE FILE.
         MTW,0    FILETYPE          CLOSE INPUT FILE, UNLESS OPEN
         BGZ      MASTERPARSER      FOR EDIT.
         CW,R1    F:EI
         BAZ      %+2
         BAL,LNK  CLOSE
         B        MASTERPARSER
STOPLASTCMD PULL   X3               POINTER OF PSD IN STACK.
         LI,T2     X'1FFFF'         SET A MASK
         LI,T1     BRK90            RETURN ADR. WANTED.
         STS,T1    0,X3
         B         M:TRTN
BRK99     EQU     %              PREPARE A CLEAN EXIT.
         PULL      X3               GET THE STACK POINTER.
         LI,T2     X'1FFFF'         MASK
         LI,T1     MASTERPARSER     ADR. OF RETURN.
         STS,T1    0,X3
         B         M:TRTN
         FIN
         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      *
*                                     *
***************************************
*
*
MASTEREXECUTIVE   EQU %
         LI,T1    CDT+1             SET CDTADR=FIRST COMMAND IN CDT
         STW,T1   CDTADR
         LW,T1    SVBPFLAG          RESTORE LAST DFLT VALUE OF BPFLAG
         STW,T1   BPFLAG
         DO       MODE=2
         LI,T1    1
         STW,T1   XEQFLAG
        LI,T1    0
        STW,T1   TABCFLAG
        STW,T1   TABXFLAG
         FIN
*
*
*
RESTART%EXECUTIVE EQU %             (INTRALINE CMND LOOP ENTERS HERE)
         LI,X1    0                 INDICATE 'ALL' MODE IS
         STW,X1   ALLOK             POTENTIALLY LEGAL
         LI,X1    1                 GET NUMBER OF COMMAND
         LB,X2    *CDTADR,X1
         BEZ      EXC50             IS CMND=0 (END OF CDT)
         CI,X2    FIRST%R:CMND      NO - IS IT A FILE COMMAND
         BL       EXC5              YES - SKIP TEST
         MTW,0    FILETYPE          NO - IS INP FILE PRESENT AND KEYED
         BLZ      EXC40             NO - ERROR
         CI,X2    FIRST%I:CMND      IS IT AN I:CMND (EXCEPT 'SE')
         BLE      EXC5
         LI,T1    -2                 IF ERRORCNT -2 OR LESS
        CW,T1     ERRORCNT          SET LOOP EXECUTED ONCE
        BGE       %+2               DONT TYPE ANY MORE CERRS
        STW,X1    ERRORCNT          ONE CERR PER I:COMMAND
         MTW,0    SETFLAG           YES - IS SYSTEM IN SET MODE
         BNEZ     EXC20             YES - GO CHECK ON CMND
         BAL,LNK  TYPEMSG           NO - TYPE: '-MISSING SET'
         DATA     ERRM8
         B        MASTERPARSER      EXIT TO PARSER
*
*  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,T1    0                 TURN OFF 'SET MODE' FLAG
         STW,T1   SETFLAG
*
*  EXECUTE CURRENT COMMAND IN CDT
*
EXC10    EXU      CMNDTBL,X2        EXECUTE COMMAND
         MTW,0    ALLFLAG           WAS CMND AN I:CMND WITH PARAM1=ALL
         BGEZ     EXC15             YES - EXECUTE IT UNTIL FLAG GOES OFF
         LB,T1    *CDTADR           INCR CDTADR TO NEXT COMMAND
         AWM,T1   CDTADR
         B        RESTART%EXECUTIVE GO PROCESS NEW COMMAND
*
*  ALLFLAG SET: RE-EXECUTE INTRALINE COMMAND UNTIL ALL OCCURRENCES ARE
*  PROCESSED
*
EXC15    LI,X1    1                 GET NUMBER OF COMMAND
         LB,X2    *CDTADR,X1
         B        EXC10             GO EXECUTE 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,T1    -1                SET SETFLAG=-1 TO INDICATE THAT SET
         STW,T1   SETFLAG            LOOP HAS BEEN INITIALIZED
         LW,T1    CDTADR            SAVE ADDR OF CMND IN CDT (IN
         STW,T1   SETADR             SETADR) FOR LATER I:CMND LOOP
         LW,P1    SV1STSET
         STW,P1   FIRSTSET          INITIALIZE LOOP PER LAST I:SET
         BAL,LNK  READRANDOM        READ FIRST RECORD TO ALTER
         BAL,LNK  SETEOD            SET EOD MARKER
         B        EXC10             GO EXECUTE COMMAND
*
*  ERROR: GIVEN COMMAND IS ILLEGAL WHEN SYSTEM IS IN STEP MODE
*
EXC30    BAL,LNK  TYPECERR          TYPE: '-CN:CMND ILGL HERE'
         DATA     ERRC4
         B        MASTERPARSER      EXIT TO PARSER
*
*  ERROR: NO SOURCE FILE NAMED
*
EXC40    BAL,LNK  TYPEMSG           TYPE: '-NO FILE NAMED'
         DATA     ERRM13
         B        MASTERPARSER      EXIT TO PARSER
*
*  END OF CDT: IF IN SET OR STEP MODES, GO TO APPROPRIATE LOOP
*
EXC50    MTW,0    STEPFLAG          IS SYSTEM IN STEP MODE
         BNEZ     STEP%LOOP         YES - GO TO STEP LOOP
         MTW,0    TTYIMGSZ          WAS INPUT LINE NULL
         BEZ      EXC55             YES - ERROR
         MTW,0    SETFLAG           IS SYSTEM IN SET MODE
         BNEZ     SET%LOOP          YES - GO TO SET LOOP
         B        MASTERPARSER      EXIT TO PARSER
*
*  ERROR: NULL COMMAND
*
EXC55     EQU      %
         B        MASTERPARSER      EXIT TO PARSER
*
*  FILE COMMANDS CAN ONLY APPEAR ONE PER LINE
*
CMNDTBL  EQU       %-1
         BAL,F:LNK F:BLANK%PRESERV   1: BP
         BAL,F:LNK F:BUILD           2: BUILD
         BAL,F:LNK F:COPY            3: COPY
         BAL,F:LNK F:DELETE          4: DELETE
         BAL,F:LNK F:EDIT            5: EDIT
         BAL,F:LNK F:END             6: END
         BAL,F:LNK S(MASTERPARSER,F:TA) TA
         BAL,F:LNK F:CR              8: CR
         BAL,F:LNK F:MERGE           9: MERGE
*
*  RECORD COMMANDS CAN ONLY APPEAR ONE PER LINE
*
         BAL,F:LNK R:COMMENTARY     10: CM
         BAL,F:LNK R:DELETE         11: DE
         BAL,R:LNK R:FIND%DELETE    12: FD
         BAL,R:LNK R:FIND%TYPE      13: FT
         BAL,R:LNK R:INSERT         14: IN
         BAL,R:LNK R:INSERT%SUP%SEQ 15: IS
         BAL,R:LNK R:MOVE%DELETE    16: MD
         BAL,R:LNK R:MOVE%KEEP      17: MK
         BAL,R:LNK R:RENUMBER       18: RN
         BAL,R:LNK R:SET%STEP       19: SS
         BAL,R:LNK R:SET%STEP%TYPE  20: ST
         BAL,R:LNK R:TYPE%SUP%SEQ   21: TS
         BAL,R:LNK R:TYPE           22: TY
         BAL,R:LNK R:TYPE%COMPRESSED 23: TC
         BAL,R:LNK R:FIND%SEQUENCE  24: FS
         RES      5
*
*  INTRALINE COMMANDS MAY BE COMPOUNDED ON ONE LINE
*
         BAL,I:LNK I:SET            30: SE (MUST BE FIRST I:CMND)
         BAL,I:LNK I:DELETE         31: D
         BAL,I:LNK I:OVERWR%EXTEND  32: E
         BAL,I:LNK I:FOLLOW%BY      33: F
         BAL,I:LNK I:SHIFT%LEFT     34: L
         BAL,I:LNK I:OVERWRITE      35: O
         BAL,I:LNK I:PRECEDE%BY     36: P
         BAL,I:LNK I:SHIFT%RIGHT    37: R
         BAL,I:LNK I:SUBSTITUTE     38: S
         BAL,I:LNK I:JUMP           39: JU
         BAL,I:LNK I:NO%CHANGE      40: NO
         BAL,I:LNK I:REVERSE%BPFLAG 41: RF
         BAL,I:LNK I:TYPE%SUP%SEQ   42: TS
         BAL,I:LNK I:TYPE           43: TY
         PAGE
******************************************
*  FILE COMMAND: SET BLANK PRESERVATION  *
******************************************
*
*
F:BLANK%PRESERV   EQU %
         LI,X1    5                 SET TO GET PARAMETER FROM CDT
         LB,X2    *CDTADR,X1
         LW,T1    *CDTADR,X2        GET 'ON' OR 'OFF' AS A TEXTC-STRING
         CW,T1    BPVON
         BNE      BPV5              IS STRING='ON'
         LI,T1    1                 YES - SET BPFLAG=1
         STW,T1   SVBPFLAG
         B        *F:LNK            EXIT
*
*  TEST FOR 'OFF'
*
BPV5     CW,T1    BPVOFF
         BNE      BPV10             IS STRING='OFF'
         LI,T1    0                 YES - SET BPFLAG=0
         STW,T1   SVBPFLAG
         B        *F:LNK            EXIT
*
*  ERROR: NOT ON OR OFF
*
BPV10    BAL,LNK  TYPEMSG           TYPE: '-NOT ON/OFF'
         DATA     ERRM5
         B        *F:LNK            EXIT
*
*
BPVON    TEXTC    'ON'
BPVOFF   TEXTC    'OFF'
         PAGE
*************************
*  FILE COMMAND: BUILD  *
*************************
*
*
F:BUILD  EQU      %
         BAL,LNK  TESTEDITACTIVE    CHECK IF EDIT FILE ACTIVE
         LI,X1    5
         LB,P1    *CDTADR,X1        SET P1=ADR OF FID IN CDT
         AW,P1    CDTADR
         DO1      MODE=2
         LW,R2    P1                SAVE FID ADDRESS
         BAL,LNK  OPENNEW           OPEN OUTPUT ONLY FILE
         BCR,8    BLD40             DOES FILE ALREADY EXIST
         DO1      MODE=2
         CAL1,1   NOPROMPT%FPT
         LI,P1    DFLTSEQ           NO - SET P1=DEFAULT SEQ #
         LI,T1    1000                       T1=1 (DEFAULT INCR)
         LI,X1    6
         LB,R1    *CDTADR,X1        GET PARAM2 TYPE
         BEZ      BLD5              TEST IF PARAM2 PRESENT
         AI,X1    1
         LB,X2    *CDTADR,X1        YES - SET P1=SEQ # FROM CDT
         LW,P1    *CDTADR,X2
*
*  PROCESS INCREMENT PARAMETER
*
BLD5     LI,X1    8
         LB,R1    *CDTADR,X1        GET PARAM3 TYPE
         BEZ      BLD08             TEST IF PARAM3 PRESENT
         AI,X1    1
         LB,X2    *CDTADR,X1        YES - SET T1=INCR FROM CDT
         LW,T1    *CDTADR,X2
*
BLD08   MTW,0    BUILDFLAG
        BEZ      BLD12
         DO       MODE=2
BLD10    CI,R2    0                 HAVE WE BUILT FIRST LINE
         BEZ      BLD12               YES--BYPASS RE-OPEN
         BAL,LNK  CLOSE               CLOSE AND SAVE BUILD FILE
         XW,P1    R2                POSITION FID FOR OPENING
         BAL,LNK  OPEN              REOPEN IN INOUT SO ESC LEAVES INTACT
         LW,P1    R2                RESET P1 TO SEQ. #
         LI,R2    1                 NOW MARK FILE AS IF WE ARE IN
         STW,R2   FILETYPE            EDIT MODE - RECORD COMM 0.K.
         LI,R2    0                 AND R2 SO WILL NOT RE-OPEN EO
         STW,R2   TABERRFLAG        EDIT WOULD DO THIS, SO SHALL BUILD
         FIN
*  TYPE NEXT SEQ # AND READ INPUT LINE
*
BLD12    BAL,LNK  TYPESEQ  TYPE 'DDDD.DDD'
         GEN4     BL,EOM,0,0
         DO       MODE=2
         LI,D1    9
         FIN
         BAL,LNK  READTELETYPE      READ INPUT LINE
         CI,R1    1
         BE       BLD30
          LW,X2     R1           GET BYTE CNT.. INTO INDEX REG.
         AI,X2     -1               MAKE X2 A BINARY COUNT
         LB,D1     CARDIMG,X2       GET LAST BYTE INPUT
         LI,X1     GNTBL1SZ         GET THE COUNT OF DIFFERENT TYPE
*                                   OF LINE TERMINATORS.
         CB,D1     GNTBL1,X1        FIND A CARRAGE RETURN
         BE        %+3
         BDR,X1    %-2
         B         %+4
         LI,D1     ' '              BLANK OUT C/R
         STB,D1    CARDIMG,X2
         MTW,-1    R1               IF CR DECREMENT CHAR. COUNT.
         STW,R1   RECSIZE
         CI,R1    MAXCLMN
         BLE      BLD25
         BAL,LNK  TYPEMSG           NO - TYPE: '--OVERFLOW'
         DATA     ERRM3
*
*  WRITE INPUT LINE AND INCREMENT SEQ. #
*
BLD25    BAL,LNK  SETEOD            FINDS COL. OF LAST NON-BLANK
         BAL,LNK  WRITERANDOM       WRITE CARD IMAGE; P1 CONTAINS SEQ. #
         AW,P1    T1                INCREMENT SEQ. #
         CW,P1    MAXSEQ            IS SEQ. NO. TOO BIG
         BLE      BLD10             NO.  GO READ MORE INPUT
         BAL,LNK  TYPEMSG           YES.
         DATA     ERRM20
         CW,R2    BUILDFLAG         DID I COME FROM A BANG BUILD
         BCS,7    BLD30             OR A BANG EDIT. IF BY BANG
*                                     BUILD DONT SAVE THE FILE.
         BAL,LNK  CLOSE
*
*  NULL INPUT LINE: EXIT
*
BLD30    EQU      %
         DO       MODE=2
         MTW,0    BUILDFLAG         IF ENTERED BY BUILD COMMAND, EXIT
         BEZ      F:END             TO TEL.
         FIN
         B        *F:LNK            EXIT
*
*  ERROR: NAMED FILE ALREADY EXISTS
*
BLD40    BAL,LNK  TYPEMSG           TYPE: '-FILE EXISTS; CAN'T BUILD'
         DATA     ERRM15
         BAL,LNK  CLOSE             CLOSE F:EI
         B        BLD30
         PAGE
************************
*  FILE COMMAND: COPY  *
************************
*
*
F:COPY   EQU      %
         BAL,LNK  TESTEDITACTIVE    CHECK IF EDIT FILE ACTIVE
         LI,X3    0                 INITIALIZE FLAG FOR
         STW,X3   COPYFL              FID1=FID2
         LI,X1    5                 OBTAIN FID 1 AND FID 2
         LB,P1    *CDTADR,X1          AS
         AW,P1    CDTADR            BYTE
         LI,X1    9                   ADDRESSES
         LB,P2    *CDTADR,X1          IN
         AW,P2    CDTADR              REGISTERS
         SLS,P1   2                   P1 AND
         SLS,P2   2                   P2
*
*  SEARCH LOOP TO DETERMINE IF FID1 = FID2
*
CPY1     AI,P1    1
*                 (OK TO BYPASS TEXTC BYTE IN COMPR)
         AI,P2    1
         LB,X1    0,P1              GET FID 1 BYTE
         BEZ      CPY1A               QUIT WHEN END OF FID
         CB,X1    0,P2
         BNE      CPY1B               OR WHEN NOT EQUAL
         B        CPY1              LOOP
*
*  FINISH FID COMPARISON - FID STRING HAS ENDED
*
CPY1A    CB,X1    0,P2              CHECK LAST BYTE
         BE       CPY32
CPY1B    LI,X1    7                 FIND OUT WHETHER ON
         LB,X2    *CDTADR,X1        OR OVER SPECIFIED
         LW,T1    *CDTADR,X2        T1='ON' OR 'OVER'
         CW,T1    X:OVER
         BNE      CPY30             NOT EQUAL --> ON
*
*  OPEN FOR COPY A OVER B
*
CPY2     LI,X1    5
         LB,P1    *CDTADR,X1        SET P1=ADR OF FID1 IN CDT
         AW,P1    CDTADR
         LI,X4    0                 SET X4=0 TO SHOW FILE UNKEYED
         BAL,LNK  OPEN1             OPEN INPUT FILE WITH THIS FID
         BCS,8    CPY40             DOES FILE EXIST
         BCS,4    %+2               YES - IS FILE KEYED
         LI,X4    1                 YES - SET X4=1 TO SHOW FILE KEYED
         LI,X1    9
         LB,P1    *CDTADR,X1        SET P1=ADR OF FID2 IN CDT
         AW,P1    CDTADR
         BAL,LNK  OPEN2             OPEN COPY FILE WITH THIS FID
         BCS,8    CPY3              FILE 2 NO EXIST YET
         BAL,LNK  CLOSE3            .. EXISTS-RELEASE GRANS
         BAL,LNK  OPEN3             OPEN FOR OUTPUT
*
*  FINISH INITIALIZATION AND PROCESS PARAMETER 4
*
CPY3     BAL,LNK  TYPEMSG           TYPE: '..COPYING'
         DATA     MSG1
         LI,X1    10
         LB,R2    *CDTADR,X1        IS 'STARTING SEQ #' PARAM PRESENT
         BNEZ     CPY10             YES - GO COPY AND RESEQ
*
*  COPY SOURCE FILE THROUGH EOF
*
CPY5     BAL,LNK  READSEQUEN        READ SOURCE RECORD
         CW,R1    L(EOF)            IS IT AN EOF
         BE       CPY20             YES - GO FINISH UP
         CI,X4    1
         BNE      CPY50
CPY5A    LW,P1    R1                GET SEQ # IN P1
         BAL,LNK  WRITE2            WRITE RECORD IN COPY FILE
         DO       MODE=2
         STW,R1   INTFLAG1
         STW,R1   INTFLAG2
         FIN
         B        CPY5              NO - LOOP
*
*  PROCESS STARTING SEQ. # AND INCREMENT PARAMETERS
*
CPY10    LI,X1    11
         LB,X2    *CDTADR,X1
         LW,P1    *CDTADR,X2        SET P1=STARTING SEQ #
         LI,T1    1000                  T1=1 (DEFAULT INCR)
         LI,X1    12
         LB,R2    *CDTADR,X1        GET PARAM4 TYPE
         BEZ      CPY15             TEST IF PARAM4 PRESENT
         AI,X1    1
         LB,X2    *CDTADR,X1        YES - SET T1=INCR FROM CDT
         LW,T1    *CDTADR,X2
*
*  COPY AND RESEQUENCE SOURCE FILE THROUGH EOF
*
CPY15    BAL,LNK  READSEQUEN        READ SOURCE RECORD
         CW,R1    L(EOF)            IS IT AN EOF
         BE       CPY20             YES - GO FINISH UP
         BAL,LNK  WRITE2            WRITE RECORD IN COPY FILE
         BCS,8    CPY50             DOES RECORD ALREADY EXIST
         DO       MODE=2
         STW,R1   INTFLAG1
         STW,P1   INTFLAG2
         FIN
         AW,P1    T1                NO - INCR SEQ #
         CW,P1    MAXSEQ            IS SEQ. NO. TOO BIG
         BLE      CPY15             NO.
         BAL,LNK  TYPEMSG           YES.
         DATA     ERRM20
*
*  EOF FOUND: CLOSE COPY FILE AND EXIT
*
CPY20    BAL,LNK  CLOSE             CLOSE INPUT FILE
         BAL,LNK  CLOSE2            CLOSE COPY FILE
         BAL,LNK  TYPEMSG           TYPE: '..COPY DONE'
         DATA     MSG2
         B        *F:LNK            EXIT
*
*  OPEN FOR COPY A ON B
*
CPY30    LI,X1    9
         LB,P1    *CDTADR,X1        P1=ADR OF FID2 IN CDT
         AW,P1    CDTADR
         BAL,LNK  OPEN2             OPEN INOUT-CHNGD TO OUT
         BCR,8    CPY35             ERROR IF FILE 2 EXISTS
         LI,X1    5                 OBTAIN FID 1 AND FID 2
         LB,P1    *CDTADR,X1          AS
         AW,P1    CDTADR            BYTE
         LI,X4    0                 X4=4 MEANS NOT KEYED
         BAL,LNK  OPEN1
         BCS,8    CPY36             IF FILE DOES NOT EXIST
         BCS,4    CPY3              IS FILE KEYED
         LI,X4    1                   MARK AS KEYED
         B        CPY3              GO TO BODY OF COPY
*
*  OPEN FOR COPY A OVER A  OR  A ON A
*
CPY32    LI,X1    5                 CHECK FID1 FOR PASSWORD
         MTW,1    COPYFL            SET TO SHOW FID1=FID2
         LB,P1    *CDTADR,X1
         AW,P1    CDTADR            P1 = FILE NAME
         LB,X1    *P1               BYTE CNT OF FILE NAME
         SLS,X1   -2                BYTE TO WORD COUNT
         AI,X1    1                 GET NEXT WORD
         AW,P1    X1
         LB,X1    *P1               BYTE CNT OF ACCOUNT
         SLS,X1   -2
         AI,X1    1                 POINT TO PASSWORD
         AW,P1    X1
         LW,X1    *P1               FETCH PASSWORD
         BNEZ     CPY60             PASSWORD GIVEN - ERROR
         LI,X1    9                 NOW GO DO SAME FOR FID2
         LB,P1    *CDTADR,X1
         AW,P1    CDTADR            P1 = FILE NAME
         LB,X1    *P1               BYTE CNT OF FILE NAME
         SLS,X1   -2                BYTE TO WORD COUNT
         AI,X1    1                 GET NEXT WORD
         AW,P1    X1
         LB,X1    *P1               BYTE CNT OF ACCOUNT
         SLS,X1   -2
         AI,X1    1                 POINT TO PASSWORD
         AW,P1    X1
         LW,X1    *P1               FETCH PASSWORD
         BNEZ     CPY60             PASSWORD GIVEN - ERROR
*
         LI,X1    5                 OBTAIN FID 1 AND FID 2
         LB,P1    *CDTADR,X1          AS
         AW,P1    CDTADR            BYTE
         BAL,LNK  OPEN3             OPEN FOR OUTPUT
         LI,X1    5                 OBTAIN FID1 AND FID2
         LB,P1    *CDTADR,X1          AS
         AW,P1    CDTADR            BYTE
         LI,X4    0                 X4=4 MEANS NOT KEYED
         BAL,LNK  OPEN1             OPEN1 OPEN1 IN. CONTINUE
         BCS,8    CPY36             IF FILE DOES NOT EXIST
         BCS,4    CPY3              IS FILE KEYED
         LI,X4    1                   MARK AS KEYED
         B        CPY3              GO TO BODY OF COPY
*
*  ERROR: COPY FILE EXISTS AND PARAMETER 2 IS 'ON'
*
CPY35    BAL,LNK  TYPEMSG           TYPE: '-P2:FILE EXISTS'
         DATA     ERRP13
         BAL,LNK  CLOSE2
         B        *F:LNK            EXIT
*
*  ERROR: SOURCE FILE NAMED DOESN'T EXIST
*
CPY36    BAL,LNK  CLOSE3
         B        CPY40
CPY37    BAL,LNK  CLOSE2            CLOSE EO WITH SAVE
         BAL,LNK  CLOSE
CPY40    BAL,LNK  TYPEMSG           TYPE: '-P1:NO SUCH FILE'
         DATA     ERRP12
         B        *F:LNK            EXIT
*
*  ERROR: DUPLICATE RECORD COPIED
*
CPY50    BAL,LNK  TYPEMSG           TYPE: '-P1:FILE NOT SEQD & P3 NULL'
         DATA     ERRP16
         BAL,LNK  CLOSE             CLOSE INPUT FILE
         MTW,0    COPYFL            DON'T DELETE INPUT FILE IF
         BNEZ     CPY56               FID1=FID2
         BAL,LNK  CLOSE2            CLOSE COPY FILE
         LI,X1    9
         LB,P1    *CDTADR,X1        SET P1=ADR OF FID2 IN CDT
         AW,P1    CDTADR
         BAL,LNK  DELETEFILE        DELETE COPY FILE
         B        CPY58             EXIT IF FID1 NOT= FID2
CPY56    BAL,LNK  CLOSE3            DELETE COPY FILE, FID1=FID2
CPY58    B        *F:LNK            EXIT
CPY60    BAL,LNK  TYPEMSG           TYPE: 'PASSWORD ERROR'
         DATA     ERRM19
         B        *F:LNK            EXIT
         PAGE
**************************************************
*  FILE COMMAND: SET TERMINATOR (X'15') MODE     *
**************************************************
*
*
F:CR     EQU      %
         LI,X1    5
         LB,X2    *CDTADR,X1
         LW,T1    *CDTADR,X2        GET PARAMETER AS A TEXTC STRING.
         CW,T1    BPVON             CHECK FOR 'ON'
         BNE      CR5
*
         LI,T1    0                 TURN 'ON'
CR3      STW,T1   CRFLAG            SET FLAG TO INCLUDE TERMINATOR
         B        *F:LNK            IN OUTPUT RECORDS.
*
CR5      CW,T1    BPVOFF            CHECK FOR 'OFF'
         BE       CR3               TURN 'OFF'
*
         B        BPV10             ERROR: -NOT ON/OFF
         PAGE
**************************
*  FILE COMMAND: DELETE  *
**************************
*
*
F:DELETE EQU      %
         BAL,LNK  TESTEDITACTIVE
         LI,X1    5
         LB,P1    *CDTADR,X1        SET P1=ADR OF FID IN CDT
         AW,P1    CDTADR
         BAL,LNK  DELETEFILE        DELETE FILE
         BCS,8    DLT10             DID FILE EXIST
*
*  TYPE MESSAGE AND EXIT
*
DLT5     BAL,LNK  TYPEMSG           TYPE: '..DELETED'
         DATA     MSG3
         B        *F:LNK            YES - EXIT
*
*  ERROR: FILE TO DELETE DOESN'T EXIST
*
DLT10    BAL,LNK  TYPEMSG           TYPE: '-NO SUCH FILE'
         DATA     ERRM14
         B        *F:LNK
         PAGE
************************
*  FILE COMMAND: EDIT  *
************************
*
*
F:EDIT   EQU      %
         MTW,0    FILETYPE          FILETYPE=-1 NEVER OPENED
         BLZ      EDT5                       +1 OPENED AS INOUT, KEYED
         BAL,LNK  CLOSE             CLOSE FILE IF EVER OPENED
*
*  OPEN FILE AND SET FILE TYPE
*
EDT5     LI,X1    5
         LB,P1    *CDTADR,X1        SET P1=ADR OF FID IN CDT
         AW,P1    CDTADR
         BAL,LNK  OPEN              OPEN FILE
         BCS,8    EDT10             DOES FILE EXIST
         BCS,4    EDT20             YES - IS IT KEYED
         LI,T1    1                 YES - SET FILETYPE=1
         STW,T1   FILETYPE
         DO       MODE=2
         LI,T1    0
         STW,T1   TABERRFLAG
         FIN
         B        *F:LNK            EXIT
*
*  ERROR: SOURCE FILE DOESN'T EXIST
*
EDT10    BAL,LNK  TYPEMSG           TYPE: '-NO SUCH FILE'
         DATA     ERRM14
EDT15    LI,T1    -1                SHOW UNSUCCESSFUL OPEN
         STW,T1   FILETYPE
         B        *F:LNK
*
*  FILE EXISTS BUT IS NOT KEYED
*
EDT20    BAL,LNK  CLOSE             CLOSE FILE
         BAL,LNK  TYPEMSG           TYPE: '-FILE NOT KEYED; MUST COPY'
         DATA     ERRM12
         B        EDT15             EXIT.
         PAGE
***********************
*  FILE COMMAND: END  *
***********************
*
*
F:END    EQU      %
         MTW,0    FILETYPE          WAS INPUT FILE EVER NAMED
         BLZ      %+2               NO - SKIP CLOSE
         BAL,LNK  CLOSE             CLOSE INPUT FILE
         DO       MODE=1
         CAL3,6   0                 EXIT TO BTM
         ELSE
         M:EXIT                     EXIT TO UTS.
         FIN
         PAGE
*************************
*  FILE COMMAND: MERGE  *
*************************
*
*
F:MERGE  BAL,LNK  TESTEDITACTIVE
         LI,X1     0                RESET THE RECORD CNT.
         STW,X1    MVD:REC:CNT
         LI,X1    5                 SET P1 TO ADDRESS OF FID1 IN CDT.
         LB,P1    *CDTADR,X1
         AW,P1    CDTADR
         STW,P1   FID1ADR
         BAL,LNK  OPEN1             OPEN MERGE SOURCE IN INPUT MODE.
         BCS,8    CPY40             ERROR IF NON-EXISTENT
         BCS,4    MRG80             OR NOT HEYED.
*
         LI,P1    0
         STW,P1   FIRSTFROM         SET UP INPUT RANGE AS DEFALT
         LW,P1    L(EOF)            ENTIRE FILE.
         STW,P1   LASTFROM
*
         AI,X1    1
         LB,P1    *CDTADR,X1        BUT READJUST IF SPECIFIL RANGE
         AI,X1    1                 GIVEN
         CI,P1    SEQ2
         BNE      MRG10
*
         LB,P1    *CDTADR,X1        COMPUTE ADDRESS OF SEQUENCE PAIR
         AW,P1    CDTADR
         LW,P2    *P1               AND STORE THEM AWAY.
         STW,P2   FIRSTFROM
         AI,P1    1
         LW,P2    *P1
         STW,P2   LASTFROM
         AI,X1    2                 STEP AROUND 'INTO'
*
MRG10    LW,P1    FIRSTFROM         VERIFY EXISTENCE OF RECORDS TO
         BAL,LNK  READNXTRANDOM     MOVE.
         CW,R1    L(EOF)            IF RECORD READ WAS 'EOF',
         BGE      MRG70             OR GREATER THAN LAST FROM, THEN
         CW,R1    LASTFROM
         BG       MRG70             'NOTHING TO MOVE'
*
         BAL,LNK  CLOSE             YES. CLOSE FILE SO WE CAN
*                                   USE F:EI ROUTINES TO DELETE
         AI,X1    2                 'TO' RANGE.
         LB,P1    *CDTADR,X1        STEP TO FID2 AND OPEN
         AW,P1    CDTADR
         STW,P1   FID2ADR
         BAL,LNK  OPEN
         BCS,8    MRG30             IF NON-EXISTENT,CREATE NEW FILE.
         BCS,4    MRG82             ERROR IF NOT KEYED
*
         AI,X1    2                 NOW GET SEQUENCE NUMERS OF 'TO'
         LB,T1    *CDTADR,X1        RANGE
         AW,T1    CDTADR
         LW,P1    *T1               IN P1,PL - TEMPORARILY.
         AI,T1    1
         LW,P2    *T1
*
         BAL,LNK  DELETE            DELETE'TO' RANGE
         BCS,8    %+2               GET 'STOP' SEQ # IF LAST 'TO'
         BAL,LNK  READSEQUEN        NOT HIT EXACTLY.
         LW,X3    R1                'STOP' SEQ # TO X3
         STW,P1   T1
         STW,P2   T2
*
MRG13   BAL,LNK  CLOSE             CLOSE FID2 AS F:EI
MRG14    LI,P3    1000              DEFAULT INCREMENT
         AI,X1    1
         LB,P1    *CDTADR,X1
         BEZ      MRG15
         AI,X1    1                 INCREMENT GIVEN.
         LB,P3    *CDTADR,X1
         AW,P3    CDTADR
         LW,P3    *P3
         STW,P3   DFLTINCR
*
MRG15    LW,P1    FID1ADR           R-OPEN FILES IN PROPER MODE.
         BAL,LNK  OPEN1             SOURCE IN INPUT.
         LW,P1    FID2ADR
         BAL,LNK  OPEN2
*
         BAL,LNK  TYPEMSG
         DATA     MSG5
MRG17    LW,P1    FIRSTFROM         GET FIRST 'FROM' RECORD IN FILE 1.
         BAL,LNK  READNXTRANDOM
         LW,P1    T1                FIRST 'TO' SEG # TO P1.
MRG20    CW,R1    L(EOF)            IF EOF READ,
         BGE      MRG55             WE'RE DONE.
         CW,R1    LASTFROM          IF SEQ # READ GREATER TRAN LAST
         BG       MRG55             'FROM' WE'RE DONE.
         STW,R1    T2
         SW,T2    LASTFROM
*
         BAL,LNK  WRITE2            WRITE RECORD INTO FILE2.
         MTW,1     MVD:REC:CNT      COUNT REC.S MOVED.
         DO       MODE=2
         STW,R1   INTFLAG1
         STW,P1   INTFLAG2
         FIN
         AI,T2    0
         BEZ      MRG56
         AW,P1    P3                INCREMENT WRITE SEQ #.
         CW,P1    MAXSEQ            IS SEQ. NO. TOO BIG
         BLE      MRG25             NO.
         BAL,LNK  TYPEMSG           YES.
         DATA     ERRM20
         B        MRG55
MRG25    CW,P1    X3                IF CURRENT WRITE SE # MEETS
         BGE      MRG65             'STOP' SEQ # WE'RE CUT OFF.
         BAL,LNK  READSEQUEN        GET NEXT 'FROM' RECORD.
         B        MRG20
*
*
*
MRG30   EQU      %                 OUTPUT FILE DOESN'T EXIST.
         AI,X1    2                 GET STARTING OUTPUT SEQUENCE.
         LB,T1    *CDTADR,X1
         AW,T1    CDTADR
         LW,T1    *T1
MRG35    LW,X3    L(EOF)            SET 'STOP' SEQUENCE TO EOF.
         B        MRG14
*                                                                     BL
*
*
MRG55    SW,P1    P3                SUCCESSFUL MERGE, MOVE DEST SEQ #
*                                  BACK TO LAST USED.  THEN USE
MRG56    BAL,LNK  CLOSE             'MK' CODE AFTER CLOSING.
         BAL,LNK  CLOSE2
         B        MVE40
*
MRG65    STW,R1   LASTFROM          SET LAST SEQ # READ.
         BAL,LNK  CLOSE
         BAL,LNK  CLOSE2
         B        MVE56             THEN USE 'MK' CODE.
*
MRG70    BAL,LNK  CLOSE             CLOSE INPUT FILE
         B        MVE58             THEN USE 'MK' ROUTINE
MRG80   BAL,LNK  CLOSE
        BAL,LNK  TYPEMSG
         DATA     ERRM17            'SOURCE NOT KEYED'
         B       *F:LNK
*
MRG82   BAL,LNK  CLOSE
        BAL,LNK  TYPEMSG
        DATA     ERRM18            DEST. NOT KEYED
        B        *F:LNK
*
         PAGE
*************************
*  FILE COMMAND: TA     *
*************************
*
*
F:TA     EQU      %
         DO       MODE=2
         LI,X1    5                 COMPUTE ADDRESS OF TAB SPECIFIER
         LB,P1    *CDTADR,X1        IN CDT.
         AW,P1    CDTADR
*
         LW,P1    *P1               GET SPECIFIER
         LI,X1    3                 AND CHECK VALIDITY.
         CW,P1    X:F-1,X1
         BE       TA5
         BDR,X1   %-2
*
         BAL,LNK  TYPEMSG           ERROR: NOT F,M,S.
         DATA     UTSM3
         B        MASTERPARSER
*
TA5      EXU      TABSET-1,X1       CHANGE MUC TABS FOR F,M OR S
*
         B        *F:LNK            RETURN
TABSET   M:DEVICE M:UC,(TAB,7,0,0,0)      FTABS
         M:DEVICE M:UC,(TAB,10,19,37,0)   MTABS
         M:DEVICE M:UC,(TAB,8,16,30,0)    STABS
         FIN
         PAGE
************************************
*  RECORD COMMAND: ADD COMMENTARY  *
************************************
*
*
R:COMMENTARY      EQU %
         LI,X1    5
         LB,X2    *CDTADR,X1        SET P1=STARTING SEQ #
         LW,P1    *CDTADR,X2
         LI,X1    7
         LB,X2    *CDTADR,X1        SET T1=STARTING COLUMN #
         LW,T1    *CDTADR,X2
         AI,T1    -1                ADJ TO INTERNAL COL. #
         BLZ      CMT40
         CI,T1    MAXCLMN           IS COL. # >= MAX COL. #
         BGE      CMT40             YES - ERROR
         BAL,LNK  READRANDOM        READ FIRST RECORD
         BCS,8    CMT50             DOES IT EXIST (IF NO, ERROR)
*
*  TYPE SEQ. # AND READ IN COMMENTARY
*
CMT10    BAL,LNK  TYPESEQ           TYPE: 'DDDD.DDD'
         GEN4     BL,EOM,0,0
         BAL,LNK  READTELETYPE2     READ COMMENTARY
         AI,R1    -1                SET R1=# OF CHARS READ, LESS C/R
         BEZ      *R:LNK            IF ONLY  C/R READ - EXIT
         LI,X1    0
         LW,X2    T1
         LI,T2    ' '
*
*  MOVE COMMENTARY INTO SPECIFIED COLUMN OF CARD
*
CMT15    LB,D0    TTYIMG,X1         MOVE COMMENTARY INTO SPECIFIED
         STB,D0   CARDIMG,X2         COLUMN
         AI,X1    1
         AI,X2    1
         BDR,R1   %+2               TEST IF ANY MORE CHARS LEFT TO MOVE
         B        CMT20             NO - GO FINISH UP
         CI,X2    MAXCLMN           YES - TEST IF ANY ROOM LEFT ON CARD
         BL       CMT15             YES - LOOP
         CB,T2    TTYIMG,X1         NO - TEST IF REMAINING CHARS ARE ALL
         BNE      CMT70              BLANKS (IF NOT, ERROR)
         AI,X1    1
         BDR,R1   %-3               LOOP
*
*  BLANK OUT REST OF CARD AFTER NEW COMMENTARY
*
CMT20    CI,X2    MAXCLMN           BLANK OUT REST OF CARD
         BGE      CMT30
         STB,T2   CARDIMG,X2
         AI,X2    1
         B        CMT20
*
*  WRITE NEW RECORD AND THEN GET NEXT RECORD TO PROCESS
*
CMT30    BAL,LNK  SETEOD
         BAL,LNK  WRITERANDOM
         BAL,LNK  READSEQUEN        READ NEXT RECORD
         CW,R1    L(EOF)            WAS IT AN EOF
         BE       CMT60             YES - ERROR
         LW,P1    R1                SET P1=SEQ # OF RECORD
         B        CMT10             GO GET MORE COMMENTARY
*
*  ERROR: SPECIFIED COLUMN NUMBER > MAX COLUMN NUMBER
*
CMT40    BAL,LNK  TYPEMSG           TYPE: '-P2:COL>72'
         DATA     ERRP14
         B        MASTERPARSER      EXIT TO PARSER
*
*  ERROR: INITIAL SEQ. # DOESN'T EXIST
*
CMT50    BAL,LNK  TYPEMSG           TYPE: '-P1:NO SUCH REC'
         DATA     ERRP1
         B        MASTERPARSER      EXIT TO PARSER
*
*  ERROR: EOF HIT
*
CMT60    BAL,LNK  TYPEMSG           TYPE: '--EOF HIT'
         DATA     ERRM1
         B        MASTERPARSER      EXIT TO PARSER
*
*  ERROR: COMMENTARY OVERFLOWS CARD
*
CMT70    BAL,LNK  TYPEMSG           TYPE: '--OVERFLOW'
         DATA     ERRM3
         B        CMT30             GO CONTINUE WITH NEXT RECORD
         PAGE
****************************
*  RECORD COMMAND: DELETE  *
****************************
*
*
R:DELETE EQU      %
         LI,X1    5
         LB,X2    *CDTADR,X1        GET ADDR OF FIRST SEQ # IN CDT
         LW,P1    *CDTADR,X2        SET P1=FIRST SEQ #
         AI,X2    1                     P2=LAST SEQ #
         LW,P2    *CDTADR,X2
         DO1      MODE=2
         MTW,1    TABXFLAG
         BAL,LNK  DELETE            DELETE ALL BETWEEN THESE SEQ #'S
         B        *R:LNK            EXIT
         PAGE
********************************************
*  RECORD COMMANDS: FIND AND DELETE(TYPE)  *
********************************************
*
*
R:FIND%SEQUENCE   EQU %
         LI,X4    2                 USE X4=2 FOR 'FS'.
         B        R:FIND%TYPE+1
*
*
R:FIND%DELETE     EQU %
         LI,X4    0                 USE X4=0 FOR 'FD'
         B        R:FIND%TYPE+1
*
*
R:FIND%TYPE       EQU %
         LI,X4    1                 USE X4=1 FOR 'FT'
         LI,P3    0                 USE P3 TO COUNT # OF MATCHES FOUND
         LI,X1    5
         LB,X2    *CDTADR,X1
         LW,P1    *CDTADR,X2        SET P1=FIRST SEQ # IN CDT
         STW,P1   FIRSTSET              FIRSTSET=1ST SEQ # IN CDT
         STW,T1   FIRSTSET          SET FIRSTSET=1ST SEQ # IN CDT
         AI,X2    1                     LASTSET=2ND SEQ # IN CDT
         LW,T1    *CDTADR,X2
         STW,T1   LASTSET
         LI,X1    7
         LB,P2    *CDTADR,X1        SET P2=ABSOLUTE ADDR OF STRING TO
         AW,P2    CDTADR             MATCH
         LI,X1    8
         BAL,LNK  PROCESSCOL#PAIR   PROCESS COL # PARAMS
         BAL,LNK  READNXTRANDOM     READ FIRST SEQ # OR NEXT HIGHEST
*
*  READ EACH RECORD AND SEE IF IT CONTAINS THE SPECIFIED STRING
*
FND20    CW,R1    L(EOF)            WAS IT AN EOF
         BE       FND70             YES - ERROR
         CW,R1    LASTSET           WAS INPUT SEQ # > LAST SEQ #
         BG       FND50             YES - FINISH UP
         STW,R1   FIRSTSET          NO - SAVE NEW SEQ #
         LW,P1    FRSTCLMN          CHECK IF REC CONTAINS STRING
FNDTYP   BAL,LNK   FINDMATCH        STARTING AT SPECIFIED COL. #
         BCS,8    FND40
         AI,P3    1                 YES - INCR MATCH COUNT
         EXU      FNDTBL1,X4        GO PERFORM APPRO ACTION
*
*  'FD' USED: DELETE RECORD
*
FND30    BAL,LNK  DELETERECORD      DELETE RECORD
         B        FND40             GO ON TO NEXT RECORD
*
*  'FT' USED: TYPE SEQ #, AND RECORD
*
FND32    LW,P1    FIRSTSET
         BAL,LNK  SETEOD
         BAL,LNK  TYPECARD
         B        FND40
*
*  'FS' USED: TYPE SEQ #
*
FND35    LW,P1    FIRSTSET          GET SEQ #
         BAL,LNK  TYPESEQ           TYPE: 'DDDD.DDD'
         GEN4     0,0,0,0
*
*  TEST IF LAST RECORD HIT: IF YES, GO FINISH UP
*
FND40    LW,R1    FIRSTSET          TEST IF LAST SEQ # = SEQ # TO STOP
         DO1      MODE=2
         STW,R1   INTFLAG1
         CW,R1    LASTSET            AT
         BE       FND50
         BAL,LNK  READSEQUEN        NO - READ NEXT RECORD
         B        FND20             LOOP
*
*  SEQ. # TO STOP AT HIT OR PASSED: FINISH UP
*
FND50    EXU      FNDTBL2,X4        GO FINISH UP
*
*  'FD' USED: TYPE '--NNN RECS DLTED'
*
FND60    LW,D1    P3
         BEZ      FND65A            WERE ANY MATCHES FOUND
         LW,P1     P3               GET RECORD COUNT IN P1
         LI,P2     BA(MSG6)+1       GET BYTE ADR. OF PLACE TO PUT CNT.
         BAL,LNK   BINTODEC         GO PUT THE NUMBER THER
         BAL,LNK   TYPEMSG
         DATA      MSG6
         B        *R:LNK            EXIT
*
*  'FT' USED: TYPE '--NONE' IF NO MATCHES FOUND
*
FND65    CI,P3    0                 WERE ANY MATCHES FOUND
         BNE      *R:LNK            YES - EXIT
FND65A   BAL,LNK  TYPEMSG           NO - TYPE: '--NONE'
         DATA     ERRM6
         B        *R:LNK            EXIT
*
*  ERROR: EOF HIT
*
FND70    BAL,LNK  TYPEMSG           TYPE: '--EOF HIT'
         DATA     ERRM1
         B        FND50             GO FINISH UP
*
*
FNDTBL1  EQU      %
         B        FND30
         B        FND32
         B        FND35
*
*
FNDTBL2  EQU      %
         B        FND60
         B        FND65
         B        FND65
         PAGE
*******************************************************
*  RECORD COMMANDS: INSERT(SUPPRESSING SEQ. NUMBERS)  *
*******************************************************
*
*
R:INSERT%SUP%SEQ  EQU %
         LI,X4    2                 USE X4=2 FOR 'IS'
         DO       MODE=2
         CAL1,1   PROMPT2%FPT
         B        R:INSERT+2
         ELSE
         B        R:INSERT+1
         FIN
*
*
R:INSERT EQU      %
         DO1      MODE=2
         CAL1,1   NOPROMPT%FPT
         LI,X4    0                 USE X4=0 FOR 'IN'
         LI,X1    5
         LB,X2    *CDTADR,X1        SET P1=STARTING SEQ #
         LW,P1    *CDTADR,X2
         LW,T1    DFLTINCR          SET T1=LAST INCR USED
         DO1      MODE=2
         MTW,1    TABXFLAG
         LI,X1    6
         LB,R1    *CDTADR,X1        GET PARAM2 TYPE
         BEZ      INS10             TEST IF PARAM2 PRESENT
         AI,X1    1
         LB,X2    *CDTADR,X1        YES - SET T1=INCR FROM CDT
         LW,T1    *CDTADR,X2
         STW,T1   DFLTINCR          SET NEW DEFAULT INCR
*
*  GET SEQ. # AT WHICH TO STOP INSERTING
*
INS10    BAL,LNK  READNXTRANDOM     READ 1ST SEQ # OR NEXT HIGHEST
         BCS,8    %+2               WAS NEXT HIGHEST READ
         BAL,LNK  READSEQUEN        NO - SO READ NEXT HIGHEST
         LW,T2    R1                SET T2=SEQ # AT WHICH TO STOP INSERT
*
*  TYPE NEXT SEQ. # AND READ INPUT LINE
*
INS20    B        %+1,X4            TYPE 'DDDD.DDD' AS REQD
         BAL,LNK  TYPESEQ
         GEN4     BL,EOM,0,0
         DO       MODE=2
         EXU      INS50,X4
         FIN
         BAL,LNK  READTELETYPE      READ INSERT
         CI,R1    1
         BE       INS40
          LW,X2     R1           GET BYTE CNT.. INTO INDEX REG.
         AI,X2     -1               MAKE X2 A BINARY COUNT
         LB,D1     CARDIMG,X2       GET LAST BYTE INPUT
         LI,X1     GNTBL1SZ         GET THE COUNT OF DIFFERENT TYPE
*                                   OF LINE TERMINATORS.
         CB,D1     GNTBL1,X1        FIND A CARRAGE RETURN
         BE        %+3
         BDR,X1    %-2
         B         %+4
         LI,D1     ' '              BLANK OUT C/R
         STB,D1    CARDIMG,X2
         MTW,-1    R1               IF CR DECREMENT CHAR. COUNT.
         STW,R1   RECSIZE
         CI,R1    MAXCLMN
         BLE      INS35
         BAL,LNK  TYPEMSG           NO - TYPE: '--OVERFLOW'
         DATA     ERRM3
*
*  WRITE INPUT IMAGE, INCREMENT SEQ. #, AND CHECK AGAINST # TO STOP AT
*
INS35    BAL,LNK  SETEOD
         BAL,LNK  WRITERANDOM       WRITE CARD IMAGE
         AW,P1    T1                INCR SEQ #
         CW,P1    T2
         BL       INS20             IS NEW SEQ # > SEQ # TO STOP AT
         CW,P1    MAXSEQ            IS SEQ. NO. TOO BIG
         BLE      INS38             NO.
         BAL,LNK  TYPEMSG           YES.
         DATA     ERRM20
INS38    BAL,LNK  TYPEMSG           RING BELL TWICE
         DATA     INSMSG
INS40    DO1      MODE=2
         B        *R:LNK            RETURN
INS50    LI,D1    9
         NOP      0                 X4 IS NEVER ONE
         LI,D1    1                 OFFSET FOR PROMPT ONLY
*
*
INSMSG   TEXTC    '   '             X'07'+X'07'+EOM
         PAGE
********************************************
*  RECORD COMMANDS: MOVE AND DELETE(KEEP)  *
********************************************
*
*
R:MOVE%DELETE     EQU %
         LI,X4    0                 USE X4=0 TO SIGNAL MD
         B        R:MOVE%KEEP+1
*
*
R:MOVE%KEEP       EQU %
         LI,X4    1                 USE X4=1 TO SIGNAL MK
*
*  GET 'FROM' SEQ. # PAIR IN T1-2, 'TO' SEQ # PAIR IN P1-2, AND
*  INCREMENT IN P3
*
         LI,X1     0
         STW,X1    MVD:REC:CNT      ZERO OUT MOVED REC. COUNT.
MVE10    LI,X1    5
         LB,X2    *CDTADR,X1        GET ADDR OF 1ST 'FROM' SEQ # IN CDT
         LW,T1    *CDTADR,X2        SET P1=FIRST 'FROM' SEQ #
         AI,X2    1                     P2=LAST 'FROM' SEQ #
         LW,T2    *CDTADR,X2
         LI,X1    7
         LB,X2    *CDTADR,X1        GET ADDR OF 1ST 'TO' SEQ # IN CDT
         LW,P1    *CDTADR,X2        SET P1=FIRST 'TO' SEQ #
         AI,X2    1                     P2=LAST 'TO' SEQ #
         LW,P2    *CDTADR,X2
         LW,P3    DFLTINCR          SET P3=LAST INCR USED
         LI,X1    8
         LB,R1    *CDTADR,X1        GET PARAM3 TYPE
         BEZ      MVE20             TEST IF PARAM3 PRESENT
         AI,X1    1
         LB,X2    *CDTADR,X1        YES - SET P3=INCR FROM CDT
         LW,P3    *CDTADR,X2
         STW,P3   DFLTINCR          SET NEW DEFAULT INCR
*
*  CHECK FOR OVERLAPPING SEQ #'S AND SET UP MOVE
*
MVE20    LW,D0    T1                PUT 'FROM' SEQ #'S IN DW
         LW,D1    T2
         CLM,P1   D0                MAKE SURE 'TO' AND 'FROM' RANGES
         BIL      MVE50              ARE MUTUALLY EXCLUSIVE
         CLM,P2   D0
         BIL      MVE50
         LW,D0     P1
         LW,D1     P2
       CLM,T1    D0
       BIL       MVE50
       CLM,T2    D0
       BIL       MVE50
         XW,T1    P1                EXCHANGE FIRST 'FROM' AND 'TO'
       BAL,LNK    READNXTRANDOM     CHECK 'FROM' RANGE
         XW,T1    P1               RESTORE
         CW,R1    L(EOF)       M    IF RECORD READ WAS AN EOF,
         BE       MVE58
         CW,R1    T2                OR SEQUENCE GREATER THAN SECOND
         BG       MVE58             'FROM', NOTHING TO MOVE
         BAL,LNK  DELETE            DELETE 'TO' RECORDS
         BCS,8    %+2               WAS LAST 'TO' SEQ # HIT BY DELETE
         BAL,LNK  READSEQUEN        YES - READ NEXT RECORD
         LW,X3    R1                SET X3=SEQ # AT WHICH TO STOP MOVE
         XW,P1    T1
         BAL,LNK  READNXTRANDOM     READ 1ST 'FROM' REC OR NEXT HIGHEST
         LW,P1    T1                SET P1=NEW 'TO' SEQ # - INCR
         SW,P1    P3
*
*  READ EACH 'FROM' RECORD AND WRITE UNDER 'TO' SEQ #
*
MVE30    CW,R1    L(EOF)            WAS AN EOF READ
         BE       MVE53             YES - GO TYPE ERROR MESSAGE
         CW,T2    R1                WAS 'FROM' SEQ # >= LAST 'FROM' SEQ
         BLE      MVE35             YES - GO FINISH UP
         AW,P1    P3                INCR 'TO' SEQ #
         CW,P1    X3                IS NEW 'TO' SEQ # > SEQ # TO STOP AT
         BGE      MVE56             YES - GO TYPE ERROR MESSAGE
         STW,R1   LASTFROM
         B        %+1,X4            DELETE 'FROM' RECORD AS REQD
         BAL,LNK  DELETERECORD
         MTW,1     MVD:REC:CNT      INCERMENT REC. COUT
         BAL,LNK  WRITERANDOM       WRITE RECORD WITH NEW 'TO' SEQ #
         DO       MODE=2
         STW,R1   INTFLAG1
         STW,P1   INTFLAG2
         FIN
         XW,P1    LASTFROM          MUST REREAD LAST 'FROM' RECORD TO
         BAL,LNK  READRANDOM         GET DCB BACK IN SEQ
         XW,P1    LASTFROM          RESTORE P1 AND LASTFROM
         BAL,LNK  READSEQUEN        READ NEXT 'FROM' RECORD
         B        MVE30             LOOP
*
*  LAST 'FROM' SEQ # HIT OR PASSED: FINISH UP
*
MVE35    BL       MVE40             WAS LAST 'FROM' SEQ # PASSED
         AW,P1    P3                NO, WAS HIT - INCR 'TO' SEQ #
         CW,P1    X3                IS NEW 'TO' SEQ # > SEQ # TO STOP AT
         BGE      MVE56             YES - GO TYPE ERROR MESSAGE
         B        %+1,X4            DELETE 'FROM' REC AS REQD
         BAL,LNK  DELETERECORD
         MTW,1     MVD:REC:CNT      INCERMENT RECORD COUNT.
         BAL,LNK  WRITERANDOM       WRITE REC WITH NEW 'TO' SEQ #
*
*  TYPE OUT LAST 'TO' SEQ # AND EXIT
*
MVE40    LI,P2    BA(MVEMSG1)+11    BUILD MSG: '--DONE AT DD.D' + NL
         BAL,LNK  MOVESEQ            FROM LAST 'TO' SEQ #
         GEN4     0,0,0,0
         AI,R1    10                ADJ CNT OF TEXTC-STRING
         STB,R1   MVEMSG1
         BAL,LNK  TYPEMSG           TYPE MSG
         DATA     MVEMSG1
         LI,P2     BA(MSG7)+1
         LW,P1     MVD:REC:CNT      GET THE NUMBER OF REC.S MOVED
         BAL,LNK   BINTODEC         CONVERT IT, STUFF IT AWAY
         BAL,LNK   TYPEMSG          AND PRINT IT OUT.
         DATA      MSG7
         B        *R:LNK            EXIT
*
*  ERROR: SEQ #'S OVERLAP
*
MVE50    BAL,LNK  TYPEMSG           TYPE; '-RNG OVERLAP'
         DATA     ERRM4
         B        *R:LNK            EXIT
*
*  ERROR: EOF HIT
*
MVE53    BAL,LNK  TYPEMSG           TYPE: '--EOF HIT'
         DATA     ERRM1
         B        MVE40             GO EXIT
*
*  ERROR: 'TO' SEQ # HIT NEXT UNDELETED RECORD
*
MVE56    SW,P1    P3                ADJ P1 TO LAST 'TO' SEQ #
         LI,P2    BA(MVEMSG2)+13    BUILD MSG: '--CUTOFF AT DDD.D ('
         BAL,LNK  MOVESEQ            WITH LAST 'TO' SEQ #
         GEN4     BL,LP,0,0
         AW,P2    R1                INCR MSG BYTE ADDR
         AI,R1    12                CALC AND SAVE MSG LENGTH
         LW,T1    R1
         LW,P1    LASTFROM          BUILD: 'DD.DD)' + NL  FROM LAST
         BAL,LNK  MOVESEQ            'FROM' SEQ #
         GEN4     RP,0,0,0
         AW,T1    R1                ADJ CNT OF TEXTC-STRING
         STB,T1   MVEMSG2
         BAL,LNK  TYPEMSG           TYPE: '--CUTOFF AT DDD.D (DD.DD)' +
         DATA     MVEMSG2            NL
         B        *R:LNK            EXIT
*
MVE58    BAL,LNK  TYPEMSG
         DATA     ERRM16
         B        *R:LNK
         PAGE
******************************
*  RECORD COMMAND: RENUMBER  *
******************************
*
*
R:RENUMBER        EQU %
         LI,X1    5
         LB,X2    *CDTADR,X1        SET P1=OLD SEQ #
         LW,P1    *CDTADR,X2
         LI,X1    7
         LB,X2    *CDTADR,X1        SET T1=NEW SEQ #
         LW,T1    *CDTADR,X2
         BAL,LNK  READRANDOM        READ OLD RECORD
         BCS,8    RNM10             DID IT EXIST
         LW,P1    T1                YES - SET P1=NEW SEQ #
         BAL,LNK  WRITENEWRANDOM    WRITE RECORD UNDER NEW SEQ #
         BCS,8    RNM13             DID THIS SEQ # ALREADY EXIST
         BAL,LNK  DELETERECORD      NO - DELETE OLD RECORD
         B        *R:LNK            EXIT
*
*  ERROR: OLD RECORD DOESN'T EXIST
*
RNM10    BAL,LNK  TYPEMSG           TYPE: '-P1:NO SUCH REC'
         DATA     ERRP1
         B        *R:LNK            EXIT
*
*  ERROR: NEW RECORD ALREADY EXISTS
*
RNM13    BAL,LNK  TYPEMSG           TYPE: '-P2:REC EXISTS'
         DATA     ERRP2
         B        *R:LNK            EXIT
         PAGE
**********************************************
*  RECORD COMMANDS: SET AND STEP (AND TYPE)  *
**********************************************
*
*
R:SET%STEP        EQU %
         LI,X1    1                 USE STEPFLAG=1 FOR 'SS'
         B        R:SET%STEP%TYPE+1
*
*
R:SET%STEP%TYPE   EQU %
         LI,X1    -1                USE STEPFLAG=-1 FOR 'ST'
         STW,X1   STEPFLAG          TURN ON 'SET AND STEP MODE' FLAGS
         STW,X1   SETFLAG
         LI,X1    5                 GET STARTING SEQ # FROM CDT
         LB,X2    *CDTADR,X1
         LW,P1    *CDTADR,X2
         LI,X1    6
         BAL,LNK  PROCESSCOL#PAIR   PROCESS COL # PARAMS
         BAL,LNK   READNXTRANDOM
         STW,R1    P1               PUT FIRST REC. NO. IN P1.
         STW,R1    FIRSTSET         NO , SO USE THE FIRST RECORD
         B         FINISH%STEP%LOOP NUMBER FOUND THAT IS HIGHER
*                                   THAN THE INPUT RECORD NO.
*
*  NULL COMMAND OR ERROR: TURN OFF 'SET MODE' AND 'STEP MODE' FLAGS
*
STP10    LI,T1    0                 TURN OFF MODE FLAGS
         STW,T1   SETFLAG
         STW,T1   STEPFLAG
         B        MASTERPARSER      EXIT TO PARSER
*
*
*
STEP%LOOP         EQU %             (EXC ENTERS HERE AT 'END OF CDT')
         MTW,-1   NOCHGFLG          WAS INPUT A 'NO' COMMAND
         BEZ      SPL10             YES - SKIP WRITE
         LW,P1    FIRSTSET          WRITE CURRENT RECORD
         BAL,LNK  WRITERANDOM
         MTW,0    TTYIMGSZ          WAS INPUT A NULL COMMAND
         BEZ      STP10             YES - GO EXIT
*
*  READ NEXT INPUT RECORD AND TYPE AS REQUIRED
*
SPL10    BAL,LNK  READSEQUEN        READ NEXT RECORD
         CW,R1    L(EOF)            WAS IT AN EOF
         BE       SPL20             YES - ERROR
         STW,R1   FIRSTSET          NO - SAVE NEW SEQ #
         LW,P1    FIRSTSET
*
*
*
FINISH%STEP%LOOP  EQU %             ('JU' ENTERS HERE TO FINISH)
         BAL,LNK  SETEOD            SET EOD MARKER
         MTW,0    STEPFLAG
         BGZ      SPL15             WAS 'ST' CMND USED
         BAL,LNK  TYPECARD          YES - TYPE CARD IMAGE
         B        MASTERPARSER      EXIT TO PARSER
*
*  'SS' COMMAND USED: JUST TYPE SEQ #
*
SPL15    BAL,LNK  TYPESEQ           TYPE: 'DDDD.DDD:'
         GEN4     EOM,0,0,0
         B        MASTERPARSER      EXIT TO PARSER
*
*  ERROR: EOF HIT
*
SPL20    BAL,LNK  TYPEMSG           TYPE: '--EOF HIT'
         DATA     ERRM1
         B        STP10             GO EXIT
         PAGE
*****************************************************
*  RECORD COMMANDS: TYPE(SUPPRESSING SEQ. NUMBERS)  *
*****************************************************
*
R:TYPE%COMPRESSED EQU %
*
R:TYPE   EQU      %
         LI,X4    1                 USE X4=1 FOR 'TY'
         B        R:TYPE%SUP%SEQ+1
*
*
R:TYPE%SUP%SEQ    EQU %
         LI,X4    0                 USE X4=0 FOR 'TS'
         LI,X1     1
         STW,X1    SETFLAG          SET THE SETFLAG TO ONE
*                                   THE RANGE FROM TY IS USED FOR
*                                   AN SE COMMAND.
         LI,R2    0                 START COUNT OF RECORDS OUTPUT.
         LI,X1    5
         LB,X2    *CDTADR,X1        GET ADDR OF FIRST SEQ % IN CDT
         LW,P1    *CDTADR,X2        SET P1=FIRST SEQ #
         AI,X2    1                     P2=LAST SEQ #
         LW,P2    *CDTADR,X2
         STW,P2    LASTSET          SAVE ENDING SEQ #
         AI,X1    1                 SET UP COL. NUMBERS
         BAL,LNK  PROCESSCOL#PAIR
         DO       MODE=2
         LW,X1    FRSTCLMN          MUST EXPAND TABS, IF
         BNEZ     TYP5
         LW,X1    LASTCLMN          COL. NO. SPECIFIED, OR
         CI,X1    MAXCLMN
         BL       TYP5
         LI,X1    1
         LB,X1    *CDTADR,X1
         CI,X1    R:TY%CMND%NMR     'TC'
         BG       TYP5
         MTW,1    TABXFLAG
         B        %+1,X4
         B        TYP5
         LI,D1    9                 OFFSET FOR SEQ
TYP5     RES      0
         FIN
         BAL,LNK  READNXTRANDOM     READ FIRST SEQ # OR NEXT HIGHEST
         STW,R1    SV1STSET         SET UP FIRST RECORD NO.
         STW,R1    FIRSTSET         AS IF A SET COMMAND WERE GIVIN.
*
*  READ AND TYPE UNTIL LAST SEQ # READ OR PASSED
*
TYP10    CW,R1    L(EOF)            WAS IT AN EOF
         BE       TYP20             YES - GO TYPE ERROR MESSAGE
         CW,P2    R1                WAS INPUT SEQ # >= LAST SEQ #
         BLE      TYP15             YES - FINISH UP
         LW,P1    R1
         B        %+1,X4            SET TO TYPE SEQ # AS REQD
         LI,P1    -1
         BAL,LNK  TYP40
         BAL,LNK  SETEOD            SET EOD MARKER
         BAL,LNK  TYPECARD          TYPE CARD IMAGE WITH INPUT SEQ #
         AI,R2    1
         BAL,LNK  READSEQUEN        READ NEXT RECORD
         B        TYP10             LOOP
*
*  LAST SEQ # HIT OR PASSED: FINISH UP
*
TYP15    BL       TYP17             WAS LAST SEQ # PASSED
         LW,P1    R1                NO, WAS HIT - PREPARE TO TYPE CARD
         B        %+1,X4            SET TO TYPE SEQ # AS REQD
         LI,P1    -1
         BAL,LNK  TYP40
         BAL,LNK  SETEOD            SET EOD MARKER
         BAL,LNK  TYPECARD          TYPE CARD IMAGE
         AI,R2    1
TYP17    AI,R2    0                 CHECK OUTPUT COUNT
         BLEZ     TYP25
         B        TYP90
*
*  ERROR: EOF HIT
*
TYP20    BAL,LNK  TYPEMSG           TYPE: '--EOF HIT'
         DATA     ERRM1
         B        TYP90
*
TYP25    BAL,LNK  TYPEMSG           TYPE: '--NONE'
         DATA     ERRM6
         B        TYP90
*
*
TYP40    LW,X1    FRSTCLMN          ADJUST THE IMAGE FOR COLUMN BOUNDS
         BEZ      TYP50             OR COMPRESSION.
         LI,X2    0                 MOVE (FIRSTCLMN,LASTCLMN-1), DOWN TO
TYP42    LB,R0    CARDIMG,X1        ZERO.
         STB,R0   CARDIMG,X2
         AI,X2    1                 INCREMENT DEST. COL. #
         AI,X1    1                 INCREMENT TO NEXT BYTE.
         CW,X1    LASTCLMN          CHECK IF DONE.
         BGE      TYP45             YES
         B        TYP42
TYP45    STW,X2   X1
         B        %+2               SET FINISH COULUMN FOR NEXT ROUTINE
TYP50    LW,X1    LASTCLMN          IF LESS THAN FULL IMAGE DESIRED,
         STW,X1   D0                SAVE TERMINAL POSITION FOR COMPRESS
         CI,X1    MAXCLMN
         BGE      TYP60
         LI,X2    ' '               BLANK OUT REGION
TYP55    STB,X2   CARDIMG,X1        (LASTCLMN,MAXCLMN-1)
         AI,X1    1
         CI,X1    MAXCLMN-1
         BLE      TYP55
*
TYP60    LI,X1    1                 FINALLY CHECK FOR COMPRESSION .
         LB,X2    *CDTADR,X1
         CI,X2    R:TY%CMND%NMR
         BG       TYP70             YES.  OTHERWISE,
*
TYP65    B        0,LNK             EXIT
*
*
TYP70    LI,X1    0                 IN RANGE (0,LASTCLMN) COMPRESS
         LI,R0    ' '               BLANK STRINGS TO LENGTH ONE.
         LI,X2    0
TYP72    CB,R0    CARDIMG,X2        CHECK FOR BLANK IN CURRENT POSITION-
         BE       TYP80             IF NOT,
TYP75    LB,D1    CARDIMG,X2        MOVE NON-BLANK STRING DOWN.
         STB,R0   CARDIMG,X2        BLANKING VACATED POSITIONS.
         STB,D1   CARDIMG,X1
         AI,X1    1                 INCREMENT TO AND
         AI,X2    1                 FROM BYTE POINTERS.
         CW,X2    D0                IF AT UPPRR LIMIT-
         BL       TYP72
         B        0,LNK             THEN RETURN
*
*
TYP80    AI,X1    1                 INCREMENT 'TO' POINTER TO LEAVE THIS
TYP82    AI,X2    1                 BLANK.  SKIP TO NON-BLANK.
         CW,X2    D0
         BGE      0,LNK
         CB,R0    CARDIMG,X2
         BE       TYP82
         B        TYP75             MOVE NEXT STRING DOWN.
TYP90    DO1      MODE=2
         B        *R:LNK
         PAGE
****************************
*  INTRALINE COMMAND: SET  *
****************************
*
*
I:SET    EQU      %
         LI,T1    1                 TURN 'SET MODE' FLAG ON
         STW,T1   SETFLAG
         LI,X1    5
         LB,X2    *CDTADR,X1        GET ADDR OF FIRST SEQ # IN CDT
         LW,P1    *CDTADR,X2        SET P1=FIRST SEQ #
         AI,X2    1                     P2=LAST SEQ #
         LW,P2    *CDTADR,X2
         STW,P2   LASTSET
         LI,X1    6
         BAL,LNK  PROCESSCOL#PAIR   PROCESS COL # PARAMS
         LW,X1    CDTADR            CALC X1=ADDR IN CDT OF NEXT COMMAND
         LB,R1    *CDTADR            AFTER 'SE'
         AW,X1    R1
         STW,X1   SETADR            PUT THIS IN SETADR FOR I:CMND LOOP
         BAL,LNK   READNXTRANDOM READ FIRST RECORD IN RANGE.
         STW,R1    SV1STSET         SET FIRST SEQ NO.
         STW,R1    FIRSTSET         SET LOOP CONTROL
         STW,R1    P1
         CW,R1     LASTSET          MAKE SURE THAT THE FIRST RECORD IS
         BLE       SET10            IN TH P1-P2 RANGE.
         BAL,LNK  TYPEMSG           NO - TYPE: '-P1:NO SUCH REC'
         DATA      ERRM6            'NONE'
         LI,T1    0                 TURN OFF 'SET MODE' FLAG
         STW,T1   SETFLAG
         B        MASTERPARSER      EXIT TO PARSER
*
*  SET EOD MARKER AND EXIT
*
SET10    BAL,LNK  SETEOD            SET EOD MARKER
         B        *I:LNK            EXIT
*
*
*
SET%LOOP EQU      %                 (EXC ENTERS HERE AT 'END OF CDT')
         MTW,0    SETFLAG           HAS ANY INTRALINE CMND BUT 'SE'
         BGZ      MASTERPARSER       BEEN EXECUTED
         LW,P1    FIRSTSET          YES - HAS LAST RECORD IN RANGE OF
         CW,P1    LASTSET            I:SET BEEN PROCESSED
         BNE      STL10             NO - GO PROCESS MORE
         BAL,LNK  WRITERANDOM       YES - WRITE LAST RECORD
         DO1      MODE=2
         STW,P1   INTFLAG1
*
*  AT END OF SET LOOP: MARK SETFLAG SO LOOP WILL BE RESTARTED IF
*  ANOTHER I:CMND IS GIVEN
*
STL5     LI,T1    1                 MARK SETFLAG TO RESTART RANGE ON
         LW,P1     CHG:STG:CNT      GET THE NO. OF STRINGS CHANGED
         CI,P1     1                CHECK FOR ONLY 1 HIT.
         BE        STL30            GO MAKE FURTHER CHECKS.
         LI,P2     BA(MSG8)+1
         BAL,LNK   BINTODEC
         BAL,LNK   TYPEMSG
         DATA      MSG8
STL30    EQU       %
         LI,P1     0                CLEAR THE CHANGED STRING COUNT
         STW,P1    CHG:STG:CNT
         STW,T1   SETFLAG            NEXT I:CMND
         B        MASTERPARSER      EXIT TO PARSER
*
*  MORE RECORDS ARE LEFT IN RANGE OF LAST I:SET TO BE PROCESSED
*
STL10    BAL,LNK  WRITERANDOM       WRITE CURRENT RECORD
         DO1      MODE=2
         STW,P1   INTFLAG1
         BAL,LNK  READSEQUEN        READ NEXT RECORD
         CW,R1    L(EOF)            WAS IT AN EOF
         BE       STL20             YES - ERROR
         CW,R1    LASTSET           IS INPUT SEQ # > SEQ # TO STOP AT
         BG       STL5              YES - GO EXIT
         STW,R1   FIRSTSET          NO - SAVE NEW SEQ #
         LI,T1    -2                SUPPRESS CERRS FOR  LOOPS
         STW,T1   ERRORCNT          TWO AND FF.
         LW,T1    SETADR            SET CDTADR BACK TO BEGINNING OF LOOP
         STW,T1   CDTADR
         BAL,LNK  SETEOD            SET EOD MARKER
         LW,T1    SVBPFLAG           REATORE LAST DFLT VALUE
         STW,T1   BPFLAG            OF BPFLAG FOR NEXT ITRATION
         B        RESTART%EXECUTIVE GO RESTART I:CMND LOOP
*
*  ERROR: EOF HIT
*
STL20    BAL,LNK  TYPEMSG           TYPE: '--EOF HIT'
         DATA     ERRM1
         B        STL5              GO EXIT
         PAGE
***********************************
*  INTRALINE COMMAND: 'DELETE' X  *
***********************************
*
*
I:DELETE EQU      %
* IT IS AN ERROR TO HAVE STRING SUB 1 ALL BLANKS.
*
*
         MTW,0     ALLFLAG          SEE IF ALL FLAG IS SET.
         BLZ       I:DELETE01
         LB,X1     *TEXTCADR        GET THE CHARACTER COUNT.
I:DELETE02 LB,P2   *TEXTCADR,X1     SERACH THE STRING FOR ANY
         CI,P2     X'40'            NON BLANK CHARACTER.
         BNE       I:DELETE01       CONTINUE
         BDR,X1    I:DELETE02
         BAL,LNK   TYPEMSG          ALL BLANKS MESSAGE
         DATA      ERRM21
         B         MASTERPARSER
I:DELETE01    EQU  %
         BAL,LNK  FINDCOLUMN        FIND COLUMN CORRES TO FIRST PARAM
         BCS,8    *I:LNK            NONE FOUND - EXIT
         AW,P1    P2                SET P1=CHAR AFTER PARAM STRING
         LW,P3    P2                    P2=0 (FIELD WIDTH)
         LI,P2    0                     P3=# TO SHIFT (=LENGTH OF STRG)
         BAL,LNK  SHIFTLEFT         SHIFT LEFT TO DELETE STRING
         SW,P1    P3                IF ALLFLAG IS ON, SET TO RESUME
         BAL,LNK  ADJUSTALLFLAG      MATCHING AFTER X AS DELETED
         BAL,LNK  SETEOD            RESET EOD MARKER
         B        *I:LNK            EXIT
         PAGE
******************************************************
*  INTRALINE COMMAND: 'OVERWRITE AND EXTEND' X BY Y  *
******************************************************
*
*
I:OVERWR%EXTEND   EQU %
         STW,I:LNK ALLOK
         BAL,LNK  FINDCOLUMN        FIND COLUMN CORRES TO FIRST PARAM
         BCS,8    *I:LNK
         AI,X1    1
         LB,P2    *CDTADR,X1        GET ADDR OF 2ND STRING IN CDT
         AW,P2    CDTADR            SET P2=ABSOLUTE ADDR OF STRING
         BAL,LNK  MOVESTRING        OVERWRITE WITH NEW STRING
         LB,T1    *P2               SET P1=COL. AFTER LAST NEW CHAR
         AW,P1    T1
         LI,T1    ' '
*
*  BLANK OUT REST OF CARD IMAGE
*
OEX10    CW,P1    LASTCLMN          BLANK OUT BUFFER FROM CHAR AFTER
         BGE      OEX20              LAST NEW CHAR TO COL. TO STOP AT
         STB,T1   CARDIMG,P1
         AI,P1    1
         B        OEX10
*
*  SET EOD AND EXIT
*
OEX20    BAL,LNK  SETEOD            RESET EOD MARKER
         B        *I:LNK            EXIT
         PAGE
****************************************
*  INTRALINE COMMAND: 'FOLLOW' X BY Y  *
****************************************
*
*
I:FOLLOW%BY       EQU %
         BAL,LNK  FINDCOLUMN        FIND COLUMN CORRES TO FIRST PARAM
         BCS,8    *I:LNK            NONE FOUND - EXIT
         AW,P1    P2                SET P1=CHAR AFTER PARAM STRING
         LI,P2    0                     P2=0 (FIELD WIDTH)
         AI,X1    1
         LB,X2    *CDTADR,X1        GET ADDR OF 2ND STRING IN CDT
         AW,X2    CDTADR            SET X2=ABSOLUTE ADDR OF STRING
         LB,P3    *X2                   P3=LENGTH OF STRING
         BAL,LNK  SHIFTRIGHT        SHIFT RIGHT TO MAKE ROOM FOR 2ND
         LW,P2    X2                 STRING
         BAL,LNK  MOVESTRING        MOVE STRING INTO HOLE
         AW,P1    P3                IF ALLFLAG IS ON, SET TO RESUME
         BAL,LNK  ADJUSTALLFLAG      MATCHING AFTER Y AS ADDED
         BAL,LNK  SETEOD            RESET EOD MARKER
         B        *I:LNK            EXIT
         PAGE
********************************************
*  INTRALINE COMMAND: SHIFT X 'LEFT' BY N  *
********************************************
*
*
I:SHIFT%LEFT      EQU %
         STW,I:LNK ALLOK
         BAL,LNK  FINDCOLUMN        FIND COLUMN CORRES TO FIRST PARAM
         BCS,8    *I:LNK            NONE FOUND - EXIT
         AI,X1    1
         LB,X2    *CDTADR,X1        GET ADDR OF N IN CDT
         LW,P3    *CDTADR,X2        SET P3=NUMBER TO SHIFT (N)
         BEZ      *I:LNK            IF N=0 - EXIT
         BAL,LNK  SHIFTLEFT         SHIFT LEFT N SPACES
         BAL,LNK  SETEOD            RESET EOD MARKER
         B        *I:LNK            EXIT
         PAGE
*******************************************
*  INTRALINE COMMAND: 'OVERWRITE' X BY Y  *
*******************************************
*
*
I:OVERWRITE       EQU %
         BAL,LNK  FINDCOLUMN        FIND COLUMN CORRES TO FIRST PARAM
         BCS,8    *I:LNK            NONE FOUND - EXIT
         AI,X1    1
         LB,P2    *CDTADR,X1        GET ADR OF 2ND STRING IN CDT
         AW,P2    CDTADR            CALC P2=ABSOLUTE ADDR OF STRING
         BAL,LNK  MOVESTRING        OVERWRITE WITH NEW STRING
         LB,X1    *P2               IF ALLFLAG IS ON, SET TO RESUME
         AW,P1    X1                 MATCHING AFTER Y AS OVERWRITTEN
         BAL,LNK  ADJUSTALLFLAG
         BAL,LNK  SETEOD            RESET EOD MARKER
         B        *I:LNK            EXIT
         PAGE
*****************************************
*  INTRALINE COMMAND: 'PRECEDE' X BY Y  *
*****************************************
*
*
I:PRECEDE%BY      EQU %
         BAL,LNK  FINDCOLUMN        FIND COLUMN CORRES TO FIRST PARAM
         BCS,8    *I:LNK            NONE FOUND - EXIT
         AI,X1    1
         LB,X2    *CDTADR,X1        GET ADDR OF 2ND STRING IN CDT
         AW,X2    CDTADR            SET X2=ABSOLUTE ADDR OF STRING
         LB,P3    *X2                   P3=LENGTH OF STRING
         BAL,LNK  SHIFTRIGHT        SHIFT RIGHT TO MAKE ROOM FOR 2ND
         XW,P2    X2                 STRING
         BAL,LNK  MOVESTRING        MOVE STRING INTO HOLE
         AW,P1    X2                IF ALLFLAG IS ON, SET TO RESUME
         AW,P1    P3                 MATCHING AFTER X AS PRECEDED BY Y
         BAL,LNK  ADJUSTALLFLAG
         BAL,LNK  SETEOD            RESET EOD MARKER
         B        *I:LNK            EXIT
         PAGE
*********************************************
*  INTRALINE COMMAND: SHIFT X 'RIGHT' BY N  *
*********************************************
*
*
I:SHIFT%RIGHT     EQU %
         STW,I:LNK ALLOK
         BAL,LNK  FINDCOLUMN        FIND COLUMN CORRES TO FIRST PARAM
         BCS,8    *I:LNK            NONE - FOUND ERROR
         AI,X1    1
         LB,X2    *CDTADR,X1        GET ADDR OF N IN CDT
         LW,P3    *CDTADR,X2        SET P3=NUMBER TO SHIFT (N)
         BEZ      *I:LNK            IF N=0 - EXIT
         BAL,LNK  SHIFTRIGHT        SHIFT RIGHT N SPACES
         BAL,LNK  SETEOD            RESET EOD MARKER
         B        *I:LNK            EXIT
         PAGE
*********************************************
*  INTRALINE COMMAND: FOR X 'SUBSTITUTE' Y  *
*********************************************
*
*
I:SUBSTITUTE      EQU %
         BAL,LNK  FINDCOLUMN        FIND COLUMN CORRES TO FIRST PARAM
         BCS,8    *I:LNK            NONE FOUND - EXIT
         AI,X1    1
         LB,X2    *CDTADR,X1        GET ADDR OF 2ND STRING IN CDT
         AW,X2    CDTADR            SET X2=ABSOLUTE ADDR OF STRING
         LB,P3    *X2                   P3=LENGTH OF STRING
         LW,T1    P1                SAVE P1
         AW,P1    P2                SET P1=CHAR AFTER PARAM1 STRING
         SW,P3    P2                CALC NUMBER TO SHIFT IN P3
         BLEZ     SBS10             IS NEW STRING LONGER THAN OLD STRING
         LI,P2    0                 YES - SET P2=0 (FIELD WIDTH)
         BAL,LNK  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,P2    0                 SET P2=0 (FIELD WIDTH)
         BAL,LNK  SHIFTLEFT         SHIFT LEFT AMOUNT OF DIFFERENCE
*
*  MOVE NEW STRING INTO POSITION
*
SBS15    LW,P1    T1                SET P1=COL. OF PARAM1 STRING
         LW,P2    X2                    P2=ADDR OF NEW STRING
         BAL,LNK  MOVESTRING        MOVE NEW STRING IN PLACE
         LB,T1    *P2               IF ALLFLAG IS ON, SET TO RESUME
         AW,P1    T1                 MATCHING AFTER Y AS SUBSTITUTED
         BAL,LNK  ADJUSTALLFLAG
         BAL,LNK  SETEOD            RESET EOD MARKER
         B        *I:LNK            EXIT
         PAGE
*****************************
*  INTRALINE COMMAND: JUMP  *
*****************************
*
*
I:JUMP   EQU      %
         MTW,0    STEPFLAG          IS SYSTEM IN 'STEP MODE'
         BEZ      JMP10             NO - ERROR
         LW,P1    FIRSTSET
         BAL,LNK  WRITERANDOM       WRITE CURRENT RECORD
         LI,X1    5                 GET SEQ # FOR JUMP FROM CDT
         LB,X2    *CDTADR,X1
         LW,P1    *CDTADR,X2
         BAL,LNK  READRANDOM        READ THIS RECORD
         BCS,8    JMP15             DID IT EXIST
         STW,P1   FIRSTSET          SAVE NEW SEQ #
         B        FINISH%STEP%LOOP  YES - GO FINISH JUMP
*
*  ERROR: 'JU' ILLEGAL AT THIS POINT
*
JMP10    BAL,LNK  TYPECERR          TYPE: '-CN:CMND ILGL HERE'
         DATA     ERRC4
         B        *I:LNK            EXIT
*
*  ERROR: RECORD TO JUMP TO DOESN'T EXIST
*
JMP15    BAL,LNK  TYPECERR          TYPE: '-CN:NO SUCH REC'
         DATA     ERRC3
         LW,P1    FIRSTSET
         BAL,LNK  READRANDOM        RESTORE OLD RECORD
         B        *I:LNK            EXIT
         PAGE
**********************************
*  INTRALINE COMMAND: NO CHANGE  *
**********************************
*
*
I:NO%CHANGE       EQU %
         MTW,0    STEPFLAG          IS SYSTEM IN STEP MODE
         BEZ      NCG10             NO - ERROR
         LI,T1    1
         STW,T1   NOCHGFLG          TURN ON 'NO CHANGE' FLAG
         B        *I:LNK            EXIT
*
*  ERROR: 'NO' ILLEGAL AT THIS POINT
*
NCG10    BAL,LNK  TYPECERR          TYPE: '-CN:CMND ILGL HERE'
         DATA     ERRC4
         B        *I:LNK            EXIT
         PAGE
********************************************************
*  INTRALINE COMMAND: REVERSE BLANK PRESERVATION FLAG  *
********************************************************
*
*
I:REVERSE%BPFLAG  EQU %
         LW,T1    BPFLAG            REVERSE BPFLAG
         EOR,T1   K1
         STW,T1   BPFLAG
         B        *I:LNK            EXIT
         PAGE
********************************************************
*  INTRALINE COMMANDS: TYPE(SUPPRESSING SEQ. NUMBERS)  *
********************************************************
*
*
I:TYPE   EQU      %
         LW,P1    FIRSTSET          GET SEQ #
         BAL,LNK  TYPECARD          TYPE CARD IMAGE WITH SEQ #
         B        *I:LNK            EXIT
*
*
I:TYPE%SUP%SEQ    EQU %
         LI,P1    -1
         BAL,LNK  TYPECARD          TYPE CARD IMAGE WITHOUT SEQ #
         B        *I:LNK            EXIT
         PAGE
******************************
*  ADD NEW PARAMETER TO CDT  *
*    P1 = TYPE OF PARAMETER  *
******************************
*
*
ADDCDTPARAM       EQU %
         PUSH     (X1,P1)           SAVE REGS
         LW,X1    PARAMPSN          BUILD CONTROL HW FOR PARAM IN CDT:
         STB,P1   *CDTADR,X1          BYTE 0: PARAM TYPE
         AI,X1    1                   BYTE 1: LOC OF PARAM VALUE RELA-
         LB,P1    *CDTADR                      TIVE TO CURRENT CDTADR
         STB,P1   *CDTADR,X1
         MTW,2    PARAMPSN          INCR TO NEXT HW
         AW,P1    PRMBUFSZ          ADJUST COUNT OF # OF WORDS IN ENTRY
         STB,P1   *CDTADR            BY SIZE OF PARAM
         SW,P1    PRMBUFSZ
         AW,P1    CDTADR            SET P1=ABSOLUTE ADR TO PUT VALUE AT
         LW,X1    PRMBUFSZ
         LI,X2    0
         LW,D0    PARAMBUF,X2       MOVE PARAM VALUE TO CDT ENTRY
         STW,D0   *P1,X2
         AI,X2    1
         BDR,X1   %-3
         LW,X1    *CDTADR           BUILD 'END OF CDT' MARKER USING
         AND,X1   XFF00              NUMBER OF NEXT CMND IN CDT
         AI,X1    X'0100'
         STW,X1   *P1,X2            SET 'END OF CDT' MARKER
         PULL     (X1,P1)           RESTORE REGS
         B        0,LNK             EXIT
         PAGE
************************************
*  CHECK IF ONLY ONE ENTRY IN CDT  *
************************************
*
*
CHECK1CDTENTRY    EQU %
         LW,D0    CDT               CHECK IF ONLY ONE ENTRY IN CDT
         CI,D0    1
         BE       0,LNK             YES - EXIT
         BAL,LNK  TYPECERR          NO - TYPE: '-CN: CMND ILGL HERE'
         DATA     ERRC4
         B        MASTERPARSER      EXIT TO PARSER
         PAGE
****************************************
*  GET FILE IDENTIFICATION             *
****************************************
*
*
GETFILEID         EQU %
         PUSH     (X1,T1)           SAVE REGS
         LI,X1    0                 USE X1 AS COUNT OF # OF WDS PUSHED
         NXTNAM   ERRP3,;
                  (NAME,*)
         LB,T1    PARAMBUF          ALLOW ONLY <= 31 BYTES IN FILE
         CI,T1    31                NAME.
         BLE      %+3
GF5      LI,LNK   L(ERRP3)
         B        GETNEXT%ERROR
         BAL,LNK  GF%PUSH%SUBR      PUSH 'FILE NAME' PARAM
         LW,T1    CHARPSN           SAVE NEXT SCAN PSN
         NXTNAM   ERRP4,;
                  (NAME,*),;
                  (S(LPAR,PERIOD),GF10),;
                  (SCOL,ILGL%SEMICOLON),;
                  (COM,*),;
                  (END,*)
         STW,T1   CHARPSN           RESTORE TO SCAN , OR C/R AGAIN
         LI,P2    0
         PUSH     P2                SET 'ACCT #' & 'PASSWORD' PARAMS =0
         PUSH     P2
         AI,X1    2                 ADJ PUSH COUNT
         B        GF30              GO FINISH UP
*
*  LEFT PARENTHESIS FOUND: GET ACCOUNT NUMBER AND PASSWORD
*
GF10     NXTNAM   ERRP3,;
                  (NAME,GF15),;
                  (S(COM,PERIOD),*)
         LI,P2    0
         PUSH     P2                SET 'ACCT #' PARAM = 0
         AI,X1    1
         B        GF18              GO PROCESS 'PASSWORD'
*
*  ACCOUNT NUMBER FOUND: PROCESS IT
*
GF15     LB,T1    PARAMBUF          8 CHARACTERS MAX.
         CI,T1    8
         BG       GF5
         BAL,LNK  GF%PUSH%SUBR
         DO1      MODE=2
         LW,T1    CHARPSN
         NXTNAM   ERRP3,;
                  (S(COM,PERIOD),GF18),;
                  (S(RPAR,NAME),GF20),;
                  (S(RPAR,COM),GF20),;
                  (S(RPAR,END),GF20)
*
*  PASSWORD PRESENT: GET AND PROCESS IT
*
GF18     NXTNAM   ERRP3,;
                  (NAME,*)
         LB,T1    PARAMBUF          8 CHARACTERS MAX.
         CI,T1    8
         BG       GF5
         BAL,LNK  GF%PUSH%SUBR      PUSH 'PASSWORD' PARAM
         DO1      MODE=2
         LW,T1    CHARPSN
         NXTNAM   ERRP3,;
                  (S(RPAR,NAME),GF30),;
                  (S(RPAR,COM),GF30),;
                  (S(RPAR,END),GF30)
*
*  NO PASSWORD PRESENT
*
GF20     LI,P2    0
         PUSH     P2                SET 'PASSWORD' PARAM = 0
         AI,X1    1
*
*  RECONSTRUCT FILE ID IN 'PARAMBUF'
*
GF30     STW,X1   PRMBUFSZ          SET # OF PARAMS = X1
         DO1      MODE=2
         STW,T1   CHARPSN           SET TO RE-SCAN LAST POSITION
         PULL     P2                RECONSTRUCT FID IN PARAMBUF
         STW,P2   PARAMBUF-1,X1
         BDR,X1   %-2
         PULL     (X1,T1)           RESTORE REGS
         B        0,LNK             EXIT
*
*  SUBR TO PUSH A NAME ONTO THE STACK
*
GF%PUSH%SUBR      EQU %
         LB,P1    PARAMBUF          SET P1=LENGTH OF NAME IN BYTES
         AI,P1    4                 ADD 1 AND ROUND SO P1=LENGTH OF
         SLS,P1   -2                 TEXTC-STRING IN WDS
         AW,X1    P1                ADJ PUSH COUNT
         LI,X2    0
         LW,P2    PARAMBUF,X2       PUSH TEXTC-STRING ONTO STACK
         PUSH     P2                 BACKWARDS
         AI,X2    1
         BDR,P1   %-3               LOOP
         B        0,LNK             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     (X1,P2)           SAVE REGS
         LW,P2    CHARPSN           SET P2=PSN OF NEXT INPUT CHAR
         LB,P1    TTYIMG,P2         GET INPUT CHAR
         AI,P2    1                 INCR CHAR PSN
         CI,P1    ' '               SKIP LEADING BLANKS
         BE       %-3
         LI,X1    GNTBL1SZ          CHECK IF CHAR CORRESPONDS TO ONE
         CB,P1    GNTBL1,X1          OF THE 'GETNEXTNAME' TYPES
         BE       GN50
         BDR,X1   %-2               NO - LOOP
         LI,X2    1                 USE X2 AS INDEX INTO PARAMBUF
*
*  TEST IF CHAR CAN BELONG TO A FILE ID 'NAME'; IF SO, BUILD NAME
*  IN PARAMBUF
*
GN10     CLM,P1   LETTERS           IS CHAR A LETTER OR DIGIT
         BIL      GN30
         CLM,P1   DIGITS
         BIL      GN30
         DO       MODE=2
         CLM,P1   LCLETTERS
         BIL      GN30
         FIN
         LI,X1    GNTBL2SZ          NO - IS CHAR ONE OF THE OTHER LEGAL
         CB,P1    GNTBL2,X1          'NAME' CHARS
         BE       GN30              YES - GO PUT CHAR IN PARAMBUF
         BDR,X1   %-2               LOOP
         CI,X2    1                 NOT A 'NAME' CHAR - WERE ANY SUCH
         BG       GN35               CHARS FOUND (IF NO, ERROR)
*
*
*
GETNEXT%ERROR     EQU %             (ENTER HERE IF NO LEGAL TYPE FOUND)
         LW,P1    0,LNK             GET ADDR OF ERROR MSG
         CW,P1    X800000           TEST IF 'DECR PARAMPSN' BIT SET
         BAZ      %+2
         MTW,-2   PARAMPSN          YES - DECR PARAM PSN BY 1
         AND,P1   X1FFFF
         CI,P1    ERRP1             IS IT A 'P' ERROR
         BL       GN25              NO - IT IS A 'C' ERROR
         STW,P1   DMY%TYPEPERR+1    PUT ERROR MSG ADDR IN DUMMY CALL
         B        DMY%TYPEPERR      GO PRINT ERROR MSG
*
*  ERROR TYPE 'C': GO TO PRINT MESSAGE
*
GN25     STW,P1   DMY%TYPECERR+1    PUT ERROR MSG ADDR IN DUMMY CALL
         B        DMY%TYPECERR      GO PRINT ERROR MSG
*
*  A LEGAL 'NAME' CHAR FOUND: PROCESS THIS
*
GN30     STB,P1   PARAMBUF,X2       PUT CHAR IN PARAMBUF
         AI,X2    1                 INCR PARAMBUF INDEX
         LB,P1    TTYIMG,P2         GET NEXT INPUT CHAR
         AI,P2    1                 INCR CHAR PSN
         CI,P1    ' '               IS CHAR=BLANK
         BNE      GN10              NO - GO GET NEXT CHAR
*
*  END OF 'NAME' FOUND: ADD TRAILING BLANKS AND FINISH BUILDING PARAMBUF
*
GN35     LI,X1    3
         LI,P1    ' '
         STB,P1   PARAMBUF,X2       PUT 3 TRAILING BLANKS ON 'NAME'
         AI,X2    1
         BDR,X1   %-2
         AI,X2    -4                PUT COUNT IN PARAMBUF TO FORM
         STB,X2   PARAMBUF           TEXTC-STRING
         AI,X2    4                 SET PARAMBUF SIZE = # WDS OF TEXT
         SLS,X2   -2
         LI,P1    NAME              SET TYPE='NAME'
         AI,P2    -1                SET CHAR PSN TO RESCAN LAST CHAR
*
*
*
GETNEXT%FINISH    EQU %             (ENTER HERE IF LEGAL TYPE FOUND)
         STW,X2   PRMBUFSZ          SET PARAMBUF SIZE
         LB,X1    *LNK              SET X1=# OF BRANCHES
         LI,X2    4                 SET X2=INDEX INTO PARAM LIST
         CB,P1    *LNK,X2           SEARCH FOR CORRES TYPE IN LIST
         BE       GN45
         AI,X2    4                 INCR INDEX
         BDR,X1   %-3               LOOP
         B        GETNEXT%ERROR     NONE FOUND - ERROR
*
*  MATCHING BRANCH FOUND: GO EXECUTE IT
*
GN45     SLS,X2   -2                SET D1=BRANCH ADDR
         LW,D1    *LNK,X2
         STW,P2   CHARPSN           RESET CHAR PSN
         PULL     (X1,P2)           RESTORE REGS
         B        *D1               GO TO BRANCH ADDR
*
*  A LEGAL 'GETNEXTNAME' TYPE FOUND
*
GN50     LB,P1    GNTYTBL1,X1       SET P1=TYPE OF MATCH FOUND
         B        GETNEXT%FINISH    GO 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   S(LP,PR)           9,11: LEFT PAREN,PERIOD
         DATA,1   S(RP,LF)          10,0 : RIGHT PAREN, 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   S(9,11)            9,11: LEFT PAREN,PERIOD
         DATA,1   S(10,0)           10,0 : RIGHT PAREN, 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     (X1,P2)           SAVE REGS
         LW,P2    CHARPSN           SET P2=PSN OF NEXT INPUT CHAR
         LB,P1    TTYIMG,P2         GET INPUT CHAR
         AI,P2    1                 INCR CHAR PSN
         CI,P1    ' '               SKIP LEADING BLANKS
         BE       %-3
         LI,X1    GPTBLSZ           CHECK IF CHAR CORRESPONDS TO ONE
         CB,P1    GPTBL,X1           OF THE 'GETNEXTPARAM' TYPES
         BE       GP20
         BDR,X1   %-2               NO - LOOP
         CLM,P1   DIGITS            CHECK IF CHAR IS A DIGIT
         BIL      GP50
         CI,P1    '.'               CHECK IF CHAR IS A '.'
         BE       GP50
         LI,X2    1                 NO - USE X2 AS INDEX INTO PARAMBUF
         CI,P1    '/'               CHECK IF A STRING FOUND
         BE       GP30
         DO       MODE=2
         CLM,P1   LCLETTERS
         BIL      GP10
         FIN
         CLM,P1   LETTERS           NO - CHECK IF ALPHA TEXT FOUND
         BOL      GETNEXT%ERROR     NO - ERROR
*
*  ALPHABETIC TEXT FOUND: BUILD TEXTC-STRING IN PARAMBUF
*
GP10     STB,P1   PARAMBUF,X2       PUT CHAR IN PARAMBUF
         AI,X2    1                 INCR PARAMBUF INDEX
         LB,P1    TTYIMG,P2         GET NEXT CHAR
         AI,P2    1                 INCR CHAR PSN
         DO       MODE=2
         CLM,P1   LCLETTERS
         BIL      GP10
         FIN
         CLM,P1   LETTERS           IS CHAR A LETTER
         BIL      GP10              YES - LOOP
         LI,P1    ALPH              NO - SET TYPE='ALPH'
         B        GP40              GO FINISH UP
*
*  A LEGAL 'GETNEXTPARAM' TYPE  FOUND
*
GP20     LB,P1    GPTYTBL,X1        SET P1=TYPE OF MATCH FOUND
         B        GETNEXT%FINISH    GO FINISH UP
*
*  STRING FOUND: BUILD TEXTC-STRING IN PARAMBUF
*
GP30     LB,P1    TTYIMG,P2         GET NEXT INPUT CHAR
         AI,P2    1                 INCR CHAR PSN
         CW,P2    TTYIMGSZ          CHECK IF END OF CMND HIT
         BG       GP45              YES - ERROR
         CI,P1    '/'               IS CHAR='/'
         BE       GP35
GP30A    STB,P1   PARAMBUF,X2       NO - PUT CHAR IN PARAMBUF
         AI,X2    1                 INCR PARAMBUF INDEX
         B        GP30              LOOP
*
*  '/' FOUND: DETERMINE IF IT IS END OF STRING OR '//'
*
GP35     LB,P1    TTYIMG,P2         GET NEXT INPUT CHAR
         AI,P2    1                 INCR CHAR PSN
         CI,P1    '/'               IS IT A '/' ALSO
         BE       GP30A             YES - PUT ONE '/' IN PARAMBUF
         LI,P1    STRG              NO - SET TYPE='STRG'
*
*  END OF ALPHA TEST OR STRING FOUND: ADD TRAILING BLANKS AND FINISH
*  BUILDING PARAMBUF
*
GP40     LI,X1    3
         LI,D1    ' '
         STB,D1   PARAMBUF,X2       PUT 3 TRAILING BLANKS ON TEXT OR
         AI,X2    1                  STRING
         BDR,X1   %-2
         AI,X2    -4                CALC LENGTH OF STRING
         BEZ      GP43              IS LENGTH=0
         STB,X2   PARAMBUF          NO - BUILD TEXTC-STRING WITH LENGTH
         AI,X2    4                 SET PARAMBUF SIZE = # OF WDS OF TEXT
         SLS,X2   -2
         AI,P2    -1                SET CHAR PSN TO RESCAN LAST CHAR
         B        GETNEXT%FINISH    GO FINISH UP
*
*  ERROR: STRING IS NULL
*
GP43     BAL,LNK  TYPEPERR          TYPE: '-PN:NULL STRNG'
         DATA     ERRP18
         B        MASTERPARSER      GO TO PARSER
*
*  ERROR: STRING TOO LONG TO FIT IN BUFFER
*
GP45     BAL,LNK  TYPEPERR          TYPE: '-PN:ILGL STRG'
         DATA     ERRP15
         B        MASTERPARSER      EXIT TO PARSER
*
*  DIGIT OR DECIMAL POINT FOUND: INITIALIZE
*
GP50     LI,X1    0                 USE X1 TO INDICATE 1ST OR 2ND SEQ #
         LI,X2    -1                USE X2 TO SHOW INTG(-1) OR SEQ(>=0)
         LI,D1    0                 USE D1 AS ACCUMULATOR
*
*  DETERMINE WHAT WAS FOUND: IF DIGIT, ACCUMULATE DIGITS AS A BINARY
*  NUMBER
*
GP52     CLM,P1   DIGITS            IS CHAR A DIGIT
         BIL      GP52A             YES - GO ACCUMULATE IT
         CI,P1    '.'               IS CHAR A '.'
         BNE      GP60
         LI,X2    3                 YES - USE X3 TO CNT DIGITS AFTER '.'
         B        GP53              GO PROCESS '.'
GP52A    MI,D1    10                ACCUMULATE DIGIT
         AI,P1    -'0'
         AW,D1    P1
         CW,D1    L(10000)
         BGE      GP53A
         LB,P1    TTYIMG,P2         GET NEXT INPUT CHAR
         AI,P2    1                 INCR CHAR PSN
         B        GP52              LOOP
*
*  DECIMAL POINT FOUND: ACCUMULATE DIGITS AFTER IT
*
GP53     LB,P1    TTYIMG,P2         GET NEXT INPUT CHAR
         AI,P2    1                 INCR CHAR PSN
         CLM,P1   DIGITS            IS CHAR A DIGIT
         BOL      GP55
         MI,D1    10                YES - ACCUMULATE IT
         AI,P1    -'0'
         AW,D1    P1
         AI,X2    -1                CHECK IF >3 DIGITS FOUND
         BGEZ     GP53              NO - LOOP
GP53A    BAL,LNK  TYPEPERR          YES - TYPE: '-PN:ILGL SEQ #'
         DATA     ERRP10
         B        MASTERPARSER      GO TO PARSER
*
*  END OF DIGITS AFTER DECIMAL POINT
*
GP55     CI,X2    0                 WERE EXACTLY 3 DIGITS FOUND
         BE       GP60
         MI,D1    10                NO - ADJ SEQ # FOR MISSING DIGITS
         BDR,X2   %-1
*
*  END OF INTEGER OR SEQ #: SEE IF SEQ # PAIR PRESENT
*
GP60     CI,X1    1                 WAS THIS 2ND SEQ # OF PAIR
         BE       GP63
         CI,P1    '-'               NO - DOES A '-' FOLLOW FIRST
         BNE      GP66
         CI,X2    -1                YES - WAS FIRST AN INTEGER
         BNE      %+2
         MI,D1    1000              YES - CONVERT TO A SEQ #
         STW,D1   PARAMBUF          PUT VALUE IN PARAMBUF
         LI,X1    1                 SET X1=2ND SEQ #
         LI,X2    -1                RESET X2 & D1
         LI,D1    0
         LB,P1    TTYIMG,P2         GET NEXT INPUT CHAR
         AI,P2    1                 INCR CHAR PSN
         CLM,P1   DIGITS            IS CHAR A DIGIT
         BIL      GP52A             YES - GO ACCUMULATE IT
         CI,P1    '.'               IS CHAR A '.'
         BNE      GP53A             NO - ERROR
         LI,X2    3                 YES - USER X3 TO CNT DIGITS AFTER '.'
         B        GP53              GO PROCESS '.'
*
*  DONE WITH SECOND SEQ # OF PAIR: FINISH UP
*
GP63     CI,X2    -1                WAS SECOND AN INTEGER
         BNE      %+2
         MI,D1    1000              YES - CONVERT TO A SEQ #
         STW,D1   PARAMBUF+1        PUT VALUE IN PARAMBUF
         LI,P1    SEQ2              SET TYPE='SEQ2'
         LI,X2    2                 SET PARAMBUF SIZE = 2
         AI,P2    -1                SET CHAR PSN TO RESCAN LAST CHAR
         CW,D1    PARAMBUF          IS SEQ # 2 >= SEQ # 1
         BGE      GETNEXT%FINISH    YES - GO FINISH UP
         BAL,LNK  TYPEPERR          NO - TYPE: '-PN:SEQ2<SEQ1'
         DATA     ERRP11
         B        MASTERPARSER      GO TO PARSER
*
*  NO '-' FOLLOWS FIRST: FINISH UP
*
GP66     LI,P1    SEQ               SET TYPE='INTG' OR 'SEQ' AS APPRO
         CI,X2    -1
         BNE      %+2
         LI,P1    INTG
         STW,D1   PARAMBUF          PUT VALUE IN PARAMBUF
         LI,X2    1                 SET PARAMBUF SIZE = 1
         AI,P2    -1                SET CHAR PSN TO RESCAN LAST CHAR
         B        GETNEXT%FINISH    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
         PAGE
*********************************************
*  CREATE NEW ENTRY IN CDT                  *
*    P1 = NUMBER OF COMMAND TO ADD          *
*    WORD AFTER BAL = NUMBER OF PARAMETERS  *
*********************************************
*
*
NEWCDTENTRY       EQU %
         PUSH     (P1,P2)           SAVE REGS
         SLS,P1   8                 BUILD CONTROL WORD OF ENTRY:
         OR,P1    CDT                 BYTE 0: LENGTH OF ENTRY (=0)
         SLS,P1   8                   BYTE 1: COMMAND #
         OR,P1    0,LNK               BYTE 2: # OF ENTRY IN CDT
         STW,P1   *CDTADR             BYTE 3: # OF PARAMETERS
         LW,P2    0,LNK             COMPUTE LENGTH OF ENTRY =
         AI,P2    3                   (# OF PARAMETERS)/2+1
         SLS,P2   -1
         STB,P2   *CDTADR           PUT THIS IN BYTE 0
         AND,P1   XFF00             BUILD 'END OF CDT' MARKER USING
         AI,P1    X'0100'            NUMBER OF NEXT CMND IN CDT
         STW,P1   *CDTADR,P2        PUT IT AFTER PARAM CONTROL HW'S
         LI,P1    0
         B        %+2
         STW,P1   *CDTADR,P2        SET ALL PARAM CONTROL HW'S TO ZERO
         BDR,P2   %-1
         PULL     (P1,P2)           RESTORE REGS
         B        1,LNK             EXIT
         PAGE
************************************************
*  ADJUST ALL FLAG                             *
*    P1 = COLUMN NUMBER TO RESUME MATCHING AT  *
************************************************
*
*
ADJUSTALLFLAG     EQU %
         MTW,0    ALLFLAG           IS ALLFLAG ON
         BLZ      0,LNK             NO - EXIT
         STW,P1   ALLFLAG           YES - SET IT TO COL. TO RESUME MATCH
         B        0,LNK             EXIT
         PAGE
******************************************************************
*  ANALYZE COMPOSITION OF FIELD TO RIGHT                         *
*    P1 = COLUMN AT WHICH TO START ANALYZE                       *
*    R1 (BP OFF) = NUMBER OF NON-BLANKS TO 1ST BLANK             *
*    R1 (BP ON)  = NUMBER OF CHARS TO LAST NON-BLANK ON CARD     *
*    R2 (BP OFF) = NUMBER OF BLANKS (-1) FROM 1ST BLANK TO NEXT  *
*                   NON-BLANK                                    *
*    R2 (BP ON)  = NUMBER OF TRAILING BLANKS ON CARD             *
*    CC1=1 IF INITIAL P1>END OF BUFFER, CC1=0 OTHERWISE          *
******************************************************************
*
*
ANLZRIGHT         EQU %
         PUSH     (P1,P2)           SAVE REGS
         CI,P1    MAXCLMN           IS START OF FIELD PAST END OF BUFFER
         BL       AR10              NO - GO ON
         LI,R1    0                 SET R1=R2=0
         LI,R2    0
         PURGE    (P1,P2)           YES - CLEAR STACK
         LCI      8                 SET CC1=1
         B        0,LNK             EXIT
*
*  TEST BP FLAG, IF OFF CALC R1=NUMBER OF NON-BLANKS
*
AR10     LI,R1    0                 SET R1=0
         CW,P1    EODCLMN           IS START OF FIELD PAST LAST NON-BLNK
         BG       AR12
         MTW,0    BPFLAG            NO - IS BLANK PRES. ON
         BNEZ     AR20
         LI,R2    0                 NO - SET R2=0
         LI,P2    ' '
AR10A    CB,P2    CARDIMG,P1        IS CHAR AT P1=BLANK
         BE       AR15+1            YES - GO COUNT BLANKS
         AI,R1    1                 NO - INCR R1 & P1
         AI,P1    1
         CW,P1    EODCLMN           IS P1 PAST LAST NON-BLANK
         BLE      AR10A             NO - CONTINUE SCAN
*
*  NOW PAST LAST NON-BLANK, CALC R2=NUMBER OF BLANKS TO END
*
AR12     LI,R2    MAXCLMN           CALC R2=DISTANCE FROM P1 TO END OF
         SW,R2    P1                 BUFFER
         B        AR18              GO EXIT
*
*  AT END OF NON-BLANKS, COUNT BLANK FIELD
*
AR15     AI,R2    1                 INCR R2 & P1
         AI,P1    1
         CB,P2    CARDIMG,P1        IS CHAR AT P1=BLANK
         BE       AR15              YES - KEEP COUNTING BLANKS
*
*  EXIT WITH CC1=0
*
AR18     PULL     (P1,P2)           RESTORE REGS
         LCI      0                 SET CC1=0
         B        0,LNK             EXIT
*
*  BP FLAG ON, CALC R1 & R2
*
AR20     LW,R1    EODCLMN           CALC R1=DISTANCE FROM P1 TO LAST
         SW,R1    P1                 NON-BLANK
         AI,R1    1
         LI,R2    MAXCLMN-1         CALC R2=NUMBER OF TRAILING BLANKS
         SW,R2    EODCLMN
         B        AR18              GO EXIT
         PAGE
*******************************************************
*  EVALUATE FIRST PARAMETERS FOR INTRALINE COMMANDS   *
*    CDTADR = ADDR OF CURRENT COMMAND IN CDT          *
*    RESULTS: P1 = COLUMN COMPUTED FROM PARAMETERS    *
*             P2 = WIDTH OF FIELD AT THIS COLUMN      *
*             X1 = POSITION OF NEXT CDT CONTROL BYTE  *
*    CC1=1 IF NO COLUMN FOUND; CC1=0 OTHERWISE        *
*******************************************************
*
FINDCOLUMN        EQU %
         PUSH     X2,(LNK,T1)       SAVE REGS
         LI,T1    0                 SET T1=ALL OCCURRENCES
         LW,P1    ALLFLAG               P1=COL. TO START MATCHING AT
         BGEZ     FC15              IS SYSTEM IN 'ALL' MODE
         LW,P1    FRSTCLMN          NO - SET P1=COL. TO START AT
         LI,X1    3                 GET NUMBER OF PARAMS IN CDT
         LB,T1    *CDTADR,X1
         CI,T1    2                 ARE THERE > 2 PARAMS
         BG       FC10
         LI,X1    4
         LI,T1    1
         LB,X2    *CDTADR,X1        NO - GET PARAM1 TYPE
         LI,X1    5
         CI,X2    STRG              IS IT A STRING
         BE       FC15A             YES - FORM IS: /ST/ X -
         LB,X2    *CDTADR,X1        NO - FORM IS: C X -
         LW,P1    *CDTADR,X2        GET COL. # FROM CDT
         AI,P1    -1                ADJUST TO INTERNAL COL. #
         CW,P1    FRSTCLMN          IS IT BELOW COL. TO START AT
         BL       FC45              YES - ERROR
         CW,P1    LASTCLMN          IS TO BEYOND COL. TO STOP AT
         BGE      FC40              YES - ERROR
         LI,P2    1                 NO - SET FIELD WIDTH = 1
         LI,X1    6                 SET NEXT CDT CTRL BYTE = 6
         B        FC20              GO EXIT
*
*  THERE ARE 3 PARAMETERS: GET 'OCCURRENCE' COUNT
*
FC10     LI,X1    5
         LB,X2    *CDTADR,X1        SET T1=OCCURRENCE CNT IN CDT
         LW,T1    *CDTADR,X2
         CI,T1    0                 CHECK IF ALL IS LEGAL FOR THIS
         BG       FC15              COMMAND
         MTW,0    ALLOK
         BEZ      FC15
         BAL,LNK  TYPECERR
         DATA     ERRC7
         MTW,1    ERRORCNT          ALLOW ONE MORE CERR
         LI,T1    1                 SUBSTITUTE 1
*
*  FIND CORRECT OCCURRENCE OF STRING IF IT EXISTS
*
FC15     LI,X1    7
FC15A    LB,P2    *CDTADR,X1        SET P2=ABSOLUTE ADDR OF PARAM2
         AW,P2    CDTADR             STRING
         BAL,LNK  FINDMATCH         FIND MATCH FOR STRING
         BCS,8    FC30              IF NONE - ERROR
         MTW,-1    CHG:STG:CNT      SLOPY WAY OF FIXING THIS PROBLEM
         LW,P1    R1                SET P1=COL. TO RESUME MATCHING
         AI,P1    1
         BDR,T1    %-5              LOOP IF NOT ON CORRECT OCCURRENCE
         MTW,1     CHG:STG:CNT      INCREMENT COUNT HERE
         CI,T1    0                 IF T1<0, 'ALL' MODE IS ACTIVE; IN
         BGE      %+2                THIS MODE ALLFLAG>=0
         STW,P1   ALLFLAG
         AI,P1    -1                SET P1=COLUMN OF MATCH
         LB,P2    *P2                   P2=LENGTH OF STRING
         AI,X1    1                     X1=NEXT CDT CONTROL BYTE
*
*  EXIT WITH CC1=0
*
FC20     PULL     X2,(LNK,T1)       RESTORE REGS
         LCI      0
         B        0,LNK             EXIT WITH CC1=0
*
*  NO MATCH FOUND: IF IN 'ALL' MODE, EXIT 'ALL' MODE; OTHERWISE, ERROR
*
FC30     LI,T1     -1               TURN OFF ALL MODE.
         STW,T1   ALLFLAG
*
*  EXIT WITH CC1=1
*
FC35     PULL     X2,(LNK,T1)       RESTORE REGS
         LCI      8
         B        0,LNK             EXIT WITH CC1=1
*
*  ERROR: COLUMN NUMBER BEYOND COLUMN TO STOP AT
*
FC40     BAL,LNK  TYPECERR          TYPE: '--CN:COL>LIMIT'
         DATA     ERRC6
         B        FC35              GO TO EXIT
*
*  ERROR: COLUMN NUMBER BELOW COLUMN TO START AT
*
FC45     BAL,LNK  TYPECERR          TYPE: '--CN:COL<LIMIT'
         DATA     ERRC10
         B        FC35              GO TO EXIT
         PAGE
***********************************************
*  FIND MATCHING STRING ON CARD               *
*    P1 = COLUMN AT WHICH TO START SEARCH     *
*    P2 = ADDR OF TEXTC-STRING TO MATCH       *
*    R1 = COLUMN AT WHICH MATCH OCCURRED      *
*    CC1=0 IF MATCH FOUND, CC1=1 IF NO MATCH  *
***********************************************
*
*
FINDMATCH         EQU %
         PUSH     (X1,T2)           SAVE REGS
         STW,P2   TEXTCADR          SAVE ADDR OF TEXTC-STRING
         LW,R1    LASTCLMN          CALC: STOPCLMN=LAST COL. # AT WHICH
         LB,P2    *TEXTCADR          MATCH CAN TAKE PLACE
         SW,R1    P2
         STW,R1   STOPCLMN
         CW,P1    STOPCLMN          IS INITIAL COL.=STOPCLMN
         BLE      FM10
         PURGE    (X1,T2)           YES - CLEAR STACK
         B        FM15              GO EXIT WITH CC1=1
*
*  GET 1ST CHAR OF TEXTC-STRING AND SEARCH FOR IT IN CARD
*
FM10     LI,X1    1                 SET T1=1ST CHAR OF TEXTC-STRING
         LB,T1    *TEXTCADR,X1
FM10A    CB,T1    CARDIMG,P1        DOES 1ST CHAR MATCH CHAR ON CARD
         BE       FM20              YES - GO COMPARE REST
FM10B    AI,P1    1                 NO - INCR TO NEXT COLUMN
         CW,P1    STOPCLMN          IS NEW COLMN>STOPCLMN
         BLE      FM10A             NO - GO COMPARE MORE
         PULL     (X1,T2)           YES - RESTORE REGS
*
*  EXIT WITH NO MATCH FOUND (CC1=1)
*
FM15     LCI      8
         B        0,LNK             EXIT WITH CC1=1
*
*  1ST CHAR MATCH FOUND, NOW COMPARE CARD WITH REST OF TEXTC-STRING
*
FM20     LI,X1    1                 SET X1=POSITION IN TEXTC-STRING
         LW,X2    P1                    X2=COL. # ON CARD
         LB,P2    *TEXTCADR             P2=# OF CHARS TO COMPARE
         AI,P2    -1
         BEZ      FM30              IF STRING IS 1 CHAR LONG - EXIT
FM20A    AI,X1    1                 INCR X1 & X2
         AI,X2    1
         LB,T2    *TEXTCADR,X1      DO 2 CHARS MATCH
         CB,T2    CARDIMG,X2
         BNE      FM10B             NO - GO START 1ST CHAR SEARCH AGAIN
         BDR,P2   FM20A             YES - LOOP UNTIL CORRECT # MATCH
*
*  EXIT WITH MATCH FOUND (CC1=0)
*
FM30     LW,R1    P1                MATCH FOUND - SET R1=COL. # OF MATCH
         CI,LNK    FNDTYP+1         IF I CAME FROM A FT,FD OR FS TYPE OF
         BE        %+2              COMMAND DON'T INCERMENT CHG:STG:CNT.
         MTW,1     CHG:STG:CNT      COUNT THE NO. OF HITS.
         PULL     (X1,T2)           RESTORE REGS
         LCI      0
         B        0,LNK             EXIT WITH CC1=0
         PAGE
******************************************
*  MOVE STRING TO CARD                   *
*    P1 = COLUMN AT WHICH TO PUT STRING  *
*    P2 = ADDR OF TEXTC-STRING TO MOVE   *
******************************************
*
*
MOVESTRING        EQU %
         PUSH     (X1,LNK)          SAVE REGS
         SLS,P2   2                 CONVERT P2 TO A BYTE ADDR
         LB,X1    0,P2              SET X1=# OF CHARS TO MOVE
         CI,P1    MAXCLMN           IS STARTING COL. BEYOND END OF CARD
         BGE      MS20A-1           YES - GO CHECK
*
*  MOVE CHAR FROM TEXTC-STRING TO CARD
*
MS5      AI,P2    1                 INCR TO NEXT TEXTC-STRING CHAR
         LB,X2    0,P2              MOVE CHAR TO CARD
         STB,X2   CARDIMG,P1
         AI,P1    1                 INCR COLUMN
         CI,P1    MAXCLMN
         BGE      MS20              HAS END OF BUFFER BEEN PASSED
         BDR,X1   MS5               NO - LOOP UNTIL ALL CHARS MOVED
*
*  EXIT
*
MS10     PULL     (X1,LNK)          RESTORE REGS
         B        0,LNK             EXIT
*
*  AT END OF BUFFER: IF MORE NON-BLANKS TO MOVE, TYPE ERROR MESSAGE
*
MS20     AI,X1    -1                END OF BUFFER: ARE THERE MORE CHARS
         BEZ      MS10               TO MOVE
         LI,X2    ' '
MS20A    AI,P2    1                 YES - IS NEXT CHAR OF TEXTC-STRING
         CB,X2    0,P2               A BLANK
         BNE      MS20B             NO - TYPE ERROR MSG
         BDR,X1   MS20A             YES - LOOP UNTIL ALL CHARS CHECKED
         B        MS10              ALL BLANKS - GO EXIT
MS20B    BAL,LNK  TYPECERR          TYPE: '--CN:OVERFLOW'
         DATA     ERRC1
         B        MS10              GO EXIT
         PAGE
******************************************************
*  PROCESS COLUMN NUMBER PAIR                        *
*    X1 = LOC OF NEXT PARAMETER CONTROL BYTE IN CDT  *
******************************************************
*
*
PROCESSCOL#PAIR   EQU %
         PUSH     (X1,P2)           SAVE REGS
         LI,P1    0                 SET P1=DFLT STARTING COL. #
         LI,P2    MAXCLMN               P2=DFLT STOPPING COL. #
         LB,X2    *CDTADR,X1        GET NEXT PARAM TYPE
         BEZ      PP10              IS PARAM PRESENT
         AI,X1    1
         LB,X2    *CDTADR,X1        YES - SET P1=STARTING COL #
         LW,P1    *CDTADR,X2
         AI,P1    -1                ADJUST TO INTERNAL COL #
         AI,X1    -1
*
*  PROCESS SECOND COLUMN NUMBER PARAMETER
*
PP10     AI,X1    2
         LB,X2    *CDTADR,X1        GET NEX PARAM TYPE
         BEZ      PP20              IS PARAM PRESENT
         AI,X1    1
         LB,X2    *CDTADR,X1        YES - SET P2=STOPPING COL # + 1
         LW,P2    *CDTADR,X2
*
*  FINISH INITIALIZATION AND EXIT
*
PP20     STW,P1   FRSTCLMN          SET STARTING AND STOPPING COL #'S
         STW,P2   LASTCLMN
         CW,P1    P2
         BGE      PP25
         CI,P1    0
         BL       PP25
         CI,P2    MAXCLMN
         BG       PP25
         PULL     (X1,P2)           RESTORE REGS
         B        0,LNK             EXIT
*
PP25     BAL,LNK  TYPEMSG           TYPE: '-BAD COL. NO. PAIR'
         DATA     ERRC11
         LI,LNK   0
         STW,LNK  SETFLAG
         STW,LNK  STEPFLAG
         B        MASTERPARSER
         PAGE
***********************************
*  FIND COLUMN OF LAST NON-BLANK  *
***********************************
*
*
SETEOD   EQU      %
         PUSH     (X1,X2)           SAVE REGS
         LI,X1    MAXCLMN/4-1
         LW,X2    4BLNKS
         CW,X2    CARDIMG,X1        MAKE GROSS COMPARISON FOR ALL
         BNE      SRS10             BLANK WORDS.
         BDR,X1   %-2
*
*
         LI,X1    3                 CHECK FIRST WORD BY BYTE.
SRS5     CB,X2    CARDIMG,X1        ITERATE THROUGH BYTES OF
         BNE      SRS15             TARGET WORD.
         BDR,X1   %-2
*
         CB,X2    CARDIMG           CHECK FIRST BYTE OF FIRST WORD,
         BNE      SRS15             FOR BLANK.
         LI,X1    -1                IF BLANK, RECORD SIZE =0.
         B        SRS15
SRS10    SLS,X1   2                 REVERT TO BYTE INDEXING, TO GET
         AI,X1    3                 BYTE WITHIN WORD.
         B        SRS5
*
SRS15    STW,X1   EODCLMN           SAVE ENDING COLUMN (BYTE INDEX)
         AI,X1    1
         STW,X1   RECSIZE           AND RECORD SIZE (TRUE BYTE COUNT)
         PULL     (X1,X2)
         B        0,LNK             EXIT
         PAGE
***************************************************
*  SHIFT STRING LEFT                              *
*    P1 = COLUMN AT WHICH TO START SHIFT          *
*    P2 = WIDTH OF FIELD STARTING AT THIS COLUMN  *
*    P3 = NUMBER TO SHIFT LEFT                    *
***************************************************
*
*
SHIFTLEFT         EQU %
         PUSH     (P1,R2)           SAVE REGS
         AW,P1    P2                START ANLZ AFTER ORIG FIELD
         BAL,LNK  ANLZRIGHT         ANLZ FIELD AT P1
         BCS,8    SL30              OOPS - FIELD IS BEYOND END OF CARD
         SW,P1    P2                RESTORE P1
*
*  COMPUTE WHERE TO SHIFT TO, COMPENSATING IF SHIFT PUSHES DATA OFF
*  LEFT END OF CARD
*
SL3      AW,R1    P2                SET R1=WIDTH OF FIELD AT P1 TO SHIFT
         LW,P2    P1                CALC: P1=BEGINNING OF 'FROM' FIELD
         SW,P2    P3                      P2=BEGINNING OF 'TO' FIELD
         BGEZ     SL5               DOES THIS SHIFT OFF LEFT END OF CARD
         BAL,LNK  TYPECERR          YES - TYPE: '--CN:UNDERFLOW'
         DATA     ERRC2
         SW,P1    P2                FIX UP 'FROM' COL. AND WIDTH SO AS
         AW,R1    P2                 TO SHIFT ONLY TO COL. 0
         BLEZ     SL20              DOES SHIFT PUSH ENTIRE FIELD OFF CRD
         LI,P2    0                 NO - SET 'TO'=COL. 0
*
*  SHIFT FIELD AT P1 LEFT
*
SL5      CI,R1    0                 IS WIDTH OF FIELD TO SHIFT = 0
         BE       SL10              YES - SKIP SHIFT
SL5A     LB,T1    CARDIMG,P1        SHIFT LEFT
         STB,T1   CARDIMG,P2
         AI,P1    1
         AI,P2    1
         BDR,R1   SL5A
*
*  BLANK OUT CLEARED CHARS ON RIGHT
*
SL10     LI,T1    ' '               BLANK OUT
         STB,T1   CARDIMG,P2
         AI,P2    1
         BDR,P3   %-2
         PULL     (P1,R2)           RESTORE REGS
         B        0,LNK             EXIT
*
*  SHIFT PUSHES EVERYTHING, INCLUDING FIELD AT P1, OFF CARD, SO BLANK
*  OUT AND EXIT
*
SL20     AW,P3    P2                CALC P3=# OF COLUMNS WIPED OUT
         SW,R1    P2
         AW,P3    R1
         LI,P2    0                 SET 'TO' FOR BLANKING=0
         B        SL10              GO BLANK OUT
*
*  FIELD TO SHIFT IS BEYOND END OF CARD: SET UP TO SHIFT IN BLANKS
*
SL30     SW,P1    P2                RESTORE R1
         CI,P1    MAXCLMN           IS FIELD BEYOND END OF CARD
         BL       SL3               NO - CONTINUE NORMALLY
         LW,P2    P1                SET P2=COL. AT WHICH TO START
         SW,P2    P3                 BLANKING OUT
         B        SL10              GO BLANK OUT
         PAGE
***************************************************
*  SHIFT STRING RIGHT                             *
*    P1 = COLUMN AT WHICH TO START SHIFT          *
*    P2 = WIDTH OF FIELD STARTING AT THIS COLUMN  *
*    P3 = NUMBER TO SHIFT RIGHT                   *
***************************************************
*
*
SHIFTRIGHT        EQU %
         CI,P1    MAXCLMN           IS FIELD BEYOND END OF CARD
         BGE      0,LNK             YES - EXIT
         PUSH     (X1,R2)           SAVE REGS
         LI,T1    0                 SET CNTS=0
         STW,T1   FIELDCNT
         STW,T1   BLANKCNT
         AW,P1    P2                START ANLZ AFTER ORIG FIELD
         CI,P1    MAXCLMN           DOES FIELD ABUTT END OF CARD
         BE       SR70              YES - GO PROCESS
*
*  BUILD 2-WD DATA BLOCK FOR EACH FIELD TO BE COMPRESSED AND PUSH
*  ON STACK
*
SR5      BAL,LNK  ANLZRIGHT         ANLZ FIELD AT P1
         BCS,8    SR50              OOPS - END OF CARD
         AWM,R2   BLANKCNT          CNT BLNKS TO COMPRESS
         STH,R1   R2
         AW,R1    P1                BUILD: R1=COLUMN AT END OF NON-BLNKS
         AI,R1    -1                       R2=(# OF NON-BLNKS,# TO SHFT)
         MTW,1    FIELDCNT          CNT FIELDS COMPRESSED
         CW,P3    BLANKCNT          ARE ENOUGH BLNKS COMPRESSED YET
         BLE      SR8               YES
         PUSH     (R1,R2)           NO - SAVE FIELD DATA BLOCK
         LW,P1    R1                INCR P1 TO NEXT FIELD
         AND,R2   XFFFF
         AW,P1    R2
         AI,P1    2
         B        SR5               ANLZ NEXT FIELD
*
*  INITIALIZE TO DO ACTUAL SHIFTS (I.E., COMPRESSING)
*
SR8      SW,P3    BLANKCNT          ADJUST (# TO SHIFT) SPEC IN R2 TO
         AW,R2    P3                 PRESERVE EXCESS BLNKS IN LAST FIELD
SR8A     LW,X1    R1                AVOID: PUSH R1,R2
         LW,X2    R2                       PULL R1,R2
         LI,T1    0
         STW,T1   BLANKCNT          CLEAR BLNK CNT
         MTW,-1   FIELDCNT          DECR FIELD CNT
         BGZ      SR12              >0 - 1 OR MORE FIELDS ON STK
         BEZ      SR10              =0 - AT 1ST FIELD (STK EMPTY)
         LH,T1    X2                <0 - SHIFT WIPES ALL BUT ORIG FIELD
         B        SR12A                   AT P1
*
*  READY TO SHIFT 1ST FIELD, BUT FIRST ADD ON ORIG FIELD AT P1
*
SR10     AH,P2    X2                ADD LENGTH OF ORIG FIELD TO (# OF
         AI,P2    -1                 NON-BLNKS) SPEC IN R2
         STH,P2   X2
*
*  SET UP PARAMETERS FOR CURRENT SHIFT
*
SR12     LH,T1    X2                SET T1=# OF CHARS IN FIELD TO SHIFT
         AI,T1    1                  (INCLUDING PRECEDING BLANK)
SR12A    AND,X2   XFFFF             KEEP CUMULATIVE CNT OF BLNKS
         AWM,X2   BLANKCNT           COMPRESSED OUT
         LW,X2    X1                CALC: X1=END OF 'FROM' FIELD
         AW,X2    BLANKCNT                X2=END OF 'TO' FIELD
         CI,T1    0                 IS # OF CHARS TO SHIFT = 0
         BE       SR15A             YES - SKIP SHIFT
*
*  DO CURRENT SHIFT, THEN CHECK NUMBER LEFT TO DO
*
SR15     LB,T2    CARDIMG,X1        COMPRESS FIELDS
         STB,T2   CARDIMG,X2
         AI,X1    -1
         AI,X2    -1
         BDR,T1   SR15
SR15A    MTW,-1   FIELDCNT          DECR FIELD CNT
         BLZ      SR20              <0 - ALL SHIFTS DONE
         PULL     (X1,X2)           >=0 - GET NEXT FIELD DATA BLOCK
         MTW,0    FIELDCNT          TEST FIELD CNT
         BGZ      SR12              >0 - 1 OR MORE FIELDS LEFT
         B        SR10              =0 - AT 1ST FIELD
*
*  ALL SHIFTS DONE, SO BLANK OUT CLEARED CHARS ON LEFT
*
SR20     LW,T1    BLANKCNT
SR20A    LI,T2    ' '               BLANK OUT
         STB,T2   CARDIMG,X2
         AI,X2    -1
         BDR,T1   %-2
         PULL     (X1,R2)           RESTORE REGS
         B        0,LNK             EXIT
*
*  END-OF-BUFFER HIT: NOT ENOUGH BLANKS TO ABSORB SHIFT
*
SR50     BAL,LNK  TYPECERR          TYPE: '--CN:OVERFLOW'
         DATA     ERRC1
         LI,T1    0                 CLEAR BLNK CNT
         XW,T1    BLANKCNT          SET T1=(# OF NON-BLNKS TO DESTROY)
         SW,T1    P3
         PULL     (R1,R2)           START ON LAST FIELD
*
*  PULL FIELD DATA BLOCKS FROM STACK AND DESTROY NON-BLANKS UNTIL
*  ENOUGH ROOM FOUND, WHEN FOUND BUILD APPROPRIATE DATA BLOCK
*
SR52     AH,T1    R2                IS CURRENT FIELD (+OTHERS ALREADY
         BLEZ     SR55               WIPED OUT) LONG ENOUGH FOR OVERFLOW
SR52A    SH,R1    R2                YES -BUILD R1 & R2 AS BEFORE:
         AW,R1    T1                  R1=COLUMN AT END OF NON-BLNKS
         AH,R2    R2                      NOT DESTROYED
         AND,R2   XFFFF               R2=(# OF NON-BLNKS NOT DESTROYED,
         SW,R2    T1                      ,# TO SHIFT)
         AW,R2    BLANKCNT
         STH,T1   R2
         B        SR8A              GO SHIFT
*
*  NOT ENOUGH ROOM FOUND YET, GET NEXT FIELD DOWN AND DESTROY PART OF IT
*
SR55     LH,T2    R2                KEEP CUMULATIVE CNT OF CHARS
         AW,T2    R2                 DESTROYED
         AND,T2   XFFFF
         AWM,T2   BLANKCNT
         MTW,-1   FIELDCNT          DECR FIELD CNT
         BEZ      SR58              =0 - AT 1ST FIELD
         PULL     (R1,R2)           >0 - GET NEXT FIELD DATA BLOCK
         AI,R1    1                 INC. FOLLOWING BLANK IN FIELD
         AI,R2    X'10000'
         B        SR52
*
*  AT 1ST FIELD AND STILL NOT ENOUGH ROOM
*
SR58     AW,T1    P2                ADD IN ORIG FIELD AT P1 AND CHK ROOM
         BLEZ     SR60
         SH,R1    R2                ENOUGH FOUND - FIX R1 & R2 TO
         LI,R2    0                  DESTROY PART OF ORIG FIELD AT P1
         STH,P2   R2
         B        SR52A
*
*  SHIFT PUSHS ALL FIELDS OFF CARD, SO BLANK OUT AND EXIT
*
SR60     AWM,P2   BLANKCNT          SET UP TO BLANK FROM ORIG P1
         LW,X2    P1
         AI,X2    -2
         B        SR20              GO BLANK OUT
*
*  FIELD TO SHIFT ABUTTS END OF CARD: SET UP TO PERFORM THIS SHIFT
*
SR70     BAL,LNK  TYPECERR          TYPE: '--CN:OVERFLOW'
         DATA     ERRC1
         SW,P2    P3                DOES SHIFT PUSH ORIG FIELD OFF CARD
         BLEZ     SR72
         STW,P3   BLANKCNT          NO - SET BLANKCNT=# OF CHARS TO
         LI,X1    MAXCLMN-1          BLANK OUT
         SW,X1    P3                SET X1=END OF 'FROM' FIELD
         LI,X2    MAXCLMN-1             X2=LAST COLUMN ON CARD
         LW,T1    P2                    T1=# OF CHARS TO SHIFT
         B        SR15              GO SHIFT THIS FIELD
*
*  ABUTTING FIELD IS SHIFTED OFF CARD, SO SET UP TO BLANK OUT
*
SR72     AW,P2    P3                SET T1=# OF CHARS TO BLANK OUT
         LW,T1    P2                        (=ORIG FIELD WIDTH)
         LI,X2    MAXCLMN-1             X2=LAST COLUMN ON CARD
         B        SR20A             GO BLANK OUT
         PAGE
***************************************
*  CONVERT BINARY TO DECIMAL STRING   *
*    P1 = BINARY NUMBER               *
*    P2 = BYTE ADDR TO PUT STRING IN  *
***************************************
*
*
BINTODEC EQU      %
         PUSH      (P1,P2),X1       SAVE RGS
         AI,P2    7                 SET P2=LAST BYTE ADDR OF STRING
         LW,D1    P1
         LI,P1    7                 SET TO LOOP 7 TIMES
BD10     LI,D0    0
         DW,D0    K10               EXTRACT RIGHTMOST DIGIT
         AI,D0    '0'               CONVERT TO EBCDIC AND PUT IN STRING
         STB,D0   0,P2
         AI,P2    -1
         BDR,P1   BD10              LOOP
         LI,D1    ' '               SET 1ST BYTE = BLANK
         STB,D1   0,P2
         AI,P2      1                GET PAST THE BLANK
         LI,X1     6                NUMBER OF FIELDS TO CHECK.
         LI,D1     X'40'            NULL CHARACTER
         LI,P1     X'F0'
BD30     EQU       %
         CB,P1     0,P2             CHECK FOR ZERO
         BNE       BD20             NOT EQU IS NOT A LEADING ZERO
         STB,D1    0,P2             MAKE IT NULL
         AI,P2     1                INCREMENT BYTE ADR.
         BDR,X1    BD30             GO FIND ANOTHER
BD20     EQU       %
         PULL      (P1,P2),X1
         B        0,LNK             EXIT
         PAGE
******************************
*        BLANK INPUT BUFFER  *
******************************
*
*
BLANKBUF PUSH     LNK
         LI,LNK   MAXCLMN/4
         LW,D1    4BLNKS
*
         STW,D1   CARDIMG-1,LNK
         BDR,LNK  %-1
*
         PULL     LNK
         B        0,LNK
         PAGE
***********************
*  CLOSE UPDATE FILE  *
***********************
*
*
CLOSE    EQU      %
         M:CLOSE  F:EI,(SAVE)
         B        0,LNK
*********************
*  CLOSE COPY FILE  *
*********************
*
*
CLOSE2   EQU      %
         M:CLOSE  F:EO,(SAVE)
         B        0,LNK
*
*
CLOSE3   M:CLOSE  F:EO,(REL)
         B        0,LNK
         PAGE
***************************************************
*  DELETE SPECIFIED RECORDS                       *
*    P1 = FIRST SEQ. NUMBER TO DELETE             *
*    P2 = LAST SEQ. NUMBER TO DELETE              *
*    R1 = SEQ. NUMBER OF LAST RECORD READ         *
*    R2 = NUMBER OF RECORDS DELETED               *
*    CC1=1 IF LAST SEQ # PASSED; CC1=0 OTHERWISE  *
***************************************************
*
*
DELETE   EQU      %
         PUSH     (P1,T1)           SAVE REGS
         LI,T1    0                 USE T1 TO COUNT # OF RECS DELETED
*
*        DELETE RECORDS VIA:
*                 READ N
*                 READ N+1
*                 DELETE N
*                 READ N+2
*                 DELETE N+1
*                 ETC.
         BAL,LNK  READNXTRANDOM     READ 1ST SEQ # OR NEXT HIGHEST #
*
*  READ AND DELETE UNTIL LAST SEQ # READ OR PASSED
*
DL10     CW,R1    L(EOF)            WAS AN EOF READ
         BE       DL30              YES - GO TYPE ERROR MESSAGE
         CW,P2    R1                NO - WAS INPUT SEQ # >= LAST SEQ #
         BLE      DL15              YES - GO FINISH UP
         STW,R1   DELNXT            N TO DELETE BUFFER
         LW,P1    DELNXT
         AI,P1    1
         BAL,LNK  READNXTRANDOM     READ N+1
         LI,LNK   3                 SET KEY LENGTH
         STB,LNK  DELNXT
         M:DELREC F:EI,(KEY,DELNXT) DELETE N
         AI,T1    1                 BUMP DELETED RECORD COUNTER
         DO       MODE=2
         LW,P1    DELNXT
         AND,P1    =X'FFFFFF'       GET RID OF THE BYTE COUNT
         STW,P1   INTFLAG1
         FIN
         B        DL10              N+1 IS OK, SET TO DELETE IT
*
*  LAST SEQ # HIT OR PASSED: IF HIT, FINISH UP AND EXIT WITH CC1=0
*
DL15     BL       DL20              WAS LAST SEQ # PASSED
         BAL,LNK  DELETERECORD      NO, WAS HIT - DELETE IT
         DO1      MODE=2
         STW,R1   INTFLAG1
         AI,T1    1                 INCR DELETE COUNT
        LW,P1    T1
         CI,P1     1                DON'T SAY ANYTHING IF ITS ONLY 1
         BE        DL17
        LI,P2    BA(MSG6)+1
        BAL,LNK  BINTODEC
        BAL,LNK   TYPEMSG
        DATA       MSG6
DL17     EQU       %
         PULL     (P1,T1)           RESTORE REGS
         LCI      0
         B        0,LNK             EXIT WITH CC1=0
*
*  LAST SEQ # WAS PASSED: EXIT WITH CC1=1
*
DL20    LW,P1    T1
         CI,P1     1                DON'T SAY ANYTHING IF ITS ONLY 1
         BE        DL25
        LI,P2    BA(MSG6)+1
        BAL,LNK  BINTODEC
        BAL,LNK   TYPEMSG
        DATA       MSG6
DL25     EQU       %
         PULL     (P1,T1)           RESTORE REGS
         LCI      8
         B        0,LNK             EXIT WITH CC1=1
*
*  ERROR: EOF HIT
*
DL30     BAL,LNK  TYPEMSG           TYPE: '--EOF HIT'
         DATA     ERRM1
         B        DL20              GO EXIT WITH CC1=1
         PAGE
*****************************************************
*  DELETE FILE                                      *
*    P1 = ADDR OF FILE ID IN CDT                    *
*    CC1=1 IF FILE DOES NOT EXIST; CC1=0 OTHERWISE  *
*****************************************************
*
*
         LOCAL    %20,%50
DELETEFILE        EQU %
         PUSH     (X1,P3)
         LI,P2    DF%ABN
         STW,P2   O2%FPT+2
         LI,P2    4                 INOUT
         STW,P2   O2%FPT+5
         LI,T1    O2%NAME
         LI,T2    O2%ACCT
         LI,P3    O2%PASS
         BAL,LNK  OPENINIT
         CAL1,1   O2%FPT
         M:CLOSE  F:EO,(REL)        FILE EXISTS, SO CLOSE AND RELEASE
         PULL     (X1,P3)
         LCI      0
         B        0,LNK
*
*
*
DF%ABN   RES      0
         LB,X1    P3
         CI,X1    3
         BNE      BADIO1
         PULL     (X1,P3)
         LCI      8
         B        0,LNK
*
*  ERROR: BAD I/O
*
BADIO    RES      0
         LW,X1    D1                MOVE CODE TO X1.
BADIO1   RES      0                 ENTER HERE IF CODE IN X1.
         SCS,X1   -4                BUILD ERROR CODE
         LB,X2    HEXCHAR,X1
         STB,X2   IOERRCOD
         SLS,X1   -28
         LB,X2    HEXCHAR,X1
         LI,X3    1
         STB,X2   IOERRCOD,X3
         BAL,LNK  TYPEMSG
         DATA     IOERRMSG
         DO       MODE=1
         CAL3,6   0
         ELSE
         M:ERR                      ERROR TO UTS.
         FIN
         PAGE
*****************************
*  DELETE LAST RECORD READ  *
*****************************
*
*
DELETERECORD      EQU %
         M:DELREC F:EI,(KEY,LASTKEY)
         B        0,LNK
         PAGE
****************************************************
*  MOVE SEQUENCE NUMBER                            *
*    P1 = SEQ. NUMBER TO CONVERT                   *
*    P2 = BYTE ADDR AT WHICH TO PUT STRING         *
*    WORD AFTER BAL = 4 CHARS TO APPEND TO STRING  *
*    R1 = NUMBER OF CHARS IN RESULTANT STRING      *
****************************************************
*
*
MOVESEQ  EQU      %
         PUSH     (X4,LNK)          SAVE REGS
         LW,X4    LNK               SAVE LINK
         STW,P2   TEMPBLCK+3        SAVE P2
         LI,P2    BA(TEMPBLCK)
         BAL,LNK  BINTODEC          CONVERT SEQ # TO EBCDIC: ' DDDDDDD'
         LW,P2    TEMPBLCK+3        RESTORE P2
         LI,X1    1
         LI,X2    3
         LI,D0    '0'
         CB,D0    TEMPBLCK,X1       CALC X1=POSITION OF 1ST NON-ZERO
         BNE      MQ10               CHAR OR 4TH DIGIT
         AI,X1    1
         BDR,X2   %-3
*
*  SUPPRESS TRAILING ZEROES
*
MQ10     LI,P1    7
         LI,X2    3
         CB,D0    TEMPBLCK,P1       CALC P1=POSITION OF 1ST NON-ZERO
         BNEZ     MQ20               DIGIT FROM RIGHT OF 4TH DIGIT
         AI,P1    -1
         BDR,X2   %-3
*
*  BUILD STRING TO LEFT OF DECIMAL POINT
*
MQ20     LB,D0    TEMPBLCK,X1       MOVE NON-ZERO DIGITS TO LEFT OF
         STB,D0   0,P2               DEC. PT. TO ADDR IN P2 (AT LEAST
         AI,P2    1                  1 DIGIT MOVED)
         AI,X1    1
         CI,X1    4
         BLE      MQ20
         LI,D0    '.'               MOVE '.' TO ADDR IN P2
         STB,D0   0,P2
         AI,P2    1
*
*  BUILD STRING TO RIGHT OF DECIMAL POINT
*
MQ25     CW,P1    X1                MOVE (IF ANY) DIGITS TO RIGHT OF
         BL       MQ30               DEC. PT. TO ADDR IN P2
         LB,D0    TEMPBLCK,X1
         STB,D0   0,P2
         AI,P2    1
         AI,X1    1
         B        MQ25
*
*  APPEND 4 SPECIFIED CHARS
*
MQ30     LI,X1    0
         LI,X2    4
MQ30A    LB,D0    *X4,X1            MOVE 4 CHARS SPECIFIED TO END OF
         BEZ      %+3                THIS STRING, SKIPPING 0 CHARS
         STB,D0   0,P2
         AI,P2    1
         AI,X1    1
         BDR,X2   MQ30A
         LW,R1    P2
         PULL     (X4,LNK)          RESTORE REGS
         SW,R1    P2                CALC R1=NUMBER OF CHARS IN STRING
         B        1,LNK             EXIT
         PAGE
*****************************************************
*  OPEN UPDATE FILE                                 *
*  OPEN UPDATE FILE (OPEN1 OPENS COPY INPUT FILE)   *
*    P1 = 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     (X1,P3)
         LI,P2    4                 INOUT
         B        %20
*
*
OPEN1    EQU      %
         PUSH     (X1,P3)
         LI,P2    1                 INPUT
*
*
%20      RES      0
         STW,P2   O%FPT+5
         LI,P2    O%ABN
         STW,P2   O%FPT+2
         LI,T1    O%NAME            SET ADDRESS REGISTERS FOR
         LI,T2    O%ACCT                STORING PARAMETERS INTO
         LI,P3    O%PASS                FPT.
         BAL,LNK  OPENINIT
         CAL1,1   O%FPT             OPEN FILE
         LW,X1    F:EI+5            FILE EXISTS.
         SLS,X1   -4                ORGANIZATION SHOULD BE KEYED.
         AND,X1   XF
         CI,X1    2
         BNE      %90
         PULL     (X1,P3)           IT IS.
         LCI      0
         B        0,LNK
*
*
%90      RES      0
         PULL     (X1,P3)
         LCI      4
         B        0,LNK
*
*
*
O%ABN    RES      0
         LB,X1    P3
         CI,X1    3
         BNE      BADIO1
         PULL     (X1,P3)           NO FILE.
         LCI      8
         B        0,LNK
         PAGE
*****************************************************
*  OPEN (OUTPUT) FILE FOR COPYING                   *
*    P1 = ADDR OF FILE ID IN CDT                    *
*    CC1=1 IF FILE DOES NOT EXIST; CC1=0 OTHERWISE  *
*****************************************************
*
*
         LOCAL    %20
OPEN3    PUSH     (X1,P3)
         LI,P2    2                 OUTPUT
         B        %20
*
*
OPEN2    EQU      %
         PUSH     (X1,P3)
         LI,P2    4                 INOUT
%20      STW,P2   O2%FPT+5
         LI,P2    O2%ABN
         STW,P2   O2%FPT+2
*
         LI,T1    O2%NAME           SAME.
         LI,T2    O2%ACCT
         LI,P3    O2%PASS
         BAL,LNK  OPENINIT
         CAL1,1   O2%FPT
         PULL     (X1,P3)
         LCI      0
         B        0,LNK
*
*
*
O2%ABN   RES      0
         LB,X1    P3
         CI,X1    3
         BNE      BADIO1
         LI,X1    2                 NO PREVIOUS FILE, OPEN FOR OUTPUT.
         STW,X1   O2%FPT+5
         CAL1,1   O2%FPT
         PULL     (X1,P3)
         LCI      8
         B        0,LNK
         PAGE
***********************************************
*  INITIALIZE OPEN FPT                        *
*    P1 = ADDR OF FILE ID IN CDT              *
*    T1 = FPT ENTRY TO PUT FILE NAME IN       *
*    T2 = FPT ENTRY TO PUT ACCOUNT NUMBER IN  *
*    P3 = FPT ENTRY TO PUT PASSWORD IN        *
***********************************************
*
*
         LOCAL    %50,%60,%65,%70,%80
OPENINIT EQU      %
         LW,X1    4BLNKS
         STW,X1   *T2
         STW,X1   *P3
         LI,X2    1
         STW,X1   *T2,X2
         STW,X1   *P3,X2
         LI,X2    -1
         LW,X1    L(X'02000202')    INITIALIZE ACCOUNT AND PASS CONTROLS
         STW,X1   *T2,X2
         LW,X1    L(X'03010202')
         STW,X1   *P3,X2
         LB,X2    *P1               MOVE FILE NAME TO BUFFER.
         STB,X2   *T1                   P1 POINTS TO IT.
         LB,X1    *P1,X2
         STB,X1   *T1,X2
         BDR,X2   %-2
         LB,X2    *T1               SKIP TO ACCOUNT. BYTE COUNT FROM FPT
         AI,X2    4
         SLS,X2   -2
         AW,P1    X2                P1 NOW AT ACCOUNT
         LB,X2    *P1
         BEZ      %50               NO ACCOUNT
         LB,X1    *P1,X2            MOVE ACCOUNT TO BUFFER
         AI,X2    -1                THIS LOOP PUTS NO BYTE COUNT INTO
         STB,X1   *T2,X2            FPT.
         AI,X2    0
         BGZ      %-4
         LB,X2    *P1               SKIP TO PASS               &
         AI,X2    4
         SLS,X2   -2
         AW,P1    X2                P1 NOW POINTS TO PASS
         B        %60
*
*
%50      RES      0
         AI,P1    1                 STEP TO PASS
         LI,X1    -2                SET FPT FOR NO ACCOUNT, BY SAYING
         STB,X2   *T2,X1                NO USABLE WORDS.
*
*
%60      RES      0
         LB,X2    *P1
         BEZ      %70               NO PASS
*
*
%65      RES      0
         LB,X1    *P1,X2            MOVE PASSWORD WITH BYTE COUNT
         AI,X2    -1
         STB,X1   *P3,X2
         AI,X2    0
         BGZ      %65
         B        %80
*                                            &
*
%70      RES      0
         LI,X1    -2                SET FPT FOR NO PASS, BY SAYING
         STB,X2   *P3,X1                NO USABLE WORDS.
*
*
%80      RES      0
         B        0,LNK
         PAGE
*****************************************************
*  OPEN NEW (OUTPUT ONLY) FILE                      *
*    P1 = ADDR OF FILE ID IN CDT                    *
*    CC1=1 IF FILE DOES NOT EXIST; CC1=0 OTHERWISE  *
*****************************************************
*
*
OPENNEW  EQU      %
         PUSH     (X1,P3)
         LI,P2    ON%ABN
         STW,P2   O%FPT+2
         LI,P2    4                 INOUT
         STW,P2   O%FPT+5
         LI,T1    O%NAME
         LI,T2    O%ACCT
         LI,P3    O%PASS
         BAL,LNK  OPENINIT
         CAL1,1   O%FPT
         PULL     (X1,P3)           FILE EXISTS.
         LCI      0                 NOTE.
         B        0,LNK
*
*
*
ON%ABN   RES      0
         LB,X1    P3
         CI,X1    3
         BNE      BADIO1
         LI,X1    2                 OPEN FOR OUTPUT.
         STW,X1   O%FPT+5
         CAL1,1   O%FPT
         PULL     (X1,P3)
         LCI      8
         B        0,LNK
*
*
************************************************************
*        VERIFY CARRIAGE RETURN EXISTS ON OUTPUT RECORD.   *
************************************************************
*
PUTCR    PUSH     LNK
         DO1      MODE=2
         BAL,LNK  TABCOMPRESS
         LW,LNK   CRFLAG            DO NOT INSERT CR WHEN FLAG IS
         BNEZ     PUTCR2            NON-ZERO
         LW,LNK   RECSIZE
         AI,LNK   -1
         LI,D1    X'15'
         CB,D1    CARDIMG,LNK
         BE       PUTCR2
*
         AI,LNK   1                 IF NO CR
         CI,LNK   MAXCLMN
         BL       %+3
         LI,LNK   MAXCLMN-1         (DO NOT GO BEYOND COL. 140)
         STW,LNK  RECSIZE
         STB,D1   CARDIMG,LNK       INSERT ONE
         MTW,1    RECSIZE
*
PUTCR2   PULL     LNK
         B        0,LNK
         PAGE
***********************************************
*  READ RANDOM RECORD OR NEXT HIGHEST ONE     *
*    P1 = SEQ. NUMBER TO READ                 *
*    R1 = SEQ. NUMBER ACTUALLY READ           *
*    CC1=0 IF RECORD EXISTS; CC1=1 OTHERWISE  *
***********************************************
*
*
         LOCAL    %20
READNXTRANDOM     EQU %
         PUSH     LNK
         BAL,LNK  READRANDOM
         BCS,8    %20
         LW,R1    LASTKEY           GOT IT, RETURN KEY.
         AND,R1   XFFFFFF
         PULL     LNK
         LCI      0
         B        0,LNK
*
*
%20      RES      0
         BAL,LNK  READSEQUEN        NOW GET NEXT KEY, IN R1.
         PULL     LNK
         LCI      8
         B        0,LNK
         PAGE
***********************************************
*  READ RANDOM RECORD                         *
*    P1 = SEQ. NUMBER TO READ                 *
*    CC1=0 IF RECORD EXISTS; CC1=1 OTHERWISE  *
***********************************************
*
*
READRANDOM        EQU %
         PUSH     (LNK,P3)
         BAL,LNK  BLANKBUF
         BAL,LNK  SETKEY            (P1) ARE KEY,I.E. SEQUENCE
         DO1      MODE=2
         M:SETDCB F:EI,(ERR,RR%ERR)
         M:READ   F:EI,;
                  (ERR,RR%ERR),;
                  (WAIT),;
                  (SIZE,MAXCLMN),;
                  (KEY,KBUF)
         BAL,LNK  SETLASTKEY
         PULL     (LNK,P3)
         LCI      0
         B        0,LNK
*
*
*
RR%ERR   RES      0
         LB,D1    P3
         CI,D1    X'43'
         BNE      BADIO
         PULL     (LNK,P3)
         LCI      8
         B        0,LNK
         PAGE
********************************
*  READ SEQUENTIAL RECORD      *
*    R1 = SEQ. NUMBER READ IN  *
********************************
*
         LOCAL    %10,%20
*
READSEQUEN        EQU %
         PUSH     (LNK,P3)
         BAL,LNK  BLANKBUF
         DO1      MODE=2
         M:SETDCB F:EI,(ABN,RS%ABN)
         M:READ   F:EI,;
                  (WAIT),;
                  (SIZE,MAXCLMN),;
                  (ABN,RS%ABN)
         BAL,LNK  SETLASTKEY
         LW,D1    F:EI+5            CHECK ORGANIZATION
         SLS,D1   -4
         AND,D1   XF
         LW,R1    *F:EI+10          RETURN SEQUENCE
         AND,R1   XFFFFFF
         CI,D1    2
         BE       %+2
         LI,R1    0                 ZERO IF NOT KEYED.
         PULL     (LNK,P3)
         B        0,LNK
*
*
*
RS%ABN   RES      0
         LB,D1    P3
         CI,D1    6
         BNE      BADIO
         LW,R1    L(EOF)
*                                   PUT LAST SEQ # IN EOF MESG
         PUSH     (P1,R1)
         LI,P1    0                 INITIALIZE LASTKEY IN CASE SEQ
         STW,P1   LASTKEY           BELOW TAKES ABN EXIT
         M:PRECORD F:EI,(ABN,RS%ABNABN),(REV)  POSN BEFORE LAST REC
         M:READ   F:EI,(ERR,RS%ABNABN),(SIZE,MAXCLMN)  AND GET KEY
         BAL,LNK  SETLASTKEY        IN CORE LOC LASTKEY
RS%ABNABN         EQU %               OR BYPASS SETTING IF TROUBLES
         LI,R1    21                NUMBER OF TEXTC BYTES
         LW,P1    LASTKEY           LAST SEQ # READ
         AND,P1   XFFFFFF           ZAP TEXTC BYTE IN KEY
         LI,P2    BA(ERRM1)+17
         BAL,LNK  MOVESEQ
         GEN4     EOM,0,0,0
         LI,P1    1                 START PAST TEXTC COUNT
RS%ABNEOM EQU     %
         LB,P2    ERRM1,P1          GET BYTE LOOKING FOR EOM
         CI,P2    EOM
         BE       RS%ABNOUT         EXIT WHEN FOUND
         AI,P1    1
         B        RS%ABNEOM         KEEP GOING TILL FOUND
RS%ABNOUT       EQU %
         AI,P1    -1                POINT TO BYTE BEFORE EOM
         STB,P1   ERRM1             AND USE IT AS TEXTC COUNT
         PULL     (P1,R1)
         PULL     (LNK,P3)
         B        0,LNK
         PAGE
*********************************
*  READ TELETYPE                *
*    R1 = NUMBER OF CHARS READ  *
*********************************
*
*
READTELETYPE2     EQU %
         PUSH     (X1,X2)           SAVE REGS
         LI,X2    1                 USE X2=1 FOR 'READTELETYPE2'
         B        RT5
*
*
READTELETYPE      EQU %
         PUSH     (X1,X2)           SAVE REGS
         LI,X2    0                 USE X2=0 FOR 'READTELETYPE'
RT5      LW,R0    4BLNKS
         LI,X1    MAXCLMN/4
         EXU      RTSTWTBL,X2
         BDR,X1   %-1
         DO       MODE=1
         CAL3,0   0                 READ A CHAR
         EXU      RTSTBTBL,X2       PUT CHAR IN BUFFER
         AI,X1    1                 INCR CHAR COUNT
         CI,R0    CR
         BNE      %-4               LOOP UNTIL C/R
         LW,R1    X1                SET R1=COL. # OF C/R
         ELSE
         MTW,0    CFLAG             IF FIRST READ, MOVE COMMAND IN
         BNEZ     RT10              FROM J:CCBUF.
         MTW,1    CFLAG
*
         LW,X1    M:UC+4            GET BYTE COUNT FROM M:UC,
         SLS,X1   -17
         LB,R0    J:CCBUF,X1        MOVE RECORD INTO APPROPRIATE
         EXU      RTSTBTBL,X2       BUFFER
         BDR,X1   %-2
*
         LB,R0    J:CCBUF
         EXU      RTSTBTBL,X2
         CI,R0    'E'               IS COMMAND A VARIETY OF EDIT.
         BNE      RT15              IF SO, MUST START WITH 'E'.
*
         STW,LNK  BUILDFLAG
         LW,R1    M:UC+4            CHECK FOR PRESENCE OF FID.
         SLS,R1   -17               IF NOEN, READ USER COMMAND.
         BAL,LNK  TYPEMSG           TYPE
         DATA     UTSM1             'EDIT HERE'
         AI,R1    -1
         LW,LNK   BUILDFLAG
         LI,X1    4                 START LOOKING IN BYTE 5.
         LI,R0    ' '
RT8      CW,X1    R1                CHECK FOR END OF RECORD
         BGE      RT5               IF SO, GET NEXT COMMAND. OTHERWISE,
         CB,R0    TTYIMG,X1         IF NON-BLANK ENCOUNTERED, ACCEPT
         BNE      RT9
         AI,X1    1                 INCREMENT TO NEXT BYTE.
         B        RT8
RT9      AI,R1    1                 UPDATE TOTAL BYTE COUNT TO INCLUDE
         B        RT17              CR, THEN EXECUTE COMMAND.
*
RT10     LW,X1    RTADDTBL,X2
         CAL1,1   RT%FPT
*
RT15     LW,R1    M:UC+4
         SLS,R1   -17
         FIN
RT17     PULL     (X1,X2)           RESTORE REGS.
         B        0,LNK             EXIT
*
*
RTSTBTBL EQU      %
         STB,R0   CARDIMG,X1
         STB,R0   TTYIMG,X1
*
RTSTWTBL EQU      %
         STW,R0   CARDIMG-1,X1
         STW,R0   TTYIMG-1,X1
*
         DO       MODE=2
RTADDTBL EQU      %
         DATA     CARDIMG
         DATA     TTYIMG
         FIN
         PAGE
******************************
*  RE-OPEN LAST UPDATE FILE  *
******************************
*
*
REOPEN   EQU      %
         CAL1,1   O%FPT
         B        0,LNK
         PAGE
**************************************
*  SET KEY FOR READ OR WRITE         *
*    P1 = SEQ. NUMBER TO PUT IN KEY  *
**************************************
*
*
SETKEY   EQU      %
         STW,P1   KBUF
         LI,D1    3
         STB,D1   KBUF
         B        0,LNK
*
*  SAVE KEY FROM LAST READ
*
SETLASTKEY        EQU %
         PUSH     LNK
         LW,D1    *F:EI+10
         STW,D1   LASTKEY
         LW,LNK   F:EI+4            SET RECORD SIZE RECEIVED
         SLS,LNK  -17
         STW,LNK  RECSIZE
         AI,LNK   -1                DELETE CR FROMIMAGE.  CHECKBOTH
         LI,D1    X'15'             BTM
         CB,D1    CARDIMG,LNK
         BE       SETK2
         LI,D1    X'0D'             AND UTS CR'S
         CB,D1    CARDIMG,LNK
         BE       SETK2
         BAL,LNK  SETEOD
         B        SETK6
SETK2    LI,D1    ' '               BLANK WILL NOT INTERFERE
         STB,D1   CARDIMG,LNK       WITH STRING EDITING.
         STW,LNK  RECSIZE
SETK6    DO1      MODE=2
         BAL,LNK  TABEXPAND
         PULL     LNK
*
*
         B        0,LNK
         PAGE
**************************************************
*  IN UTS VERSION, EACH RECORD SUBJECT TO        *
*  EDITING WILL HAVE EMBEDDED TAB CHARACTERS     *
*  EXPANDED ACCORDING TO THE CURRENT TAB         *
*  STOPS CONTAINED IN THE M:UC DCB.              *
**************************************************
*
         DO       MODE=2
TABEXPAND         EQU %
         MTW,0    FILETYPE          IF NOT EDITING,
         BLZ      0,LNK             EXIT.
         MTW,0    TABXFLAG
        BNEZ     0,LNK
         PUSH     (X3,LNK)
         LI,X3    0                 START AT FIRST TAB IN DCB.
         LI,X4    0                 START AT FIRST CHAR. IN CARDIMG
         STW,X4   TABCFLAG          INDICATE DONT COMPRESS
TABX4    LI,P1    X'05'
TABX5    CB,P1    CARDIMG,X4
         BE       TABX10
         AI,X4    1
         CW,X4    RECSIZE
         BL       TABX5             WHEN OUT OF CHARACTERS,
*
TABX7    PULL     (X3,LNK)          EXIT
         B        0,LNK
*
TABX10   LB,X1    M:UC+15,X3
         BNEZ     TABX15
*
         AI,X3    0                 IF NO MORE TABS IN DCB, WE CAN
         BNEZ     TABX7             EXIT, UNLESS THERE WERE NO TABS
TABX12   MTW,0    TABERRFLAG        AT ALL.
         BNEZ     TABX7
         MTW,1    TABERRFLAG
         BAL,LNK  TYPEMSG           IN THAT CASE, ERROR.
         DATA     UTSM8
         B        TABX7
*
TABX15   AI,X1    -1                IS THIS TAB POSITION GREATER THAN
         CW,X1    X4                POSITION OF TAB CODE.
         BG       TABX17
         AI,X3    1                 IF NOT, TRY NEXT TAB POSITION,
         CI,X3    16                IF NOT AT MAX NBR OF TABS.
         BL       TABX10
         B        TABX7
*
TABX17   LI,P1    ' '               PUT A BLANK OVER ACTUAL TAB CODE.
         STB,P1   CARDIMG,X4
         MTW,1    TABCFLAG          TO INDICATE COMPRESS
         AI,X4    1                 INCREMENT TO NEXT BYTE.
         LW,X2    RECSIZE
         AI,X2    -1                DETERMINE LAST BYTE POSITION.
*
         SW,X1    X4                COMPUTE NUMBER OF BLANKS TO INSERT.
         BEZ      TABX4             IF ZERO, ITERATE.
         AW,X1    X2                INCREMENT TO NEW LAST BYTE.
         STW,X1   RECSIZE           SET NEW RECORD SIZE.
         MTW,1    RECSIZE
TABX19   LB,P2    CARDIMG,X2        MOVE BYTES UP, STARTING AT TOP,
         STB,P1   CARDIMG,X2        BLANKING AS WE GO.
         STB,P2   CARDIMG,X1
         AI,X1    -1
         AI,X2    -1
         CW,X2    X4                GO DOWN ONLY TO BYTE JUST ABOVE
         BGE      TABX19            TAB BLANK.
*
         LW,X4    X1                INCREMENT BYTE POSITION TO LAST
         AI,X3    1
         B        TABX4             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    FILETYPE
        BLZ      0,LNK
         MTW,0    TABCFLAG          IF NO COMPRESSION NEEDED, EXIT.
         BEZ      0,LNK
         PUSH     (X3,P2)
         LI,X3    0
         LB,X1    M:UC+15,X3
         BNEZ     TABC13
TABC5    PULL     (X3,P2)           EXIT.
         B        0,LNK
TABC10   LB,X1    M:UC+15,X3        SKIP TO LAST TAB POSITION+1
         BEZ      TABC15            IN DCB.
TABC13   AI,X3    1
         CI,X3    16
         BL       TABC10
TABC15   AI,X3    -1                MOVE DOWN TO NEXT LOWER TAB
         BLZ      TABC5             POSITION. IF ALL GONE, EXIT.
         LB,X1    M:UC+15,X3
         CW,X1    RECSIZE           DONT PUT ANY TAB CHARACTERS
         BG       TABC15            PAST END OF RECORD
         AI,X1    -2                MAKE INDEX TO NEXT LOWER BYTE.
         LI,P1    ' '               IS NEXT LOWER BYTE A BLANK.
         CB,P1    CARDIMG,X1
         BNE      TABC15            IF NOT, WE CAN'T COMPRESS IMAGE.
         LW,X4    X3                IF BLANK, WE CAN COMPRESS DOWN
         AI,X4    -1
         BLZ      TABC17            TO NEXT LOWER TAB POSITION.
         LB,X4    M:UC+15,X4
         AI,X4    -2                TAB POSITION,
TABC17   LW,X2    X1                CREATE NEW INDEX,
TABC18   CB,P1    CARDIMG,X2        MOVE IT DOWN TO
         BNE      TABC20            A NON-BLANK,
         AI,X2    -1
         CW,X2    X4                OR TAB BOUNDARY.
         BG       TABC18
*
TABC20   AI,X2    1                 MOVE BACK UP TO BLANK.
         AI,X1    1                 MOVE BACK UP TO TAB COLUMN.
         LI,P2    X'05'             PUT TAB CHARACTER OVER BLANK,
         STB,P2   CARDIMG,X2
         AI,X2    1                 INCREMENT, AND CHECK IF MORE SPACE
         CW,X2    X1                EXISTS BETWEEN INDICES.
         BE       TABC15            IF NOT, TRY NEXT LOWER TAB.
*
TABC25   LB,P2    CARDIMG,X1        MOVE BYTES DOWN, STARTING AT TAB
         STB,P2   CARDIMG,X2        COLUMN, AND CONTINUING UP TO END
         AI,X2    1                 OF RECORD.
         AI,X1    1
         CW,X1    RECSIZE
         BL       TABC25
*
         STW,X2   RECSIZE           SET NEW, SMALLER RECORD SIZE,
         B        TABC15            AND GET NEXT TAB.
         FIN
         PAGE
*********************************
*  TEST IF EDIT FILE IS ACTIVE  *
*********************************
*
*
TESTEDITACTIVE    EQU %
         MTW,0    FILETYPE          TEST IF EDIT FILE ACTIVE
         BLZ      0,LNK             NO - EXIT
         PUSH     LNK               SAVE REG
         BAL,LNK  CLOSE             CLOSE IT
         BAL,LNK  TYPEMSG           TYPE: '..EDIT STOPPED'
         DATA     MSG4
         LI,D1    -1                SET FILETYPE=-1 (NOT OPEN)
         STW,D1   FILETYPE
         PULL     LNK               RESTORE REG
         B        0,LNK             EXIT
         PAGE
********************************
*  TYPE CARD IMAGE             *
*    P1 = SEQ. NUMBER TO TYPE  *
********************************
*
*
TYPECARD EQU      %
         PUSH     (X1,LNK)          SAVE REGS
         LW,X2    EODCLMN           SET X2=NUMBER OF SIGNIFICANT CHARS
         AI,X2    1
         CI,P1    0                 IS SEQ # < 0 (MEANING DON'T TYPE IT)
         BGE      TC25
*
         DO       MODE=1
        LI,P1    72                72 CHARACTERS IF NO SEQ #
TC5      LI,X1    0                 INITIALIZE CHARACTER POSITION.
TC10     LB,R0    CARDIMG,X1        SEND CHARACTER
         CAL3,1   0
         AI,X1    1                 UPDATE CHARACTER POSITION.
         AI,X2    -1                IF ALL CHARACTERS GONE, GET OUT.
         BLEZ     TC15
         BDR,P1   TC10
*
         BAL,LNK  TYPEMSG           INTERSPERSE WITH CR/LF.
         DATA     MSG0
         LI,P1    72                NOW ITERATE ON 72.
         B        TC10
*
         ELSE
TC5      CAL1,1   TPC%FPT
         FIN
TC15     BAL,LNK  TYPEMSG
         DATA     MSG0
         PULL     (X1,LNK)          RESTORE REGS
         B        0,LNK             EXIT
*
*
TC25     BAL,LNK  TYPESEQ           TYPE SEQ #
         GEN4     BL,EOM,0,0
        LI,P1    62                62 CHARACTERS ALOWWS FOR SEQ #
         B        TC5
         PAGE
**************************************************
*  TYPE COMMAND OR PARAMETER ERROR               *
*    WORD AFTER BAL = WORD ADDR OF TEXTC-STRING  *
**************************************************
*
*
TYPECERR EQU      %
         MTW,-1   ERRORCNT          IS ERROR CNT EXHAUSTED
         BLZ      1,LNK             YES - SKIP PRINTING ERROR MSG
         PUSH     (X1,P1),LNK
         LI,X1    2
         LI,X2    'C'
         LB,D0    *CDTADR,X1        GET # OF CURRENT CMND IN CDT
         LW,P1    0,LNK             SET P1=ADDR OF STRING
         B        TP10
*
*
TYPEPERR EQU      %
         PUSH     (X1,P1),LNK
         LW,P1    0,LNK             SET P1=ADDR OF STRING
         MTW,-1   CDT               TEST IF ONLY ONE CMND IN CDT
         BGZ      TP20              NO - GO FIX UP ERROR MSG
*
*  ONLY ONE COMMAND IN CDT: PRINT 'P' ERROR AS IT STANDS
*
TP5      LI,X2    'P'
         LW,D0    PARAMPSN          CALC POSITION OF CURRENT PARAMETER
         AI,D0    -2
         SLS,D0   -1
*
*  SEARCH FOR FIRST 'C(P)'
*
TP10     SLS,P1   2                 SET P1=X1=BYTE ADDR OF STRING
         LW,X1    P1
         AI,X1    1                 SEARCH DOWN STRING TO FIRST 'C(P)'
         CB,X2    0,X1
         BNE      %-2
         AI,X1    1                 SET X1=ADDR OF CHAR AFTER 'C(P)'
         OR,D0    XF0               CONVERT COUNT TO EBCDIC (MOD 10)
         STB,D0   0,X1               AND PUT IN STRING
         DO       MODE=1
         LB,X2    0,P1              SET X2=LENGTH OF STRING
         AI,P1    1
         LB,R0    0,P1              GET CHAR FROM STRING
         CAL3,1   0                 TYPE IT
         BDR,X2   %-3               LOOP
         LI,R0    CR                TYPE: L/F + C/R
         CAL3,1   0
         LI,R0    LF
         CAL3,1   0
         ELSE
         SLS,P1   -2                GO BACK TO WORD ADDRESS.
         STW,P1   DMY%TPM+1         SET UP ADDRESS FOR TYPEMSG.
         BAL,X1   DMY%TPM
         FIN
         PULL     (X1,P1),LNK
         B        1,LNK             EXIT
*
* THERE IS MORE THAN ONE COMMAND IN CDT: ADD 'CN' TO ERROR MSG
*
TP20     LW,D1    TPMSG             PUT '-C1' IF TEMPBLCK
         STW,D1   TEMPBLCK
         LB,X1    *P1               GET LENGTH OF ERROR MSG
         LW,X2    X1
         AI,X2    2
         STB,X2   TEMPBLCK          PUT LENGTH+2 IN TEMPBLCK
         LB,D1    *P1,X1            MOVE ERROR MSG TO TEMPBLCK AFTER
         STB,D1   TEMPBLCK,X2        '-C1'
         AI,X2    -1
         BDR,X1   %-3               LOOP
         LI,X1    2
         LB,D0    *CDTADR,X1        GET # OF CMND IN CDT
         AI,D0    '0'               CONVERT TO EBCDIC
         LI,X1    3
         STB,D0   TEMPBLCK,X1       PUT IT AFTER 'C' TO YIELD FORM:
         LI,P1    TEMPBLCK           '-CNP1:ERROR MSG'
         B        TP5               GO PROCESS 'P'
*
*
TPMSG    TEXTC    '-C1'
         PAGE
**************************************************
*  TYPE MESSAGE
*    WORD AFTER BAL = WORD ADDR OF TEXTC-STRING  *
**************************************************
*
*
TYPEMSG  EQU      %
         PUSH     (X1,X2),LNK       SAVE REGS
         DO       MODE=1
         LW,X1    0,LNK             SET X1=BYTE ADDR OF STRING
         SLS,X1   2                     X2=NUMBER OF CHARS TO TYPE
         LB,X2    0,X1
         AI,X1    1
         LB,R0    0,X1              GET CHAR FROM STRING
         CI,R0    EOM               IS CHAR=EOM
         BE       TM5               YES - STOP TYPING
         CAL3,1   0                 TYPE IT
         BDR,X2   %-5               LOOP
         LI,R0    CR                TYPE: L/F + C/R
         CAL3,1   0
         LI,R0    LF
         CAL3,1   0
         ELSE
         LW,LNK   0,LNK             GET ADDRESS OF MESSAGE AND BYTE
         LI,X1    0
         LB,X2    *LNK
*                                   NOW RUN DOWN TO FIRST NON-ZERO
*                                   CHARACTER
         CB,X1    *LNK,X2
         BNE      %+2
         BDR,X2   %-2
*
         LI,R0    EOM               IF EOM, DO NOT PRINT IT.
         CB,R0    *LNK,X2           BUT MARK NOT TO RETURN CARRIAGE.
         BNE      TM4
*
         AI,X2    -1                EOM FOUND.
         LI,X1    -1
*
TM4      CAL1,1    TYPM%FPT
         AI,X1    0
         BLZ      TM5
*
         BAL,LNK  TYPEMSG           YES.  CALL RECURSIVELY TO
         DATA     MSG0              SEND IT OUT.
         FIN
TM5      PULL     (X1,X2),LNK       RESTORE REGS.
         B        1,LNK             EXIT
         PAGE
***************************************************
*  TYPE SEQUENCE NUMBER                           *
*    P1 = SEQ. NUMBER TO TYPE                     *
*    WORD AFTER BAL = 4 CHARS TO APPEND TO SEQ #  *
***************************************************
*
*
TYPESEQ  EQU      %
         PUSH     (X2,LNK)          SAVE REGS
         LW,X2    LNK
         LI,P2    BA(TEMPBLCK)
         BAL,LNK  BINTODEC          CONVERT SEQ # TO EBCDIC: ' DDDDDDD'
         LW,D0    TEMPBLCK+1        PUT A '.' BETWEEN 4TH AND 5TH
         LW,D1    0,X2               DIGITS AND APPEND 4 SPECIFIED
         SLD,D0   -8                 CHARS TO END
         LB,P1    TEMPBLCK+1
         SLS,P1   8
         OR,P1    KPE
         STW,D0   TEMPBLCK+1        PUT THIS BACK IN TEMP BLOCK
         STH,P1   TEMPBLCK+1
         STW,D1   TEMPBLCK+2
         LW,P1    0,X2              GET 4TH SPECIFIED CHAR AND PUT
         SLS,P1   24                 IN TEMP BLOCK
         STW,P1   TEMPBLCK+3
         LI,D0     ' '              ADD ZEROS BETWEEN DECIMAL
         LI,D1     '0'              POINT AND ANY NUMBER
         LI,X2     BA(TEMPBLCK)+6
         CB,D0     0,X2             IF NECCESSARY.
         BNE       TS10             ZEROS COULD ONLY BE NEEDED
         STB,D1    0,X2             IN TEMPBLCK +6 AND +7.
         AI,X2     1
         CB,D0     0,X2             SEE IF SECOND ONE IS NECCESSARY
         BNE       TS10
         STB,D1    0,X2
*
*  MAKE STRING INTO A TEXTC-STRING AND TYPE
*
TS10     LI,P1    12                ATTACH COUNT TO MAKE A TEXTC-STRING
         STB,P1   TEMPBLCK
         BAL,LNK  TYPEMSG           TYPE: 'DDD.DDDXXX' WITH LEADING
         DATA     TEMPBLCK           0'S SUPPRESSED
         PULL     (X2,LNK)          RESTORE REGS
         B        1,LNK             EXIT
         PAGE
***********************************************
*  WRITE RECORD IN COPY FILE                  *
*    P1 = SEQ. NUMBER TO WRITE                *
*    CC1=1 IF RECORD EXISTS; CC1=0 OTHERWISE  *
***********************************************
*
*
WRITE2   EQU      %
         PUSH     (LNK,P3)
         BAL,LNK  SETKEY
         BAL,LNK  PUTCR
         DO1      MODE=2
         M:SETDCB F:EO,(ABN,W2%ABN)
         M:WRITE  F:EO,;
                  (WAIT),;
                  (KEY,KBUF),;
                  (NEWKEY),;
                  (ABN,W2%ABN),;
                  (SIZE,*RECSIZE)
         PULL     (LNK,P3)
         LCI      0                 NON-EXISTENT
         B        0,LNK
*
*
W2%ABN   RES      0
         LB,D1    P3
         CI,D1    X'16'
         BNE      BADIO
*
         PULL     (LNK,P3)
         LCI      8                 RECORD EXISTED
         B        0,LNK
         PAGE
***********************************************
*  WRITE NEW RANDOM RECORD                    *
*    P1 = SEQ. NUMBER TO WRITE                *
*    CC1=0 IF RECORD EXISTS; CC1=1 OTHERWISE  *
***********************************************
*
*
WRITENEWRANDOM    EQU %
         PUSH     (LNK,P3)
         BAL,LNK  SETKEY
         BAL,LNK  PUTCR
         DO1      MODE=2
         M:SETDCB F:EI,(ABN,WNR%ABN)
         M:WRITE  F:EI,;
                  (WAIT),;
                  (KEY,KBUF),;
                  (NEWKEY),;
                  (SIZE,*RECSIZE),;
                  (ABN,WNR%ABN)
         PULL     (LNK,P3)
         LCI      0
         B        0,LNK
*
*
*
WNR%ABN  RES      0
         LB,D1    P3
         CI,D1    X'16'
         BNE      BADIO
         PULL     (LNK,P3)
         LCI      8
         B        0,LNK
         PAGE
*********************************
*  WRITE RANDOM RECORD          *
*    P1 = SEQ. NUMBER TO WRITE  *
*********************************
*
*
WRITERANDOM       EQU %
         PUSH     LNK
         BAL,LNK  SETKEY
         BAL,LNK  PUTCR
         M:WRITE  F:EI,;
                  (WAIT),;
                  (KEY,KBUF),;
                  (ONEWKEY),;
                  (SIZE,*RECSIZE)
         PULL     LNK
         B        0,LNK
ENDEDITOR         EQU    %+10
         END      BEGINEDITOR

