**********************************************************************
*M* EDIT IS A FILE BUILDING/MAINTENANCE UTILITY FOR ON-LINE CP-V USERS
**********************************************************************
*P*      NAME     EDIT
*P*
*P*      PURPOSE  THE EDIT PROCESSOR IS A FILE MANIPULATION
*P*               UTILITY AVAILABLE TO ON-LINE CP-V USERS.
*P*               ITS CAPABILITIES INCLUDE THE BUILDING, DELETING
*P*               COPYING AND MERGING OF ENTIRE FILES AND EDITING
*P*               RECORDS WITHIN FILES AS WELL AS EDITING OF DATA
*P*               WITHIN RECORDS.
*P*
*P*      REFERENCE: EDIT SUBSYSTEM TECHNICAL MANUAL.  THIS 105
*P*               PAGE DOCUMENT CONTAINS DETAILED FLOWCHARTS, TABLES
*P*               AND SUBROUTINE DESCRIPTIONS, AND JUST ABOUT
*P*               EVERYTHING A SYSTEMS PROGRAMMER NEEDS
*P*               TO GET INTO EDIT FOR MODIFICATIONS OR DEBUGGING.
*P*
*P*      REFERENCE: CP-V EDIT REFERENCE CARD (COMMAND STRUCTURE)
*P*               THIS CARD CONTAINS THE COMMAND STRUCTURES FOR
*P*               ALL THE EDIT FUNCTIONS AND IS VERY
*P*               HANDY TO KEEP BY THE USERS TERMINAL.
*P*
*P*      REFERENCE: CP-V TIME SHARING REFERENCE MANUAL.
*P*               THIS MANUAL HAS AN EDIT SECTION WHICH SHOWS
*P*               IN GREAT DETAIL ALL THE EDIT COMMANDS ALONG
*P*               WITH EXAMPLES OF USAGE.  IT WOULD BE THE USERS
*P*               BEST INITIAL INTRODUCTION TO EDIT.
*P*
*P*      REFERENCE: CP-V TIME-SHARING USER'S GUIDE.
*P*               THIS MANUAL CONTAINS A SECTION ON EDIT
*P*               SIMILAR TO THE TIME-SHARING REFERENCE MANUAL.
*P*
*P*
*P*      DESCRIPTION: EDIT IS ORGINIZED IN A HIGHLY MODULAR FASHON.
*P*               UPON ENTRY, 'BEGINEDITOR' PERFORMS INITIALIZATION
*P*               AFTER WHICH 'MASTERPARSER' CONTROLS INPUT COMMAND
*P*               SCAN OF A LINE OF USER COMMANDS.  FROM A LINE OF
*P*               INPUT COMMAND(S) THE COMMAND DESCRIPTION TABLE (CDT)
*P*               IS BUILT.  ERROR CHECKS ARE MADE AND WARNINGS GIVEN
*P*               TO THE USER IF NECESSARY. 'MASTERPARSER' USES A
*P*               NUMBER OF SUBROUTINES TO BUILD THE CDT: 'GETNAME'
*P*               AND 'GETNEXTPARAM' TO BREAK DOWN TEXT STRINGS;
*P*               'PARSE:I:CMND%INTG' TO PROCESS INTEGER STRINGS;
*P*               'PARSE:I:CMND%STRG' TO PROCESS ALPHABETIC STRINGS
*P*               IN SLASHES; AND ROUTINES OF THE FORM 'PARSE:CMND'
*P*               FOR COMMAND PROCESSING.
*P*
*P*               ON ENCOUNTERING A CARRIAGE RETURN CHARACTER,
*P*               CONTROL IS PASSED TO THE 'MASTEREXECUTIVE' ROUTINE
*P*               TO PERFORM THE COMMANDS WHICH THEN RESIDE IN THE CDT.
*P*               'MASTEREXECUTIVE' SERVES AS A DRIVER FOR COMMAND
*P*               PROCESSING USING 'F:' ROUTINES FOR FILE COMMANDS,
*P*               'R:' ROUTINES FOR RECORD COMMANDS AND 'I:' ROUTINES
*P*               FOR INTRA-RECORD COMMAND PROCESSING.
*P*
         PAGE
*
*  A CDT ENTRY HAS THE FOLLOWING FORMAT WHEN COMPLETE:
*
*    *****************************************************************
*    *  # OF WORDS   *    COMMAND    *  # OF ENTRY   *   MAX # OF    *
*    * IN THIS ENTRY *    NUMBER     *    IN CDT     *    PARAMS     *
*    *               *               *               *               *
*    *****************************************************************
*    *  PARAM1 TYPE  * WORD DISP TO  *  PARAM2 TYPE  * WORD DISP TO  *
*    *               * PARAM1 REL TO *               * PARAM2 REL TO *
*    *               *START OF ENTRY *               *START OF ENTRY *
*    *****************************************************************
*    *  PARAM3 TYPE  * WORD DISP TO  *  PARAM4 TYPE  * WORD DISP TO  *
*    *               * PARAM3 REL TO *               * PARAM4 REL TO *
*    *               *START OF ENTRY *               *START OF ENTRY *
*    *****************************************************************
*    .               .               .               .               .
*    .               .               .               .               .
*    .               .               .               .               .
*    *****************************************************************
*    * PARAMN-1 TYPE * WORD DISP TO  *  PARAMN TYPE  * WORD DISP TO  *
*    *               *PARAMN-1 REL TO*               * PARAMN REL TO *
*    *               *START OF ENTRY *               *START OF ENTRY *
*    *****************************************************************
*    *                         PARAM1 DATA                           *
*    *****************************************************************
*    *                         PARAM2 DATA                           *
*    *****************************************************************
*    *                         PARAM3 DATA                           *
*    *****************************************************************
*    *                         PARAM4 DATA                           *
*    *****************************************************************
*    .                                                               .
*    .                                                               .
*    .                                                               .
*    *****************************************************************
*    *                        PARAMN-1 DATA                          *
*    *****************************************************************
*    *                         PARAMN DATA                           *
*    *****************************************************************
         PAGE
*                 MODE = 1 FOR BTM VERSION
*                      = 2 FOR UTS VERSION
*
MODE     EQU      2
*
EDITBASE CSECT    0
         SYSTEM SIG7FD
         SYSTEM   BPM
         DO       MODE=2
,BPMPT0,BPMPT1 ;
         M:PT     1                 SET PROTECTION TYPE 1 FOR FPTS
         DEF      BPMPT0            BASE OF SYSTEM BPM PT 0
         DEF      BPMPT1            BASE OF SYSTEM BPM PT 1
         FIN
*
S        FNAME                      THIS FUNCTION SIMPLY SELECTS
         PROC                       THE FIRST OR SECOND PARAMETER
         PEND     AF(MODE)
*
*
         DEF      EDITBASE          DATA AREA FOR EDIT
         DEF      BEGINEDITOR       EDITOR START ADDRESS
         DEF      SECT1             DATA AREA ADDRESS (FOR GENMDS)
         DEF      SECT5             PURE PROCEDURE ADDR (FOR GENMDS)
         DEF      CNAMETBL          COMMAND NAME TABLE
         DEF      CBRCHTBL          COMMAND TRANSFER VECTOR
         DEF      CNMRTBL           COMMAND NUMBER TABLE
         DO       MODE=2
         DEF      PATCH             PATCH AREA (FOR GENMDS)
         REF      J:CCBUF           TTY BUFFER PASSED FROM TEL
         REF      M:UC              DCB FOR USER TERMINAL
         REF      M:EI              EDIT INPUT DCB
         REF      M:EO              EDIT OUTPUT DCB
         REF      M:C               EDIT COMMAND INPUT DCB FOR FILES
         REF      F:ERRMSG          DCB FOR READING ERROR MESSAGE FILE
         REF      JB:CCARS          BYTE COUNT OF STRING IN J:CCBUF
         ELSE
         DEF      F:EI              BTM DCB (INPUT)
         DEF      F:EO              BTM DCB (OUTPUT)
         DEF      F:C               BTM DCB (COMMAND INPUT FROM FILES)
         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
*
*
*
CHK%ABN  CNAME    4
CHK%ERR  CNAME    3
         PROC
         DO       MODE=2
LF       LI,T1    X'1FFFF'          L/MASK FOR ERR/ABN IN DCB
         AND,T1   AF(1)+NAME        ADR OF ERR/ABN IN DCB
         CI,T1    AF(2)             C/DCB'S ADR W/CALLER'S
         BE       %+2               BE; ALREADY SET, SKIP M:SETDCB
         FIN
         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
COL1     EQU      13                PARAM TYPE FOR 1ST COL #
COL2     EQU      14                PARAM TYPE FOR LAST COL #
STRG:AND EQU      STRG+X'10'
STRG:OR  EQU      STRG+X'20'
STRG:EOR EQU      STRG+X'30'
STRG:NOT EQU      X'80'
*
*
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      256
SEQLIM   EQU      9999999           FOR MAX. SEQ. NO.
STACKSZ  EQU      125               SIZE OF TEMP STACK
*
*
*
BL       EQU      ' '
CM       EQU      ','
CR       EQU      S(X'15',X'0D')
EOF      EQU      10000000
EOM      EQU      ' '               EOM CHARACTER
FF       EQU      X'0C'
LF       EQU      S(X'25',X'15')
PR       EQU      '.'
LP       EQU      '('
RP       EQU      ')'
SC       EQU      ';'
PAD      EQU      ' '               PAD (.FF) CHAR
         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  *
*******************
*
*
SECT1    EQU      %
K1       DATA     1
K10      DATA     10
KPE      DATA     '.'
*
X7       DATA     7
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'
X:C      TEXTC    'C'
*
         FIN
*
*  SPECIAL LIMITS
*
         BOUND    8
DIGITS   DATA     '0','9'
LETTERS  DATA     'A','Z'
         DO       MODE=2
LCLETTERS DATA    X'81',X'A9'
LIM%A%F  DATA     'A','F'
LIM%XA%XF DATA    X'A',X'F'
         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
         BOUND    8
CARDIMG  RES,1    MAXCLMN           CARD IMAGE
         BOUND    8
TTYIMG   RES,1    MAXCLMN           TELETYPE IMAGE
         BOUND    8
         DATA     ,                 ENSURE BYTE BEFORE COMPRIMG IS NON-BLANK
COMPRIMG RES,1    MAXCLMN           COMPRESSED IMAGE (TC)
         BOUND    8
RECSIZE  DATA     MAXCLMN           GLOBAL: SIZE OF CARDIMG
TTYIMGSZ DATA     0                 GLOBAL: SIZE OF TTYIMG
COMPRIMGSZ DATA   0                 COMPRESSED IMAGE SIZE
CDT      RES      100               GLOBAL: COMMAND DESCRIPTION TABLE
CDTADR   RES      1                 GLOBAL: ADR OF CURRENT CMND IN CDT
SSE%CDT  RES      100               SAVED CDT W/STRING SELECTION EXPRESSION
CHARPSN  RES      1                 PARSER: PSN OF NEXT CHAR TO SCAN
TCHARPSN DATA     0                 TEMP CHAR POSITION (CHARPSN)
PREVIOUS%CHARPSN DATA 0             CHARSPN BEFORE LAST FIELD WAS SCANNED
CMND%DCB%ADR DATA M:UC              ADR OF DCB FOR CMND INPUT (XEQ)
COPYFL   DATA     0                 F:COPY-- FID1=FID2 IF 1
CRFLAG   DATA     0                 GLOBAL; NZ/PUT CR ON END OF RECS
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
XEQ%ECHO%FLAG DATA 0                GLOBAL: NZ/ECHO XEQ RECS
XEQ%ECHOED DATA   0                 GLOBAL: CURRENT XEQ REC ECHO'D
XEQ%REC# DATA     0                 # OF XEQ RECS ECHOED
CURRENT%CMND#      DATA 0           CMND # OF CURRENT CMND
LAST%TYPE%CMND DATA 0               CMND # OF LAST TY/TS/TC/RR
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
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
TERM%CHAR DATA    0                 GLOBAL: COMMAND TERMINATOR CHAR
SAVE1    DATA     0                 TEMP SAVE
SAVE2    DATA     0                 TEMP SAVE
*
DELNXT   DATA     0                 DELETE TEMP
*
         BOUND    8
STACKDW  DATA     STACK             GLOBAL: DW FOR HARDWARE PSW/PLW
         DATA,2   STACKSZ,0
MVD:REC:CNT DATA  0                 COUNT OF RECORDS MOVED
CHG:STG:CNT DATA  0                 COUNT OF STRINGS CHANGED
SAVED:CHG:STG:CNT DATA 0            CHG:STG:CNT, SAVED AT START OF REC
RP%FLAG  DATA     0                 GLOBAL: NZ/PRESERVE REC SIZE
CT%FLAG  DATA     0                 TYPE BEFORE 'CM' INPUT
TRECSIZE DATA     0                 TAB RECORD SIZE (FOR RP-ON)
ZERO:STG:FLG DATA 0                 FLAG TO INDICATE ZERO STRINGS
ERRKEY   DATA     0                 KEY FOR ERRMSG.:SYS FILE READ
         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'
ERRC12   TEXTC    '-C1:REC>139 CHARS'
ERRC14   TEXTC    '-C1:DESTINATION RECS EXIST'
ERRC15   TEXTC    '-C1:INPUT ERROR; REC NOT CHANGED'
ERRC16   TEXTC    '-C1:CMND CAN''T BE COMPOUNDED'
*
*
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 OCCURRENCES OF BLANKS.'
*
ERRM22   TEXTC    '--FILE OPEN FOR INPUT ONLY; CANNOT UPDATE'
ERRM23   TEXTC    '-INPUT ERROR - RETRY'
ERRM24   TEXTC    '-BEGINNING OF FILE HIT'
ERRM25   TEXTC    '-FILE OPEN FOR INPUT ONLY; CAN''T UPDATE'
ERRM26   TEXTC    '--NOTHING TO DELETE'
ERRM27   TEXTC    ':FILE NOT CREATED BY EDIT (KEYM NOT 3)'
ERRM28   TEXTC    ':I/O ABN/ERR - ',;
                  '                                        ',;
                  '                                        '
TC1HYPH  TEXTC    '-'
TC2HYPH  TEXTC    '--'
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'
ERRP15   TEXTC    '-P1:ILGL STRG'
ERRP16   TEXTC    '-P1:FILE NOT KEYED & P3 NULL'
ERRP17   TEXTC    '-P1:PARAM MISSING'
ERRP18   TEXTC    '-P1:NULL STRG'
ERRP19   TEXTC    '-P1:NOT LOGICAL OPERATOR'
ERRP20   TEXTC    '-P2:COL NOT ALLOWED'
ERRP21   TEXTC    '-P1:REC EXISTS'
ERRP22   TEXTC    '-P1:NOT 1 TO 8 CHARS'
ERRP23   TEXTC    '-P1:ILLEGAL HEXADECIMAL DIGIT'
ERRP24   TEXTC    '-P1:NOT COL # OR STRING SELECTOR'
*
*
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'
MSGXEQ:  TEXTC    'XEQ: ',EOM       FOR ECHOING XEQ CMNDS
*
*
IOERRMSG DATA     X'0060C2C1'+((IOERRCOD+2-IOERRMSG)*4-1)**24
         TEXT     'D I/O; ABN CODE'
IOERRCOD TEXT     '        '        ABN CODE-SUBCODE PUT HERE
*
*
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
         DO       MODE=2
         MTW,0    BUILDFLAG         WAS ENTRY FROM TEL (!B)
         BNEZ     MASTERPARSER      NO
         B        F:END             YES, EXIT
         ELSE
         B        MASTERPARSER      CONTINUE
         FIN
*
*
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
         TEXTC    'F:C'
         DATA     F:C
LINK1    DATA     0
         ELSE
*
**************************************************
*        UTS INTERFACE PARAMETERS AND MESSAGES.  *
**************************************************
*
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
TABXFLAG         DATA 1
TABX%FLAG DATA    1                 GLOBAL: NZ/'TABX ON'
TSADDR   DATA     0                 TEMP STACK ADDRESS
XEQFLAG  DATA     -1                MINUS ONE IF NOT IN EXECUTION.
CRPT%KEY DATA     0                 KEY FOR DATA ENCRYPTION
CRPT%FLAG DATA    0                 NZ/DATA ENCRYPTION ON
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
TYPM%FPT GEN,8,24 X'11',M:UC
         DATA     X'34000010'
         PZE      *LNK
         PZE      *X2
         DATA      1
*
*
UTSM1    TEXTC    'EDIT HERE'
UTSM2    TEXTC    '* '              * + EOM
UTSM3    TEXTC    '-NOT F/M/S/C'
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'
*                                            *****
PATCH    EQU      %                 100 WORDS OF ZERO'D PATCH SPACE
         LIST     0
         DO1      100
         DATA
         LIST     1
*
         FIN
         PAGE
***********************************************
*  OPEN FPT'S (HAND-CODED TO AVOID PROBLEMS)  *
***********************************************
*
*
OPEN%DCB%ADR DATA 0                 ADR OF DCB BEING OPENED
O%FPT    GEN,1,7,24 1,X'14',OPEN%DCB%ADR    M:OPEN *OPEN%DCB%ADR
         DATA     X'E5480001'
         DATA     BADIO             (ERR,BADIO)
O%FPT%ABN DATA    O%ABN             (ABN,O%ABN)
         DATA     CARDIMG           BUF
         DATA     2                 KEYED
O%FPT%MODE 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
         DATA     X'E5480001'
         DATA     BADIO             (ERR,BADIO)
O2%FPT%ABN DATA   O2%ABN            (ABN,O2%ABN)
         DATA     CARDIMG           (BUF,CARDIMG)
         DATA     2                 (KEYED)
O2%FPT%MODE DATA  4                 (INOUT)
         DATA     2                 (SAVE)
         DATA     3                 (KEYM,3)
         DATA     X'01000808'
O2%NAME  RES      8
         DATA     X'02000202'
O2%ACCT  RES      2
         DATA     X'03010202'
O2%PASS  RES      2
         DO       MODE=2
RELATIVE1 DATA    X'06200000'       THIS FPT FOR
         DATA     X'60000000'       RESETTING RELATIVE TABS, SPACE INSERTION
SVSPCINS DATA,2   0,X'20'           SPACE INSERTION MASK
SVTABSIM DATA,2   0,X'80'           LHW=BIT VALUE IS FILLED IN
         FIN
         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
         DO       MODE=1
F:C      CSECT    0
F:C      M:DCB    (FILE),;
                  (IN),;
                  (PASS,'SECRET'),;
                  (SAVE)
M:C      EQU      F:C
         FIN
         PAGE
***********************************
*                                 *
*     B E G I N   E D I T O R     *
*                                 *
***********************************
*
*
*
         CSECT    S(0,1)
BEGINEDITOR       EQU %
SECT5    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
*
         M:TS                       SAVE RELATIVE TABBING MODE
         LI,1     2                 L/BTD TO BYTE 2 OF R8
         LB,1     8,1               L/BYTE 2 OF R8
         AND,1    SVSPCINS          &/STATUS W/MASK; G/SPACE INSERTION BIT
         STH,1    SVSPCINS          S/SPACE INSERTION BIT INTO FPT
         AND,8    SVTABSIM          MASK FOR LATER RESTORE
         STH,8    SVTABSIM          SET UP FPT
         M:STA    (TABREL,ON)       SET RELATIVE TABBING
         M:XCON   F:END             ESTABLISH EXIT CONTROL
         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
         ELSE
F:TA     EQU      %                 DUMMY LABEL FOR TA COMMAND IN BTM
         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
         STW,T1   SAVED:CHG:STG:CNT 0/SAVED CHG:STG:CNT
         STW,T1   CT%FLAG           SET TYPE 'CM' FLAG OFF
         STW,T1   XEQ%ECHOED        RESET XEQ REC ECHOED FLAG
         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
         MTW,1    XEQ%REC#          INC COUNT OF XEQ RECS
         BAL,LNK  XEQ%ECHO%10       ECHO TTYIMG IF XEQ MODE & DESIRED
         AI,R1    -1                SAVE CNT OF # OF CHARS INPUT,
         STW,R1   TTYIMGSZ           LESS C/R
*
*  SPECIAL HANDLING OF LF AND UP-ARROW-CR COMMANDS
*
         LW,T1    SETFLAG           SEE IF SE HAS BEEN DONE
         BE       RESUME%PARSING    NOPE
         LB,T1    TTYIMG            L/1ST BYTE OF TTYIMG
         CI,T1    LF                C/1ST BYTE W/LF CHAR
         BE       MPLF10            B/LF; TYPE NEXT REC
         LH,T1    TTYIMG            L/1ST 2 BYTES OF TTYIMG
         CI,T1    '^'**8+CR         C/1ST 2 BYTES W/^CR
         BNE      RESUME%PARSING    B/NOT ^CR
         LW,P1    SV1STSET          L/STARTING SEQ # IN SET RANGE
         BAL,LNK  READ%NXT%REVERSE  READ NEXT REC BEFORE 1ST SEQ #
         BCR,8    MPLFUP            B/REC EXISTS
         LW,R1    *F:EI+10          L/KEY OF LAST REC READ
         AND,R1   =X'FFFFFF'        STRIP BC
         STW,R1   SV1STSET          S/SEQ # AS 1ST IN RANGE
         STW,R1   LASTSET           S/SEQ # AS LAST IN RANGE
         STW,R1   FIRSTSET          S/SEQ # AS CURRENT SEQ # IN RANGE
         BAL,LNK  TYPEMSG           BAL/TYPE ERROR MSG; BOF HIT
         DATA     ERRM24            '-BEGINNING OF FILE HIT'
         B        MASTERPARSER      B; GET NEXT COMMAND
MPLF10   LW,P1    LASTSET           LAST GUY IN SE RANGE
         AI,P1    1                 PLUS 1
         CW,P1    MAXSEQ            TOO FAR
         BG       RESUME%PARSING    YUP
         BAL,LNK  READNXTRANDOM
MPLFUP   CW,R1    MAXSEQ            IS SEQ. NO. TOO BIG
         BG       RESUME%PARSING    YUP
         STW,R1   SV1STSET          S/SEQ # AS 1ST IN RANGE
         STW,R1   LASTSET           S/SEQ # AS LAST IN RANGE
         STW,R1   FIRSTSET          S/SEQ # AS CURRENT SEQ #
         LW,X1    LAST%TYPE%CMND    L/LAST TY/TS/TC/RR CMND #
         BNE      %+2               BNE; 1 HAS BEEN ISSUED
         LI,X1    I:TY#             L/'TY' CMND #
         STW,X1   CURRENT%CMND#     S/NEW CURRENT CMND #
         BAL,LNK  S(TYPECARD,TYPRR) TS/TY/TC/RR REC
         B        MASTERPARSER      B; G/NEXT CMND
*
*
*
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
         OR,T1    =X'00404040'      CONVERT CMND TO UPPER CASE
         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
*
*
*
         PAGE
*
*  DEFINITION OF COMMANDS:
*
*  THE PR PROC BUILDS THE FOLLOWING PARALLEL TABLES:
*
*  LF FORMS A TEXTC ENTRY THAT IS THE COMMAND NAME, AND IS PUT INTO
*     A WORD TABLE 'CNAMETBL'.
*
*  CF(2) IS THE COMMAND NUMBER (USED IN THE EXECUTION PHASE), AND IS
*     PUT INTO A BYTE TABLE 'CNMRTBL'.
*
*  AF(1) IS THE ROUTINE THAT PARSES THE COMMAND, AND
*     FORMS A BRANCH INSTRUCTION IN THE WORD TABLE 'CBRCHTBL'.
*
CNAMETBL CSECT    1
CBRCHTBL CSECT    1
CNMRTBL  CSECT    1
*
PR       CNAME
         PROC
         USECT    CNAMETBL
I        SET      S:UT(LF)
         GEN4     S:NUMC(LF),I(1),I(2)|X'40',I(3)|X'40' TEXTC LF
         USECT    CBRCHTBL
         B        AF(1)
         USECT    CNMRTBL
         DATA,1   CF(2)
         PEND
*
         DO1      5                 1 DUMMY ENTRY, 4 SPARES
' '      PR,0     0                 DUMMY
'BP'     PR,F:BP# PARSE:BP          BP
         DO1      MODE=2
'TA'     PR,F:TA# PARSE:TA          TAB
'CR'     PR,F:CR# PARSE:CR          CR
'ECHO'   PR,F:EC# PARSE:ECHO        ECHO
'XEQ'    PR,F:XQ# PARSE:XEQ         XEQ
'CRPT'   PR,F:CP# PARSE:CRPT        CRPT (DATA ENCRYPTION)
'TABX'   PR,F:TE# PARSE:TABX        TABX (TAB EXPANSION)
'BUILD'  PR,F:BU# PARSE:BUILD       BUILD
'B'      PR,F:BU# PARSE:BUILD       BUILD (SHORT FORM)
'COPY'   PR,F:CO# PARSE:COPY        COPY
'C'      PR,F:CO# PARSE:COPY        COPY (SHORT FORM)
'DELETE' PR,F:DE# PARSE:DELETE      DELETE
'D'      PR,F:DE# PARSE:DELETE      DELETE(SHORT FORM)
'EDIT'   PR,F:ED# PARSE:EDIT        EDIT
'E'      PR,F:ED# PARSE:E           EDIT AND END (SHORT FORM)
'END'    PR,F:EN# PARSE:END         END
'X'      PR,F:EN# PARSE:END         END (X)
'MERGE'  PR,F:ME# PARSE:MERGE       MERGE
'M'      PR,F:ME# PARSE:MERGE       MERGE (SHORT FORM)
'RP'     PR,F:RP# PARSE:RP          RP
'DE'     PR,R:DE# PARSE:DE          DE
'FD'     PR,R:FD# PARSE:FD          FD
'FT'     PR,R:FT# PARSE:FT          FT
'IN'     PR,R:IN# PARSE:IN          IN
'IS'     PR,R:IS# PARSE:IS          IS
'IP'     PR,R:IP# PARSE:IP          IP
'MD'     PR,R:MD# PARSE:MD          MD
'MDP'    PR,R:MDP# PARSE:MDP        MDP
'MK'     PR,R:MK# PARSE:MK          MK
'MKP'    PR,R:MKP# PARSE:MKP        MKP
'RN'     PR,R:RN# PARSE:RN          RN
'SS'     PR,R:SS# PARSE:SS          SS
'ST'     PR,R:ST# PARSE:ST          ST
'AD'     PR,R:AD# PARSE:AD          AD
'TS'     PR,R:TS# PARSE:TS          TS
'TY'     PR,R:TY# PARSE:TY          TY
'TC'     PR,R:TC# PARSE:TC          TC
'FS'     PR,R:FS# PARSE:FS          FS
'CM'     PR,R:CM# PARSE:CM          CM
'CT'     PR,R:CM# PARSE:CT          CT
         DO1      MODE=2
'RR'     PR,R:RR# PARSE:RR          RR
'SE'     PR,I:SE# PARSE:SE          SE
'JU'     PR,I:JU# PARSE:JU          JU
'NO'     PR,I:NO# PARSE:NO          NO
'RF'     PR,I:RF# PARSE:RF          RF
'TX'     PR,I:TX# PARSE:TX          TX
CTBLSZ   EQU      BA(%)-BA(CNMRTBL)-1
         USECT    BEGINEDITOR       GO BACK TO PROCEDURE
R:R:%TO%I:   DATA,1 0               INTER-RECORD W/INTRA EQUIVALENTS
         DATA,1   R:TS#             TS
         DATA,1   R:TY#             TY
         DATA,1   R:TC#             TC
         DATA,1   R:RR#             RR
         DATA,1   R:AD#             AD
         DATA,1   R:DE#             DE
         BOUND    4
I:R:%TO%I:   DATA,1 0               INTRA-RECORD W/INTER EQUIVALENTS
         DATA,1   I:TS#             TS
         DATA,1   I:TY#             TY
         DATA,1   I:TC#             TC
         DATA,1   I:RR#             RR
         DATA,1   I:AD#             AD
         DATA,1   I:DE#             DE
#R:%TO%I:   EQU BA(%)-BA(I:R:%TO%I:)-1    # OF INTRA/INTER COMMANDS
         BOUND    8
LIMCRLF  DATA     CR,LF             CR, LF CHARACTERS
         PAGE
********************************
*  PROCESS INTRALINE COMMANDS  *
********************************
*
*
PARSE:I:CMND%STRG EQU %
         LI,P1    0
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY WITH CMND=0
         DATA     3                 MAX OF 3 PARAMS
         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     4                 MAX OF 4 PARAMS
         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
         OR,T1    =X'00404040'      CONVERT CMND TO UPPER CASE
         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)
*
*  FINISH TYPE GAMMA:  X /STR/   OR
*                      X N/STR/  OR
*                      X  C
*
TYPE%GAMMA ;
         NXTPRM   ERRP4,;           '-PN:ILGL SYNTAX'
                  (INTG,*),;
                  (STRG,GAMMA1)
         LI,P1    INTG              L/PARAM TYPE; INTEGER
         BAL,LNK  ADDCDTPARAM       ADD INTEGER TO CDT
         NXTPRM   ERRP4,;           '-PN:ILGL SYNTAX'
                  (STRG,*),;
                  (END,MASTEREXECUTIVE),;
                  (SCOL,RESUME%PARSING)
GAMMA1   ;
         LI,P1    STRG              L/PARAM TYPE; STRING
         BAL,LNK  ADDCDTPARAM       ADD STRING TO CDT
GAMMA2   ;
         NXTPRM   *ERRP4,;          '-PN:ILGL SYNTAX'
                  (END,MASTEREXECUTIVE),;
                  (SCOL,RESUME%PARSING)
*
*  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    4                 C/# OF PARAMS W/4
         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    'A'               A
         TEXTC    'D'               D
         TEXTC    'E'               E
         TEXTC    'F'               F
         TEXTC    'L'               L
         TEXTC    'O'               O
         TEXTC    'P'               P
         TEXTC    'R'               R
         TEXTC    'S'               S
ICTBLSZ  EQU      %-ICNAMETBL-1
*
*  INTRALINE COMMAND NUMBER TABLE
*
ICNMRTBL EQU      %
         DATA,1   0                 (FILLER)
         DATA,1   I:A#              A
         DATA,1   I:D#              D
         DATA,1   I:E#              E
         DATA,1   I:F#              F
         DATA,1   I:L#              L
         DATA,1   I:O#              O
         DATA,1   I:P#              P
         DATA,1   I:R#              R
         DATA,1   I:S#              S
         BOUND    4
*
*  INTRALINE COMMAND BRANCH TABLE
*
ICBRCHTBL         EQU %-1
         B        TYPE%GAMMA        A
         B        TYPE%I:CMND%D     D
         B        TYPE%ALPHA        E
         B        TYPE%ALPHA        F
         B        TYPE%BETA         L
         B        TYPE%ALPHA        O
         B        TYPE%ALPHA        P
         B        TYPE%BETA         R
         B        TYPE%I:CMND%S     S
         PAGE
*****************************
*  PARSE FORM:  BP ON(OFF)  *
*  PARSE FORM:  TA F(M,S)   *
*  PARSE FORM:  RP ON(OFF)  *
*  PARSE FORM:  CR ON(OFF)  *
*  PARSE FORM:  ECHO ON(OFF)*
*  PARSE FORM:  TABX ON(OFF)*
*****************************
*
*
PARSE:RP EQU      %
PARSE:BP EQU      %
PARSE:CR EQU      %
PARSE:TA EQU      %
PARSE:ECHO EQU    %
PARSE:TABX EQU    %
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY
         DATA     1
         BAL,LNK  CHECK1CDTENTRY    MAKE SURE 'BP' IS FIRST CMND
         NXTPRM   ERRP4,;
                  (ALPH,*)
         BAL,LNK  PARAMBUF:TO:UPPERCASE CONVERT PARAMBUF TO UPPERCASE
         LI,P1    ALPH              PUT ALPHA TEXT IN CDT
         BAL,LNK  ADDCDTPARAM
         NXTPRM   *ERRP4,;
                  (SCOL,ILGL%SEMICOLON),;
                  (END,MASTEREXECUTIVE)
PARAMBUF:TO:UPPERCASE ;
         LI,X1    0                 L/BTD TO BYTE 0
PTUC10   AI,X1    1                 INC BTD INTO PARAMBUF
         LB,T1    PARAMBUF,X1       L/CHAR FROM PARAMBUF
         CLM,T1   LCLETTERS         C/CHAR W/LOWER CASE CHAR LIMITS
         BOL      PTUC70            BOL; NOT LOWER CASE
         AI,T1    X'40'             CONVERT LOWER CASE TO UPPER CASE
         STB,T1   PARAMBUF,X1       S/MODIFIED CHAR BACK INTO PARAMBUF
PTUC70   CB,X1    PARAMBUF          C/BTD W/SIZE OF PARAMBUF
         BL       PTUC10            BL; MORE CHARS TO CHECK
         B        0,LNK             DONE; RETURN
         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,*),;
                  (COM,PBU05),;
                  (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)
PBU30    EQU      %
         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
*
*        ENTER HERE FOR FORM:  ( ,,I )
*
PBU05    LI,P1    1000              ONE IS DEFAULT SEQ #
         STW,P1   PARAMBUF
         LI,P1    SEQ               PUT SEQ # IN CDT
         BAL,LNK  ADDCDTPARAM
         B        PBU30             GET INCREMENT
         PAGE
********************************************
*  PARSE FORM:  COPY FID1 TO FID2(,N(,I))  *
*  PARSE FORM:  COPY FID1(,N(,I))          *
********************************************
*
*
PARSE:COPY        EQU %
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY
         DATA     5
         BAL,LNK  CHECK1CDTENTRY    MAKE SURE 'COPY' IS FIRST CMND
         LW,T1    CHARPSN           L/CURRENT CHAR POSITION IN SCAN
         STW,T1   TCHARPSN          S/CHAR PSN IN CASE RE-SCAN
         BAL,LNK  GETFILEID         GET FILE ID 1
         LI,P1    NAME              PUT IT IN CDT
         BAL,LNK  ADDCDTPARAM
         NXTPRM   ERRC9,;
                  (COM,PCO20),;     FOR IMPLICIT FID2 W/SEQ #'S
                  (END,PCO20),;     FOR IMPLICIT FID2
                  (ALPH,*)
         BAL,LNK  PARAMBUF:TO:UPPERCASE CONVERT PARAMBUF TO UPPER CASE
         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)
*
PCO20    LW,T1    X:OVER            L/TEXTC 'OVER'
         STW,T1   PARAMBUF          S/'OVER'; SIMULATE OVER
         LW,T1    TCHARPSN          L/SAVED CHAR POSITION
         STW,T1   CHARPSN           S/POS; RESCAN FID1
         LI,P1    ALPH              L/PARAM TYPE; ALPHA
         BAL,LNK  ADDCDTPARAM       ADD 'OVER' TO CDT
         BAL,LNK  GETFILEID         GET FID1 AGAIN AS IMPLICIT FID2
         BAL,LNK  ADDCDTPARAM       ADD 'FID2' TO CDT
         NXTPRM   *ERRP4,;          '-PN:ILGL SYNTAX'
                  (COM,GET%SEQ%INCR),; B/COMMA
                  (SCOL,ILGL%SEMICOLON),; B/SEMI-COLON
                  (END,*)           FALL THRU IF END
         LI,T1    DFLTSEQ           L/DEFAULT SEQ # (1.000)
         STW,T1   PARAMBUF          S/SEQ #
         LI,P1    SEQ               L/PARAM TYPE; SEQ #
         BAL,LNK  ADDCDTPARAM       ADD SEQ # (1.000)
         B        MASTEREXECUTIVE   B; EXEC CMND
         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    BAL,LNK  PARAMBUF:TO:UPPERCASE CONVERT PARAMBUF TO UPPER CASE
         LI,P1    ALPH              L/STRING TYPE; ALPHA
         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
************************************
*  SEE IF E 'FID' OR JUST PLAIN E  *
************************************
*
*
PARSE:E  EQU      %
         LW,P1    CHARPSN           POSITION OF NEXT INPUT CHAR.
         LB,LNK   TTYIMG,P1         NEXT INPUT CHAR.
         AI,P1    1
         CI,LNK   ' '               SKIP IF BLANK
         BE       %-3
         LI,P1    F:ED#             L/CMND # FOR EDIT
         CI,LNK   CR                IS FIRST NON-BLANK CHAR. = CR
         BE       %+3               YES-PLAIN OLD E
         CI,LNK   LF                NO -HOW ABOUT LF
         BNE      PARSE:EDIT        NOT PLAIN OLD E
         LI,P1    F:EN#             COMMAND #   FOR END
         B        PARSE:END
         PAGE
******************************
*  PARSE FORMS:  DELETE FID  *
*                EDIT   FID  *
*                XEQ    FID  *
******************************
*
*
PARSE:XEQ EQU %
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 CRPT COMMAND  *
************************
PARSE:CRPT ;
         BAL,LNK  NEWCDTENTRY
         DATA     1
         BAL,LNK  CHECK1CDTENTRY    MAKE SURE FIRST COMMAND
         NXTNAM   ERRP4,;           '-PN:ILGL SYNTAX'
                  (NAME,*),;        FALL THRU IF NAME ENTRY (HEX)
                  (END,MASTEREXECUTIVE)  EXEC IF END OF CMND (RESET)
         BAL,LNK  PARAMBUF:HEX:INTG CONVERT PARAMBUF FROM EBCDIC HEX
*                                   .. TO INTEGER
         LI,P1    INTG              L/INTG PARAM TYPE #
         BAL,LNK  ADDCDTPARAM       ADD INTEGER IN PARAMBUF TO CDT
         NXTPRM   *ERRP4,;          '-PN:ILGL SYNTAX'
                  (SCOL,ILGL%SEMICOLON),; IF SEMICOLON, ERROR
                  (END,MASTEREXECUTIVE) IF END OF CMND, EXEC
*
*
*
PARAMBUF:HEX:INTG ;                 CONVERT PARAMBUF FROM EBCDIC HEX TO INTEGER
         PUSH     LNK               PUSH LINK REG
         BAL,LNK  PARAMBUF:TO:UPPERCASE CONVERT PARAMBUF TO UPPER CASE
         PULL     LNK               PULL LINK REG
         LB,X1    PARAMBUF          L/SIZE OF TEXT IN PARAMBUF
         BEZ      P:H:I:10          B/SIZE IS 0; ERROR
         CI,X1    8                 C/SIZE W/8
         BLE      P:H:I:15          BLE; OK
P:H:I:10 BAL,LNK  TYPEPERR          TYPE ERROR MESSAGE
         DATA     ERRP22            '-P1:NOT 1 TO 8 CHARS'
         B        MASTERPARSER      B; GET NEXT COMMAND
P:H:I:15 LI,T1    0                 CLEAR ACCUMULATOR
         LI,X2    1                 L/1; BTD TO FIRST CHAR
P:H:I:20 LB,T2    PARAMBUF,X2       L/CHAR OF HEX
         CLM,T2   DIGITS            C/CHAR W/'0', '9'
         BIL      P:H:I:50          B/0 -> 9
         CLM,T2   LIM%A%F           C/CHAR W/'A', 'F'
         BIL      P:H:I:40          B/A -> F
P:H:I:30 BAL,LNK  TYPEPERR          TYPE ERROR MESSAGE
         DATA     ERRP23            '-P1:ILLEGAL HEXADECIMAL DIGIT'
         B        MASTERPARSER      B; GET NEXT COMMAND
P:H:I:40 AI,T2    -'A'+'0'+10       CHAR IS A -> F
P:H:I:50 AI,T2    -'0'              STRIP LEADING BITS (GARBAGE)
         SCS,T2   -4                POSITION IN LEFT 4 BITS
         SLD,T1   4                 SHIFT FROM T2 TO T1
         AI,X2    1                 INC BTD INTO PARAMBUF
         BDR,X1   P:H:I:20          BDR/GET NEXT CHAR
         STW,T1   PARAMBUF          S/VALUE INTO PARAMBUF
         LI,T2    1                 L/1; SIZE OF PARAMBUF
         STW,T2   PRMBUFSZ          S/NEW SIZE OF PARAMBUF
         B        0,LNK             RETURN
         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 FORM:  CT N,C  *
*************************
*
*
PARSE:CT EQU      %
         MTW,1    CT%FLAG           SET TYPE FLAG ON
*                                   AND TURN CMND INTO 'CM'
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    COL1              L/PARAM TYPE; 1ST COL #
         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, SS, AND ST SE COMMANDS   *
************************************
*
*
PARSE:SS EQU      %
PARSE:ST EQU      %
PARSE:SE EQU      %
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY
         DATA     28                MAX # OF PARAMS
         BAL,LNK  CHECK1CDTENTRY    MAKE SURE THIS IS 1ST CMND
         NXTPRM   ERRP5,;
                  (END,*),;
                  (SCOL,PDE3),;
                  (INTG,PDE5),;
                  (SEQ,PDE10),;
                  (SEQ2,PDE15)
         CI,P1    I:SE#             C/CMND # W/SE CMND #
         BNE      PCO5              B/NOT SE; ILLEGAL - NO SEQ #'S
         BAL,LNK  SE:ALL            SE0-9999.999
         B        MASTEREXECUTIVE   B;EXEC CMND
PDE3     CI,P1    I:SE#             C/CMND # W/SE CMND #
         BNE      PCO5              B/NOT SE; ILLEGAL - NO SEQ #'S
         BAL,LNK  SE:ALL            SE0-9999.999;
         B        RESUME%PARSING    B; GET REST OF CMND
*
*  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    LI,P1    SEQ2              L/PARAM TYPE; SEQ # PAIR
         BAL,LNK  ADDCDTPARAM
PDE20    NXTPRM   *ERRP4,;
                  (COM,*),;
                  (SCOL,RESUME%PARSING%IF%OK),;
                  (END,MASTEREXECUTIVE)
         NXTPRM   ERRP24,;          '-PN:NOT COL # OR STRING SELECTOR'
                  (INTG,PDE25),;    B/INTEGER
                  (ALPH,*),;        FALL THRU IF ALPHA (E.G., 'NOT')
                  (STRG,*)          FALL THRU IF '/STR/'
         BAL,LNK  PARSE:SSER        PARSE STRING SELECTION EXPRESSION
         NXTPRM   *ERRP4,;          '-CN:ILGL SYNTAX'
                  (COM,*),;         FALL THRU IF COMMA; COL #'S
                  (SCOL,RESUME%PARSING%IF%OK),; B/SEMI-COLON
                  (END,MASTEREXECUTIVE) B/END OF LINE
         NXTPRM   ERRP7,;           '-P1:NOT COL #'
                  (INTG,*)          FALL THRU IF INTEGER (COL #)
PDE25    ;
         LI,P1    COL1              L/PARAM TYPE; 1ST COL #
         BAL,LNK  ADDCDTPARAM       PUT 1ST COL # IN CDT
         NXTPRM   *ERRP4,;
                  (COM,*),;
                  (SCOL,RESUME%PARSING%IF%OK),;
                  (END,MASTEREXECUTIVE)
         NXTPRM   ERRP7,;
                  (INTG,*)
         LI,P1    COL2              L/PARAM TYPE; 2ND COL #
         BAL,LNK  ADDCDTPARAM       PUT 2ND COL # IN CDT
         NXTPRM   *ERRP4,;
                  (SCOL,RESUME%PARSING%IF%OK),;
                  (END,MASTEREXECUTIVE)
RESUME%PARSING%IF%OK ;
         LI,X1    1                 L/INDEX TO CMND # IN CDT
         LB,X1    *CDTADR,X1        L/CMND #
         LB,X1    FLAG,X1           L/FLAGS FOR THIS CMND
         CI,X1    SEMICOLON%OK      C/FLAGS W/SEMI-OK FLAG
         BANZ     RESUME%PARSING    B/OK; G/NEXT CMND
ILGL%SEMICOLON    ;
         LI,T1    X'0100'           L/CMND REL POSITION VALUE OF 1
         AWM,T1   *CDTADR           INC REL POS OF CUR CMND
         BAL,LNK  TYPECERR          TYPE ERROR MESSAGE
         DATA     ERRC16            '-C1:CMND CAN'T BE COMPOUNDED'
         B        MASTERPARSER      B; G/NEXT CMND LINE
         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     28                # OF PARAMS
         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)
         BAL,LNK  PARSE:SSE         PARSE STRING SELECTION EXPRESSION
*
*
GET%COL#%PAIR     EQU %
         NXTPRM   *ERRP4,;
                  (COM,*),;
                  (SCOL,ILGL%SEMICOLON),;
                  (END,MASTEREXECUTIVE)
         NXTPRM   ERRP7,;
                  (INTG,*)
         LI,P1    COL1              L/PARAM TYPE; 1ST COL #
         BAL,LNK  ADDCDTPARAM
         NXTPRM   *ERRP4,;
                  (COM,*),;
                  (SCOL,ILGL%SEMICOLON),;
                  (END,MASTEREXECUTIVE)
         NXTPRM    ERRP7,;
                   (INTG,*)
         LI,P1    COL2              L/PARAM TYPE; 2ND COL #
         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:SSER        ;
         LW,T1    PREVIOUS%CHARPSN  L/SAVED CHARSPN
         STW,T1   CHARPSN           S/POS; RE-SCAN LAST FIELD SCANNED
PARSE:SSE         ;
         PUSH     LNK               PUSH LINK REG
         LI,P1    0                 L/0; INIT 'NOT' FLAG
         NXTPRM   ERRP8,;
                  (ALPH,*),;
                  (STRG,PSSE35)
         BAL,LNK  PARAMBUF:TO:UPPERCASE CONVERT PARAMBUF TO UPPER CASE
         LI,P1    STRG:NOT
         LW,T1    PARAMBUF
         CW,T1    X:NOT             IS OPERATOR 'NOT'
         BE       PSSE30            YES
         BAL,LNK  TYPEPERR
         DATA     ERRP8
         B        MASTERPARSER
PSSE30   ;                          GET NOT/STRING'
         NXTPRM   ERRP8,;
                  (STRG,*)
PSSE35   AI,P1    STRG              PUT 'STRING' PARAM IN CDT
PSSE37   BAL,LNK  ADDCDTPARAM
         LI,P1    0
         NXTPRM   *ERRP4,;
                  (ALPH,*),;
                  (COM,PSSE80),;    B/COMMA; RESET CHARPSN
                  (SCOL,PSSE80),;   B/SEMI-COLON; RESET CHARPSN
                  (END,MASTEREXECUTIVE)
         BAL,LNK  PARAMBUF:TO:UPPERCASE CONVERT PARAMBUF TO UPPER CASE
         AI,P1    STRG:AND
         LW,T1    PARAMBUF
         CW,T1    X:AND             IS OPERATOR 'AND'
         BE       PSSE50
         AI,P1    STRG:OR-STRG:AND
         CW,T1    X:OR              IS OPERATOR 'OR'
         BE       PSSE50
         AI,P1    STRG:EOR-STRG:OR
         CW,T1    X:EOR             IS OPERATOR 'EOR'
         BE       PSSE50
PSSE40   BAL,LNK  TYPEPERR          NONE OF THE ABOVE
         DATA     ERRP19
         B        MASTERPARSER
PSSE50   ;                          GET  SECOND STRING(OR '.NOT')
         NXTPRM   *ERRP19,;
                  (COM,*),;
                  (STRG,PSSE37)
         NXTPRM   *ERRP19,;
                  (ALPH,*)
         BAL,LNK  PARAMBUF:TO:UPPERCASE CONVERT PARAMBUF TO UPPER CASE
         AI,P1    STRG:NOT
         LW,T1    PARAMBUF          IS OPERATOR 'NOT'
         CW,T1    X:NOT
         BNE      PSSE40            B/NOT 'NOT'
         NXTPRM   ERRP8,;
                  (STRG,PSSE37)
PSSE80   ;
         LW,T1    PREVIOUS%CHARPSN  L/CHARPSN AT START OF LAST NXTPRM
         STW,T1   CHARPSN           RESET CHARPSN; CALLER WILL RE-PARSE
PSSE90   ;
         PULL     LNK               RESTORE LINK REG
         B        0,LNK             RETURN TO CALLER
*
*
X:AND    TEXTC    'AND'
X:OR     TEXTC    'OR'
X:EOR    TEXTC    'EOR'
X:NOT    TEXTC    'NOT'
         PAGE
***************************
*  PARSE FORM:  IN N(,I)  *
***************************
*
*
PARSE:IP EQU      %
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)  *
*               MDP N(-M),K(-L)(,I)  *
*               MKP N(-M),K(-L)(,I)  *
**************************************
*
*
PARSE:MKP EQU     %                 MK, PROTECTING DESTINATION RECS
PARSE:MDP EQU     %                 MD, PROTECTING DESTINATION RECS
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
********************************
*                JU N          *
********************************
*
*
PARSE:JU EQU      %
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY
         DATA     1
         NXTPRM   ERRP5,;
                  (INTG,*),;
                  (SEQ,PSS20),;
                  (SEQ2,ILGL%SEQ2)
         BAL,LNK  ADJINT
*
*  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 FORM:  TX  *
*********************
*
*
PARSE:TX EQU      %
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)  &  TC  *
*                RR N(-M)  &  RR  *
*                AD N(-M)  &  AD  *
*                DE N(-M)  &  DE  *
***********************************
*
*
PARSE:TC EQU      %
PARSE:DE EQU      %                 DE COMMAND
PARSE:AD EQU      %                 AD COMMAND
PARSE:RR EQU      %                 RR COMMAND
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,X1    #R:%TO%I:         L/# OF INTER/INTRA COMMANDS
         CB,P1    R:R:%TO%I:,X1     C/CMND # W/INTER/INTRA CMND #'S
         BNE      %+3               BNE; NOT FOUND
         LB,P1    I:R:%TO%I:,X1     L/EQUIVALENT INTRA-RECORD INTER/INTRA CMND #
         B        %+2               B
         BDR,X1   %-4               BDR/CHECK NEXT TYPE CMND #
         BAL,LNK  NEWCDTENTRY
         DATA     0
         LI,X1    1                 L/INDEX TO CMND #
         LB,X1    *CDTADR,X1        L/CMND #
         CI,X1    I:DE#             C/CMND # W/INTRA DE CMND
         BE       PTY20             B/INTRA DE BEING PARSED
         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
*
         LI,X1    1                 L/INDEX TO CMND # IN CDT
         LB,X1    *CDTADR,X1        L/CMND #
         LB,X1    FLAG,X1           L/FLAGS FOR THIS CMND
         CI,X1    COL#LEGAL         C/FLAGS W/COL #'S LEGAL FLAG
         BANZ     GET%COL#%PAIR     B/LEGAL
PTY20    NXTPRM   ERRP4,;           '-PN:ILGL SYNTAX'
                  (END,MASTEREXECUTIVE)  MAKE SURE END OF COMMAND
         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
*
*  SET SE RANGE TO ALL RECS:  SAME AS  SE0-9999.999
*
SE:ALL   PUSH     LNK               SAVE LINK REG
         LI,T1    0                 L/0
         STW,T1   PARAMBUF          0/PARAMBUF; 1ST SEQ #
         LW,T1    MAXSEQ            L/HIGHEST LEGAL SEQ # (9999.999)
         STW,T1   PARAMBUF+1        S/HI SEQ # IN PARAMBUF
         LI,T1    2                 L/2; # OF 'PARAMS' IN PARAMBUF
         STW,T1   PRMBUFSZ          S/PARAM BUF SIZE
         LI,P1    SEQ2              L/PARAM TYPE; SEQ # PAIR
         BAL,LNK  ADDCDTPARAM       ADD PARAMS TO CDT
         PULL     LNK               PULL LINK REG
         B        0,LNK             RETURN
         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.
         LB,P1    FLAG,X2           L/FLAGS FOR THIS CMND
         CI,P1    BRK%DISP2         C/FLAG W/DISP 2 SEQ #'S FLAG
         BANZ     BRK50             B/DISPLAY 2 SEQ #'S
         CI,P1    BRK%DISP1         C/FLAG W/DISP 1 SEQ # FLAG
         BAZ      BRK80             B/NOT TO DISPLAY SEQ #'S
         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  XEQ%ECHO%20       BAL/ECHO XEQ REC IF ANY
         BAL,LNK  TYPEMSG           TYPE '-- X TO ABORT'
         DATA     UTSM6
         M:READ   M:UC,(BUF,CFLAG),(SIZE,4),(BTD,0)
         LB,X1    CFLAG             IF CHARACTER IS NOT X
         CI,X1    'X'               CONTINUE COMMAND.
         BE        STOPLASTCMD
         CI,X1    'X'-X'40'         C/CHAR W/LOWER-CASE X
         BE       STOPLASTCMD       B/LOWER-CASE X; ABORT COMMAND
         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
         BAL,LNK  RESET%XEQ%MODE    RESET XEQ MODE
         LI,T1    -1
         STW,T1   ALLFLAG
         MTW,0    COPYFL            DOES FID1=FID2
         BEZ      BRK91             NO
         LW,R1    L(X'00200000')    CHECK IF FILES GOT OPEN
         CW,R1    F:EI              (INPUT)
         BAZ      %+2
         BAL,LNK  CLOSE             CLOSE,SAVE OLD FILE
         CW,R1    F:EO              (OUTPUT)
         BAZ      %+2
         BAL,LNK  CLOSE3            CLOSE,RLS NEW FILE
         B        MASTERPARSER
BRK91    EQU      %
         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
         MTW,0    SETFLAG           ARE WE IN SET MODE
         BNEZ     RESTART%EXECUTIVE YES, DON'T RESET TAB FLAGS
        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%F:CMND      IS IT A FILE COMMAND
         BL       EXC6              NO - ITS A CONTROL CMND
         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
         LB,T1    FLAG,X2           L/FLAGS FOR THIS CMND
         CI,T1    TYPE%CMND         C/FLAGS W/TYPE CMND FLAG
         BANZ     EXC19             B/TYPE COMMAND
         BAL,LNK  TYPEMSG           NO - TYPE: '-MISSING SET'
         DATA     ERRM8
         B        MASTERPARSER      EXIT TO PARSER
*
*        CONTROL COMMAND -- 'BP', 'TA', 'CR'
*
EXC6     MTW,0    STEPFLAG          IS SYSTEM IN STEP MODE
         BNEZ     EXC30             YES - ERROR
         B        EXC10             CONTINUE
*
*  F:CMND, R:CMND, OR 'SE': CHECK TO SEE THAT SYSTEM IS NOT IN STEP MODE
*
EXC5     LI,T1    0                 L/0
         STW,T1   SSE%CDT           MAKE SURE SSE CDT IS RESET
         BNEZ     EXC30             YES - ERROR
         STW,T1   SETFLAG
         DO       MODE=2
         STW,T1   TABCFLAG          AND RESET TAB FLAGS
         STW,T1   TABXFLAG
         FIN
*
*  EXECUTE CURRENT COMMAND IN CDT
*
EXC10    STW,X2   CURRENT%CMND#     S/CURRENT COMMAND NUMBER
         LB,X1    FLAG,X2           L/FLAGS FOR THIS CMND
         CI,X1    TYPE%CMND         C/FLAGS W/TYPE CMND FLAG
         BAZ      %+2               B/NOT TYPE COMMAND
         STW,X2   LAST%TYPE%CMND    S/LAST TYPE CMND #
EXC12    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
         LI,T1    0                 TURN OFF COPY FLAG
         STW,T1   COPYFL
         STW,T1   CT%FLAG           TURN OFF 'CT' FLAG
         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    LW,X2    CURRENT%CMND#     L/CURRENT CMND #
         B        EXC12             B; EXEC CMND AGAIN
*
*   FOR TY(TS) USE WHOLE RANGE IF SE NOT SPECIFIED
*
EXC19    EQU      %
         LW,P1    MAXSEQ            HIGHEST VALUE
         STW,P1   LASTSET
         LI,P1    0                 BEGIN AT THE BEGINNING
         BAL,LNK  READNXTRANDOM     READ 1ST RECORD
         CW,R1    L(EOF)            WAS IT AN EOF
         BE       TYP20             YES - MUST BE NULL FILE
         STW,R1   SV1STSET          FIRST SEQ. NO. RETURNED IN R1
         BAL,LNK  SE%INIT           INIT SE LOOP
         B        EXC10             B; EXEC CMND
*
*  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
         BAL,LNK  SE%INIT           INIT SE LOOP
         B        EXC10             B; EXEC CMND
*
*
SE%INIT  ;
         PUSH     LNK               PUSH LNK REG
         LW,T1    CDTADR            SAVE ADDR OF CMND IN CDT (IN
         STW,T1   SETADR             SETADR) FOR LATER I:CMND LOOP
         LW,P1    SV1STSET
         BAL,LNK  READNXTRANDOM     READ FIRST REC IN RANGE
         CW,R1    L(EOF)            C/SEQ # JUST READ W/EOF
         BE       CMT60             B/EOF; '--EOF HIT'
         CW,R1    LASTSET           C/SEQ # JUST READ W/HI REQUESTED
         BLE      SE%INIT5          BLE; WE'VE GOT RECS TO PROCESS
         BAL,LNK  TYPEMSG           TYPE ERROR MESSAGE
         DATA     ERRM6             '--NONE'
         B        MASTERPARSER      B; G/NEXT COMMAND
SE%INIT5 STW,R1   FIRSTSET          S/SEQ #
         LI,T1    -1                L/-1; FLAG
         STW,T1   SETFLAG           INDICATE SE LOOP HAS BEEN INITIALIZED
         PULL     LNK               PULL LNK REG
         B        0,LNK             RETURN
*
*  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
         PAGE
CMNDTBL  EQU      %                 BAL,13 TO ROUTINE
FLAG     CSECT    1                 FLAGS FOR EACH COMMAND
         USECT    CMNDTBL           GO BACK TO CMNDTBL
*
EXC      CNAME
         PROC
LF       EQU      %-CMNDTBL         COMMAND NUMBER
         BAL,13   CF(2)             BAL TO ROUTINE
         USECT    FLAG              GO TO FLAG SECTION
         DATA,1   AF(1)             FLAGS FOR COMMAND
         USECT    CMNDTBL           GO BACK TO MAIN PROCEDURE SECTION
         PEND
*
*  EXC PROC SETS UP COMMAND NUMBERS, FLAGS, AND BAL'S TO EXECUTION ROUTINES.
*  LF IS COMMAND NUMBER, IS DEFINED SEQUENTIALLY BY EXC PROC.
*  CF(2) IS ROUTINE EXECUTION ADDRESS, IS BAL,13'D TO.
*  AF(1) ARE FLAGS: (STARTING IN COL 32)
*
COMPRESSED EQU    X'80'             TYPE CARDIMG COMPRESSED
TYPE%SEQ# EQU     X'40'             TYPE SEQ # BEFORE TYPING CARDIMG
PROTECTED EQU     X'20'             DESTINATIONS RECS PROTECTED
SEMICOLON%OK EQU  X'10'             SEMI-COLON IS OK AS CMND TERMINATOR
COL#LEGAL EQU     8                 COLUMN NUMBERS ARE LEGAL
TYPE%CMND EQU     4                 TYPE COMMAND (TC,TS,TS, ETC)
BRK%DISP2 EQU     2                 DISPLAY 2 SEQ #'S ON BREAK
BRK%DISP1 EQU     1                 DISPLAY 1 SEQ # ON BREAK
*
*
*  FILE AND OTHER MAJOR COMMANDS.  CAN APPEAR ONLY ONE PER LINE
*
         EXC,0                                                     DUMMY
F:BP#    EXC,F:BP                                                     BP
F:TA#    EXC,F:TA                                                     TA
F:CR#    EXC,F:CR                                                     CR
F:EC#    EXC,F:ECHO
F:RP#    EXC,F:RP                                                     RP
F:XQ#    EXC,F:XEQ
F:CP#    EXC,F:CRPT
F:TE#    EXC,F:TABX
FIRST%F:CMND EQU %-CMNDTBL          NUMBER OF FIRST FILE COMMAND
F:BU#    EXC,F:BUILD                                                  BUILD
F:CO#    EXC,F:COPY            BRK%DISP2                              COPY
F:DE#    EXC,F:DELETE                                                 DELETE
F:ED#    EXC,F:EDIT                                                   EDIT
F:EN#    EXC,F:END                                                    END
F:ME#    EXC,F:MERGE           BRK%DISP2                              MERGE
*
*  RECORD COMMANDS.  CAN APPEAR ONLY ONE PER LINE
*
FIRST%R:CMND EQU %-CMNDTBL          COMMAND NUMBER OF FIRST RECORD COMMAND
R:DE#    EXC,R:DELETE          BRK%DISP1                              DE
R:FD#    EXC,R:FIND%DELETE     BRK%DISP1+COL#LEGAL                    FD
R:FT#    EXC,R:FIND%TYPE       TYPE%SEQ#+BRK%DISP1+COL#LEGAL          FT
R:IN#    EXC,R:INSERT                                                 IN
R:IS#    EXC,R:INSERT%SUP%SEQ                                         IS
R:IP#    EXC,R:INSERT%PROTECT  PROTECTED
R:MD#    EXC,R:MOVE%DELETE     BRK%DISP2                              MD
R:MDP#   EXC,R:MOVE%DELETE     BRK%DISP2+PROTECTED                    MDP
R:MK#    EXC,R:MOVE%KEEP       BRK%DISP2                              MK
R:MKP#   EXC,R:MOVE%KEEP       BRK%DISP2+PROTECTED                    MKP
R:RN#    EXC,R:RENUMBER                                               RN
R:SS#    EXC,R:SET%STEP                                               SS
R:ST#    EXC,R:SET%STEP%TYPE   TYPE%SEQ#                              ST
R:AD#    EXC,R:AD              TYPE%SEQ#
R:TS#    EXC,R:TYPE%SUP%SEQ    TYPE%CMND+COL#LEGAL                    TS
R:TY#    EXC,R:TYPE            TYPE%SEQ#+TYPE%CMND+COL#LEGAL          TY
R:TC#    EXC,R:TYPE%COMPRESSED COMPRESSED+TYPE%SEQ#+TYPE%CMND+COL#LEGAL
R:FS#    EXC,R:FIND%SEQUENCE   BRK%DISP1+COL#LEGAL                    FS
R:CM#    EXC,R:COMMENTARY      TYPE%SEQ#                              CM-CT
R:RR#    EXC,R:REREAD          TYPE%SEQ#+TYPE%CMND                    RR
         DO1      3                 DUMMYS
         EXC,0                                                     DUMMY
*
*  INTRA-RECORD COMMANDS.  CAN BE MORE THAN ONE PER LINE.
*
FIRST%I:CMND EQU %-CMNDTBL          NUMBER OF FIRST I: COMMAND
I:SE#    EXC,I:SET             COL#LEGAL+SEMICOLON%OK                 SE
I:DE#    EXC,I:DELETE%REC
I:A#     EXC,I:ALIGN
I:D#     EXC,I:DELETE                                                 D
I:E#     EXC,I:OVERWR%EXTEND                                          E
I:F#     EXC,I:FOLLOW%BY                                              F
I:L#     EXC,I:SHIFT%LEFT                                             L
I:O#     EXC,I:OVERWRITE                                              O
I:P#     EXC,I:PRECEDE%BY                                             P
I:R#     EXC,I:SHIFT%RIGHT                                            R
I:S#     EXC,I:SUBSTITUTE                                             S
I:JU#    EXC,I:JUMP                                                   JU
I:NO#    EXC,I:NO%CHANGE                                              NO
I:RF#    EXC,I:REVERSE%BPFLAG                                         RF
I:AD#    EXC,I:AD              TYPE%SEQ#
I:TS#    EXC,I:TYPE%SUP%SEQ    TYPE%CMND                              TS
I:TY#    EXC,I:TYPE            TYPE%SEQ#+TYPE%CMND                    TY
I:TX#    EXC,I:TYPEX           TYPE%SEQ#                              TX
I:TC#    EXC,I:TYPE%COMPRESSED COMPRESSED+TYPE%SEQ#+TYPE%CMND         TC
I:RR#    EXC,I:REREAD          TYPE%SEQ#+TYPE%CMND                    RR
         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
*
         DO       MODE=2
BLD08   MTW,0    BUILDFLAG
        BEZ      BLD12
BLD10    STW,T1   DFLTINCR          S/DEFAULT INCREMENT
         CI,R2    0
         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
         ELSE
BLD08    EQU      %
BLD10    EQU      %
         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
         CI,R2    0                 IF THIS IS BANG BUILD,
         BEZ      BLD30             R2 IS NON-ZERO
         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
         MTW,0    COPYFL            DOES FID1=FID2
         BEZ      CPY20             NO, SAVE BOTH
         BAL,LNK  CLOSE             OTHERWISE, SAVE ORIGINAL
         BAL,LNK  CLOSE3            AND DELETE COPY
         B        *F:LNK            EXIT
*
*  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
         LI,X1    9                 OPEN THE 'TO' FILE AS EDIT
         LB,P1    *CDTADR,X1
         AW,P1    CDTADR
         BAL,LNK  OPEN
         BCS,4    EDT20             NOT KEYED, CANT OPEN FOR EDIT
         LI,R2    1                 SET EDIT FILE OPEN
         STW,R2   FILETYPE
         LI,R2    0
         STW,R2   TABERRFLAG
         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     *
*  FILE COMMAND: RECORD SIZE PRESERVATION        *
*  FILE COMMAND: ECHO XEQ RECORDS                *
*  FILE COMMAND: BLANK PRESERVATION              *
**************************************************
*
*
F:BP     LI,X3    SVBPFLAG          L/ADR OF FLAG CELL TO MODIFY
         B        CR1               B; MERGE W/COMMON CODE
*
F:RP     LI,X3    RP%FLAG           L/ADR OF FLAG CELL TO MODIFY
         B        CR1               B; MERGE W/COMMON CODE
F:TABX   LI,X3    TABX%FLAG         L/ADR OF FLAG CELL TO MODIFY
         B        CR1               B; MERGE W/COMMON CODE
*
*
F:ECHO   LI,X3    XEQ%ECHO%FLAG     L/ADR OF FLAG CELL TO MODIFY
         B        CR1               B; MERGE W/COMMON CODE
*
F:CR     LI,X3    CRFLAG            L/ADR OF FLAG CELL TO MODIFY
CR1      ;
         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
*
CR3      STW,T1   0,X3              SET FLAG
         CI,X3    TABX%FLAG         C/FLAG ADR W/TABX FLAG ADR
         BNE      *F:LNK            BNE; RETURN
         CI,T1    0                 C/FLAG W/0
         BNE      CR4               BNE; SETTING TABX, SO SET SPACE INSERTION
         M:STA    (SPACEINSERT,OFF) TURN SPACE INSERTION OFF
         B        *F:LNK            RETURN
CR4      M:STA    (SPACEINSERT,ON)  TURN SPACE INSERTION ON
         B        *F:LNK            IN OUTPUT RECORDS.
*
CR5      SW,T1    BPVOFF            SEE IF 'OFF'
         BE       CR3               TURN 'OFF'
         BAL,LNK  TYPEMSG           TYPE ERROR MESSAGE
         DATA     ERRM5             '-NOT ON/OFF'
         B        *F:LNK            RETURN
*
BPVON    TEXTC    'ON'
BPVOFF   TEXTC    'OFF'
         PAGE
F:CRPT ;                            EXEC CRPT COMMAND
         LI,X1    5                 L/INDEX IN CDT TO KEY DISP
         LB,X1    *CDTADR,X1        L/INDEX IN CDT TO CRPT KEY
         BEZ      FCRPT50           BEZ; NO KEY; RESET
         LW,X2    *CDTADR,X1        L/CRPT KEY
         STW,X2   CRPT%KEY          S/CRPT KEY; SAVE
         LI,X1    CRPT%KEY          L/ADR OF CRPT KEY
FCRPT50  STW,X1   CRPT%FLAG         SSET/RESET CPRT FLAG
         BAL,LNK  SET%CRPT          SET/RESET DATA ENCRYPTION
         B        *F:LNK            RETURN
         PAGE
************************
*  FILE COMMAND:  XEQ  *
************************
F:XEQ    ;
         BAL,LNK  RESET%XEQ%MODE    CLOSE M:C IF OPEN
         LI,X1    5                 L/INDEX IN CDT TO FID
         LB,P1    *CDTADR,X1        L/INDEX IN CDT TO FID
         AW,P1    CDTADR            L/ADR OF FID IN CDT
         LI,X1    M:C               L/ADR OF CMND DCB
         BAL,LNK  OPENIN            OPEN M:C INPUT MODE
         BCS,8    DLT10             B/FID DOESN'T EXIST
         STW,X1   CMND%DCB%ADR      S/NEW DCB ADR FOR CMNDS
         LI,T1    0                 L/0
         STW,T1   XEQ%REC#          0/XEQ REC COUNT
         B        *F:LNK            RETURN
         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
         LI,X1    -1                RESET FILETYPE TO NEVER OPENED
         STW,X1   FILETYPE          TO MAKE XCON HAPPY
*
*  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
EDT7     EQU      %
         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
         CAL1,8   RELATIVE1         SET/RESET RELATIVE TABBING
         M:XCON   0                 TURN OFF EXIT CONTROL AND
         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
*
*
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
         PUSH     P1                SAVE ENDING SEQ. NO
         LW,P1    FID2ADR           ADDR OF 'INTO' FILENAME
         BAL,LNK  OPEN              OPEN IT FOR EDIT
         LI,R2    1                 SET EDIT FILE OPEN
         STW,R2   FILETYPE
         LI,R2    0
         STW,R2   TABERRFLAG
         PULL     P1                RETRIEVE ENDING SEQ. NO.
         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    4                 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,16,34,0)   FTABS
         M:DEVICE M:UC,(TAB,10,19,37,0)   MTABS
         M:DEVICE M:UC,(TAB,8,16,30,0)    STABS
         M:DEVICE M:UC,(TAB,8,12,36,0)    CTABS
         FIN
         PAGE
******************************
*  INTER-RECORD ADD COMMAND  *
******************************
R:AD     LI,X1    5                 L/INDEX IN CDT TO SEQ # INDEX
         LB,X2    *CDTADR,X1        L/INDEX IN CDT TO SEQ #'S
         LW,P1    *CDTADR,X2        L/FIRST SEQ #
         AI,X2    1                 INC INDEX; POINT TO HI SEQ #
         LW,P2    *CDTADR,X2        L/HI SEQ #
         BAL,LNK  READRANDOM        READ FIRST REC
         BCS,8    CMT50             B/DOESN'T EXIST; '-P1:NO SUCH REC'
         LW,R1    P1                L/FIRST SEQ #
RAD50    STW,R1   FIRSTSET          S/CUR SEQ #
         PUSH     R:LNK             SAVE LINK
         BAL,I:LNK I:AD             DO AN INTRA-RECORD ADD COMMAND
         PULL     R:LNK             RESTORE LINK
         BAL,LNK  SETEOD            SET END OF RECORD
         BAL,LNK  WRITERANDOM       WRITE REC BACK OUT
         BAL,LNK  READSEQUEN        READ NEXT REC FROM FILE
         CW,R1    L(EOF)            C/NEW SEQ # W/END-OF-FILE
         BE       CMT60             B/EOF; '--EOF HIT'
         CW,R1    P2                C/CURRENT SEQ # W/HI SEQ #
         BLE      RAD50             BLE; PROCESS REC
         B        *R:LNK            RETURN
         PAGE
******************************
*  INTRA-RECORD ADD COMMAND  *
******************************
I:AD     CAL1,1   NOPROMPT%FPT      RESET PROMPT CHARACTER
         MTW,1    ZERO:STG:FLG      DON'T SAY '0 STRINGS CHANGED'
         BAL,LNK  TYPECARD%FIRSTSET%NOCR  TYPE CARDIMG, NO TRAILING CR
         BAL,LNK  READTELETYPE3     READ INTO COMPRIMG FROM TERMINAL
         AI,R1    -1                DEC REC SIZE
         BEZ      *I:LNK            B/NO CHARS READ; IGNORE
         MTW,1    CHG:STG:CNT       COUNT AS 1 CHANGED STRING
         LI,X1    0                 L/0; INIT INDEX INTO COMPRIMG
         LW,X2    RECSIZE           L/RECSIZE; INIT INDEX INTO CARDIMG
IAD50    LB,T1    COMPRIMG,X1       L/BYTE OF COMPRIMG
         STB,T1   CARDIMG,X2        S/BYTE INTO CARDIMG
         AI,X1    1                 INC COMPRIMG INDEX
         AI,X2    1                 INC CARDIMG INDEX
         BDR,R1   IAD70             BDR/MOVE NEXT CHAR
         STW,X2   RECSIZE           END; S/NEW SIZE OF CARDIMG
         B        *I:LNK            RETURN
IAD70    CI,X2    MAXCLMN           C/CARDIMG INDEX W/MAX
         BL       IAD50             BL; MOVE NEXT CHAR
         STW,X2   RECSIZE           S/NEW CARDIMG SIZE
         BAL,LNK  TYPECERR%UNCONDT  TYPE ERROR MESSAGE
         DATA     ERRC1             '--CN:OVERFLOW'
         B        *I:LNK            RETURN
         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)
         DO       MODE=2
         MTW,0    CT%FLAG           IS TYPE FLAG ON
         BEZ      %+2               NO
         CAL1,1   NOPROMPT%FPT      YES, TURN OFF PROMPT
         FIN
*
*  TYPE SEQ. # AND READ IN COMMENTARY
*
CMT10    BAL,LNK  TYPESEQ           TYPE: 'DDDD.DDD'
         GEN4     BL,EOM,0,0
         MTW,0    CT%FLAG           IS TYPE FLAG ON
         BEZ      CM10A             NO, CONTINUE
*
*        CT SPECIFIED, TYPE CARD TO COLUMN REQUESTED
*
         LW,D0    RECSIZE           SAVE RECSIZE TEMPORARILY
         STW,T1   RECSIZE           SET NEW RECSIZE (COLUMN NO)
         MTW,1    RECSIZE
         LW,X1    T1                COLUMN FOR PROMPT
         LB,X3    CARDIMG,X1
         LI,X2    '*'
         STB,X2   CARDIMG,X1        ADD TO TYPE IMAGE
         DO       MODE=2
         EXU      TYPECARDIMG       TYPE CARDIMG
         ELSE
         LI,X2    0
         LW,T2    T1                GET NO. CHARS TO TYPE
         AI,T2    1
CM10B    LB,R0    CARDIMG,X2        GET NEXT CHARACTER
         CAL3,1   0                 TYPE IT
         AI,X2    1
         BDR,T2   CM10B             CONTINUE UNTIL ALL CHARS. TYPED
         FIN
         STB,X3   CARDIMG,X1        RESTORE CHARACTER TO CARD IMAGE
         STW,D0   RECSIZE
*
CM10A    EQU      %
         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
         AI,R2    0                 C/# OF RECS DEL'D W/0
         BNE      *R:LNK            BNE; DON'T SQUAWK
         BAL,LNK  TYPEMSG           TYPE MESSAGE
         DATA     ERRM26            '--NOTHING TO DELETE'
         B        *R:LNK            EXIT
*
*
I:DELETE%REC ;
         BAL,LNK  DELETERECORD      DELETE CURRENT RECORD
         LW,T1    CHG:STG:CNT       L/CHANGED STRING COUNT
         STW,T1   SAVED:CHG:STG:CNT S/COUNT AS SAVED COUNT;
*                                   .. DON'T WRITE REC AT END OF
*                                   .. SE LOOP
         B        *I:LNK            B; RETURN
         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
         AI,X2    1                     LASTSET=2ND SEQ # IN CDT
         LW,T1    *CDTADR,X2
         STW,T1   LASTSET
         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 #
         BAL,LNK  XSSE              CHECK STRING SELECTION EXPRESSION
         BCR,8    FND40             B/REC NOT SELECTED
         AI,P3    1                 BIG MATCH - 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    BAL,LNK  SETEOD            SET REC SIZE
         BAL,LNK  TYPECARD%FIRSTSET TYPE CARDIMG; FIRSTSET IS SEQ #
         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
XSSE%CONDT        ;
         INT,T1   CDT+1             L/LH OF 1ST WD OF 1ST CDT ENTRY
         AND,T1   =X'FF'            &/LH W/.FF; MASK FOR CMND #
         CI,T1    FIRST%I:CMND      C/CURRENT CMND # W/1ST INTRA CMND (SE)
         BLE      XSSE%CONDT20      BLE; NOT INTRA CMND
         LI,T1    SSE%CDT           L/ADR OF SAVED SSE
         MTW,0    SSE%CDT           SEE IF SSE CDT ENTRY EXISTS
         BNEZ     XSSE%CONDT30      B/SAVED SSE EXISTS; USE IT
         LCI      8                 L/CC'S INDICATING REC IS SELECTED
         B        0,LNK             RETURN; NO STRING SELECTION EXP AVAIL
XSSE%CONDT20      ;
         LI,T1    CDT+1             L/ADR OF 1ST ENTRY IN CDT TABLE
XSSE%CONDT30      ;
         XW,T1    CDTADR            &/1ST ADR W/CURRENT ADR IN CDT
         PUSH     (LNK,T1)          PUSH LINK, SAVED CDT ADR
         BAL,LNK  XSSE              CHECK FOR STRING SELECTION OPERATORS
         STCF     T2                SAVE CC'S
         PULL     (LNK,T1)          PULL REGS
         STW,T1   CDTADR            S/SAVED CDT ADR
         LC       T2                L/SAVED CC'S
         B        0,LNK             RETURN TO CALLER
XSSE     ;
         PUSH     (X1,LNK)          SAVE REGS
         LI,D0    STRG:NOT          L/EXPRESSION ACCUM; TRUE
         LI,X2    STRG              L/PARAM TYPE FO FIND
         BAL,LNK  FINDPARAM         FIND STRG'S
         B        XSSE70            B/NO STRINGS
         AI,X1    -1                DEC CDT PNTR TO TYPE
         LW,P1    FRSTCLMN          L/FIRST COL # TO CHECK
XSSE30   LI,T1    STRG              L/STRING PARAM TYPE
         LI,T2    X'F'              L/MASK
         LB,X2    *CDTADR,X1        L/PARAM TYPE FROM CDT
         CS,T1    X2                C/TYPE, MASK W/CUR TYPE
         BNE      XSSE70            BNE; ASSUME NO MORE STRGS
         AI,X1    1                 INC PNTR TO PARAM DISPLACEMENT
         LB,P2    *CDTADR,X1        L/DISP TO STRING TEXT
         AW,P2    CDTADR            G/ADR OF STRG TEXT
         AI,X1    1                 INC PNTR TO NEXT PARAM
         LI,D1    STRG:NOT          L/.NOT. FLAG
         AND,D1   X2                &/.NOT. W/FLAG IN CDT; IF NOT WAS
*                                   .. SPECIFIED, STRG:NOT BIT WILL
*                                   .. NOT BE SET
         BAL,LNK  FINDMATCH         CHECK FOR PRESENCE OF STRING
         BCS,8    %+2               B/NOT PRESENT
         EOR,D1   =STRG:NOT         D1 IS NOW SET ONLY IF STRING
*                                   .. OPERATOR IS TRUE
         SLS,X2   -4                RJ/AND-OR-EOR FLAGS
         AND,X2   X7                MASK FLAGS W/7
         EXU      LOGIC,X2          SET D0; NON-XERO IF EXPRESSION IS
*                                   .. TRUE SO FAR
         B        XSSE30            B/CHECK NEXT STRING OPERATOR
XSSE70   STB,D0   *STACKDW          S/EXPRESSION FLAG INTO LNK IN STACK
         PULL     (X1,LNK)          PULL REGS
         LC       LNK               L/RESULT INTO CC1
         B        0,LNK             RETURN
*
*
LOGIC    AND,D0   D1                FIRST STRING IMPLICIT OPERATOR
         AND,D0   D1                AND
         OR,D0    D1                OR
         EOR,D0   D1                EOR
         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%PROTECT EQU %
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    INS19             B/REC DOESN'T EXIST
         LW,X2    CURRENT%CMND#     L/CURRENT CMND #
         LB,X2    FLAG,X2           L/FLAGS FOR THIS CMND
         CI,X2    PROTECTED         C/FLAGS W/PROTECTED FLAG BIT
         BAZ      INS18             B/EXISTING REC NOT PROTECTED
         BAL,LNK  TYPEMSG           TYPE MESSAGE
         DATA     ERRP21            '-P1:REC EXISTS:
         B        *R:LNK            RETURN
INS18    BAL,LNK  READSEQUEN        READ NEXT REC
INS19    LW,T2    R1                SET T2 = HI SEQ #
*
*  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    EQU      %
         B        *R:LNK            RETURN
         DO       MODE=2
INS50    LI,D1    9
         NOP      0                 X4 IS NEVER ONE
         LI,D1    1                 OFFSET FOR PROMPT ONLY
*
         FIN
*
INSMSG   TEXTC    '   '             X'07'+X'07'+EOM
         PAGE
********************************************
*  RECORD COMMANDS: MOVE AND DELETE(KEEP)  *
********************************************
*
*
R:MOVE%DELETE     EQU %
R:MOVE%DELETE%P EQU %               MOVE-DELETE, PROTECTED
         LI,X4    0                 USE X4=0 TO SIGNAL MD
         B        R:MOVE%KEEP+1
*
*
R:MOVE%KEEP       EQU %
R:MOVE%KEEP%P EQU %                 MOVE-KEEP, PROTECTED
         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
         LW,X3    CURRENT%CMND#     L/CURRENT CMND #
         LC       FLAG,X3           L/FLAGS FOR CMND INTO CC'S
         BCR,PROTECTED**-4 MVE25    B/NOT PROTECTED MODE (MKP, MDP)
         BAL,LNK  READNXTRANDOM     READ P1 REC OR 1ST AFTER P1
         CW,R1    P2                C/SEQ # READ W/END 'TO' SEQ #
         BG       MVE25             BG; NO DEST TO DELETE
         BAL,LNK  TYPECERR%UNCONDT  TYPE ERROR MESSAGE
         DATA     ERRC14            '-CN:DESTINATION RECS EXIST'
         B        MASTERPARSER      B; G/NEXT COMMAND
MVE25    ;
         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
         BAL,LNK  PROCESSCOL#PAIR   PROCESS COL # PARAMS
         BAL,LNK   READNXTRANDOM
         STW,R1    P1               PUT FIRST REC. NO. IN P1.
         CW,R1    L(EOF)
         BE       SPL20
         STW,R1    FIRSTSET         NO , SO USE THE FIRST RECORD
         BAL,LNK  SAVE%SSE          SAVE CURRENT CDT ENTRY
         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  XSSE%CONDT        CHECK FOR STRING SELECT EXP
         BCR,8    SPL10             B/STRING SELECT EXP WAS FALSE
         BAL,LNK  SETEOD            SET EOD MARKER
         MTW,0    STEPFLAG
         BGZ      SPL15             WAS 'ST' CMND USED
         LW,X1    LAST%TYPE%CMND     L/LAST TYPE CMND #
         BNEZ     %+2               BNEZ; TYPE HAS BEEN DONE
         LI,X1    I:TY#             L/INTRA TY CMND #; NO TYPES YET
         STW,X1   CURRENT%CMND#     CHANGE US TO A TY/TS/TC/RR CMND
         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:REREAD      EQU %
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 #
         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
         CI,X4    1                 'TY' AND 'TC'
         BE       TYP5
         MTW,1    TABXFLAG
TYP5     RES      0
         FIN
         BAL,LNK  READNXTRANDOM     READ FIRST SEQ # OR NEXT HIGHEST
         STW,R1    SV1STSET         SET UP FIRST RECORD NO.
*
*  READ AND TYPE UNTIL LAST SEQ # READ OR PASSED
*
TYP10    STW,R1   FIRSTSET          S/CUR SEQ #
         CW,R1    L(EOF)            C/CUR SEQ # W/EOF SEQ #
         BE       TYP20             YES - GO TYPE ERROR MESSAGE
         CW,P2    R1                WAS INPUT SEQ # >= LAST SEQ #
         BL       TYP17             B/CUR SEQ # > HI SEQ #
         LW,P1    R1
         BAL,LNK  TYP40
         BAL,LNK  SETEOD            SET EOD MARKER
         BAL,LNK  S(TYPECARD,TYPRR)
         AI,R2    1
         CW,P2    R1                C/HI SEQ # W/CUR SEQ #
         BLE      TYP17             B/DONE
TYP12    BAL,LNK  READSEQUEN        READ NEXT RECORD SEQUENTIALLY
         B        TYP10             LOOP
TYP17    AI,R2    0                 CHECK OUTPUT COUNT
         BLEZ     TYP25
         B        TYP90
*
*  ERROR: EOF HIT
*
TYP20    BAL,LNK  TYPEMSG           TYPE: '--EOF HIT'
         DATA     ERRM1
         AI,R2    0                 WERE ANY RECORDS GOTTEN
         BLEZ     TYP25A            NO, RESET SET FLAG
         B        TYP90
*
TYP25    BAL,LNK  TYPEMSG           TYPE: '--NONE'
         DATA     ERRM6
TYP25A   LI,T1    0                 TURN OFF SET FLAG IF '-NONE'
         STW,T1   SETFLAG
         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,
         CI,X1    MAXCLMN
         BGE      0,LNK             BGE; EXIT
         LI,X2    ' '               BLANK OUT REGION
TYP55    STB,X2   CARDIMG,X1        (LASTCLMN,MAXCLMN-1)
         AI,X1    1
         CI,X1    MAXCLMN-1
         BLE      TYP55
*
         B        0,LNK             RETURN
TYP90    EQU      %
         B        *R:LNK
         DO       MODE=2
TYPRR    LW,X2    CURRENT%CMND#     L/CMND  #
         CI,X2    R:RR#             C/CMND # W/RR CMND #
         BE       %+3               B/INTER RR CMND
         CI,X2    I:RR#             C/CMND # W/INTRA RR CMND
         BNE      TYPECARD%FIRSTSET B/NOT EITHER RR CMND #
         PUSH     (X1,R:LNK)        PUSH REGS
         BAL,I:LNK I:REREAD         DO INTRA-REC REREAD
         BAL,LNK  WRITERANDOM       WRITE REC BACK TO FILE
TYPRR90  PULL     (X1,R:LNK)        PULL REGS
         B        0,LNK             RETURN
         FIN
         PAGE
I:REREAD ;
         LW,R1    RECSIZE           L/BC OF REC READ
         CI,R1    140               C/BC W/COC'S MAX BC
         BL       I:RR10            BL; OK
         BAL,LNK  TYPECARD          TYPE CARD IMAGE
         BAL,LNK  TYPECERR%UNCONDT  TYPE ERROR MESSAGE
         DATA     ERRC12            TEXTC '-CN:REC>139 CHARS'
         B        I:RR40            B; EXIT SUBROUTINE
I:RR10   BAL,LNK  I:RR90            BLANK REST OF CARDIMG
         CAL1,1   NOPROMPT%FPT      RESET PROMPT CHAR
         LW,X1    CURRENT%CMND#     L/CURRENT CMND #
         LC       FLAG,X1           L/FLAGS FOR THIS CMND
         BCR,TYPE%SEQ#**-4 I:RR20   B/NOT TO PRECEDE W/SEQ #
         LW,P1    FIRSTSET          L/CURRENT SEQ #
         BAL,LNK  TYPESEQ           TYPE SEQ #
         GEN4     BL,EOM,0,0        FOLLOW W/1 BLANK
I:RR20   BAL,LNK  REREADCARDIMG     DO M:READ (COC,REREAD)
         LW,X1    R1                L/SIZE FROM ABOVE READ
         AI,X1    -1                DEC BC OF M:READ RESPONSE
         BLEZ     I:RR40            B/NOTHING READ
         LI,D1    ' '               L/BLANK
         STB,D1   CARDIMG,X1        S/BLANK; REPLACE CR OR LF
         BAL,LNK  SETEOD            SET REC SIZE, ADD CR IF DESIRED
         MTW,1    CHG:STG:CNT       INC CHNG CNT; DO WRITE IF SE
I:RR40   B        *I:LNK            RETURN
*
*
I:RR90   PUSH     (X3,X2),LNK       PUSH REGS FOR RT17 EXIT
         LI,X2    0                 L/0; INDEX FOR CARDIMG
         B        RT17              B; BLANK OUT REST OF CARDIMG
         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
         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
         BAL,LNK  SAVE%SSE          SAVE CDT ENTRY IN SSE%CDT
         LB,X1    *CDTADR           L/SIZE OF CURRENT ENTRY
         AW,X1    CDTADR            +ADR OF CDT ENTRY; G/ADR OF NEXT
         MTH,0    *X1               CHECK 1ST HW OF NEXT CDT ENTRY
         BEZ      MASTERPARSER      BEZ; END-OF-CDT ENTRY
         BAL,LNK  XSSE%CONDT        CHECK FOR STRING SELECT EXP
         BCS,8    *I:LNK            B/EXP NOT THERE OR TRUE
         LB,T1    *CDTADR           L/SIZE OF SE CMND ENTRY
         AWM,T1   CDTADR            ADD SIZE TO CDT ADR
         BAL,LNK  SE%INIT           INIT SE LOOP
         LB,T1    *CDTADR           L/SIZE OF CURRENT CDT ENTRY
         BEZ      *I:LNK            BEZ; AT END, RETURN
         AWM,T1   CDTADR            ADD CURRENT ENTRY SIZE TO CDTADR
         B        %-3               B/CHECK NEXT CDT ENTRY
         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%SE%CONDT WRITE REC IF CHANGED
         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.
         BG       %+3               CHECK FOR ZERO STRINGS
         MTW,0    ZERO:STG:FLG      AND WHETHER TO ANNOUNCE IT
         BNEZ     STL30             NO, DON'T BOTHER
         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   ZERO:STG:FLG      THE ZERO STRING FLAG,
         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%SE%CONDT WRITE REC IF CHANGED
         DO1      MODE=2
STL15    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 #
         STW,R1   INTFLAG1          S/SEQ # READ
         BAL,LNK  XSSE%CONDT        CHECK FOR STRING SELECT EXP
         BCR,8    STL15             B/EXPRESSION WAS FALSE
         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
SAVE%SSE ;
         LB,X1    *CDTADR           L/SIZE OF CURRENT CDT ENTRY
         AI,X1    -1                -1 TO BC; ASSUME AT LEAST 1 WD
         LW,T1    *CDTADR,X1        L/WD OF CURRENT CDT ENTRY
         STW,T1   SSE%CDT,X1        S/WD OF CDT IN SAVE AREA
         BDR,X1   %-2               BDR/MOVE NEXT CDT WD
         LW,T1    *CDTADR           L/FIRST WD OF CDT
         STW,T1   SSE%CDT           S/LAST WD OF CDT
         B        0,LNK             RETURN
         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
         MTW,1    CHG:STG:CNT       INC CHANGED STRING COUNT
         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
         MTW,1    CHG:STG:CNT       INC CHANGED STRING COUNT
         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
         MTW,1    CHG:STG:CNT       INC CHANGED STRING COUNT
         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
         MTW,1    CHG:STG:CNT       INC CHANGED STRING COUNT
         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: ALIGN X AT COLUMN Y  *
********************************************
*
*
I:ALIGN ;
         STW,I:LNK ALLOK            DON'T PERMIT 'ALL OCCURRENCES'
         BAL,LNK  FINDCOLUMN        FIND COLUMN TO ALIGN
         BCS,8    *I:LNK            B/NOT FOUND
         PUSH     P1                PUSH P1
         BAL,LNK  FINDCOL2          FIND COLUMN TO ALIGN WITH
         BCS,8    *I:LNK            B/NOT FOUND
         MTW,1    CHG:STG:CNT       INC CHANGED STRING COUNT
         LW,P3    P1
         PULL     P1                PULL P1
         SW,P3    P1                G/# OF COLUMNS DISPLACEMENT
         BEZ      *I:LNK            B/NOT DISPLACEMENT
         BLZ      %+3               B/LEFT DISPLACEMENT
         BAL,LNK  SHIFTRIGHT        SHIFT STRING RIGHT
         B        %+3               B
         LCW,P3   P3                MAKE P3 POSITIVE
         BAL,LNK  SHIFTLEFT         SHIFT STRING LEFT
         BAL,LNK  SETEOD            SET NEW EOD POINTER
         B        *I:LNK            RETURN
         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
         MTW,1    CHG:STG:CNT       INC CHANGED STRING COUNT
         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
         MTW,1    CHG:STG:CNT       INC CHANGED STRING COUNT
         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
         MTW,1    CHG:STG:CNT       INC CHANGED STRING COUNT
         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
         MTW,1    CHG:STG:CNT       INC CHANGED STRING COUNT
         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:TYPEX  ;
         LW,P1    CHG:STG:CNT       L/# OF STRINGS CHANGED ON SE
         CW,P1    SAVED:CHG:STG:CNT C/COUNT W/SAVED COUNT
         BE       *I:LNK            BE; NO CHANGE ON THIS REC
         B        TYPEBAL           B; TYPE REC
I:TYPE%COMPRESSED EQU %
         LI,D0    MAXCLMN           L/MAX SIZE OF CARDIMG
I:TYPE   EQU      %
I:TYPE%SUP%SEQ    EQU %
         MTW,1    ZERO:STG:FLG      DON'T OUTPUT ON TS
TYPEBAL  BAL,LNK  TYPECARD%FIRSTSET TYPE CARDIMG; FIRSTSET IS 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   '@'
         DO1      MODE=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
         STW,P2   PREVIOUS%CHARPSN  S/CHAR POSITION
         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
         CI,P1    '#'
         BE       GP25              B IF HEX BYTE FOLLOWS
         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        GP41              GO FINISH UP
*
*  A LEGAL 'GETNEXTPARAM' TYPE  FOUND
*
GP20     LB,P1    GPTYTBL,X1        SET P1=TYPE OF MATCH FOUND
         LI,X2    1                 SET INDEX IN CASE OF DEFAULT
         B        GETNEXT%FINISH    GO FINISH UP
*
*  STRING FOUND: BUILD TEXTC-STRING IN PARAMBUF
*
*        TRANSLATE SINGLE HEX BYTE INTO STRING
*
GP25     RES      0
         LB,P1    TTYIMG,P2         GET NEXT TEXT CHAR
         AI,P2    1                 INCREMENT TEXT POINTER
         AI,P1    -'0'
         BGEZ     GP26
         AI,P1    '0'-'A'+10       CONVERT TO VALUE
         CLM,P1   LIM%XA%XF
         BIL      GP26              B/.A -> .F
         AI,P1    X'40'             CONVERT POSS LOWER CASE TO UPPER
         CLM,P1   LIM%XA%XF         C/CHAR (+.40) W/.A, .F
         BOL      P:H:I:30          '-P1:ILLEGAL HEXADECIMAL DIGIT'
GP26     LW,X1    P1                SAVE FIRST DIGIT
         LB,P1    TTYIMG,P2         GET NEXT TEXT CHAR
         AI,P2    1                 INCREMENT TEXT POINTER
         AI,P1    -'0'
         BGEZ     GP27
         AI,P1    '0'-'A'+10       CONVERT TO VALUE
         CLM,P1   LIM%XA%XF
         BIL      GP27              B/.A -> .F
         AI,P1    X'40'             CONVERT POSS LOWER CASE TO UPPER
         CLM,P1   LIM%XA%XF         C/CHAR (+.40) W/.A, .F
         BOL      P:H:I:30          '-P1:ILLEGAL HEXADECIMAL DIGIT'
GP27     SLS,X1   4
         AW,P1    X1                COMBINE DIGITS
         CW,P2    TTYIMGSZ
         BG       GP45              B/FELL OFF END OF CMND
         STB,P1   PARAMBUF,X2       SET CHARACTER IN TEXTC STRING
         AI,X2    1                 INCREMENT TEXTC POINTER
         LB,P1    TTYIMG,P2         GET NEXT CHAR
         AI,P2    1                 INCR CHAR PSN
         B        GP40              B TO TEST FOR MORE STRING
*
*        CONVERT EBCDIC STRING
*
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
*
GP40     RES      0
         CI,P1    '#'
         BE       GP25              B IF A HEX BYTE FOLLOWS
         CI,P1    '/'               B IF AN EBCDIC STRING FOLLOWS
         BE       GP30              B IF AN EBCDIC STRING FOLLOWS
         LI,P1    STRG              SET PARAM TYPE
GP41     RES      0                 CLEANUP FOR ALPHA OR STRING
         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.
         DO1      MODE=2
         DATA,1   FF                0: FORM 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.
         DO1      MODE=2
         DATA,1   0                 0: FORM 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,X1    5                 L/INDEX TO 1ST PARAM POINTER
         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    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 -
         LI,X2    3                 L/INDEX TO # OF PARAMS
         LB,X2    *CDTADR,X2        L/# OF PARAMS POSSIBLE
         CI,X2    4                 C/# W/4
         BE       FC10              B/4; FORM IS N/STR/
FC05     ;
         LB,X2    *CDTADR,X1        L/COLUMN #
         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
         MTW,1    ZERO:STG:FLG      DON'T OUTPUT '0 STRINGS'
         B        FC20              GO EXIT
*
*  FORM IS  N/STR/   GET OCCURRENCE COUNT
*
FC10     ;
         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
FC15     AI,X1    2                 POINT TO POINTER FOR /STR/
*
*  FIND CORRECT OCCURRENCE OF STRING IF IT EXISTS
*
FC15A    LB,P2    *CDTADR,X1        SET P2=ABSOLUTE ADDR OF PARAM2
         AW,P2    CDTADR             STRING
FC15B    ;
         BAL,LNK  FINDMATCH         FIND MATCH FOR STRING
         BCS,8    FC30              IF NONE - ERROR
         LW,P1    R1                SET P1=COL. TO RESUME MATCHING
         AI,P1    1
         BDR,T1   FC15B             BDR/CHECK NEXT OCCURRENCE
         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
*
*  FIND COLUMN # SPECIFIED BY SECOND PARAM GROUP
*  ENTRY:  AS FOR FINDCOLUMN, BUT
*             X1 = NEXT CDT CONTROL BYTE INDEX
*  EXIT:   AS FOR FINDCOLUMN
*
FINDCOL2 ;
         PUSH     X2,(LNK,T1)       SAVE REGS
         LW,X2    X1
         AI,X1    1                 POINT TO PARAMETER TEXT POINTER
         LI,T1    1                 OCCURRENCE COUNT DEFAULT
         LW,P1    FRSTCLMN          L/COLUMN # TO START AT
         LB,X2    *CDTADR,X2        L/PARAM TYPE CODE
         CI,X2    STRG              C/CODE W/STRING TYPE CODE
         BE       FC15A             B/FORM IS /STR/
         LW,X2    X1
         AI,X2    1
         LB,X2    *CDTADR,X2        G/NEXT PARAM TYPE CODE
         BEZ      FC05              B/NO MORE PARAMS (FORM IS C)
         B        FC10              B
         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
         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                        *
******************************************************
*
*
PROCESSCOL#PAIR   EQU %
         PUSH     (X1,LNK)          SAVE REGS
         LI,P1    0                 SET P1=DFLT STARTING COL. #
         LI,P2    MAXCLMN               P2=DFLT STOPPING COL. #
         LI,X2    COL1              L/PARAM TYPE; 1ST COL #
         BAL,LNK  FINDPARAM         FIND 1ST COL # IN CDT
         B        PP10              B/NOT PRESENT
         LW,P1    *CDTADR,X2
         AI,P1    -1                ADJUST TO INTERNAL COL #
*
*  PROCESS SECOND COLUMN NUMBER PARAMETER
*
PP10     ;
         LI,X2    COL2              L/PARAM TYPE; 2ND COL #
         BAL,LNK  FINDPARAM         FIND 2ND COL # IN CDT
         B        PP20              B/NOT PRESENT
         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,LNK)          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
FINDPARAM         ;
         LI,T1    X'FF'             L/MASK FOR # OF PARAMS IN CDT ENT
         AND,T1   *CDTADR           G/# OF PARAMS IN CDT
         LI,X1    4                 L/4; INDEX TO FIRST PARAM ENTRY
FNDPRM5  LB,T2    *CDTADR,X1        L/PARAM TYPE
         AND,T2   =X'F'             &/PARAM TYPE F/.F
         CW,T2    X2                C/PARAM TYPE W/DESIRED TYPE
         BNE      FNDPRM8           BNE
         AI,X1    1                 INC PARAM PNTR
         LB,X2    *CDTADR,X1        L/DISP TO PARAM IN CDT
         B        1,LNK             RETURN + 1
FNDPRM8  AI,X1    2                 INC CDT PNTR
         BDR,T1   FNDPRM5           BDR/CHECK NEXT PARAM ENTRY
         B        0,LNK             RETURN; NOT FOUND
         PAGE
***********************************
*  FIND COLUMN OF LAST NON-BLANK  *
***********************************
*
*
SETEOD   EQU      %
         MTW,0    RP%FLAG           CHECK RECORD PRESERVATION
         BNEZ     0,LNK             B/'RP ON'; DON'T CHANGE REC SIZE
         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      %
         PUSH     X1                SAVE X1
         LH,X1    F:EI              L/LH OF WD 0 OF F:EI DCB
         CI,X1    X'20'             C/LH W/.20; FILE OPEN BIT
         BAZ      %+2               BAZ; FILE NOT OPEN; DON'T CLOSE
         M:CLOSE  F:EI,(SAVE)
         PULL     X1                RESTORE X1
         B        0,LNK
*********************
*  CLOSE COPY FILE  *
*********************
*
*
CLOSE2   EQU      %
         PUSH     X1                SAVE X1
         LH,X1    F:EO              L/LH OF WD 0 OF F:EO DCB
         CI,X1    X'20'             C/LH W/.20; FILE OPEN BIT
         BAZ      %+2               BAZ; FILE NOT OPEN; DON'T CLOSE
         M:CLOSE  F:EO,(SAVE)
         PULL     X1                RESTORE X1
         B        0,LNK
*
*
CLOSE3   PUSH     X1                SAVE X1
         LH,X1    F:EO              L/LH OF WD 0 OF F:EO DCB
         CI,X1    X'20'             C/LH W/.20; FILE OPEN BIT
         BAZ      %+2               BAZ; FILE NOT OPEN; DON'T CLOSE
         M:CLOSE  F:EO,(REL)        CLOSE F:EO W/RELEASE
         PULL     X1                RESTORE X1
         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,LNK)          PUSH REGS
         LI,R2    0                 L/0; ACCUM FOR # 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
         BAL,LNK  INOUT             RETURN IF F:EI OPEN INOUT OR OUT
         M:DELREC F:EI,(KEY,DELNXT) DELETE N
         AI,R2    1                 INC # OF RECS DELETED
         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,R2    1                 INC # OF RECS DELETED
         CI,R2    1                 C/# DEL'D W/1
         BE       DL17              BE; DON'T SQUAWK
         LW,P1    R2                L/# DEL'D
        LI,P2    BA(MSG6)+1
        BAL,LNK  BINTODEC
        BAL,LNK   TYPEMSG
        DATA       MSG6
DL17     EQU       %
         PULL     (P1,LNK)          PULL REGS
         LCI      0
         B        0,LNK             EXIT WITH CC1=0
*
*  LAST SEQ # WAS PASSED: EXIT WITH CC1=1
*
DL20     CI,R2    1                 C/# OF RECS DEL'D W/1
         BLE      DL25              BLE; DON'T SQUAWK
         LW,P1    R2                L/# DEL'D
        LI,P2    BA(MSG6)+1
        BAL,LNK  BINTODEC
        BAL,LNK   TYPEMSG
        DATA       MSG6
DL25     EQU       %
         PULL     (P1,LNK)          PULL 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  *
*****************************************************
*
*
DELETEFILE        EQU %
         PUSH     (X1,P3)
         LI,P2    DF%ABN
         STW,P2   O2%FPT%ABN        S/ABN ADR FOR OPEN
         LI,P2    4                 INOUT
         STW,P2   O2%FPT%MODE       S/MODE FOR OPEN
         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
BADIO1   RES      0                 ENTER HERE IF CODE IN X1.
         DO       MODE=2
         LW,D0    10                L/ERR CODE, SUBCODE
         SLD,D0   -24               RJ/CODE IN D0
         SLS,D0   1                 SHIFT CODE LEFT 1 BIT
         SLD,D0   7                 SHIFT CODE, SUBCODE LEFT 7 BITS
         MTB,3    D0                ADD BC FOR KEY;REG CONTAINS
*                                   .. 03 00 XX YY  WHERE XX IS CODE,
*                                   .. YY IS SUBCODE
         STW,D0   ERRKEY            S/KEY FIR READ
         PUSH     8,10              SAVE REGS
         M:OPEN   F:ERRMSG,(FILE,'ERRMSG',':SYS'),;
                  (ERR,BADIOBAD),(ABN,BADIOBAD),(IN)
         M:READ   F:ERRMSG,(BUF,ERRM28+4),(BTD,0),(SIZE,80),;
                  (KEY,ERRKEY),(ERR,BADIOBAD),(ABN,BADIOBAD)
         LW,X1    F:ERRMSG+13       L/BC OF ERRMSG REC READ
         AI,X1    14                ADJUST FOR ERROR MSG INIT TEXT
         STB,X1   ERRM28            S/BC OF ERROR MESSAGE TEXT
         LI,X1    X'1FFFF'          L/MASK FOR WA
         AND,X1   10                &/MASK W/DCB ADR
         BAL,LNK  TYPE%FID%MSG      TYPE ERROR MSG
         DATA     TC1HYPH           '-'
         DATA     ERRM28            ':I/O ERR/ABN - (TEXT OF ERRMSG.:SYS)'
         PULL     8,10              PULL REGS
         M:XXX
BADIOBAD PULL     8,10              PULL REGS
         FIN
         LB,X1    10                L/ERR/ABN CODE
         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
         LB,X2    P3,X3             GET SUBCODE
         SLS,X2   -1                AND RIGHT JUSTIFY
         SCS,X2   -4                BUILD ERROR SUBCODE
         LB,X1    HEXCHAR,X2
         AI,X3    2
         STB,X1   IOERRCOD,X3
         SLS,X2   -28
         LB,X1    HEXCHAR,X2
         STB,X1   IOERRCOD+1
         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 %
         PUSH     LNK
         BAL,LNK  INOUT             RETURN IF F:EI OPEN INOUT OR OUT
         M:DELREC F:EI,(KEY,LASTKEY)
         PULL     LNK
         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                 CONVERT BLANKS TO ZEROS
         LI,X2    7                 BEFORE CALCULATING FIRST
         LI,D0    X'40'             NON-ZERO POSITION.
         LI,D1    X'F0'
         CB,D0    TEMPBLCK,X1
         BNE      %+4
         STB,D1   TEMPBLCK,X1
         AI,X1    1
         BDR,X2   %-4
*
         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)   *
*  OPENIN: OPEN SPECIFIED DCB IN INPUT MODE         *
*    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    *
*****************************************************
*
*
OPENIN   PUSH     (X1,P3)           SAVE REGS
         LI,P2    1                 L/1; INPUT MODE
         B        OPN10             B; MERGE W/COMMON CODE
OPEN     EQU      %
         PUSH     (X1,P3)
         LI,P2    4                 INOUT
         B        OPN05
*
*
OPEN1    EQU      %
         PUSH     (X1,P3)
         LI,P2    1                 INPUT
*
*
OPN05    ;
         LI,X1    F:EI              L/DCB ADR
OPN10    STW,X1   OPEN%DCB%ADR      S/DCB ADR FOR M:OPEN
         STW,LNK  SAVE1             SAVE FOR POSSIBLE TEST
         STW,P1   SAVE2             SAVE FOR POSSIBLE RE-USE
OPN15 ;
         STW,P2   O%FPT%MODE        S/MODE FOR OPEN FPT
         LI,P2    O%ABN
         STW,P2   O%FPT%ABN         S/ABN ADR FOR OPEN FPT
         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    *O%FPT            L/DCB ADR
         BAL,LNK  CHK%FILE%TYPE     CHECK WHAT WE'RE OPEN TO
         BAL,LNK  SET%CRPT          SET/RESET DATA ENCRYPTION
         LI,D1    X'C'              L/MASK FOR MODE CHECK
         CH,D1    F:EI+1            C/MASK W/MODE IN DCB
         BANZ     OPN30             B/OUT OR INOUT
         LW,LNK   SAVE1             LNK SAVED ABOVE
         CI,LNK   EDT7              WAS OPEN CALLED BY 'EDIT FID'
         BNE      OPN30             NO
         BAL,LNK  TYPEMSG           FILE OPEN INPUT ONLY
         DATA     ERRM22            TELL USER AND GO
OPN30    RES      0
         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    X'14'
         BNE      O%ABN1            NOT RESTRICTED ACCESS
         CW,P3    =X'00FE0000'      C/SUBCODE W/.7F
         BANZ     BADIO1            B/14-XX; DON'T TREAT AS 14-00
         LI,P2    1
         CW,P2    O%FPT%MODE        MODE=INPUT
         BE       O%ABN1            NO
         LW,P1    SAVE1             LNK SAVED ABOVE
         CI,P1    EDT7              WAS OPEN CALLED BY 'EDIT FID'
         BNE      O%ABN1            NO
         LW,P1    SAVE2             YES-ADDR O F FID SAVED ABOVE
         B        OPN15             NOW-TRY OPENING INPUT
O%ABN1   EQU      %
         CI,X1    3
         BNE      BADIO1
         PULL     (X1,P3)           NO FILE.
         LCI      8
         B        0,LNK
         PAGE
SET%CRPT ;                          SET/RESET DATA ENCRYPTION
         LH,T1    F:EI              L/LH OF WD 0 OF F:EI DCB
         CI,T1    X'20'             C/LH W/.20; DCB-OPEN BIT
         BAZ      %+2               BAZ; NOT OPEN
         M:SETDCB F:EI,(CRPT,*CRPT%FLAG) SET/RESET ENCRYPTION
         LH,T1    F:EO              L/LH OF WD 0 OF F:EI DCB
         CI,T1    X'20'             C/LH W/.20; DCB-OPEN BIT
         BAZ      0,LNK             BAZ; DCB NOT OPEN
         M:SETDCB F:EO,(CRPT,*CRPT%FLAG) SET/RESET ENCRYPTION
         B        0,LNK             RETURN
         PAGE
*****************************************************
*  OPEN (OUTPUT) FILE FOR COPYING                   *
*    P1 = ADDR OF FILE ID IN CDT                    *
*    CC1=1 IF FILE DOES NOT EXIST; CC1=0 OTHERWISE  *
*****************************************************
*
*
OPEN3    PUSH     (X1,P3)
         LI,P2    2                 OUTPUT
         B        OPEN2G
*
*
OPEN2    EQU      %
         PUSH     (X1,P3)
         LI,P2    4                 INOUT
OPEN2G   STW,P2   O2%FPT%MODE
         LI,P2    O2%ABN
         STW,P2   O2%FPT%ABN        S/ABN ADR FOR OPEN
*
         LI,T1    O2%NAME           SAME.
         LI,T2    O2%ACCT
         LI,P3    O2%PASS
         BAL,LNK  OPENINIT
         CAL1,1   O2%FPT
         LW,X1    O2%FPT            L/DCB ADR
         BAL,LNK  CHK%FILE%TYPE     CHECK WHAT WE'RE OPEN TO
         BAL,LNK  SET%CRPT          SET/RESET DATA ENCRYPTION
         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%MODE       S/MODE FOR OPEN
         CAL1,1   O2%FPT
         BAL,LNK  SET%CRPT          SET/RESET DATA ENCRYPTION
         PULL     (X1,P3)
         LCI      8
         B        0,LNK
         PAGE
CHK%FILE%TYPE     ;
         PUSH     (X1,LNK)          PUSH REGS
         LI,X2    12*4              L/BTD TO KEYM IN DCB
         LB,X2    *X1,X2            L/KEYM
         CI,X2    3                 C/KEYM W/3; EDIT'S KEYM
         BE       CHK%F90           B/3; OK
         LI,X2    X'F0'             L/MASK FOR ORG CHECK
         AND,X2   5,X1              &/MASK W/ORG IN DCB
         CI,X2    X'10'             C/ORG W/1; CONSECUTIVE
         BE       CHK%F90           B/CONSEC; IGNORE KEYM
         BAL,LNK  TYPE%FID%MSG      TYPE ERROR MESSAGE
         DATA     TC2HYPH           '--'
         DATA     ERRM27            ':FILE NOT CREATED BY EDIT' (KEYM NOT 3)'
CHK%F90  PULL     (X1,LNK)          RESTORE REGS
         B        0,LNK             RETURN
*
*
*
TYPE%FID%MSG      ;
         PUSH     (X1,LNK)          PUSH REGS
         LI,P1    BA(COMPRIMG)+1    L/DESTINATION BUF ADR
         LW,X2    0,LNK             L/WA OF 1ST TEXTC STRG OF MSG
         BAL,LNK  MBSTC             MOVE TO COMPRIMG
         LW,X2    6,X1              L/PNTR TO VLP
         AI,X2    1                 INC VLP PNTR; POINT TO FILENAME
         BAL,LNK  MBSTC             MOVE FILENAME TO MSG BUF
         LI,P2    1                 L/1; BC OF '.'
         LI,X2    BA(='....')       L/BA OF '....;
         BAL,LNK  MBS               MOVE '.' TO MSG BUF
         LW,X2    6,X1              L/VLP PNTR
         LI,T1    X'FF'             L/.FF; MASK FOR SIZE OF VLP ENTRY
         AND,T1   0,X2              G/SIZE OF FILENAME ENTRY
         AW,X2    T1                G/ADR OF WD BEFORE NEXT VLP ENTRY
         AI,X2    2                 G/ADR OF WD AFTER ACNT VLP ENTRY
         LI,P2    7                 L/7; BTD TO LAST CHAR OF ACNT
         LI,T1    ' '               L/BLANK
         CB,T1    *X2,P2            C/BLANK W/CHAR OF ACNT
         BNE      %+2               B/NON-BLANK
         BDR,P2   %-2               B/CHECK NEXT CHAR TO LEFT
         AI,P2    1                 G/# OF NON-BLANK CHARS IN ACNT
         SLS,X2   2                 G/BA OF ACNT VLP ENTRY
         BAL,LNK  MBS               MOVE ACNT ENTRY TO MSG BUF
         LW,X2    *STACKDW          L/LNK FROM STACK
         LW,X2    1,X2              L/2ND TEXTC POINTER FROM CALLER'S LIST
         BAL,LNK  MBSTC             MOVE 2ND CALLER'S STRING TO MSG BUF
         AI,P1    -BA(COMPRIMG)-1   G/SIZE OF MSG BUF
         STB,P1   COMPRIMG          MAKE MSG BUF TEXTC
         BAL,LNK  TYPEMSG           TYPE MSG BUF
         DATA     COMPRIMG          ADR OF MSG BUF
         PULL     (X1,LNK)          PULL REGS
         B        2,LNK             RETURN TO CALLER
*
*
MBSTC    ;
         SLS,X2   2                 G/BA OF TEXTC STRING
         LB,P2    0,X2              L/BC OF TEXTC STRING
         AI,X2    1                 G/BA OF 1ST CHAR IN STRING
MBS      EQU      %
         DO       MODE=2
         STB,P2   P1                S/BC IN MBS CNTRL WD
         MBS,X2   0                 MOVE STRING
         ELSE
         LB,T1    0,X2              L/BYTE OF SOURCE STRING
         STB,T1   0,P1              S/BYTE INTO DESTINATION
         AI,X2    1                 INC SOURCE BA
         AI,P1    1                 INC DEST BA
         BDR,P2   MBS               BDR/MOVE NEXT CHAR
         FIN
         B        0,LNK             RETURN
         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        *
***********************************************
*
*
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%ABN         S/ABN ADR FOR OPEN
         LI,P2    4                 INOUT
         STW,P2   O%FPT%MODE        S/MODE FOR OPEN FPT
         LI,T1    O%NAME
         LI,T2    O%ACCT
         LI,P3    O%PASS
         BAL,LNK  OPENINIT
         LI,X1    F:EI              L/DCB ADR FOR M:OPEN
         STW,X1   OPEN%DCB%ADR      S/DCB ADR
         CAL1,1   O%FPT
         LW,X1    *O%FPT            L/DCB ADR
         BAL,LNK  CHK%FILE%TYPE     CHECK WHAT WE'RE OPEN TO
         BAL,LNK  SET%CRPT          SET/RESET DATA ENCRYPTION
         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%MODE        S/MODE FOR OPEN
         CAL1,1   O%FPT
         BAL,LNK  SET%CRPT          SET/RESET DATA ENCRYPTION
         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
         BEZ      PUTCR2            B/'CR OFF'
         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  *
***********************************************
*
*
READNXTRANDOM     EQU %
         PUSH     LNK
         BAL,LNK  READRANDOM
         BCS,8    RDNXRD20          B/REC DOESN'T EXIST
         LW,R1    LASTKEY           GOT IT, RETURN KEY.
         AND,R1   XFFFFFF
         PULL     LNK
         LCI      0
         B        0,LNK
*
*
RDNXRD20 ;
         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
         CHK%ERR  F:EI,RR%ERR       SKIP SETDCB IF UNNECESSARY
         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 THE RECORD BEFORE THE CURRENT RECORD  *
***********************************************
*
*
READ%NXT%REVERSE ;
         PUSH     (LNK,P3)          SAVE REGS
         BAL,LNK  READRANDOM        READ REC CURRENTLY POINTED TO BY P1
,FPRDREV  M:READ  F:EI,;
                  (ERR,BADIO),;
                  (ABN,RNR%ABN),;
                  (SIZE,MAXCLMN),;
                  (REV)
         BAL,LNK  BLANKBUF          BLANK BUFFER
         CAL1,1   FPRDREV           READ F:EI IN REVERSE AGAIN
         BAL,LNK  SETLASTKEY        SET LAST KEY SEQ #
         LW,R1    *F:EI+10          L/KEY
         AND,R1   =X'FFFFFF'        STRIP OFF BC OF KEY
         PULL     (LNK,P3)          PULL REGS
         LCI      0                 L/CC'S OF 0; GOOD READ
         B        0,LNK             RETURN
*
RNR%ABN  ;
         LB,D1    10                L/ABN CODE
         CI,D1    4                 C/CODE W/4; BOF
         BNE      BADIO             B/NOT BEGINNING OF FILE
         PULL     (LNK,P3)          PULL REGS
         LCI      8                 L/CC'S OF 8; BOF
         B        0,LNK             RETURN
         PAGE
********************************
*  READ SEQUENTIAL RECORD      *
*    R1 = SEQ. NUMBER READ IN  *
********************************
*
*
READSEQUEN        EQU %
         PUSH     (LNK,P3)
         BAL,LNK  BLANKBUF
         CHK%ABN  F:EI,RS%ABN       SKIP SETDCB IF UNNECESSARY
         DO1      MODE=2
         M:SETDCB F:EI,(ABN,RS%ABN)
         M:READ   F:EI,;
                  (WAIT),;
                  (SIZE,MAXCLMN),;
                  (ERR,BADIO),;
                  (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
         DO       MODE=2
RRD%ABN  BAL,LNK  TYPECERR%UNCONDT  TYPE ERROR MESSAGE
         DATA     ERRC15            '-CN:INPUT ERROR; REC NOT CHANGED'
         B        MASTERPARSER      B; G/NEXT COMMAND
         FIN
         PAGE
*********************************
*  READ TELETYPE                *
*    R1 = NUMBER OF CHARS READ  *
*********************************
*
*
         DO       MODE=2
REREADCARDIMG EQU %
         PUSH     (X3,X2),LNK       PUSH REGS
         LI,X2    0                 L/INDEX FOR CARDIMG
         LW,X1    RTADDTBL,X2       L/WA OF BUFFER
         LB,X3    *X1               L/1ST CHAR OF BUF; SAVE
RT2      M:READ   M:UC,(BUF,*X1),(SIZE,MAXCLMN),(BTD,0),;
                  (COC,REREAD),(ABN,RRD%ABN)
         LH,R1    M:UC+4            L/LH OF WD 4 OF M:UC DCB
         SLS,R1   -1                SHIFT RIGHT 1 BIT; G/ARS
         CI,R1    1                 C/ARS W/1
         BG       RT15              BG; MERGE WITH READ CLEANUP
         STB,X3   *X1               S/1ST BYTE OF BUF BACK IN
         B        RT2               B; DO REREAD AGAIN
         FIN
READTELETYPE3 EQU %                 READ INTO COMPRIMG
         MTB,1    LNK               INC BUFFER POINTER INDEX
READTELETYPE2 EQU %                 READ INTO TTYIMG
         MTB,1    LNK               INC BUFFER POINTER INDEX
READTELETYPE EQU %
         PUSH     (X3,X2),LNK       PUSH REGS
         LB,X2    LNK               L/BUFFER POINTER INDEX
RT5      EQU      %
         DO       MODE=1
         LW,R0    4BLNKS            L/BLANKS
         LI,X1    MAXCLMN/4
         EXU      RTSTWTBL,X2
         BDR,X1   %-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
*
         LB,X1    JB:CCARS          GET BYTE CNT FROM J:PUF
         LB,R0    J:CCBUF,X1        MOVE RECORD INTO APPROPRIATE
         EXU      RTSTBTBL,X2       BUFFER
         BDR,X1   %-2
*
         LB,R0    J:CCBUF
         EXU      RTSTBTBL,X2
         LB,R1    JB:CCARS
         CI,R0    'B'               IS COMMAND 'BUILD' FROM TEL
         BE       RT17              YES. IT STARTS WITH 'B'.
*
         STW,LNK  BUILDFLAG
         BAL,LNK  TYPEMSG           TYPE
         DATA     UTSM1             'EDIT HERE'
         AI,R1    -1
         LW,LNK   BUILDFLAG
         LB,R0    J:CCBUF
         CI,R0    'E'               IS THIS A FORM OF EDIT
         BNE      RT5               IF NOT, MUST BE A START, RUN,
*                                   OR GJOB SO READ FIRST COMMAND.
*
*  ASSUME WE'RE PROCESSING EDIT COMMAND:  COMMAND STARTS
*  WITH AN 'E'.  EITHER 'EDIT' OR 'EDIT FID'.  FORM IS:
*
*  E(JUNK)    -OR-
*  E(JUNK)  FID
*
*  WHERE (JUNK) IS OPTIONAL NON-BLANK, NON-TERMINATING CHARACTERS
*  THAT ARE BLANKED OUT AS THEY ARE ENCOUNTERED.  THE FOLLOWING
*  IS A LEGAL EDIT CALLING COMMAND:
*
*  EDITEXP.CPVPLS     FILENAME.ACCOUNT.PASSWORD
*
         LI,X1    X'80001'          L/NEG BITS, BTD OF 1
         AI,R1    X'80000'          ADD NEG BITS TO SIZE
         LI,R0    ' '
RT7      CW,X1    R1                C/BTD W/SIZE
         BGE      RT5               BGE; END OF COMMAND
         CB,R0    TTYIMG,X1         C/BLANK W/CHAR IN CMND
         STB,R0   TTYIMG,X1         S/BLANK
         BIR,X1   %+1               INC BTD
         BNE      RT7               B/NOT BLANK CHAR
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
         BIR,X1   RT8               INC BTD, BRANCH
RT9      AW,R1    =X'80000'+1       GET SIZE BACK
         B        RT17              CR, THEN EXECUTE COMMAND.
*
RT10     LW,X1    RTADDTBL,X2
RT11     M:READ   *CMND%DCB%ADR,(BUF,*X1),(SIZE,MAXCLMN),;
                  (BTD,0),(WAIT),(ABN,RTRDAB)
RT15     LW,X4    CMND%DCB%ADR      L/ADR OF CMND DCB
         LW,R1    4,X4              L/WD 4 OF CMND DCB
         SLS,R1   -17
RT17     LW,1     R1                L/ARS
         AW,1     RTBATBL,X2        G/BA OF 1ST BYTE BEYOND DATA READ
         LI,D0    0                 L/0 FOR DIVIDE WORD
         LI,D1    MAXCLMN           L/BYTE SIZE OF BUF
         SW,D1    R1                BUF SIZE - ARS OF READ
         DW,D0    =255              # OF 255 BYTE SEGMENTS IN D1, SIZE
*                                   .. OF LAST SEGMENT TO BLANK IN D0
         BEZ      RT20              B/NO 255 BYTE SEGMENTS TO BLANK
         MTB,-1   1                 SET BC OF 255 IN R1
         MBS,0    BA(4BLNKS)        MOVE 255 BLANKS
         BDR,D1   %-2               BDR/MOVE NEXT 255 BYTE SEG
RT20     STB,D0   1                 S/BC FOR LAST SEGMENT
         MBS,0    BA(4BLNKS)        BLANK LAST SEGMENT
         FIN
         LW,X3    R1                L/BC OF REC READ
         AI,X3    -1                DEC BC; G/BTD TO LAST BYTE
         LB,X4    *X1,X3            L/LAST CHAR
         EXU      RTCUSUB,X2        EXU CLEANUP SUBROUTINE
         STW,R1   RECSIZE,X2        S/RECORD SIZE
         AI,X3    0                 +0 TO INDEX TO LAST CHAR
         BLZ      RT40              BLZ; NO CHARS
         STW,X4   TERM%CHAR         S/LAST CHAR (TERMINATOR)
RT40     ;
         PULL     (X3,X2),LNK       PULL REGS
         B        0,LNK             EXIT
*
RTCUSUB  NOP                        CLEANUP FOR READING CARDIMG
         BAL,LNK  RT70              CLEANUP FOR READING TTYIMG
         BAL,LNK  RT70              CLEANUP FOR READING COMPRIMG
*
RT70     LH,D0    M:C               L/LH OF COMMAND FILE INPUT DCB
         CI,D0    X'20'             C/LH OF WD 0 W/.20; FILE OPEN BIT
         BAZ      0,LNK             B/FILE NOT OPEN
         CI,R1    MAXCLMN           C/REC SIZE W/MAX
         BGE      0,LNK             BGE; CAN'T ADD ANYTHING TO REC
         CLM,X4   LIMCRLF           C/LAST CHAR W/CR, LF
         BE       0,LNK             B/CR; RETURN
         BCR,12   0,LNK             B/LF; RETURN
         AI,R1    1                 INC REC SIZE; WE'RE ADDING CR
         AI,X3    1                 INC BTD TO LAST CHAR
         LI,X4    CR                L/CR CHAR
         STB,X4   *X1,X3            S/CR AS LAST CHAR IN BUF
         B        0,LNK             RETURN
*
RTSTBTBL EQU      %
         STB,R0   CARDIMG,X1
         STB,R0   TTYIMG,X1
         STB,R0   COMPRIMG,X1
*
RTSTWTBL EQU      %
         STW,R0   CARDIMG-1,X1
         STW,R0   TTYIMG-1,X1
         STW,R0   COMPRIMG-1,X1
*
RTADDTBL EQU      %
         DATA     CARDIMG
         DATA     TTYIMG
         DATA     COMPRIMG          ADR OF COMPRESSED IMAGE
         DO       MODE=2
TYPE%BUF%CAL1 EQU %
TYPECARDIMG ;
         M:WRITE  M:UC,(BUF,CARDIMG),(SIZE,*RECSIZE),(BTD,0)
TYPETTYIMG ;
         M:WRITE  M:UC,(BUF,TTYIMG),(SIZE,*TTYIMGSZ),(BTD,0)
         M:WRITE  M:UC,(BUF,COMPRIMG),(SIZE,*COMPRIMGSZ),(BTD,0)
RTBATBL  DATA     BA(CARDIMG)
         DATA     BA(TTYIMG)
         DATA     BA(COMPRIMG)
         FIN
RTRDAB   LB,R1    10                L/IO ERR/ABN CODE
         CI,R1    6                 C/CODE W/END-OF-FILE CODE
         BNE      RTRDABG           B/NOT EOF
         BAL,LNK  RESET%XEQ%MODE    BAL/RESET XEQ MODE
         B        RT11              B; RE-ISSUE READ TO TERMINAL
RTRDABG  CI,R1    7                 C/IO ERR/ABN CODE W/LOST-DATA
         BNE      RT15              B/NOT LOST-DATA/PARITY ERROR
         BAL,LNK  TYPEMSG           TYPE '-INPUT ERROR - RETRY'
         DATA     ERRM23            ERR MESSAGE TEXTC
         B        RT11              B; RE-ISSUE READ
         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
         STW,LNK  EODCLMN           SAVE ENDING COLUMN
         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
         MTW,-1   EODCLMN           DECREMENT ENDING COLUMN
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
         MTW,0    TABX%FLAG
         BEZ      0,LNK             B/ 'TABX OFF' CMND ISSUED
         PUSH     (X3,LNK)
         LW,X3    RECSIZE           SAVE RECSIZE
         STW,X3   TRECSIZE
         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
         MTW,0    TABX%FLAG
         BEZ      0,LNK             B/ 'TABX OFF' CMND ISSUED
         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      TABC30            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.
*
TABC30   MTW,0    RP%FLAG           PRESERVE RECORD SIZE
         BEZ      TABC5             B/'RP OFF'
         LW,X2    TRECSIZE          YES, RESET RECORD SIZE
         STW,X2   RECSIZE
TABC35   STB,P1   CARDIMG,X1        BLANK REST OF RECORD
         AI,X1    1
         CW,X1    X2                END OF RECORD
         BL       TABC35            NO
         B        TABC5             YES, RETURN
         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
XEQ%ECHO%10 EQU %
         LW,T1    XEQ%ECHO%FLAG     L/XEQ REC FLAG
         BEZ      0,LNK             B/NOT TO ECHO XEQ RECS
XEQ%ECHO%20 EQU %
         LW,T1    XEQ%ECHOED        L/XEQ REC ECHOED FLAG
         BNEZ     0,LNK             B/REC ECHOED
         LH,T1    M:C               L/LH OF WD 0 OF M:C DCB
         CI,T1    X'20'             C/LH W/.20; DCB OPEN BIT
         BAZ      0,LNK             BAZ; NOT OPEN
         PUSH     LNK,P1            SAVE REGS
         LW,P1    XEQ%REC#          L/# OF RECS XEQ'D
         MI,P1    1000              X/1000; MAKE SEQ #
         LI,T1    X'F0'             L/MASK FOR ORG IN DCB
         AND,T1   M:C+5             &/MASK W/ORG
         CI,T1    X'10'             C/ORG W/1; CONSEQ
         BE       %+3               BE; CONSEQ ORG
         LW,P1    *M:C+10           L/KEY FROM DCB
         AND,P1   =X'00FFFFFF'      &/KEY W/.FFFFFF; STRIP BC
         BAL,LNK  TYPEMSG           TYPE 'XEQ: '
         DATA     MSGXEQ:
         BAL,LNK  TYPE%TTYIMG%SEQ   TYPE TTYIMG, W/SEQ #
         PULL     LNK,P1            RESTORE REGS
         MTW,1    XEQ%ECHOED        S/REC ECHOED FLAG
         B        0,LNK             RETURN
*
*
RESET%XEQ%MODE EQU %
         LH,T1    M:C               L/LH OF WD 0 OF M:C
         CI,T1    X'20'             C/LH W/.20; FILE OPEN BIT
         BAZ      0,LNK             B/FILE NOT OPEN; NOT XEQ
         M:CLOSE  M:C,(SAVE)        CLOSE M:C
         LI,T1    M:UC              L/ADR OF TERMINAL DCB
         STW,T1   CMND%DCB%ADR      S/NEW CMND DCB ADR
         B        0,LNK             RETURN
         PAGE
********************************
*  TYPE CARD IMAGE             *
*    P1 = SEQ. NUMBER TO TYPE  *
********************************
*
TYPE%TTYIMG%SEQ ;
         PUSH     (X3,LNK)          SAVE REGS
         LI,X3    1                 L/1; TTYIMG BUFFER FLAG
         B        TC4C              B; MERGE W/COMMON CODE
TYPECARD%FIRSTSET%NOCR EQU %
         MTB,1    LNK               SET NO-CR-AT-END FLAG
*
TYPECARD%FIRSTSET EQU %
         LW,P1    FIRSTSET          L/SEQ # TO TYPE
TYPECARD EQU      %
         PUSH     (X3,LNK)          SAVE REGS
         LI,X3    0                 L/0; ASSUME NOT COMPRESSED
         LW,X1    CURRENT%CMND#     L/CURRENT COMMAND #
         LC       FLAG,X1           L/FLAGS FOR COMMAND
         BCR,COMPRESSED**-4 TC4     B/NOT TYPE COMPRESSED
         LI,X4    -1                L/-1; INIT BTD IN COMPRIMG
TC3E     LB,R0    CARDIMG,X3        L/BYTE OF INPUT REC
         CI,R0    ' '               C/CHAR W/BLANK
         BNE      TC3G              B/NOT BLANK
         CB,R0    COMPRIMG,X4       C/BLANK W/LAST CHAR IN OUTPUT BUF
         BE       TC3J              B/LAST CHAR IS BLANK; MULT BLANKS
TC3G     AI,X4    1                 +1 TO OUTPUT BUF PNTR
         STB,R0   COMPRIMG,X4       S/CHAR IN OUTPUT BUF
TC3J     AI,X3    1                 +1 TO INPUT BUF PNTR
         CW,X3    RECSIZE           C/INPUT BUF PNTR W/REC SIZE
         BL       TC3E              BL; KEEP GOING
         AI,X4    1                 +1 TO OUTPUT BUF PNTR
         STW,X4   COMPRIMGSZ        S/OUTPUT BUF SIZE
         LI,X3    2                 L/2; INDEX FOR COMPRESSED TYPE
TC4      EQU      %
         LC       FLAG,X1           L/FLAGS FOR THIS COMMAND
         BCR,TYPE%SEQ#**-4 TC5      B/SEQ #'S NOT TO BE TYPED
TC4C     BAL,LNK  TYPESEQ           TYPE SEQ #
         GEN4     BL,EOM,0,0        TYPE BLANK
         DO       MODE=1
         LI,P1    62                L/# OF CHARS PER LINE - 10 FOR BTM
         B        %+2               B
TC4G     LI,P1    72                L/# OF CHARS PER LINE FOR BTM
         LW,X2    CARDIMGSZ,X3      L/SIZE OF BUFFER
         CI,X3    0                 C/TYPE FLAG W/0; CARDIMG
         BNE      %+3               B/NOT TYPING CARDIMG
         LW,X2    EODCLMN           L/# OF CHARS TOTAL - 1
         AI,X2    1                 +1 TO CHAR COUNT
TC5      LI,X1    0                 INITIALIZE CHARACTER POSITION.
         LW,X4    RTADDTBL,X3       L/ADR OF BUF TO TYPE
TC10     LB,R0    *X4,X1            L/CHAR FROM BUF
         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      EXU      TYPE%BUF%CAL1,X3  TYPE BUFFER
         FIN
TC15     LW,X4    *STACKDW          L/LNK REG FROM STACK
         CW,X4    =X'01000000'      C/LNK REG W/.01000000
         BANZ     TC18              BANZ; NO CR AT END REQUESTED
         BAL,LNK  TYPEMSG           TYPE MESSAGE
         DATA     MSG0
TC18     PULL     (X3,LNK)          RESTORE REGS
         B        0,LNK             EXIT
*
*
         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
TYPECERR%UNCONDT ;
         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
         BAL,LNK  SET%MIN%SIZE      SET MIN SIZE FOR REC
         CHK%ABN  F:EO,W2%ABN       SKIP SETDCB IF UNNECESSARY
         DO1      MODE=2
         M:SETDCB F:EO,(ABN,W2%ABN)
         M:WRITE  F:EO,;
                  (WAIT),;
                  (KEY,KBUF),;
                  (NEWKEY),;
                  (ABN,W2%ABN),;
                  (ERR,BADIO),;
                  (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
         BAL,LNK  SET%MIN%SIZE      SET MIN SIZE FOR REC
         CHK%ABN  F:EI,WNR%ABN      SKIP SETDCB IF UNNECESSARY
         DO1      MODE=2
         M:SETDCB F:EI,(ABN,WNR%ABN)
         BAL,LNK  INOUT             RETURN IF F:EI OPEN INOUT OR OUT
         M:WRITE  F:EI,;
                  (WAIT),;
                  (KEY,KBUF),;
                  (NEWKEY),;
                  (SIZE,*RECSIZE),;
                  (ERR,BADIO),;
                  (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
*
*
*
SET%MIN%SIZE      ;
         LW,D1    RECSIZE           L/REC SIZE
         BNEZ     0,LNK             BNEZ; OK
         LW,D1    RP%FLAG           L/REC SIZE PRESERVATION FLAG
         BNEZ     0,LNK             BNEZ; DON'T TOUCH SIZE
         LI,D1    1                 L/1; NEW SIZE OF REC; WAS 0 CHARS
         STW,D1   RECSIZE           S/NEW SIZE OF 1
         LI,D1    ' '               L/BLANK CHAR
         STB,D1   CARDIMG           S/BLANK AS 1ST (ONLY) CHAR OF REC
         B        0,LNK             RETURN
         PAGE
*********************************
*  WRITE RANDOM RECORD          *
*    P1 = SEQ. NUMBER TO WRITE  *
*********************************
*
*
WRITERANDOM%SE%CONDT ;
         LW,T1    CHG:STG:CNT       L/CHANGED STRING COUNT
         CW,T1    SAVED:CHG:STG:CNT C/COUNT W/SAVED COUNT
         BE       0,LNK             BE; NO CHANGE, SKIP WRITE
         STW,T1   SAVED:CHG:STG:CNT MAKE COUNTERS EQUAL
WRITERANDOM       EQU %
         PUSH     LNK
         BAL,LNK  SETKEY
         BAL,LNK  PUTCR
         BAL,LNK  INOUT             RETURN IF F:EI OPEN INOUT OR OUT
         BAL,LNK  SET%MIN%SIZE      SET MIN SIZE OF REC
         M:WRITE  F:EI,;
                  (WAIT),;
                  (KEY,KBUF),;
                  (ONEWKEY),;
                  (ERR,BADIO),;
                  (SIZE,*RECSIZE)
         PULL     LNK
         B        0,LNK
INOUT    EQU      %                 CHECK F:EI FOR MODE=OUT OR INOUT
         LI,D1    12
         CH,D1    F:EI+1            FUN=OUT OR INOUT
         BANZ     0,LNK             YES, RETURN TO BAL+1
         BAL,LNK  TYPEMSG           TYPE ERROR MESSAGE
         DATA     ERRM25            '-FILE OPEN FOR INPUT ONLY; CAN''T UPDATE'
         B        MASTERPARSER      B; GET NEXT COMMAND
ENDEDITOR EQU     =%                END OF EDITOR PROCEDURE
         END      BEGINEDITOR

