**********************************************************************
*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
*
D        EQU      %                 MAIN DATA SECTION
         SYSTEM SIG7FD
         SYSTEM   BPM
,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
*
S        FNAME                      THIS FUNCTION SIMPLY SELECTS
         PROC                       THE FIRST OR SECOND PARAMETER
         PEND     AF(MODE)
*
*
         DEF      P                 EDIT MAIN PROCEDURE SECTION
         DEF      D                 EDIT MAIN DATA SECTION
         DEF      CNAMETBL          COMMAND NAME TABLE
         DEF      CBRCHTBL          COMMAND TRANSFER VECTOR
         DEF      CNMRTBL           COMMAND NUMBER TABLE
         DO       MODE=2
         DEF      PATCHD            DATA PATCH SPACE
         DEF      PATCHP            PROCEDURE PATCH SPACE
         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
         REF      J:ACCN            USER'S ACCOUNT NUMBER.
         REF      M:DO              OUTPUT DCB FOR BATCH
         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
*
* PROC SIMILAR TO TEXTC, BUT ALLOWS NON-CHARACTER AFGUMENT FIELDS.
* NON-CHARACTER FIELDS GET THEIR VALUE SET TO THE BYTE DISPLACEMENT
* OF THE NEXT CHARACTER.
*
TXTC     CNAME
         PROC
         LOCAL    I,C
C        SET
I        DO       NUM(AF)
         DO       TCOR(AF(I),S:C)
C        SET      C,AF(I)
         ELSE
AF(I)    SET      S:NUMC(C)+1
         FIN
         FIN
LF       TEXTC    S:PT(C)
         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 #
SN       EQU      15
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
MATCHANY1 EQU     X'01'             SPECIAL CHAR: MATCHES ANY 1 CHAR
MATCHANYN EQU     X'02'             SPECIAL CHAR: MATCHES ANY CHAR STRG
EOT      EQU      4
GS       EQU      X'1D'
         PAGE
*******************
*  CONSTANT DATA  *
*******************
*
*
P        CSECT    1                 EDIT PROCEDURE (PT 1) SECTION
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
PATCHP   EQU      %                 100 WORDS OF ZERO'D PROCEDURE PATCH SPACE
         LIST     0
         DO1      10
         DATA     ,,,,,,,,,
         LIST     1
         PAGE
*******************
*  VARIABLE DATA  *
*******************
*
         USECT    D                 GO TO EDIT MAIN DATA SECTION
*
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
TTYIMG   RES,1    MAXCLMN           TELETYPE IMAGE
         BOUND    4
*
******>
******>  WARNING
******>
* THERE IS A 90 WORD FPARAM BUFFER IMMEDIATELY FOLLOWING
* THE ADJUST DCB FPT (FPSETAC).  THE FPARAM BUFFER OCCUPIES
* THE SAME SPACE AS THE CARDIMG BUFFER AND THE COMPRIMG BUFFER.
*
FPSETAC  GEN,8,24 X'14',F:EO        ADJUST DCB FPT
         DATA     X'0000E030',0     VLP, READ/WRITE ACCOUNTS
FPARAM   EQU      %                 BUFFER FOR FPARAMS
*
         BOUND    8
COMPRIMG RES,1    MAXCLMN           COMPRESSED IMAGE (TC)
         BOUND    8
CARDIMG  RES,1    MAXCLMN           CARD IMAGE (CURRENT FILE RECORD)
         BOUND    4
         DO1      (%-FPARAM)<90
         RES      90-(%-FPARAM)     MAKE SURE FPARAM IS AT LEAST 90 WORDS
RECSIZE  DATA     MAXCLMN           GLOBAL: SIZE OF CARDIMG
TTYIMGSZ DATA     0                 GLOBAL: SIZE OF TTYIMG
COMPRIMGSZ DATA   0                 COMPRESSED IMAGE SIZE
CDTBAS%  DATA     CDTFIXED          POINTER TO BASE OF CDT AREA
CDTFIXEDSZ EQU    80                SIZE OF FIXED CDT AREA
CDTFIXED RES      CDTFIXEDSZ        FIXED CDT AREA
CDTEND%  DATA     CDTFIXED+CDTFIXEDSZ-1 END OF CDT AREA RESERVED
CDTADR   RES      1                 GLOBAL: ADR OF CURRENT CMND IN CDT
SSE%CDTSZ EQU     17+(MAXCLMN/4)    SIZE OF SAVED SSE BUFFER
SSE%CDT  RES      SSE%CDTSZ         SAVED CDT W/STRING SELECT EXPR
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 DATA     0                 FINDMATCH: 1ST COLUMN (COL 1)
CRNSTRDLM ;
         DATA     0                 CURRENT STRING DELIMITER CHARACTER
FIRSTFROM         DATA
FIRSTTO  DATA     0                 FIRST 'TO' RECORD ON M/MK/MD ETC
FIRSTSET RES      1                 GLOBAL: FIRST SEQ. # FOR SET CMND
IFCNT    DATA     0                 IF/EI COUNTER
NXTCPYSEQ# DATA   -1                NEXT SEQ # FOR INTRA COPY CMD'S
LSTCPYSEQ# DATA   0                 LAST SEQ # OF INTRA COPY CMD
SEFRSTCLMN DATA   0                 SAVED (ON SE/SS/ST) 1ST COLUMN
SELASTCLMN DATA   MAXCLMN           SAVED (ON SE/SS/ST) LAST COLUMN
KBUF     RES      1                 I/O: HOLDS KEY FOR CURRENT I/O
LASTCLMN DATA     MAXCLMN           FINDMATCH: LAST COLUMN
MANYF    DATA     0                 FLAG FOR FOUND WILD TEXT
MANYP    DATA                       POINTER THEREFOR
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 I:TY#           CMND # OF LAST TY/TS/TC/RR CMND
MAXSEQ   DATA     SEQLIM            GLOBAL: MAX. SEQ. NO. ALLOWED
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+2         GLOBAL: STACK FOR PUSH/PULL OF REGS
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
TEMPBLCKSZ EQU    80
TEMPBLCK RES,1    TEMPBLCKSZ        GLOBAL: TEMP FOR MSG WHEN FILLING
*                                   .. IN THE CN: AND PN:
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
DELETED%REC%CNT DATA 0              # OF DELETED RECS
TRUNC%REC%CNT   DATA 0              # OF RECORDS TRUNCATED
TRUNC%REC%FLG   DATA 0
MSG9     TEXTC    ' 0000000 RECORDS TRUNCATED'
CONSEC%FILE DATA  0                 EDIT FILE IS CONSECUTIVE
CALLEDR8 DATA     0                 VALUE OF R8 WHEN EDIT WAS CALLED (M:LINK)
INPUTSAVER DATA   -15               LIMIT RECORD LOSS TO 15
DELETELIMIT DATA  9999999           LIMIT OF RECORDS TO DELETE PER CMD
CHG:STG:CNT DATA  0                 COUNT OF STRINGS CHANGED
SAVED:CHG:STG:CNT DATA 0            CHG:STG:CNT, SAVED AT START OF REC
DONT%WRITE%SE%CONDT DATA 0          DON'T WRITE SE REC AT END OF SE LOOP
RL:CHG:STG:CNT DATA 0               CHANGE COUNT ON RL COMMAND
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  *
********************
         USECT    P
*
*
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'
ERRC17   TEXTC    ;
 '-C1:DOESN''T MAKE SENSE TO TERMINATE INPUT WITH THIS COMMAND'
ERRC18   TEXTC    '-C1:TOO MANY EI''S'
ERRC19   TEXTC    '-C1:MISSING STRING SELECTION EXPRESSION'
ERRC20   TEXTC   '-C1:NO SEQUENCE NUMBER SPECIFIED FOR COPY DESTINATION'
ERRC21   TEXTC    ;
  '-C1:TOO MANY COMMANDS; CAN''T GET ENOUGH MEMORY TO HOLD THEM'
*
*
         USECT    D
ERRM1    TEXTC    '--EOF HIT AFTER YYYY.YYY'
         USECT    P
ERRM3    TEXTC    '--OVERFLOW'
ERRM4    TEXTC    '-RNG OVERLAP'
ERRM5    TEXTC    '-NOT ON/OFF'
ERRM6    TEXTC    '--NONE'
ERRM8    TEXTC    '-MISSING SE'
ERRM12   TEXTC    '--FILE NOT KEYED; CANNOT UPDATE'
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'
*
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 AND/OR IS CONSECUTIVE; CANNOT UPDATE'
ERRM26   TEXTC    '--NOTHING TO DELETE'
ERRM27   TEXTC    ':FILE NOT CREATED BY EDIT (KEYM NOT 3)'
         USECT    D
ERRM28   TEXTC    ' I/O ABN/ERR - ',;
                  '                                        ',;
                  '                                        '
ERRM29A  TXTC     '--DELETE ',ERRM29AS1,'DDDD.DDD'
ERRM29B  TXTC     ' TO ',ERRM29BS2,'DDDD.DDD'
ERRM29C  TXTC     '? (Y OR N)  ',EOM
ERRM31A  TXTC     ;
 '-RECORD EXISTS IN COPY DESTINATION RANGE AT ',ERRM31AS1,'DDDD.DDD'
ERRM31B  TXTC     '; SOURCE SEQ # IS ',ERRM31BS2,'DDDD.DDD'
         USECT    P
ERRM40   TEXTC    ;
  '-STRING SELECTION EXPRESSION ON SE, SS OR ST IS TOO LONG'
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'
ERRP25   TEXTC    '-P1:NOT STRING SELECTION EXPRESSION'
*
*
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'
         USECT    D
MSG6     TEXTC   '         RECORDS DELETED'
MSG7     TEXTC     ' 0000000 RECORDS MOVED'
MSG8     TEXTC    '         STRINGS CHANGED'
MSGXEQ:  TEXTC    'XEQ: ',EOM       FOR ECHOING XEQ CMNDS
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
*
INTRTN   DATA     0                 PLACE TO RETURN FROM X THAT ABORTS.
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'
TABC%FLAG DATA    0                 NZ/'TABC ON'
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
OUT%DCB%ADR DATA  M:UC
TYPM%FPT GEN,8,24 X'91',OUT%DCB%ADR
         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 ',EOM
UTSM7    TEXTC    'WHILE DELETING)  ',EOM
UTSM8    TEXTC   '--TAB CHAR. FOUND; ''TA'' NEEDED FOR COL. SIMULATION'
*                                            *****
PATCHD   DATA     ,,,,,,,,,         10 WORDS OF ZERO'D DATA PATCH SPACE
*
         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'E56C0001'       P1,2,3,6,8,10,11,13,14.
         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     FPARAM            FPARAM ADR
         DATA     3                 MAX KEY LENGTH
O1%DP    DATA     0                 DEVICE CODE.
         DATA     X'01000808'
O%NAME   RES      8
         DATA     X'07000101'
O%SN     RES      1
         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'E54C0001'       P1,2,3,6,8,10,13,14.
         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)
O2%DP    DATA     0                 DEVICE NAME.
         DATA     X'01000808'
O2%NAME  RES      8
         DATA     X'07000101'
O2%SN    RES      1
         DATA     X'02000202'
O2%ACCT  RES      2
         DATA     X'03010202'
O2%PASS  RES      2
FPRSTAC  GEN,8,24 X'14',F:EO        ADJUST DCB FPT
         DATA     X'0000E030',0     RESET READ/WRITE ACCOUNT NUMBERS
         DATA     X'05000001',0     READ ACCOUNTS
         DATA     X'06010001',0     WRITE ACCOUNTS
         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  *
*************************************
*
*
F:EI     EQU      M:EI
*
*  COPY FILE DCB
*
F:EO     EQU      M:EO
         PAGE
***********************************
*                                 *
*     B E G I N   E D I T O R     *
*                                 *
***********************************
*
*
*
         USECT    P                 GO TO EDIT MAIN PROCEDURE SECTION
BEGINEDITOR       EQU %
         STW,8    CALLEDR8          SAVE R8 FOR LATER CHECK FOR BEING
*                                   .. M:LINK'D TO
         LC       *79               IF BATCH, SKIP THE TERM STUFF
         BCS,8    NOTBATCH
         LI,1     M:DO              AND USE M:C AND M:DO INSTEAD
         STW,1    OUT%DCB%ADR
         LI,1     M:C
         STW,1    CMND%DCB%ADR
         MTW,1    XEQ%ECHO%FLAG
         B        MASTERPARSER
NOTBATCH RES
*
         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
         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   *CDTBAS%          0/# OF CMNDS
         STW,T1   CHARPSN           SET NEXT CHAR TO SCAN = 0
         STW,T1    MVD:REC:CNT      SET MVD:REC:CNT = 0
         STW,T1   DELETED%REC%CNT   0/# OF RECS DELETED
         STW,T1   INTRTN            RETURN FROM X THAT ABORTS.
         STW,T1   DONT%WRITE%SE%CONDT RESET DON'T-WRITE-SE-REC FLAG
         STW,T1   RL:CHG:STG:CNT    CHANGE COUNT ON RL PASS
         STW,T1    CHG:STG:CNT      SET CHG:STG:CNT = 0
         STW,T1   SAVED:CHG:STG:CNT 0/SAVED CHG:STG:CNT
         STW,T1   IFCNT             IF/EI COUNTER
         STW,T1   CT%FLAG           SET TYPE 'CM' FLAG OFF
         STW,T1   XEQ%ECHOED        RESET XEQ REC ECHOED FLAG
         STW,T1   TRUNC%REC%CNT     CLEAR TRUNCATED RECORD COUNT
         LI,T1    X'0100'           PUT 'END OF CDT' MARKER IN CDT
         LW,X1    CDTBAS%           L/ADR OF 1ST WD OF CDT
         AI,X1    1                 G/ADR OF 2ND WD OF CDT
         STW,T1   0,X1              0/2ND WD
         STW,X1   CDTADR            S/ADR OF 2ND WD OF CDT
         LI,T1    500000            SET TO PRINT ALL ERROR MSGS
         STW,T1   ERRORCNT
         MTW,0    STEPFLAG          IS SYSTEM IN STEP MODE
         BEZ      %+3
         BAL,LNK  TYPEMSG           YES - TYPE '*'
         DATA     UTSM2
         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,
         LW,X1    R1                L/BTD TO LAST BYTE OF CMND
         LI,T1    ' '               L/BLANK
         B        %+3               B
         CB,T1    TTYIMG,X1         C/BLANK W/BYTE OF CMND BUF
         BNE      %+3               B/NOT BLANK
         AI,X1    -1                DEC BTD
         BGEZ     %-3               B/MORE BLANKS TO STRIP
         AI,X1    1                 BACK TO SIZE
         STW,X1   TTYIMGSZ          S/CMND BUF SIZE
*
*  SPECIAL HANDLING OF LF AND UP-ARROW-CR COMMANDS
*
         MTW,0    FILETYPE
         BLZ      RESUME%PARSING    NO FILE OPEN
         LW,T1    STEPFLAG
         BNE      MPLF05            B/STEP MODE; NO SPECIAL HANDLING
*                                   .. OF UP-ARROW, EOT, AND GS
         LB,T1    TTYIMG            L/1ST BYTE OF TTYIMG
         CI,T1    LF                C/1ST BYTE W/LF CHAR
         BE       MPLF10            B/LF; TYPE NEXT REC
         CI,T1    GS
         BE       MPLF10
         CI,T1    EOT
         BE       %+4
         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
         BAL,LNK  TYPEMSG           BAL/TYPE ERROR MSG; BOF HIT
         DATA     ERRM24            '-BEGINNING OF FILE HIT'
         B        MASTERPARSER      B; GET NEXT COMMAND
MPLF05   ;
         LB,T1    TTYIMG            L/1ST BYTE OF TTYIMG
         CI,T1    LF                C/1ST BYTE W/LINE FEED
         BNE      RESUME%PARSING    B/NOT LF
         LW,T1    =('NO'**16+CR**8) L/NO COMMAND
         STW,T1   TTYIMG            SET UP A 'NO' COMMAND
         LI,T1    2                 L/SIZE OF NO COMMAND
         STW,T1   TTYIMGSZ          S/NEW CMD SIZE
         B        RESUME%PARSING
MPLF10   LW,P1    LASTSET           LAST GUY IN SE RANGE
         AI,P1    1                 PLUS 1
         BAL,LNK  READNXTRANDOM
MPLFUP   CW,R1    L(EOF)            AT THE END
         BE       CMT60             YES.
         STW,R1   SETFLAG
         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    *CDTBAS%          INC # OF CDT ENTRIES
         NXTPRM   ERRC9,;
                  (INTG,PARSE:I:CMND%INTG),;
                  (STRG,PARSE:I:CMND%STRG),;
                  (ALPH,*),;
                  (END,MASTEREXECUTIVE)
         LI,X1    CTBLSZ
*
* BLANK THE TRAILING CHARACTERS IN THE COMMAND NAME, AND SEARCH THE COMMAND
* NAME TABLE FOR THIS COMMAND.
*
         LW,T1    PARAMBUF          L/1ST WORD OF COMMAND NAME
         OR,T1    =X'00404040'      FORCE UPPER CASE
         LW,T2    PARAMBUF+1        L/2ND WORD OF COMMAND NAME
         OR,T2    =X'40404040'      FORCE UPPER CASE
         LI,P1    ' '               L/BLANK
         LB,X2    PARAMBUF          L/NUMBER OF CHARACTERS IN COMMAND NAME
PRS05    ;
         AI,X2    1                 INC BTD INTO NAME IN REGS
         CI,X2    8                 C/BTD W/MAX+1
         BGE      %+3               B/DONE BLANKINS TRAILING CHARACTERS
         STB,P1   T1,X2             S/BLANK INTO TRAILING CHAR
         B        PRS05             B
         CD,T1    CNAMETBL,X1       C/CMND TEXT W/CNMD TABLE ENTRIES
         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
         LI,T1    X'10'             SET CONSEC FILE FROM EI
         AND,T1   F:EI+5
         SLS,T1   -4
         CI,P1    FIRST%R:CMND      IF RECORD COMMAND
         BGE      %+2
         LI,T1    0
         STW,T1   CONSEC%FILE
         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 DOUBLEWORD TEXTC 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
         ERROR,15,S:NUMC(LF)>7 'COMMAND NAME > 7 CHARACTERS LONG'
         TEXTC    LF
         DO1      S:NUMC(LF)<4
         TEXT     ' '               PAD OUT TO DOUBLE WORD
         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)
'TABC'   PR,F:TC# PARSE:TABC        TABC (FORCE TAB COMPRESSION)
'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
'IF'     PR,I:IF# PARSE:IF          IF
'EL'     PR,I:EL# PARSE:EL          ELSE
'EI'     PR,I:EI# PARSE:EI          ENDIF
'QR'     PR,I:QR# PARSE:QR          QUIT PROCESSING THIS RECORD
'CL'     PR,I:CL# PARSE:CL          SET COLUMN LIMITS
'CI'     PR,I:CI# PARSE:CI          COPY CURRENT RECORD, INTERLACING/DELETING
'CP'     PR,I:CP# PARSE:CP          COPY CURRENT RECORD, PROTECTED
'RL'     PR,I:RL# PARSE:RL          REPEAT COMMAND LINE
'L'      PR       LINK:PCL          LIST [FILES]
'DL'     PR,F:DL# PARSE:DL          DELETE LIMIT
CTBLSZ   EQU      BA(%)-BA(CNMRTBL)-1
         USECT    P                 GO TO MAIN PROCEDURE SECTION
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 FORM:  TABC ON(OFF)*
*****************************
*
*
PARSE:RP EQU      %
PARSE:BP EQU      %
PARSE:CR EQU      %
PARSE:TA EQU      %
PARSE:ECHO EQU    %
PARSE:TABX EQU    %
PARSE:TABC 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  *
***********************
*
*
PARSE:END         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
         CI,P1    R:SS#
         BE       PDE08             B/SS CMD
         CI,P1    R:ST#
         BNE      PDE15             B/NOT ST CMD
PDE08 ;
         LW,P1    MAXSEQ            SS OR ST W/1ST SEQ # ONLY; SET 2ND
*                                   .. SEQ # TO HI VALUE
         STW,P1   PARAMBUF+1
*
*  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/'
PDE21 ;
         BAL,LNK  PARSE:SSER        PARSE STRING SELECTION EXPRESSION
GET%COL#%PAIR EQU %
         NXTPRM   *ERRP4,;          '-CN:ILGL SYNTAX'
                  (COM,*),;         FALL THRU IF COMMA; COL #'S
                  (SCOL,RESUME%PARSING%IF%OK),; B/SEMI-COLON
                  (END,CHK%END%TOO%SOON)
         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,CHK%END%TOO%SOON)
         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,CHK%END%TOO%SOON)
RESUME%PARSING%IF%OK ;
         LI,X1    1                 L/INDEX TO CMND # IN CDT
         LB,X1    *CDTADR,X1        L/CMND #
         LH,X1    FLAG,X1           L/FLAGS FOR THIS CMD
         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
CHK%END%TOO%SOON ;
         LI,X1    1                 L/INDEX TO CMD # IN CDT
         LB,X1    *CDTADR,X1        L/CMD #
         LH,X1    FLAG,X1           L/FLAGS FOR THIS CMD
         CI,X1    NOT%END           C/FLAG W/NOT-LEGAL-AT-END FLAG
         BAZ      MASTEREXECUTIVE   B/CMD OK IF AT END OF INPUT
END%TOO%SOON ;
         BAL,LNK  TYPECERR%UNCONDT
         DATA     ERRC17            '-P1:DOESN'T MAKE SENSE ...'
         LI,P1    I:EL#
         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 SSE, IF PRESENT
         B        GET%COL#%PAIR
*
*  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,*),;
                  (ALPH,PSSE60),;
                  (STRG,PSSE37)
         NXTPRM   *ERRP19,;
                  (ALPH,*)
PSSE60   ;
         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: EL
* PARSE: EL SSE (,C(,D))
*
PARSE:EL EQU      %
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY
         DATA     28                # OF PARAMS
         NXTPRM   ERRP25,;          '-P1:NOT STRING SELECTION EXPRESSION'
                  (END,CHK%END%TOO%SOON),;
                  (SCOL,RESUME%PARSING%IF%OK),;
                  (ALPH,*),;
                  (STRG,*)
         B        PDE21
*
* PARSE: IF SSE (,D(,D))
*
PARSE:IF EQU      %
         MTW,1    IFCNT             INC IF COUNT FOR BALANCE CHECKS
         BAL,LNK  NEWCDTENTRY       BUILD NEW CDT ENTRY
         DATA     28                # OF PARAMS
         NXTPRM   ERRP25,;          '-PN:NOT STRING SELECTION EXPRESSION'
                  (END,PIF70),;
                  (SCOL,PIF70),;
                  (ALPH,*),;
                  (STRG,*)
         B        PDE21
PIF70 ;
         BAL,LNK  TYPECERR%UNCONDT
         DATA     ERRC19            '-CN:MISSING STRING SELECTION EXPRESSION'
         B        MASTERPARSER
         PAGE
*
* PARSE FORM:  EI (ENDIF)
*
PARSE:EI RES      0
         MTW,-1   IFCNT             DEC IF COUNTER
         BGEZ     PEI20             B/STILL MORE IF'S THAN ENDIF'S
         BAL,LNK  TYPECERR%UNCONDT  MORE EI'S THAN IF'S
         DATA     ERRC18            '-CN:TOO MANY EI'S'
         B        MASTERPARSER
         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
         NXTPRM   ERRP5,;
                  (INTG,*),;
                  (COM,PIN10),;
                  (END,PIN15),;
                  (SEQ,PBU10),;
                  (SEQ2,ILGL%SEQ2)
         BAL,LNK  ADJINT
         B        PBU10
PIN10    NXTPRM   ERRP6,;
                  (INTG,*),;
                  (SEQ,PIN11)
         BAL,LNK  ADJINT
PIN11    LI,LNK   PIN20
         LW,P1    PARAMBUF
         B        PIN18
PIN15    LI,LNK   MASTEREXECUTIVE
         LW,P1    DFLTINCR
PIN18    AW,P1    LASTSET
         STW,P1   PARAMBUF
         CW,P1    MAXSEQ            C/IN SEQ # W/MAX
         BLE      PIN19             B/OK
MAXSEQEXC ;
         BAL,LNK  TYPEMSG
         DATA     ERRM20            '-MAX SEQ. NO. EXCEEDED'
         B        MASTERPARSER
PIN19    LI,P1    SEQ
         B        ADDCDTPARAM
PIN20    LCW,P1   LASTSET
         AWM,P1   PARAMBUF
         B        PBU20             GET INCREMENT
         PAGE
********************************
*  PARSE FORM:  L...........   *
*                 LINK TO PCL  *
********************************
LINK:PCL RES
         LW,X1    TTYIMGSZ          MAKE TEXTC COMMAND FOR PCL
         LW,X2    X1
         AI,X1    -1
         LB,P1    TTYIMG,X1
         STB,P1   TTYIMG,X2
         BDR,X2   %-3
         LW,X1    TTYIMGSZ
         LI,P1    'L'               MAKE SURE IT'S UPPER CASE
         STH,P1   TTYIMG
         STB,X1   TTYIMG            SET COUNT
         M:XCON   0
         M:LINK   'PCL',':SYS',(CMD,TTYIMG),ERROR
         M:XCON   F:END
         B        MASTERPARSER
         PAGE
***********************
*  PARSE FORM:  DL N  *
***********************
*
*
PARSE:DL RES
         BAL,LNK  NEWCDTENTRY
         DATA     1
         BAL,LNK  CHECK1CDTENTRY
         NXTPRM   ERRP9,;
                  (INTG,*)
         LI,P1    INTG
         BAL,LNK  ADDCDTPARAM
         NXTPRM   (ERRC9),;
                  (END,MASTEREXECUTIVE)
         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
***************************************
*        PARSE FORMS:  CI (N(,I))
*        PARSE FORMS:  CP (N(,I))
***************************************
*
PARSE:CI RES
PARSE:CP RES
         BAL,LNK  NEWCDTENTRY       BUILD CDT ENTRY
         DATA     2
         NXTPRM   ERRP4,;
                  (SEQ,PARSE:C2),;
                  (INTG,PARSE:C2A),;
                  (COM,PARSE:C3),;
                  (SEQ2,ILGL%SEQ2),;
                  (SCOL,RESUME%PARSING),;
                  (END,MASTEREXECUTIVE)
PARSE:C2A  RES    0
         BAL,LNK  ADJINT            CONVERT INTEGER TO SEQ NR
PARSE:C2 ;
         LI,P1    SEQ
         BAL,LNK  ADDCDTPARAM       PUT SEQ # IN CDT
         NXTPRM   *ERRP4,;
                  (COM,PARSE:C3A),;
                  (SCOL,RESUME%PARSING),;
                  (END,MASTEREXECUTIVE)
*
PARSE:C3  RES     0
         MTW,2    PARAMPSN          SKIP PARAMETER 1
PARSE:C3A  RES     0
         NXTPRM   ERRP6,;
                  (INTG,*),;
                  (SEQ,PARSE:C3B)
         BAL,LNK  ADJINT
PARSE:C3B  RES    0
         LI,P1    SEQ
         MTW,0    PARAMBUF
         BEZ      ILGL%SEQ2         B IF ZERO INCREMENT
         BAL,LNK  ADDCDTPARAM
         NXTPRM   *ERRP4,;
                  (SCOL,RESUME%PARSING),;
                  (END,MASTEREXECUTIVE)
         PAGE
***************************************
*        PARSE FORM:  CL (C1(,C2))    *
***************************************
PARSE:CL RES
         NXTPRM   ERRP4,;
                  (END,*),;
                  (SCOL,*),;
                  (INTG,PCL10),;
                  (STRG,PCL20)
*        FORM IS     CL
         MTW,-1   CHARPSN           RESCAN TERMINATOR LATER
         BAL,LNK  NEWCDTENTRY
         DATA     1                 ONE EMPTY ENTRY
         NXTPRM   ERRP4,;
                  (END,MASTEREXECUTIVE),;
                  (SCOL,RESUME%PARSING)
*
PCL10    RES      0
*        FORM IS     CL N . . .
         LW,T1    PARAMBUF          SAVE INTEGER
         NXTPRM   ERRP4,;
                  (END,*),;
                  (SCOL,*),;
                  (COM,PCL12),;
                  (STRG,PCL14)
*        FORM IS    CL N
         MTW,-1   CHARPSN           RESCAN TERMINATOR LATER
         BAL,LNK  NEWCDTENTRY
         DATA     2                 TWO ENTRIES, ONE NULL
         STW,T1   PARAMBUF
         LI,T2    1
         STW,T2   PRMBUFSZ          SIZE OF PARAM
         LI,P1    INTG
         BAL,LNK  ADDCDTPARAM
         NXTPRM   ERRP4,;
                  (END,MASTEREXECUTIVE),;
                  (SCOL,RESUME%PARSING)
*
PCL12    RES      0
*        FORM IS    CL N, . . .
         BAL,LNK  NEWCDTENTRY
         DATA     3
         STW,T1   PARAMBUF
         LI,T2    1
         STW,T2   PRMBUFSZ          SIZE OF PARAM
         LI,P1    INTG
         BAL,LNK  ADDCDTPARAM       PUT COL NR  IN CDT
         B        PCL30
*
PCL14    RES      0
*        FORM IS   CL N/STRG/. . .
         BAL,LNK  NEWCDTENTRY
         DATA     4
         LI,T2    1                 INTEGER PARAM SIZE
         XW,T1    PARAMBUF
         XW,T2    PRMBUFSZ
         LI,P1    INTG
         BAL,LNK  ADDCDTPARAM       PUT OCCURRENCE CT IN CDT
         XW,T1    PARAMBUF
         XW,T2    PRMBUFSZ
         LI,P1    STRG
         BAL,LNK  ADDCDTPARAM       PUT STRING IN CDT
         NXTPRM   ERRP4,;
                  (END,MASTEREXECUTIVE),;
                  (SCOL,RESUME%PARSING),;
                  (COM,PCL30)
*
PCL20    RES      0
*        FORM IS    CL /STRG/. . .
         BAL,LNK  NEWCDTENTRY
         DATA     3
         LI,P1    STRG
         BAL,LNK  ADDCDTPARAM
         NXTPRM   ERRP4,;
                  (END,MASTEREXECUTIVE),;
                  (SCOL,RESUME%PARSING),;
                  (COM,*)
*
PCL30    RES      0
*        FORM IS    CL . . .,. . .
         NXTPRM   ERRP4,;
                  (INTG,*),;
                  (STRG,PCL40)
*        FORM IS    CL . . .,N. . .
         LI,P1    INTG
         BAL,LNK  ADDCDTPARAM
         NXTPRM   ERRP4,;
                  (STRG,*),;
                  (END,MASTEREXECUTIVE),;
                  (SCOL,RESUME%PARSING)
*        FORM IS    CL . . .,N/STRG/
*
PCL40    RES      0
*        FORM IS     CL . . .,. . ./STRG/
         LI,P1    STRG
         BAL,LNK  ADDCDTPARAM
         NXTPRM   ERRP4,;
                  (END,MASTEREXECUTIVE),;
                  (SCOL,RESUME%PARSING)
*
         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  *
*               QR  *
*               NO  *
*********************
*
*
PARSE:TX EQU      %
PARSE:RF EQU      %
PARSE:QR RES      0
PARSE:NO RES      0
PARSE:RL RES      0
PEI20    RES      0
         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
         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 #
         LH,X1    FLAG,X1           L/FLAGS FOR THIS CMD
         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
         MTW,0    CONSEC%FILE       IF NOT KEYED
         BNEZ     0,LNK             NO ADJUSTMENT NECESSARY
         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
*
* SET DEFAULT SE RANGE TO INCLUDE ALL OF THE CURRENT FILE.
*
SETDFLT  ;
         PUSH     (P1,T1)
         LI,T1    0
         STW,T1   SV1STSET          START OF IMPLICIT SE
         STW,T1   FRSTCLMN          LOWER COLUMN LIMIT
         LI,T1    1
         STW,T1   FILETYPE          EDIT IN PROGRESS
         STW,T1   SETFLAG           SAY SE HAS BEEN DONE
         LI,T1    MAXCLMN
         STW,T1   LASTCLMN          UPPER COL LIMIT + 1
         LW,P1    MAXSEQ            L/HIGHEST LEGAL SET #; GO TO END
         BAL,LNK  READNXTRANDOM     FIND LAST REC OF FILE
         LW,T1    LASTKEY           L/SEQ # OF LAST REC IN FILE
         AND,T1   =X'FFFFFF'        MASK OFF KEY BYTE COUNT
         STW,T1   LASTSET           END OF SE RANGE = SEQ # OF LAST REC
         PULL     (P1,T1)
         B        0,LNK
         PAGE
***********************************
*                                 *
*  BREAK-KEY INTERRUPT HANDLER    *
*  UTS ONLY.                      *
*                                 *
***********************************
*
         DO       MODE=2
BRK%KEY  PUSH      X3               SAVE POINTER OF PSD IN STACK
         MTW,0    XEQFLAG           IF NOT EXECUTING, GET NEXT COMMAND.
         BLZ       BRK99
         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     ' ',' ',EOM,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.
         LH,P1    FLAG,X2           L/FLAGS FOR THIS CMD
         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     ' ',' ',EOM,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    X'10'             IN CASE THIS IS MERGE FROM CONSEC
         AND,P2   F:EI+5            SET CONSEC%FILE PROPERLY
         SLS,P2   -4
         STW,P2   CONSEC%FILE
         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
         LI,X1    0                 IF TWO NUMBERS, MUST BE KEYED OUTPUT
         STW,X1   CONSEC%FILE
         BAL,LNK  MOVESEQ           MOVE SECOND SEQ # NUMBER INTO
         TEXT     ')  ',EOM
         AW,R1    T1                INCREMENT MSG LENGTH
         B        BRK55
*
BRK80    ;
         LW,T1    XEQ%ECHOED
         BNEZ     BRK82             B/XEQ RECORD ALREADY ECHOED
         LH,T1    M:C
         CI,T1    X'20'
         BAZ      BRK82             B/M:C NOT OPEN; NOT XEQ MODE
         LC       *79
         BCR,8    BRK81             B/NOT ONLINE
         BAL,LNK  TYPEMSG           DO A CARRIAGE RETURN
         DATA     MSG0
BRK81    BAL,LNK  XEQ%ECHO%20       ECHO THE XEQ RECORD
BRK82    ;
         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
STOPLASTCMD RES
         BAL,LNK  RESET%XEQ%MODE
         LI,T1    -1
         STW,T1   ALLFLAG
         LI,T1    0
         STW,T1   LASTKEY
         STW,T1   SETFLAG
         STW,T1   STEPFLAG
         LW,T1    SAVED:CHG:STG:CNT L/CHANGED STRING COUNT SAVED AT LAST WRITE
         STW,T1   CHG:STG:CNT       RESET CHANGE COUNT TO THAT AT BEGINNING
*                                   .. OF REC SO NO WRITE WILL OCCUR.
         MTW,0    COPYFL            DOES FID1 = FID2
         BEZ      BRK91             NO
         STW,T1   COPYFL
         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        BRK90
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      BRK90             FOR EDIT.
         CW,R1    F:EI
         BAZ      %+2
         BAL,LNK  CLOSE
BRK90    LW,T1    INTRTN            DO WE HAVE A SUMMARY TO TYPE
         BNEZ     %+2               YES
BRK99     EQU     %              PREPARE A CLEAN EXIT.
         LI,T1    MASTERPARSER
         LI,T2     X'1FFFF'         MASK
         PULL     X3                GET XTACK POINTER
         CI,X3    0
         BE       *T1               DUMMY ENTRY
         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 %
         LW,X1    TTYIMGSZ          L/SIZE OF COMMAND
         AI,X1    -1                G/BTD TO LAST BYTE
         LB,X1    TTYIMG,X1         L/LAST BYTE OF COMMAND LINE
         CI,X1    ';'               C/LAST BYTE W/;
         BNE      EXC2              B/NOT ; (NOT CONTINUED)
         LI,T1    0
         STW,T1   CHARPSN           SET UP FOR NEW SCAN
         STW,T1   XEQ%ECHOED        SAY LINE HASN'T BEEN ECHOED IF XEQ
         LH,T1    M:C
         CI,T1    X'20'
         BANZ     EXC1              B/XEQ MODE
         BAL,LNK  TYPEMSG
         DATA     =(2**24+'>'**16+EOM**8) '>'
EXC1     ;
         BAL,LNK  READTELETYPE2     READ NEXT COMMAND LINE
         AI,R1    -1                SAVE CNT OF # OF CHARS INPUT
         LW,X1    R1                L/BTD TO LAST BYTE OF CMND
         LI,T1    ' '               L/BLANK
         B        %+3               B
         CB,T1    TTYIMG,X1         C/BLANK W/BYTE OF CMND BUF
         BNE      %+3               B/NOT BLANK
         AI,X1    -1                DEC BTD
         BGEZ     %-3               B/MORE BLANKS TO STRIP
         AI,X1    1                 BACK TO SIZE
         STW,X1   TTYIMGSZ          S/CMND BUF SIZE
         MTW,1    XEQ%REC#          INC XEQ RECORD NUMBER
         BAL,LNK  XEQ%ECHO%10       ECHO XEQ REC IF APPROPOS
         B        RESUME%PARSING    PARSE THE CONTINUATION LINE
EXC2     RES      0
         LW,T1    CDTBAS%           L/ADR OF 1ST WD OF CDT
         AI,T1    1                 G/ADR OF 2ND WD OF 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
         STW,X2   CURRENT%CMND#     S/CURRENT COMMAND NUMBER (EXC INDEX)
         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       EXC4              B/FILE COMMAND
         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
         LH,T1    FLAG,X2           L/FLAGS FOR THIS CMD
         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
EXC4     ;
         LI,T1    -1
         STW,T1   NXTCPYSEQ#        ZAP NEXT COPY SEQ #; MAKE USER
*                                   .. SPECIFY IT AT LEAST ONCE
*
*  F:CMND, R:CMND, OR 'SE': CHECK TO SEE THAT SYSTEM IS NOT IN STEP MODE
*
EXC5     LI,T1    MAXCLMN
         STW,T1   SELASTCLMN        RESET LAST SE-SAVED COLUMN
         STW,T1   LASTCLMN          RESET LAST COLUMN
         LI,T1    0
         STW,T1   SEFRSTCLMN        RESET FIRST SE-SAVED COLUMN
         STW,T1   FRSTCLMN          RESET FIRST COLUMN
         STW,T1   SSE%CDT           MAKE SURE SSE CDT IS RESET
         MTW,0    STEPFLAG
         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    LW,X2    CURRENT%CMND#     L/CURRENT CMND #
         BEZ      EXC50             B/END-OF-CDT
         LH,X1    FLAG,X2           L/FLAGS FOR THIS CMD
         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
*
*
*  WE'RE PROCESSING THE FIRST RECORD, AND ARE IN AN INTRA-RECORD
*  PROCESSING LOOP.  FIND THE FIRST RECORD, AND DETERMINE IF IT
*  IS SELECTED FOR EDITTING.
*
SE%INIT  ;
         LI,T1    STL5              SET RETURN IN CASE OF BREAK
         STW,T1   INTRTN
         PUSH     LNK               PUSH LNK REG
         LI,T1    0                 L/0; ASSUME INTRA CMMD WAS ISSUED
         LW,X2    CURRENT%CMND#     L/CURRENT CMND #
         CI,X2    1ST:INTRA:CMND#   C/CUR # W/1ST INTRA (NOT INCL SE)
         BGE      %+2               B/INTRA CMND
         LB,T1    *CDTADR           L/SIZE OF CURRENT CDT ENTRY; SKIP
*                                   .. PAST CURRENT ENTRY LATER IN SE LOOP
         AW,T1    CDTADR            + ADR OF CURRENT ENTRY IN CDT
         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
         BAL,LNK  XSSE%CONDT        CHECK FOR STRING SELECT EXP
         BCS,8    SE%INIT8          B/EXP NOT THERE OR TRUE
*
*  THIS RECORD ISN'T SELECTED BECAUSE OF STRING SELECTION EXPRESSION;
*  INCREMENT THE CDT POINTER TO THE END-OF-CDT MARKER SO THAT
*  THE EXC ROUTINES WON'T DO ANY FURTHER PROCESSING ON THIS RECORD.
*
         LB,T1    *CDTADR           L/SIZE OF CURRENT CDT ENTRY
         BEZ      SE%INIT6          BEZ; AT END
         AWM,T1   CDTADR            ADD CURRENT ENTRY SIZE TO CDTADR
         B        %-3               B/CHECK NEXT CDT ENTRY
SE%INIT6 STW,T1   CURRENT%CMND#     SET CUR CMND # TO END-OF-CDT CMND
SE%INIT8 ;
         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,2   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)
*
NOT%END  EQU      X'100'            CMD NOT LEGAL AT END OF INPUT LINE
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
F:TC#    EXC,F:TABC
F:DL#    EXC,F:DLIMIT
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
1ST:INTRA:CMND# EQU %-CMNDTBL       CMND # OF 1ST INTRA CMND (NOT INCL 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
I:IF#    EXC,I:IF              SEMICOLON%OK+COL#LEGAL+NOT%END
I:EL#    EXC,I:EL              SEMICOLON%OK+COL#LEGAL+NOT%END
I:EI#    EXC,I:EI              SEMICOLON%OK
I:QR#    EXC,I:QR              SEMICOLON%OK
I:CL#    EXC,I:CL              SEMICOLON%OK+COL#LEGAL
I:CI#    EXC,I:CI              SEMICOLON%OK
I:CP#    EXC,I:CP              SEMICOLON%OK+PROTECTED
I:RL#    EXC,I:RL              SEMICOLON%OK
         DO1      4                 SPARE ENTRIES
         EXC,0
         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
BLD33    SW,P1    DFLTINCR
BLD34    STW,P1   SV1STSET
         STW,P1   LASTSET
         STW,P1   SETFLAG
         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    9                 GET FID2 LOC AND LENGTH.
         BAL,LNK  CPY33
         LW,P2    X1                SAVE LOC.
         STB,X2   P2                SAVE SIZE.
*
         LI,X1    5                 GET FID1 LOC AND LENGTH.
         BAL,LNK  CPY33
         CB,X2    P2                IF LENGTHS OF FID1 AND FID2
         BNE      CPY1B               AREN'T SAME, FID1 NOT = FID2.
*
         SLS,P2   2                 CONVERT WORD/LENGTH,LOC TO BYTE.
         LW,LNK   X1                GET DEST ADDRESS.
         STB,X2   LNK               SET COUNT.
         SLS,LNK  2                 CONVERT TO BC/BA.
         CBS,P2   0
         BE       CPY32             FID1 = FID2?
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    CPY20             SET BREAK RETURN
         STW,R1   INTRTN
         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
         STW,R1   INTFLAG1
         BAL,LNK  WRITE2            WRITE RECORD IN COPY FILE
         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
         STW,R1   INTFLAG1
         STW,P1   INTFLAG2
         BAL,LNK  WRITE2            WRITE RECORD IN COPY FILE
         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
         B        EDT6
*
*  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
         BAL,LNK  CPY33             NO PASSWORD FOR FID1?
         BNEZ     CPY60             PASSWORD GIVEN--ERROR.
         LI,X1    9                 CDT IX OF FID2 OFFSET.
         LI,LNK   CPY34             NO PASSWORD FOR FID2?
*
CPY33    EQU      %                 SUBR TO CHECK FOR PASSWORD.
*    TAKES CDT INDEX OF DESIRED FID IN X1 AND RETURNS
*    ADDRESS OF FID IN X1 AND LENGTH OF FID (IN WORDS)
*    IN X2.   CC'S ARE SET ON PASSWORD.
         LB,P1    *CDTADR,X1
         AW,P1    CDTADR            P1 = FILE NAME
         LCW,X2   P1                SAVE FIRST ADDR TO CALC FID SIZE.
         AI,P1    1                 SKIP SN FIRST WORD.
         MTW,0    -1,P1             IF SN THERE,
         BEZ      %+2
         AI,P1    2                   SKIP PACK NAME AND RESOURCE TYPE.
         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
         AW,X2    P1                CALC SIZE TO PASSWORD.
         LW,X1    P1                CALC ADDR OF FID.
         SW,X1    X2                CALC FID START ADDRESS.
         MTW,0    *P1               CHECK IF PASSWORD GIVEN.
         B        *LNK
CPY34    EQU      %
         BNEZ     CPY60             PASSWORD GIVEN--ERROR.
*
*
* OPEN AND CLOSE THE INPUT FILE TO GET THE FPARAMS.
*
         LI,X1    5
         LB,P1    *CDTADR,X1
         AW,P1    CDTADR
         LI,X4    0
         BAL,LNK  OPEN1             OPEN F:EI TO GET FPARAMS
         BCS,8    CPY40             B/FILE DOESN'T EXIST
         BAL,LNK  CLOSE             CLOSE INPUT (F:EI) FILE
*
* SET TO 0 THE SIGNIFICANT SIZE OF ALL FPARAM ENTRIES THAT
* WE DON'T WANT TO PRESERVE.  WE PRESERVE READ AND WRITE
* ACCOUNT NUMBERS.
*
         LI,P1    FPARAM            L/ADR OF FPARAM BUF
         LI,X1    2                 L/2; INDEX IN CONTROL WORD TO SIG SIZE
         LI,R1    0                 L/0; CONSTANT
CPY34E ;
         LB,X4    *P1               L/TYPE FROM CONTROL WORD IN FPARAM
         CI,X4    5                 C/TYPE W/5; READ ACCOUNT
         BE       CPY34H            B/READ ACCOUNT; LEAVE
         CI,X4    6                 C/TYPE W/6; WRITE ACCOUNT
         BE       CPY34H            B/WRITE ACCOUNT; LEAVE
         STB,R1   *P1,X1            0/SIGNIFICANT SIZE OF THIS ENTRY
CPY34H ;
         LW,X4    =X'00FF0000'      L/MASK FOR LAST-ENTRY INDICATOR
         CW,X4    *P1               CHECK FOR LAST ENTRY
         BANZ     CPY34M            B/LAST ENTRY
         LI,X4    X'FF'             L/MASK FOR RESERVED SIZE
         AND,X4   *P1               G/RESERVED SIZE
         AW,P1    X4                ADD SIZE TO ENTRY POINTER
         AI,P1    1                 +1 FOR SIZE OF CONTROL WORD
         CI,P1    FPARAM+88         C/POINTER W/MAX REASONABLE
         BL       CPY34E            B/MORE ENTRIES TO LOOK AT
CPY34M ;
         CAL1,1   FPSETAC           SET READ/WRITE ACCOUNTS ON F:EO
         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:TABC   LI,X3    TABC%FLAG         L/ADR OF FORCE-TAB-COMPRESSION FLAG
         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
         LI,T1    1                 L/1; 'TRUE'/'ON' FLAG
*
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:  DLN  *
************************
F:DLIMIT RES
         LI,X1    5                 GET PARAMETER
         LB,X1    *CDTADR,X1
         LW,X1    *CDTADR,X1
         STW,X1   DELETELIMIT
         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
EDT6     RES
         BCS,4    EDT20             YES - IS IT KEYED
         BAL,LNK  SETDFLT           SET DEFAULT SE RANGE, ETC
         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    RES
         BAL,LNK  TYPEMSG           TYPE: '-FILE NOT KEYED; MUST COPY'
         DATA     ERRM12
         LH,X1    F:EI+1            DONT REOPEN IF ALREADY INPUT
         CI,X1    12
         BAZ      %+4
         BAL,LNK  CLOSE
         LI,X1    F:EI
         BAL,LNK  OPENIN
         MTW,1    CONSEC%FILE       SET THE FLAG
         B        EDT6
         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
         LC       *79
         BCR,8    %+2
         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
         LI,P2    1                 SET DIVISOR TO ADJUST SEQ#S
         BAL,LNK  OPEN1             OPEN MERGE SOURCE IN INPUT MODE.
         BCS,8    CPY40             ERROR IF NON-EXISTENT
         BCR,4    %+3               IF CONSEC,
         MTW,1    CONSEC%FILE       SET THE FLAG
         LI,P2    1000              AND ADJUST SEQ#S
*
         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,T2    *P1
         DW,T2    P2                ADJUST IF CONSEC
         STW,T2   FIRSTFROM
         LW,T2    1,P1              AND THE NEXT
         DW,T2    P2
         STW,T2   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'
         LW,T2    CONSEC%FILE       SAVE FILE ORG
*
         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
*
MRG13   BAL,LNK  CLOSE             CLOSE FID2 AS F:EI
MRG14    LI,P3    1000              DEFAULT INCREMENT
         STW,P1   FIRSTTO           S/FIRST 'TO' SEQ #
         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
         LI,P1    MRG80             SET RETURN FROM BREAK
         STW,P1   INTRTN
MRG17    LW,P1    FIRSTFROM         GET FIRST 'FROM' RECORD IN FILE 1.
         STW,T2   CONSEC%FILE       SET SEQNESS
         BAL,LNK  READNXTRANDOM
         LW,P1    FIRSTTO
MRG20    LI,T1    0                 OUTPUT IS KEYED
         STW,T1   CONSEC%FILE
         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.
         MTW,1     MVD:REC:CNT      COUNT REC.S MOVED.
         DO       MODE=2
         STW,R1   INTFLAG1
         STW,P1   INTFLAG2
         FIN
         BAL,LNK  WRITE2            WRITE RECORD INTO FILE2.
         CW,R1    LASTFROM          ARE WE DONE
         BE       MRG55             ALL DONE
         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
         STW,T2   CONSEC%FILE
         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,P1    *T1
MRG35    LW,X3    L(EOF)            SET 'STOP' SEQUENCE TO EOF.
         B        MRG14
*
*
MRG55    LI,T1    MVE40             SUCCESSFUL MERGE, USE
MRG56    BAL,LNK  CLOSE             'MK' CODE AFTER CLOSING.
         BAL,LNK  CLOSE2
         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
         LW,P1    INTFLAG2          GET ENDING SEQ#
         B        *T1
*
MRG65    ;
         LW,P2    R1                SAVE CURRENT SOURCE SEQ #
         BAL,LNK  READSEQUEN        READ NEXT REC FROM SOURCE FILE
         CW,R1    LASTFROM          C/NEXT SEQ # W/LAST SOURCE DESIRED
         STW,P2   LASTFROM          SET LAST SEQ # READ
         BG       MRG55             B/NEXT REC WAS OUT OF
*                                   .. DESIRED SOURCE RANGE; DON'T FLAG
*                                   .. AS A CUTOFF
         CW,R1    L(EOF)
         BE       MRG55             B/EOF; DON'T FLAG AS CUTOFF
         LI,T1    MVE56+1           USE 'MK' MESSAGE
         B        MRG56
*
MRG70    BAL,LNK  CLOSE             CLOSE INPUT FILE
         B        MVE58             THEN USE 'MK' ROUTINE
MRG80    LI,T1    MVE45             BREAK RETURN
         B        MRG56
*
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 *OUT%DCB%ADR,(TAB,7,16,34,0)   FTABS
         M:DEVICE *OUT%DCB%ADR,(TAB,10,19,37,0)  MTABS
         M:DEVICE *OUT%DCB%ADR,(TAB,8,16,30,0)   STABS
         M:DEVICE *OUT%DCB%ADR,(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
         STW,P1   SV1STSET
         STW,P1   LASTSET
         STW,P1   SETFLAG
         CW,P2    FIRSTSET          C/HI SEQ # W/CURRENT SEQ #
         BE       *R:LNK            BE; AT END
         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
         MTW,0    DELETED%REC%CNT
         BNE      *R:LNK            BNE; DON'T SQUAWK
         BAL,LNK  TYPEMSG           TYPE MESSAGE
         DATA     ERRM26            '--NOTHING TO DELETE'
         B        *R:LNK            EXIT
*
*
         PAGE
*
* INTRA-RECORD DE
*
* IF DE IS THE ONLY COMMAND ON THE LINE, AND THERE IS NO
* STRING SELECTION EXPRESSION IN EFFECT, AND THE SE RANGE
* COVERS MORE THAN 1 RECORD, AND THIS ISN'T XEQ MODE,
* ASK THE USER IF HE/SHE (IT?) REALLY WANTS TO DELETE.
*
I:DELETE%REC ;
         LW,T1    *CDTADR
         CI,T1    X'FE00'
         BANZ     IDR80             B/NOT ONLY CMD ON LINE
         LW,T1    DELETED%REC%CNT
         BNEZ     IDR80             B/BEEN HERE ALREADY FOR THIS CMD
         LW,P1    LASTSET
         CW,P1    FIRSTSET
         BE       IDR80             B/ONLY 1 REC TO DE
         MTW,0    STEPFLAG
         BNEZ     IDR80             B/IN SS/ST MODE
         LW,R1    P1                COPY SEQ # IN CASE REC EXISTS
         BAL,LNK  READRANDOM        TRY TO READ REC W/SEQ# = LASTSET
         BCR,8    %+2               B/REC EXISTS
         BAL,LNK  READ%NXT%REVERSE  READ LAST REC IN RANGE
         LW,P1    FIRSTSET          L/SEQ # OF CURRENT REC
         BAL,LNK  READRANDOM        REPOSITION TO ORIGINAL (CURRENT) REC
         CW,R1    FIRSTSET          C/LAST ACTUAL REC # W/CURRENT #
         BE       IDR80             REALLY ONLY 1 REC
         LW,P1    R1                COPY SEQ # FOR DISPLAY
IDR20 ;
         LI,P2    BA(ERRM29B)+ERRM29BS2 L/ADR OF 2ND SEQ # IN MSG
         BAL,LNK  MOVESEQ           CONVERT, MOVE SEQ #
         DATA     0                 FOR MOVESEQ
         AI,R1    ERRM29BS2-1       (SIZE OF SEQ #)+(BTD TO SEQ #)-1 = SIZE
         STB,R1   ERRM29B           S/BC (TEXTC)
         LH,T1    M:C
         CI,T1    X'20'
         BANZ     IDR80             B/XEQ MODE
         LW,P1    SSE%CDT           L/1ST WORD OF SIDE-BUFFERED STR SELECT EXP
         BEZ      IDR30             B/NO SSE
         LI,P1    SSE%CDT           L/ADR OF SIDE-BUFFERED SSE
         XW,P1    CDTADR            SET UP CDTADR W/SSE FOR FINDPARAM
         LI,X2    STRG
         BAL,LNK  FINDPARAM         LOOK FOR STRING IN SSE
         B        IDR25             B/NO STRING
         STW,P1   CDTADR            RESTORE CDT ADR
         B        IDR80
IDR25    ;
         STW,P1   CDTADR            RESTORE CDT ADR
IDR30    ;
         LI,P2    BA(ERRM29A)+ERRM29AS1 L/ADR OF 1ST SEQ # IN MSG
         LW,P1    FIRSTSET          L/CURRENT REC SEQ #
         BAL,LNK  MOVESEQ           CONVERT, MOVE SEQ #
         DATA     0                 FOR MOVESEQ
         AI,R1    ERRM29AS1-1       (SIZE OF SEQ #)+(BTD TO SEQ #)-1 = SIZE
         STB,R1   ERRM29A           S/BC (TEXTC)
         BAL,LNK  CONCAT            CONCATENATE MSG SEGMENTS INTO COMPRIMG
         DATA     ERRM29A           MSG SEGMENT
         DATA     ERRM29B           MSG SEGMENT
         DATA     ERRM29C           MSG SEGMENT
IDR40    ;
         LC       *79
         BCR,8    IDR80
         BAL,LNK  TYPEMSG           TYPE '--DELETE X TO Y ...' MSG
         DATA     COMPRIMG          MSG BUFFER
         M:READ   M:UC,(BUF,CFLAG),(SIZE,4),(BTD,0)
         LB,X1    CFLAG             L/1ST BYTE OF RESPONSE
         OR,X1    =X'40'            CONVERT TO UPPER CASE
         CI,X1    'N'               CHECK FOR 'N' (NO)
         BE       MASTERPARSER      ABORT COMMAND
         CI,X1    'Y'               CHECK FOR 'Y' (YES)
         BNE      IDR40             B/NEITHER N OR Y; ASK AGAIN
IDR80    ;
         BAL,LNK  DELETERECORD      DELETE CURRENT RECORD
         MTW,1    DONT%WRITE%SE%CONDT DONT'T WRITE REC AT END OF SE LOOP
         MTW,1    ZERO:STG:FLG      DON'T OUTPUT '0 STRINGS CHANGED'
         B        *I:LNK            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    FND60             SET RETURN IN CASE OF BREAK
         STW,X4   INTRTN
         LI,X4    0                 USE X4=0 FOR 'FD'
         B        R:FIND%TYPE+1
*
*
R:FIND%TYPE       EQU %
         LI,X4    1                 USE X4=1 FOR 'FT'
         LI,P3    0                 USE P3 TO COUNT # OF MATCHES FOUND
         LI,X1    5
         LB,X2    *CDTADR,X1
         LW,P1    *CDTADR,X2        SET P1=FIRST SEQ # IN CDT
         STW,P1   SV1STSET          SAVE START
         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
         BAL,LNK  STL34
         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        ;
         LW,T1    CDTBAS%
         AI,T1    1                 G/ADR OF 1ST CDT ENTRY
         INT,T1   *T1
         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      ;
         LW,T1    CDTBAS%           L/ADR OF CDT AREA
         AI,T1    1                 G/ADR OF 1ST ENTRY
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
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
         LW,P1    FRSTCLMN          L/FIRST COL # TO CHECK
         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
*
* INTRA-LINE COMMAND: EL (ELSE)
*
I:EL     EQU      %
         LI,P1    -1                L/FLAG INDICATING WE DON'T CARE ABOUT
*                                   .. RECOGNIZING MORE EL'S
         B        XIF25             MERGE W/IF CODE
*
* INTRA-LINE COMMAND: IF
*
I:IF     EQU      %
         LI,P1    I:EL#             L/ELSE CMD #; RECOGNIZE ELSE'S
XIF20 ;
         LW,X1    FRSTCLMN          SAVE 1ST COLUMN
         LW,X2    LASTCLMN          SAVE LAST COLUMN
         BAL,LNK  PRC%CLM%CL%DFL    PROCESS COL'S, 'CL' CMD DEFAULTS
         BAL,LNK  XSSE              EVALUATE STRING SELECTION EXPRESSION
         STCF     LNK               SAVE CC'S
         STW,X1   FRSTCLMN          RESTORE 1ST COLUMN
         STW,X2   LASTCLMN          RESTORE LAST COLUMN
         LC       LNK               L/CC'S SET BY XSSE
         BCS,8    *I:LNK            B/SSE TRUE, OR NOT THERE
*
* SSE (STRING SELECTION EXPRESSION) WAS FALSE.
* SKIP TO THE END OF CMD, OR PROPER EL OR EI CMD.
*
XIF25 ;
         LI,T1    0                 IF BLOCK LEVEL COUNTER
         LI,X1    1                 L/INDEX TO CMD # FIELD
XIF30 ;
         LB,X2    *CDTADR           L/LENGTH OF CMD
         LW,R0    *CDTADR,X2        L/WRD 0 OF NEXT CMD
         LB,R0    R0,X1             L/CMD # OF NEXT CMD
         BEZ      *I:LNK            B/END-OF-CDT CMD; RE
         AWM,X2   CDTADR            INC CDTADR TO NEXT CMD
         CI,R0    I:IF#
         BNE      %+3               B/NOT 'IF' CMD
         AI,T1    1                 INC 'IF' LEVEL CL/
         B        XIF30             B
         CI,R0    I:EI#
         BNE      XIF50             B/NOT EI (END IF)
         AI,T1    -1                END-IF; DEC 'IF' LEVEL CSE
         BLZ      *I:LNK            B/EI AT INITIAL LEVEL
         B        XIF30             B
XIF50 ;
         CW,R0    P1
         BNE      XIF30             B/NOT EL (ELSE)
         CI,T1    0
         BNE      XIF30             B/NOT AT INITIAL LEVEL
         B        XIF20             B; EL TO BE EVALUATED
*
* EI - ENDIF
*
* COMMAND IS MARKER ONLY.
*
I:EI ;
         B        *I:LNK            RETURN
         PAGE
*
* QR - QUIT COMMAND PROCESSING FOR THIS RECORD.
*
I:QR     RES      0
IQR30 ;
         LB,X2    *CDTADR           L/SIZE OF CMD
         LW,R0    *CDTADR,X2        L/WRD 0 OF NXT CMD
         CW,R0    =X'00FF0000'
         BAZ      *I:LNK            B/'END-OF-CDT' MARKER
         AWM,X2   CDTADR            POINT TO NEXT CMD
         B        IQR30             LOOP
         PAGE
*
* REPEAT THE COMMAND LINE FOR THE SAME RECORD, UNTIL
* THE RECORD STOPS CHANGING.
*
I:RL     RES      0
         LW,T1    CHG:STG:CNT       L/CHANGED STRING COUNT
         SW,T1    SAVED:CHG:STG:CNT (CHANGED COUNT)-(CHANGED COUNT AT
*                                   .. START OF RECORD)
         CW,T1    RL:CHG:STG:CNT    C/DIFF W/DIFF SAVED ON RL BEFORE
         STW,T1   RL:CHG:STG:CNT    S/DIFF
         BE       *I:LNK            B/NO CHANGES TO THIS REC
         LW,T1    SEFRSTCLMN
         STW,T1   FRSTCLMN          RESTORE 1ST COL
         LW,T1    SELASTCLMN
         STW,T1   LASTCLMN          RESTORE LAST COL
         LW,T1    SVBPFLAG
         STW,T1   BPFLAG            RESTORE BP FLAG
         LW,T1    CDTBAS%           L/ADR OF CDT AREA
         AI,T1    1                 POINT TO 1ST ENTRY
         LI,X1    1                 L/BTD TO CMND #
         LB,X1    *T1,X1            L/CMND #
         CI,X1    1ST:INTRA:CMND#
         BGE      %+3               B/INTRA CMND
         LB,X1    *T1               L/SIZE OF 1ST ENTRY; NOT INTRA
         AW,T1    X1                INC TO NEXT ENTRY
         STW,T1   CDTADR            S/ADR OF NEXT CMND TO EXEC
         B        RESTART%EXECUTIVE PROCESS COMMAND LINE AGAIN
         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 #
         LH,X2    FLAG,X2           L/FLAGS FOR THIS CMD
         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        BLD33             RETURN, SETTING LN
         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
**********************************************************************
*        INTRALINE COMMAND:  COPY CURRENT RECORD TO ANOTHER LINE     *
**********************************************************************
*
I:CI     RES
I:CP     RES
         LI,X1    4
         MTW,0    MVD:REC:CNT
         BNEZ     ICO1              B/WE'VE ALREADY OBTAINED SEQ # ON
*                                   .. THIS CMD LINE
         MTW,1    ZERO:STG:FLG      IGNORE NO STRINGS CHANGED
         LB,P2    *CDTADR,X1        PARAM 1 TYPE
         BNEZ     ICO2              B IF SPECIFIED
ICO1     ;
         AI,X1    1
         LW,P1    NXTCPYSEQ#
         B        ICO6
*
ICO2     RES      0
         AI,X1    1
         LB,X2    *CDTADR,X1        PARAM1 POINTER
         LW,P1    *CDTADR,X2        PARAM1
         STW,P1   LSTCPYSEQ#        S/CURRENT AS LAST WRITTEN
         MTW,-1   LSTCPYSEQ#        ADJUST FOR +1 LATER
ICO6     RES      0
         CI,P1    0
         BL       ICO9              B/NO DEST SEQ # SPECIFIED YET
         CW,P1    MAXSEQ
         BG       MAXSEQEXC         B/MAX SEQ # EXCEEDED; ABORT
         STW,P1   NXTCPYSEQ#        SET DEFAULT INSERT POINT
         AI,X1    1
         LB,P2    *CDTADR,X1        NEXT PARAMETER TYPE
         BEZ      ICO8              B IF NOT SPECIFIED
         AI,X1    1
         LB,X2    *CDTADR,X1        NEXT PARAMETER POINTER
         LW,P1    *CDTADR,X2        NEXT PARAMETER
         STW,P1   DFLTINCR          SET DEFAULT INCREMENT
ICO8     RES      0
         LW,X2    CURRENT%CMND#     L/CURRENT CMD NUMBER
         LH,X2    FLAG,X2           L/FLAGS FOR THIS COMMAND
         CI,X2    PROTECTED
         BAZ      ICO8F             B/NOT PROTECTED (NOT CP)
         BAL,LNK  SWAPBUFS          SWAP CARDIMG AND COMPRIMG
         LW,P1    LSTCPYSEQ#        L/SEQ # USED ON LAST CI/CP
         AI,P1    1                 READ NEXT REC AFTER LAST
         BAL,LNK  READNXTRANDOM     READ NEXT REC AFTER LAST
         BAL,LNK  SWAPBUFS          SWAP BUFFERS BACK
         CW,R1    NXTCPYSEQ#        C/NEXT REC W/SEQ WE'RE GOING TO WRITE
         BG       ICO8F             B/NEXT REC BEYOND REC TO WRITE
         LI,P2    BA(ERRM31A)+ERRM31AS1 L/ADR OF 1ST SEQ # IN MSG
         LW,P1    R1                L/SEQ # OF REC IN THE WAY
         BAL,LNK  MOVESEQ           CONVERT, MOVE SEQ #
         DATA     0                 FOR MOVESEQ
         AI,R1    ERRM31AS1-1       (SIZE OF SEQ #)+(BTD TO SEQ #)-1 = SIZE
         STB,R1   ERRM31A           S/BC (TEXTC)
         LW,P1    FIRSTSET          CURRENT SE RECORD SEQ #
         LI,P2    BA(ERRM31B)+ERRM31BS2 L/ADR OF 2ND SEQ # IN MSG
         BAL,LNK  MOVESEQ           CONVERT, MOVE SEQ #
         DATA     0                 FOR MOVESEQ
         AI,R1    ERRM31BS2-1       (SIZE OF SEQ #)+(BTD TO SEQ #)-1 = SIZE
         STB,R1   ERRM31B           S/BC (TEXTC)
         BAL,LNK  CONCAT            CONCATENATE MSG SEGMENTS INTO COMPRIMG
         DATA     ERRM31A           MSG SEGMENT
         DATA     ERRM31B           MSG SEGMENT
         BAL,LNK  TYPEMSG           TYPE 'RECORD ALREADY EXISTS ...'
         DATA     COMPRIMG          MSG BUFFER
         B        MASTERPARSER      GET NEXT COMMAND LINE
ICO8F    ;
         LW,P1    NXTCPYSEQ#        SEQ NR FOR COPY DESTINATION
         STW,P1   LSTCPYSEQ#        SAVE # AS LAST SEQ # WRITTEN
         BAL,LNK  WRITERANDOM       WRITE LINE AT NEW LOCATION
         AW,P1    DFLTINCR          GENERATE NEW DFLT INSERT SEQ #
         STW,P1   NXTCPYSEQ#        S/NEW DFLT SEQ #
         MTW,1    MVD:REC:CNT
         BAL,LNK  SWAPBUFS          SAVE CURRENT RECORD AS EDITTED
         LW,P1    FIRSTSET          CURRENT REC NR
         BAL,LNK  READRANDOM        FORCE SEQUENCE BACK TO SET RANGE
         BAL,LNK  SWAPBUFS          RESTORE EDITTED RECORD
         B        *I:LNK
*
ICO9     RES      0                 BAD COPY SEQ NR
         BAL,LNK  TYPECERR%UNCONDT
         DATA     ERRC20            '-PN:NO SEQUENCE NUMBER ... FOR DEST'
         B        MASTERPARSER
         PAGE
*****************************************************
*        INTRALINE COMMAND:  SET COLUMN LIMITS      *
*****************************************************
*
I:CL     RES
         LI,T1    0                 LOW LIM DEFAULT
         STW,T1   FRSTCLMN          SELECT ENTIRE RECORD
         LI,T2    MAXCLMN           HI LIM DEFAULT
         STW,T2   LASTCLMN          SELECT ENTIRE RECORD
         LI,X1    4
         LB,X1    *CDTADR,X1        PARAM 1 TYPE
         BEZ      COLLIM50          UNSPECIFIED. DEFAULT.
         BAL,LNK  FINDCOLUMN
         BCS,8    COLLIM70          B/NOT FOUND
         LW,T1    P1                SET NEW FIRST COL LIM
         LB,P1    *CDTADR,X1
         BEZ      COLLIM50          PARAM2 UNSPECIFIED. DEFAULT.
         BAL,LNK  FINDCOL2
         BCS,8    COLLIM70          B/NOT FOUND
         LW,T2    P1
         AW,T2    P2
COLLIM50 RES      0
         CI,T1    0
         BGE      %+2
         LI,T1    0
         CI,T2    MAXCLMN
         BLE      %+2
         LI,T2    MAXCLMN
COLLIM60 ;
         STW,T1   FRSTCLMN          SET NEW FIRST COL LIM
         STW,T2   LASTCLMN          SET NEW LAST COL LIM
         B        *I:LNK            RETURN
*
COLLIM70 ;
         LI,T1    0
         LI,T2    0
         B        COLLIM60          SET COL'S TO SELECT NOTHING
         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 #
         STW,P1   FIRSTTO           SAVE 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 #
         LH,LNK   FLAG,X3           L/FLAGS FOR THIS CMD
         CI,LNK   PROTECTED
         BAZ      MVE25             B/NOT PROTECTED MODE
         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
         LI,X1    MVE45             SET RETURN FOR BREAK
         STW,X1   INTRTN
         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
         DO       MODE=2
         STW,R1   INTFLAG1
         STW,P1   INTFLAG2
         FIN
         BAL,LNK  WRITERANDOM       WRITE RECORD WITH NEW 'TO' SEQ
         XW,P1    LASTFROM          MUST REREAD LAST 'FROM' RECORD TO
         BAL,LNK  READRANDOM         GET DCB BACK IN SEQ
         XW,P1    LASTFROM          RESTORE P1 AND LASTFROM
         BCS,8    %+3               IF NOT THERE, WE DELETED IT
         BAL,LNK  READSEQUEN        READ NEXT 'FROM' RECORD
         B        MVE30             LOOP
         BAL,LNK  READSEQUEN        IF WE DELETED (MD)
         CW,X3    LASTFROM          THE END OF TO AREA,
         BNE      MVE30             ..
         LW,X3    R1                DONT CUTOFF THERE.
         B        MVE30
*
*  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 #
         STW,P1   INTFLAG2          S/SEQ # AS LAST 'TO' #
*
*  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
MVE45    RES
         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
         LW,P1    FIRSTTO           L/FIRST 'TO' SEQ #
         STW,P1   SV1STSET          SET UP SE RANGE= DESTINATION OF MOVE
         STW,P1   SETFLAG           SAY SE HAVE AN SE RANGE
         LW,P1    INTFLAG2          L/SEQ # OF LAST 'TO' RECORD WRITTEN
         STW,P1   LASTSET           S/END OF SE RANGE SEQ #
         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,T2    0                 GET/SET CONSEC FOR SECOND #
         XW,T2    CONSEC%FILE
         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
         STW,T2   CONSEC%FILE
         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        MVE45
*
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        BLD34
*
*  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
         AI,X2    1                 INC CDT PTR
         LW,P2    *CDTADR,X2        L/HI SEQ #
         STW,P2   LASTSET           SAVE HI SEQ #
         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
         CW,R1    LASTSET           C/CURRENT # W/HI SEQ #
         BLE      STP05             BLE; OK
         BAL,LNK  TYPEMSG           NO RECS IN RANGE
         DATA     ERRM6             'NONE'
         B        STP10
STP05 ;
         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')
         LW,T1    SEFRSTCLMN        L/SAVED FIRST COLUMN #
         STW,T1   FRSTCLMN          RESTORE
         LW,T1    SELASTCLMN        L/SAVED LAST COLUMN # (FROM SS/ST)
         STW,T1   LASTCLMN          RESTORE
         LW,P1    FIRSTSET          WRITE CURRENT RECORD
         BAL,LNK  WRITERANDOM%SE%CONDT WRITE REC IF CHANGED
         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
         CW,R1    LASTSET           C/CURRENT REC # W/HI SEQ #
         BG       STP10             BG; DONE
         STW,R1   FIRSTSET          NO - SAVE NEW SEQ #
         LW,P1    FIRSTSET
*
*
*
FINISH%STEP%LOOP  EQU %             ('JU' ENTERS HERE TO FINISH)
         STW,R1   INTFLAG1          SET UP BREAK KEY DISPLAY
         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 #
         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
         STW,P1   SV1STSET          SET START OF RANGE
         BAL,LNK  READNXTRANDOM     READ FIRST SEQ # OR NEXT HIGHEST
*
*  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 #
         LH,X1    FLAG,X1           L/FLAGS FOR THIS CMD
         CI,X1    TYPE%SEQ#
         BAZ      I:RR20            B/NOT TO TYPE 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,(T1,T2) PUSH REGS FOR RT17 EXIT
         LI,X2    0                 L/0; INDEX FOR CARDIMG
         LW,X1    RTADDTBL,X2       L/ADR OF CARDIMG BUFFER
         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
         STW,P1   SV1STSET          SET START
         BAL,LNK   READNXTRANDOM READ FIRST RECORD IN RANGE.
         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  SE%INIT           INIT SE LOOP
         B        *I:LNK            EXIT
*
*
*
SET%LOOP EQU      %                 (EXC ENTERS HERE AT 'END OF CDT')
         LW,T1    SEFRSTCLMN        L/SAVED FIRST COLUMN #
         STW,T1   FRSTCLMN          RESTORE
         LW,T1    SELASTCLMN        L/SAVED LAST COLUMN # (FROM SS/ST)
         STW,T1   LASTCLMN          RESTORE
         MTW,0    SETFLAG           HAS ANY INTRALINE CMND BUT 'SE'
         BGZ      MASTERPARSER       BEEN EXECUTED
         LW,P1    FIRSTSET          YES - HAS LAST RECORD IN RANGE OF
         STW,P1   INTFLAG1
         CW,P1    LASTSET            I:SET BEEN PROCESSED
         BNE      STL10             NO - GO PROCESS MORE
         BAL,LNK  WRITERANDOM%SE%CONDT WRITE REC IF CHANGED
*
*  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       %
         LW,P1    MVD:REC:CNT       L/MOVED RECORD COUNT
         BEZ      STL31             B/NONE MOVED
         LI,P2    BA(MSG7)+1        L/ADR OF MSG
         BAL,LNK  BINTODEC          CONVERT TO CHARACTER DECIMAL
         BAL,LNK  TYPEMSG           TYPE 'XXXX RECORDS MOVED'
         DATA     MSG7              ADR OF MSG
STL31 ;
         LW,P1    TRUNC%REC%CNT     GET COUNT OF TRUNCATED RECORDS
         BEZ      STL32             DONT PRINT 0 RECORDS
         LI,P2    BA(MSG9)+1        BEGINNING OF FIELD
         BAL,LNK  BINTODEC
         BAL,LNK  TYPEMSG           NNNNNNN RECORDS TRUNCATED
         DATA     MSG9
STL32    EQU      %
         LI,P1     0                CLEAR THE CHANGED STRING COUNT
         STW,P1   ZERO:STG:FLG      THE ZERO STRING FLAG,
         STW,T1   SETFLAG            NEXT I:CMND
STL33    LI,LNK   MASTERPARSER
STL34    LW,P1    DELETED%REC%CNT   L/# OF RECS DELETED (VIA ;DE)
         BEZ      0,LNK             B/NONE; DON'T OUTPUT MESSAGE
         PUSH     LNK
         LI,P2    BA(MSG6)+1        L/ADR OF # IN MESSAGE
         BAL,LNK  BINTODEC          PUT # IN MESSAGE
         BAL,LNK  TYPEMSG           OUTPUT '# RECORDS DELETED'
         DATA     MSG6              '       RECORDS DELETED'
         PULL     LNK
         B        0,LNK
*
*  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          SET UP BREAK KEY DISPLAY
         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
         CI,X1    SSE%CDTSZ         C/SIZE W/BFR SIZE
         BLE      SAVSSE5           B/OK
         BAL,LNK  TYPEMSG
         DATA     ERRM40            '-STRING SELECTION EXP... TOO LONG'
         B        MASTERPARSER      GET NEXT COMMAND LINE
SAVSSE5  ;
         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
         LW,T1    FRSTCLMN
         STW,T1   SEFRSTCLMN        SAVE FIRST COLUMN FOR LATER RESTORE
         LW,T1    LASTCLMN
         STW,T1   SELASTCLMN        SAVE LAST COLUMN FOR LATER RESTORE
         B        0,LNK             RETURN
         PAGE
***********************************
*  INTRALINE COMMAND: 'DELETE' X  *
***********************************
*
*
I:DELETE 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
         AI,D0    0                 IF NOTHING MOVED, WE'RE DELETEING
         BEZ      %+2               BLANKS AND MUST PROGRESS TO EVER END
         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
         LW,X2    P2
         BAL,LNK  STRINGSIZE        GET THE REAL SIZE IN P3
         BAL,LNK  MOVESTRING        OVERWRITE WITH NEW STRING
         AW,P1    P3
         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
         BAL,LNK  STRINGSIZE        COMPUTE REPLACEMENT STRING SIZE
         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
         BCR,8    %+3               B/FOUND
         PULL     P1                PULL P1
         B        *I:LNK            RETURN
         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
         LW,X2    P2
         BAL,LNK  STRINGSIZE
         AW,P1    P3
         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
         BAL,LNK  STRINGSIZE        COMPUTE REPLACEMENT STRING SIZE
         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
         BAL,LNK  STRINGSIZE        COMPUTE REPLACEMENT STRING SIZE
         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
         BAL,LNK  STRINGSIZE
         AW,P1    P3
         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%SE%CONDT WRITE REC IF CHANGED
         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
         CW,P1    FIRSTSET          C/SEQ # TO JUMP TO W/1ST SEQ ON
*                                   .. SS/ST CMD
         BL       JMP05             BL; OUT OF INITIAL RANGE
         CW,P1    LASTSET           C/SEQ # TO JUMP TO W/2ND SEQ ON
*                                   .. SS/ST CMD
         BLE      JMP07             BLE; JUMPED-TO REC IN INITIAL RANGE
*
* THE REC BEING JUMPED TO IS OUTSIDE OF THE RANGE SPECIFIED ON
* THE SS/ST CMD RANGE; SET THE END-OF-RANGE TO A HI VALUE SO
* THE SS/ST LOOP WON'T STOP PROCESSING.
*
JMP05 ;
         LW,P2    MAXSEQ            L/HI SEQ VALUE
         STW,P2   LASTSET
JMP07 ;
         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,1    DONT%WRITE%SE%CONDT DON'T WRITE REC AT END OF SE LOOP
         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
         AW,P1    CDTADR            SET P1=ABSOLUTE ADR TO PUT VALUE AT
         CW,P1    CDTEND%           C/ADR OF WHERE END-OF-CDT WILL GO
*                                   .. W/END OF CDT AREA
         BLE      ACP50             B/ROOM
         PUSH     LNK
         BAL,LNK  EXPCDT            EXPAND CDT AREA (VIA M:GP)
         PULL     LNK
         LB,P1    *CDTADR           RESTORE P1
         AW,P1    CDTADR
ACP50    ;
         SW,P1    PRMBUFSZ
         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    *CDTBAS%          CHECK IF ONLY 1 CDT ENTRY
         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,GF3),;
                  (SN,*)
*
         LB,T1    PARAMBUF          SN MUST BE 'DP#X...'.
         CI,T1    3                 TOO FEW CHARS?
         BLE      GF5
*
         LW,T1    PARAMBUF          STARTS 'DP#'?
         AND,T1   XFFFFFF
         CW,T1    ='DP#'
         BNE      GF5
*
         LI,T1    '-'               LOOK FOR DEVICE NAME.
         LI,P2    3
         AI,P2    1
         CB,P2    PARAMBUF
         BG       %+4
         CB,T1    PARAMBUF,P2
         BE       GF2%RNAME
         B        %-5
* NO DEVICE NAME.
         CI,P2    8                 TOO MANY CHARS FOR SN?
         BG       GF5               YES--TELL USER.
         LI,P2    0
         STW,P2   PARAMBUF+2        DEFAULT DEVICE NAME.
         B        GF3%HAVRNAME
*
GF2%RNAME CI,P2   5                 MUST HAVE SN TOO (NOT DP#-...).
         BL       GF5
         CI,P2    8                  BUT CAN'T HAVE TOO MANY CHARS.
         BG       GF5               (MAX DP#XXXX-DD).
*
         LB,T1    PARAMBUF          DEVICE NAME MUST HAVE 2 CHARS.
         SW,T1    P2                (T1)=# CHARS.
         CI,T1    2
         BNE      GF5
*
         AI,P2    1                 GET DEVICE NAME.
         LB,T1    PARAMBUF,P2
         SLS,T1   8                 MAKE ROOM FOR NEXT CHAR.
         STW,T1   PARAMBUF+3
         AI,P2    1
         LB,T1    PARAMBUF,P2
         AW,T1    PARAMBUF+3
         STW,T1   PARAMBUF+2        SAVE DEVICE NAME.
         STH,T1   PARAMBUF+2        SET BYTES NON-ZERO FOR CPY1.COPY.
** NOTE: THESE BYTES ARE MASKED OFF IN OPENINIT.
*
         AI,P2    -3                BLANK OUT REST OF SN.
         LI,T1    ' '
         AI,P2    1
         CI,P2    7
         BG       GF3%HAVRNAME
         STB,T1   PARAMBUF,P2
         B        %-4
GF3%HAVRNAME LI,P2 11               SET LENGTH OF 'NAME'.
         STB,P2   PARAMBUF
         BAL,LNK  GF%PUSH%SUBR      PUSH SN
         NXTNAM   ERRP3,;
                  (NAME,GF4)
*
GF3      LI,P2    0                 INDICATE NO SN.
         AI,X1     1                INCREMENT STACK COUNT.
         PUSH     P2
GF4      EQU      %
         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
         LW,P2    ='    '           MAKE DW ACCOUNT FOR COMPARE.
         LW,LNK   ='    '
         LW,X2    T1                GET # CHARS.
         LB,T1    PARAMBUF,X2
         AI,X2    -1
         STB,T1   P2,X2
         BGZ      %-3               MOVE ALL CHARS.
*
         CW,P2    J:ACCN            IF USER'S ACCOUNT,
         BNE      GF16
         CW,LNK   J:ACCN+1
         BNE      GF16
*
         LI,P2    0                   USE DEFAULT.
         PUSH     P2
         AI,X1    1
         B        GF17
*
GF16     BAL,LNK  GF%PUSH%SUBR      PUSH ACCOUNT.
*
GF17     EQU      %
         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,P2    -1                GET LAST CHAR.
         LB,P1    TTYIMG,P2
         AI,P2    1
*
         CI,P1    '/'               CHECK IF SN INDICATOR.
         BNE      GN40              IF NOT, ORDINARY NAME.
*
         LI,P1    SN                IT'S A SN.
         LB,X2    PARAMBUF
         AI,X2    4
         SLS,X2   -2
         B        GETNEXT%FINISH
*
GN40     EQU      %
         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   '@'
         DATA,1   '!'
         DATA,1   '"'
         DATA,1   '&'
         DATA,1   '^'
         DATA,1   '|'
         DATA,1   '\'
         DATA,1   '['
         DATA,1   ']'
         DATA,1   '{'
         DATA,1   '}'
         DATA,1   '+'
GNTBL2SZ EQU      BA(%)-BA(GNTBL2)-1
         BOUND    4
         PAGE
***************************************************
*  GET NEXT PARAMETER FROM TELETYPE INPUT BUFFER  *
*    GEN,8,24  # OF BRANCHES,ADDR OF ERROR MSG    *
*    GEN,8,24  TYPE 1,BRANCH ADDR 1               *
*      ...        ...  ...  ...                   *
*    GEN,8,24  TYPE N,BRANCH ADDR N               *
***************************************************
*
*
GETNEXTPARAM      EQU %
         PUSH     (X1,P2)           SAVE REGS
         LW,P2    CHARPSN           SET P2=PSN OF NEXT INPUT CHAR
         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
         LB,X1    STRDLMTBL         L/SIZE OF STRING DELIMITER CHR TABLE
         CB,P1    STRDLMTBL,X1      C/CURRENT CHR W/TABLE CHRS
         BNE      %+3               B/CRN CHR DOESN'T MATCH
         STW,P1   CRNSTRDLM         S/CRN CHR AS DELIMITER CHR
         B        GP30              B
         BDR,X1   %-4               BDR/CHECK NEXT DLM CHR
         CI,P1    '#'
         BE       GP25              B IF HEX BYTE FOLLOWS
         CI,P1    '?'
         BE       GP28              B IF FIXED LENGTH MATCH-ANY
         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
*
*        FIXED LENGTH MATCH-ANY SPECIFIER
*        CAUSES INSERT OF N ONE-CHARACTER MATCH-ANY BYTES
*
GP28     RES      0
         LI,X1    0                 LENGTH
GP28C    RES      0                 ACCUMULATE DECIMAL NUMBER
         LB,P1    TTYIMG,P2
         AI,P2    1                 INCREMENT SCAN POINTER
         CLM,P1   DIGITS
         BOL      GP28F             B IF END OF COUNT
         MI,X1    10
         AI,P1    -'0'
         AW,X1    P1                ACCUMULATE CURRENT DIGIT
         B        GP28C
*
GP28F    RES      0
         CI,X1    MAXCLMN
         BGE      GP45              B IF COUNT IS TOO BIG
         LI,R0    MATCHANY1         ONE-CHAR MATCH-ANY
         CI,X1    0
         BNE      %+3               B IF SPECIFIED LENGTH
         LI,R0    MATCHANYN         MATCH ANY LENGTH
         LI,X1    1                 INSERT ONE BYTE
         STB,R0   PARAMBUF,X2
         AI,X2    1
         BDR,X1   %-2               INSERT SPECIFIED NR OF THEM
         B        GP40
*
*        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
         CW,P1    CRNSTRDLM         C/CRN CHR W/STRING DLM CHR
         BE       GP35
GP30A    STB,P1   PARAMBUF,X2       NO - PUT CHAR IN PARAMBUF
         AI,X2    1                 INCR PARAMBUF INDEX
         B        GP30              LOOP
*
* TABLE OF CHARACTERS THAT DELIMIT LITERAL STRINGS
*
STRDLMTBL ;
         TEXTC    '/"'''            / " '
         DATA     0                 PATCH SPACE
*
* THE STRING DELIMITER CHARACTER WAS FOUND; DETERMINE IF 2
* CONTIGUOUS OCCURANCES OF IT (I.E., LITERAL DELIMITER CHARACTER).
*
GP35     LB,P1    TTYIMG,P2         GET NEXT INPUT CHAR
         AI,P2    1                 INCR CHAR PSN
         CW,P1    CRNSTRDLM         C/CRN CHR W/STRING DELIMITER CHR
         BE       GP30A             B/DOUBLE DELIM CHR; LITERAL DELIM
*
GP40     RES      0
         CI,P1    '?'
         BE       GP28              B/FIXED LENGTH MATCH-ANY
         CI,P1    '#'
         BE       GP25              B IF A HEX BYTE FOLLOWS
         LB,X1    STRDLMTBL         L/SIZE OF STRING DELIMITER CHR TABLE
         CB,P1    STRDLMTBL,X1      C/CURRENT CHR W/TABLE CHRS
         BNE      %+3               B/CRN CHR DOESN'T MATCH
         STW,P1   CRNSTRDLM         S/CRN CHR AS DELIMITER CHR
         B        GP30              B
         BDR,X1   %-4               BDR/CHECK NEXT DLM CHR
         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
         MTW,0    CONSEC%FILE
         BNEZ     GP53A
         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
         MTB,0    D1                DONT OVERFLOW
         BNEZ     GP53A
         MTW,0    CONSEC%FILE       BUT PERMIT LARGE NUMBERS
         BNEZ     %+3               IF CONSECUTIVE
         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
         AW,X2    CONSEC%FILE       YEES-WAS FIRST INTG OF KEYED FILE
         BGEZ     %+2
         MI,D1    1000              YES - CONVERT TO A SEQ #
         STW,D1   PARAMBUF          PUT VALUE IN PARAMBUF
         LI,X1    1                 SET X1=2ND SEQ #
         LB,P1    TTYIMG,P2         GET NEXT INPUT CHAR
         AI,P2    1                 INCR CHAR PSN
         CLM,P1   DIGITS            IS CHAR A DIGIT
         BIL      GP50+1            YES - GO ACCUMULATE IT
         CI,P1    '.'               IS CHAR A '.'
         BNE      GP53A             NO - ERROR
         B        GP50+1            YES - GO PROCESS '.'
*
*  DONE WITH SECOND SEQ # OF PAIR: FINISH UP
*
GP63     AW,X2    CONSEC%FILE       WAS SECOND INTG OF KEYED FILE
         BGEZ     %+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    *CDTBAS%            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
         AW,P2    CDTADR            G/ADR OF WHERE END-OF-CDT WILL GO
         CW,P2    CDTEND%
         BLE      NCE50             B/ROOM
         PUSH     LNK
         BAL,LNK  EXPCDT            EXPAND CDT AREA (VIA M:GP)
         PULL     LNK
NCE50    ;
         LB,P2    *CDTADR           RESTORE P2
         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
*
* EXPAND THE CDT AREA VIA M:GP'S
*
EXPCDT   ;
         PUSH     (8,9),X1
         LW,8     CDTBAS%           L/ADR OF BASE OF CDT AREA
         CI,8     CDTFIXED
         BNE      EXPCDT60          B/ALREADY USING DYNAMIC MEM
         M:GP     1                 GET 1 PAGE
         BCR,8    EXPCDT25          B/GOT THE MEM
EXPCDT22 BAL,LNK  TYPECERR%UNCONDT
         DATA     ERRC21            '-CN:TOO MANY COMMANDS...'
         B        MASTERPARSER      GET NEXT COMMAND LINE
EXPCDT25 ;
         LI,X1    CDTFIXEDSZ-1      L/# OF WORDS TO MOVE -1
EXPCDT30 LW,8     *CDTBAS%,X1
         STW,8    *9,X1             MOVE FIXED CDT TO DYNAMIC
         BDR,X1   EXPCDT30
         CI,X1    0
         BE       EXPCDT30          B/MOVE FIRST WORD OF AREA
         STW,9    CDTBAS%           S/1ST WORD OF DYNAMIC AREA
         AI,9     512-1             G/ADR OF LAST WORD OF DYNAMIC AREA
         STW,9    CDTEND%           S/NEW END POINTER
         AI,9     -(512-1)-CDTFIXED G/DIFF IN ADR BETWEEN NEW AND FIXED
         AWM,9    CDTADR            RE-POINT POINTER TO CURRENT CDT ENTRY
         AWM,9    SETADR            RE-POINT POINTER TO CDT AFTER SE
         B        EXPCDT90
EXPCDT60 ;
         M:GP     1                 GET ANOTHER PAGE
         BCS,8    EXPCDT22          B/DIDN'T GET
         LI,8     512               L/WORDS IN PAGE
         AWM,8    CDTEND%           UPDATE END-OF-CDT AREA POINTER
EXPCDT90 ;
         PULL     (8,9),X1
         B        0,LNK             RETURN
         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. #
         BGEZ     %+2
         LW,P1    EODCLMN           LAST COLUMN FOR ZERO
         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
         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
         LW,P2    P1                CHAR PAST MATCH
         LW,P1    R1                FIRST CHAR OF MATCH
         SW,P2    P1                LENGTH OF MATCH
         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      *
*    P1 = COLUMN PAST END OF MATCHED STRING
*    CC1=0 IF MATCH FOUND, CC1=1 IF NO MATCH  *
***********************************************
*
*        TEXTC STRINGS CONSIST OF FIXED PARTS AND VARIABLE PARTS.
*        A FIXED PART IS COMPOSED OF CHARACTERS AND ONE-CHAR
*        MATCH-ANY BYTES.  IT MUST COMPARE BYTE-BY-BYTE WITH
*        A STRING IN THE SEARCH (CHARACTERS MUST COMPARE VALUES,
*        BUT MATCH-ANY BYTES MUST ONLY COMPARE POSITION).
*        VARIABLE PARTS ARE MATCH-ANY-STRING BYTES.
*        A VARIABLE PART MAY MATCH ANY STRING (POSSIBLY NULL)
*        NECESSARY TO ALLOW THE REMAINDER OF THE SAMPLE TO COMPARE.
*
FINDMATCH         EQU %
         PUSH     (X1,T2)           SAVE REGS
         STW,P2   TEXTCADR          SAVE ADDR OF TEXTC-STRING
         LW,X2    P1                STARTING COLUMN FOR SEARCH STRING
         LI,R1    0                 CLEAR MATCHANY POINTER
         STW,R1   MANYP
         LI,X1    1                 START OF TEXTC SAMPLE
*
FM10     RES      0                 FIND START OF NEXT FIXED-LENGTH PART
         LW,T1    X1                SAVE START OF FIXED-LENGTH SAMPLE
*
FM12     RES      0                 SCAN SEARCH STRING FOR MATCH
         LW,T2    X2                SAVE START OF FIXED LENGTH MATCH
         CB,X1    *TEXTCADR
         BG       FM90              B IF END OF SAMPLE
         CW,X2    LASTCLMN
         BGE      FM95              B IF END OF SEARCH STRING
         LB,R0    *TEXTCADR,X1      NEXT SAMPLE CHAR
         CI,R0    MATCHANYN
         BE       FM30              B IF A MATCH-ANY-STRING
         CI,R0    MATCHANY1
         BE       FM19              B IF ONE-CHAR MATCHANY
         CB,R0    CARDIMG,X2
         BE       FM20              B IF MATCHING CHARACTER
         AI,X2    1                 ADVANCE FIRST-CHARACTER SEARCH
         B        FM12              TRY AGAIN FOR START
*
FM19     RES
         MTB,0    MANYP             IF ALREADY STARTED,
         BNEZ     %+2               JUST COUNT
         STW,X2   MANYP
         MTB,1    MANYP
FM20     RES      0                 FIRST CHAR MATCHED. CONTINUE.
         CI,X1    1
         BNE      %+2               B IF NOT FIRST MATCH
         LW,R1    X2                SAVE START OF FIRST MATCH
         AI,X1    1                 ADVANCE SAMPLE POINTER
         AI,X2    1                 ADVANCE SEARCH STRING POINTER
         CB,X1    *TEXTCADR
         BG       FM90              B IF END OF SAMPLE
         CW,X2    LASTCLMN
         BGE      FM95              B IF END OF SEARCH STRING
         LB,R0    *TEXTCADR,X1      NEXT SAMPLE CHAR
         CI,R0    MATCHANYN
         BE       FM30              B IF A MATCH-ANY-STRING
         CI,R0    MATCHANY1
         BE       FM19              B IF ONE-CHAR MATCHANY
         CB,R0    CARDIMG,X2
         BE       FM20              B IF MATCHING CHARACTER
*        MATCH FAILED.  BACK UP TO START OF LAST FIXED PART
         LI,X1    0                 CLEAR FIXED MATCHANY MEMORY
         STB,X1   MANYP
         LW,X1    T1                RESTORE SAMPLE POINTER
         LW,X2    T2                RESTORE SEARCH STRING POINTER
         AI,X2    1                 ADVANCE FIRST-CHARACTER SEARCH
         B        FM10
*
FM30     RES      0                 MATCH ANY STRING
         CI,X1    1
         BNE      %+2               B IF NOT FIRST MATCH
         LW,R1    X2                SAVE START OF FIRST MATCH
         STW,X2   MANYP             AND START OF ANY STRING
         MTW,1    MANYP             MAKE COLUMN 1 WORK TOO
         AI,X1    1                 ADVANCE SAMPLE POINTER
         B        FM10              SEARCH FOR START OF NEXT FIXED PART
*
FM90     RES      0                 SUCCESS
         LW,R0    X2                SAVE END+1 OF SEARCH STRING
         MTB,0    MANYP
         BNEZ     FM91              GOT SOME FIXED LENGTH ANYS
         MTW,0    MANYP
         BEZ      FM92              NONE AT ALL
         MTW,-1   MANYP
         SW,T2    MANYP             GET SIZE OF THE ANY
         STB,T2   MANYP
FM91     LW,T1    MANYP
         LB,T2    MANYP
         STW,T1   MANYF             SET THEW FLAG
         SCS,T2   -8
         AI,T2    BA(COMPRIMG)
         MBS,T1   BA(CARDIMG)
FM92     PULL     (X1,T2)
         LW,P1    R0
         LCI      0
         B        0,LNK
*
FM95     RES      0                 FAILURE
         PULL     (X1,T2)
         LCI      8
         B        0,LNK
         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
         LI,X2    0
         STW,X2   MANYP
*
*  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
         CI,X2    3                 IF SPECIAL, MOVE FROM
         BGE      MS9               MOVE FROM MATCH STRING
         MTB,0    MANYF             ANYTHING THERE
         BNEZ     %+1,X2
         B        MS9               ZERO OR NOTHING TO PUT
         B        MS7               FGIXED LENGTHG
         LW,X2    MANYP
         CB,X2    MANYF
         BL       %+4
         LI,X2    0
         STW,X2   MANYP
         B        MS8
         AI,X1    1                 REDO THIS CHAR
         AI,P2    -1
MS7      LW,X2    MANYP
         CB,X2    MANYF
         BGE      MS8
         MTW,1    MANYP
         LB,X2    COMPRIMG,X2
MS9      RES
         STB,X2   CARDIMG,P1
         AI,P1    1                 INCR COLUMN
         CI,P1    MAXCLMN
         BGE      MS20              HAS END OF BUFFER BEEN PASSED
MS8      RES
         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
******************************************************
*  CALCULATE ACTUAL SIZE OF STRING TO BE PUT         *
*    RETURNS NUMBER OF CHARS IN P3                   *
******************************************************
STRINGSIZE RES
         LB,P3    *X2               SIZE IN CDT
         MTB,0    MANYF
         BEZ      0,LNK             NO POSSIBLE VARIAIONT
         PUSH     (X1,LNK)
         LI,X1    0
         LI,P1    0
         LW,LNK   P3
STR10    AI,X1    1
         LB,P2    *X2,X1
         CI,P2    1
         BNE      STR40
         AI,P3    -1                MAY NOT BE THERE
         CB,P1    MANYF
         BGE      %+3
         AI,P3    1
         AI,P1    1
STR40    CI,P2    2
         BNE      STR60
         SW,P3    P1
         AI,P3    -1
         LB,P2    MANYF
         AW,P3    P2
         LI,P1    0
STR60    BDR,LNK  STR10
         PULL     (X1,LNK)
         B        0,LNK
         PAGE
******************************************************
*  PROCESS COLUMN NUMBER PAIR                        *
******************************************************
*
PRC%CLM%CL%DFL RES 0                PROCESS COLUMNS, WITH SE/ST/CL, ETC.
*                                   .. COMMAND DEFAULTS
         PUSH     (X1,LNK)
         LW,P1    FRSTCLMN          L/FIRST COLUMN, USE AS DEFAULT
         LW,P2    LASTCLMN          L/LAST COLUMN, USE AS DEFAULT
         B        PP05              B; MERGE W/COMMON CODE
*
PROCESSCOL#PAIR   EQU %
         PUSH     (X1,LNK)          SAVE REGS
         LI,P1    0                 SET P1=DFLT STARTING COL. #
         LI,P2    MAXCLMN               P2=DFLT STOPPING COL. #
PP05     ;
         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  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      %
         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    MTW,0    RP%FLAG
         BNEZ     CHK%TRUNC         CHECK TO SEE IF RECORD TRUNCATED
         STW,X1   EODCLMN           STORE LAST COLUMN (BYTE INDEX)
         AI,X1    1
         STW,X1   RECSIZE           AND RECORD SIZE (TRUE BYTE COUNT)
         PULL     (X1,X2)
         B        0,LNK             EXIT
CHK%TRUNC MTW,1   TRUNC%REC%FLG     GUILTY UNTIL PROVEN INNOCENT
         LI,X2    0
         AI,X1    1                 ACTUAL RECORD SIZE
         CW,X1    RECSIZE
         BG       %+2               B/ RECORD TRUNCATED
         STW,X2   TRUNC%REC%FLG     CLEAR RECORD TRUNCATED FLAG
         PULL     (X1,X2)
         B        0,LNK
         PAGE
***************************************************
*  SHIFT STRING LEFT                              *
*    P1 = COLUMN AT WHICH TO START SHIFT          *
*    P2 = WIDTH OF FIELD STARTING AT THIS COLUMN  *
*    P3 = DISTANCE TO SHIFT LEFT                  *
*    D0 = RETURNS ZERO IF NOTHING MOVED           *
***************************************************
*
*
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      LW,D0    R1                IS WIDTH OF FIELD TO SHIFT ZERO
         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        SL5               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,P1   FIELDCNT          SAVE STARTING CLOUMN
         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
         AW,P1    R1                POINT TO LAST NON-BLANK
         CW,P3    BLANKCNT          ARE ENOUGH BLNKS COMPRESSED YET
         BLE      SR8               YES
         AW,P1    R2
         AI,P1    1
         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
         LW,X1    P1                FIRST CHAR TO MOVE
         AI,X1    -1
         LW,X2    R2
         AW,X2    X1                FIRST DESTINATION
SR10     CW,X1    FIELDCNT          ANYTHING (MORE) TO MOVE
         BL       SR20A             DONE
*
*  DO CURRENT SHIFT, THEN CHECK NUMBER LEFT TO DO
*
SR15     LB,T2    CARDIMG,X1        COMPRESS FIELDS
         STB,T2   CARDIMG,X2
         AI,X2    -1
SR16     AI,X1    -1
         CI,T2    ' '               ONLY MOVE ONE BLANK BETWEEN FIELDS
         BNE      SR10
         MTW,0    BPFLAG            UNLESS BLANK PREVERVATING
         BNEZ     SR10
         CB,T2    CARDIMG,X1        IS NEXT A BLANK TOO
         BE       SR16              YUP
         B        SR10
*
*  ALL SHIFTS DONE, SO BLANK OUT CLEARED CHARS ON LEFT
*
SR20A    LI,T2    ' '               BLANK OUT
         STB,T2   CARDIMG,X2
         AI,X2    -1
         CW,X2    FIELDCNT          ARE WE DONE YET
         BGE      %-3
         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
         SW,P3    BLANKCNT          P3=# OF NONBLANKS TO REMOVE
         LI,X1    MAXCLMN
SR52     LB,T2    CARDIMG,X1        FIND ENOUGH NONBLANKS TO SCRATCH
         AI,X1    -1
         CB,T2    CARDIMG,X1
         BNE      %+3
         CI,T2    ' '               ONLY COUNT ONE BLANK FROM A
         BE       SR52              STRING OF THEM
         BDR,P3   SR52
         AI,X1    -1
         B        SR71
*
*  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
         LI,X1    MAXCLMN-1          BLANK OUT
         SW,X1    P3                SET X1=END OF 'FROM' FIELD
SR71     RES
         LI,X2    MAXCLMN-1             X2=LAST COLUMN ON CARD
         B        SR10
*
*  ABUTTING FIELD IS SHIFTED OFF CARD, SO SET UP TO BLANK OUT
*
SR72     RES
         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)
         CAL1,1   FPRSTAC           RESET READ/WRITE ACCOUNTS
         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
         CAL1,1   FPRSTAC           RESET READ/WRITE ACCOUNTS
         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         *
*    CC1=1 IF LAST SEQ # PASSED; CC1=0 OTHERWISE  *
***************************************************
*
*
DELETE   EQU      %
         PUSH     (P1,LNK)          PUSH REGS
         LI,R2    STL33             SET RETURN FROM BREAK
         STW,R2   INTRTN
         LW,R2    P1                SAVE START
*
*        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
         STW,R1   DELNXT
         CW,P2    R1                NO - WAS INPUT SEQ # >= LAST SEQ #
         BLE      DL15              YES - GO FINISH UP
         LW,P1    DELNXT
         AI,P1    1
         BAL,LNK  READNXTRANDOM     READ N+1
         LW,LNK   DELETELIMIT       CHECK LIMIT
         CW,LNK   DELETED%REC%CNT
         BLE      DL40              ENOUGH
         LW,LNK   DELNXT
         STW,LNK  INTFLAG1
         MTB,3    DELNXT            SET BYTE COUNT
         MTW,1    DELETED%REC%CNT   COUNT IT
         BAL,LNK  INOUT             RETURN IF F:EI OPEN INOUT OR OUT
         M:DELREC F:EI,(KEY,DELNXT) DELETE N
         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
         LW,LNK   DELETELIMIT
         CW,LNK   DELETED%REC%CNT
         BLE      DL40              FLICK IT IN
         DO1      MODE=2
         STW,R1   INTFLAG1
         MTW,1    DELETED%REC%CNT
         BAL,LNK  DELETERECORD1     WAS HIT, DELETE IT.
         BAL,LNK  DL21              TYPE A MESSAGE..MAYBE
         PULL     (P1,LNK)          PULL REGS
         LCI      0
         B        0,LNK             EXIT WITH CC1=0
*
*  LAST SEQ # WAS PASSED: EXIT WITH CC1=1
*
DL20     LI,LNK   DL25
DL21     LW,P1    DELETED%REC%CNT   MESSAGE IF MORE THAN ONE
         BDR,P1   STL34
         CW,R2    P2                OR IF ONE AND MORE EXPECTED
         BNE      STL34
         B        0,LNK             ELSE NOTHING
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
*
* ERROR: TOO MANY TO BE DELETED
*
DL40     LI,P2    BA(MVEMSG2)+13    OUPUT A CUTOFF MSG
         LW,P1    INTFLAG1
         BAL,LNK  MOVESEQ           PUT IN MSG LAST DELETED REC
         GEN4     0,0,0,0
         AI,R1    12                SET NSG SIZE
         STB,R1   MVEMSG2
         LW,R1    DELNXT            GET FIRST TO BE SAVED
         BAL,LNK  TYPEMSG
         DATA     MVEMSG2
         B        DL20
         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
         LI,R1    O2%SN
         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.
         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
         LI,X1    -4
         SCS,D0   -12
BADIO2   LI,X2    15
         AND,X2   D0
         LB,X2    HEXCHAR,X2
         STB,X2   ERRM28+5,X1
         SCS,D0   4
         BIR,X1   BADIO2
         LI,X1    5
         PUSH     10
         LH,10    F:ERRMSG
         CI,10    X'20'
         BANZ     %+2
         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
BADIOBAD PULL     10
         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)'
         LI,X3    0
         PUSH     X3
         B        STOPLASTCMD
         PAGE
*****************************
*  DELETE LAST RECORD READ  *
*****************************
*
*
DELETERECORD      EQU %
         LW,D1    SV1STSET          IF ONLY ONE RECORD TO CONSIDER
         CW,D1    LASTSET           ...
         BE       DELETERECORD1     DONT..
         MTW,1    DELETED%REC%CNT   COUNT IT
DELETERECORD1 RES
         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    6
         MTW,0    CONSEC%FILE
         BNEZ     %+2               USE ALL CHARS IF CONSEC
         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
         MTW,0    CONSEC%FILE
         BNEZ     MQ20
         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
         MTW,0    CONSEC%FILE
         BNEZ     MQ25
         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
         LI,X1    0                 CLEAR WILD CHAR MEMORY
         STW,X1   MANYF
         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.
         LI,R1    O%SN
         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
         LW,X1    F:EI+5            CHECK IF KEYED
         CI,X1    X'10'
         BANZ     %90               NOPE.
         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
         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
         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
         LI,R1    O2%SN
         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
*
* CONCATENATE A LIST OF TEXTC STRINGS INTO COMPRIMG, CREATING A
* TEXTC STRING.
*
CONCAT ;
         PUSH     (X2,P2)
         LI,P1    BA(COMPRIMG)+1    L/ADR OF DESTINATION BUFFER
CONCAT5 ;
         LW,X2    0,LNK             L/POINTER (POSSIBLY) TO SOURCE TEXTC
         MTB,0    X2                LOOK AT BYTE 0 OF POINTER
         BNEZ     CONCAT9           B/NON-ZERO; IT'S AN INSTRUCTION
         SLS,X2   2                 CONVERT TO BA
         LB,P2    0,X2              L/SIZE (FROM TEXTC BC)
         STB,P2   P1                S/SIZE IN MBS CONTROL WORD
         MBS,X2   1                 MOVE STRING
         AI,LNK   1                 INC POINTER INTO LIST
         B        CONCAT5           B
CONCAT9 ;
         AI,P1    -BA(COMPRIMG)-1   - BA(BUF); G/SIZE
         STB,P1   COMPRIMG          S/SIZE
         PULL     (X2,P2)
         B        0,LNK             RETURN
         PAGE
***********************************************
*  INITIALIZE OPEN FPT                        *
*    P1 = ADDR OF FILE ID IN CDT              *
*          R1= FPT ENTRY TO PUT SN IN                         *
** NOTE: THE FPT DEVICE NAME WORD MUST RESIDE DEVNOFS WORDS
**       BEFORE THE FILE NAME WORD.
DEVOFS   EQU      2
*    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      %
         LI,X1    0
         STW,X1   CONSEC%FILE
         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
         LW,X1    =X'07000001'      SET SN CONTROL WORD.
         STW,X1   *R1,X2
*
         LB,X1    *P1               SN THERE?
         BEZ      OI%40             NO IF ZERO LENGTH.
*
         LI,X1    X'100'            INDICATE SIGNIFICANT WDS.
         AWM,X1   *R1,X2
         AI,P1    1                 GET SN.
         LW,X1    *P1
         STW,X1   *R1               STORE IN FPT.
         AI,P1    1                 INCREMENT IX TO DEVICE NAME.
         LW,X1    *P1               GET DEVICE NAME.
         AND,X1   =X'FFFF'          MASK OFF BYTES SET BY GETFILEID.
OI%40    AI,T1    -DEVOFS           CALC ADDR OF DEVICE NAME.
         STW,X1   *T1               SET DEVICE NAME.
         AI,T1     DEVOFS
         AI,P1    1                 INCREMENT IX TO FILE NAME.
         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
         LI,R1    O%SN
         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
***************************************************
*        SWAP INPUT BUFFER WITH EXTRA BUFFER      *
***************************************************
*
*
SWAPBUFS RES      0
         PUSH     LNK
         LI,LNK   (MAXCLMN+3)/4     NR WORDS TO SWAP
         LW,D1    CARDIMG-1,LNK
         XW,D1    COMPRIMG-1,LNK
         STW,D1   CARDIMG-1,LNK     SWAP BUFFER CONTENTS
         BDR,LNK  %-3
         BAL,LNK  SETEOD            DETERMINE SIZE OF RECORD IN CARDIMG
         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),;
                  (ABN,RS%ABN),;
                  (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
         BCS,8    %+2               IF NONE, MUST HAVE DELETED IT
,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    LASTKEY
         AND,R1   XFFFFFF
         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,R1    LASTKEY           RETURN SEQUENCE
         AND,R1   XFFFFFF
         PULL     (LNK,P3)
         LCI      0
         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)
         LCI      8                 NO RECORD READ
         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,(T1,T2) 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
         BLE      RT3               B/0 OR 1 BYTE READ; READ AGAIN
         LI,X4    M:UC              L/ADR OF DCB (SET UP FOR CLEANUP)
         B        RT16              B; MERGE W/CLEANUP CODE
RT3 ;
         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,(T1,T2) 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
         OR,R0    =X'40'            CONVERT LOWER-CASE TO UPPER
         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
         LI,X1    TTYIMG            PREPARE TO THROW THE BATCH CALLING LINS
         LC       *79
         BCS,8    %+5
         INT,R0   J:CCBUF
         MTW,0    CALLEDR8          UNLESS LINKED TO.
         BNEZ     %+2
         EXU      RT12
         OR,R0    =X'40'            CONVERT LOWER-CASE TO UPPER
         STB,R0   TTYIMG            SAVE THE CHARAT BYTE 0
         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      RT8E              B/NON-BLANK; BEGINNING OF 1ST FIELD
*                                   .. AFTER END OF LOAD MODULE NAME/
*                                   .. ACCOUNT/PASSWORD
         BIR,X1   RT8               INC BTD, BRANCH
*
* SEE IF AN EDIT COMMAND (OTHER THAN THE IMPLICIT 'EDIT' OR 'BUILD')
* IS BEING PASSED.  THE FORMAT OF IT WOULD BE:
*
* EDIT.ACCOUNT.PASSWORD  COMMAND  ARGUMENTS
*
* E.G., THE FOLLOWING ARE LEGAL:
*
* EDIT XEQ CMDFILE
* E C FID,1,1
*
*
* LOOK FOR A COMMAND NAME: IT MUST BE ALL ALPHA CHARACTERS.
*
         LW,D1    X1                SAVE THE CMD BTD
RT8E     LB,D0    TTYIMG,X1         L/CHR OF CMD LINE
         CLM,D0   LETTERS           C/CHR W/UPPER-CASE ALPHA
         BIL      %+3               B/UPPER-CASE
         CLM,D0   LCLETTERS         C/CHR W/LOWER-CASE ALPHA
         BOL      RT8G              B/NOT LOWER CASE (OR UPPER)
         BIR,X1   %+1               INC CMD BTD
         CW,X1    R1                C/BTD W/CMD SIZE
         BLE      RT8E              B/MORE CHRS IN CMD
         B        RT9               END OF CMD; NO EXPLICIT PASSED CMD
RT8G ;
         CW,D1    X1                C/SAVED CMD BTD W/CURRENT BTD
         BE       RT9               B/NO ALPHAS IN FIELD JUST EXAMINED
         CI,D0    ' '               C/1ST NON-ALPHA W/BLANK
         BNE      RT9               B/NOT BLANK; NOT EXPLICIT CMD
*
* SO FAR, THE CMD IS OF THE FORMAT:
* E  ALPHAS
*
RT8J ;
         BIR,X1   %+1               INC BTD
         CW,X1    R1                C/BTD W/SIZE
         BG       RT9               B/END OF CMD; NOT EXPLICIT CMD
         CB,R0    TTYIMG,X1         C/BLANK W/BYTE OF CMD
         BE       RT8J              B/BLANK; KEEP SKIPPING BLANKS
         LB,D0    TTYIMG,X1         L/1ST CHR AFTER BLANKS IN CMD
         CI,D0    '.'               C/CHR W/.
         BE       RT9               B/'.'; FILENAME.ACCOUNT, NOT EXPL CMD
         CI,D0    X'40'             CHECK FOR CONTROL CHR (DELIMITER)
         BL       RT9               B/CONTROL CHR; NOT EXPL CMD
         STB,R0   TTYIMG            BLANK THE 'E' (EDIT.ACCOUNT.PASSWORD AFTER
*                                   .. BEING BLANKED PREVIOUSLY); THIS
*                                   .. WILL MAKE THE 2ND FIELD OF THE ORIGINAL
*                                   .. CMD THE 1ST FIELD
RT9      AW,R1    =X'80000'+1       GET SIZE BACK
         B        RT17              CR, THEN EXECUTE COMMAND.
*
RT10     LW,X1    RTADDTBL,X2
RT11     MTW,0    CALLEDR8          CHECK VALUE OF R8 WHEN EDIT WAS CALLED
         BEZ      RT12              B/NOT M:LINK'D TO
         LW,X4    CMND%DCB%ADR      L/ADR OF CURRENT COMMAND DCB
         CI,X4    M:UC              C/ADR W/M:UC
         BE       F:END             B/M:LINK AND READING M:UC; EXIT BACK
RT12     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
RT16 ;
         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,(T1,T2) PULL REGS
         B        0,LNK             EXIT
*
RTCUSUB  BAL,LNK  RT70              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
         LI,D0    2                 IF M:C IS DEVICE, SCRUB BLANKS
         CW,D0    M:C               FROM THE RECORD
         BAZ      RT72
RT71     CI,X4    ' '
         BNE      RT72
         AI,X3    -1
         LB,X4    *X1,X3
         BDR,R1   RT71
RT72     RES
         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  *OUT%DCB%ADR,(BUF,CARDIMG),;
                  (SIZE,*RECSIZE),(BTD,0),WAIT
TYPETTYIMG ;
         M:WRITE  *OUT%DCB%ADR,(BUF,TTYIMG),;
                  (SIZE,*TTYIMGSZ),(BTD,0),WAIT
         M:WRITE  *OUT%DCB%ADR,(BUF,COMPRIMG),;
                  (SIZE,*COMPRIMGSZ),(BTD,0),WAIT
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
         BE       %+3
         CI,R1    5                 OR EOD
         BNE      RTRDABG           B/NOT EOF
         LI,R1    3                 IF READING A DEVICE, QUIT
         CS,R1    M:C
         BE       F:END
         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
**************************************
*  SET KEY FOR READ OR WRITE         *
*    P1 = SEQ. NUMBER TO PUT IN KEY  *
**************************************
*
SETKEY   EQU      %
         STW,P1   KBUF
         LI,D1    3
         STB,D1   KBUF
         MTW,0    CONSEC%FILE
         BEZ      0,LNK
         LW,D1    P1
         SW,D1    F:EI+14
         SW,D1    F:EI+19
         AI,D1    -1
         PUSH     (LNK,P3)          PUSH IN CASE WE GO TO RS%ABN
         M:PRECORD F:EI,(ABN,RS%ABN),(N,*D1)
         PULL     (LNK,P3)          RESTORE STACK
         LCI      0                 SAY WE GOT REC
         B        0,LNK
*
*  SAVE KEY FROM LAST READ
*
SETLASTKEY        EQU %
         PUSH     LNK
         LW,D1    *F:EI+10
         MTW,0    CONSEC%FILE
         BEZ      SETK1
         LI,D1    X'400'            GET REV BIT
         AND,D1   F:EI
         SLS,D1   -10
         AW,D1    F:EI+14
SETK1    RES
         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    TABC%FLAG
         BNEZ     TABX2             B/FORCE-TAB-COMPRESSION SET; MUST EXPAND
         MTW,0    TABX%FLAG
         BEZ      0,LNK             B/ 'TABX OFF' CMND ISSUED
TABX2    ;
         PUSH     (X3,LNK)
         LW,X3    RECSIZE           SAVE RECSIZE
         STW,X3   TRECSIZE
         LI,T1    0                 L/LOGICAL COLUMN -1; ACCOUNT FOR BACKSPACES
         LI,X4    0                 START AT FIRST CHAR. IN CARDIMG
         STW,X4   TABCFLAG          INDICATE DONT COMPRESS
TABX4    LB,P1    CARDIMG,X4        L/CHAR OF CARD
         CI,P1    X'05'             C/CHR W/TAB
         BE       TABX9             B/TAB; EXPAND
         CI,P1    X'08'             C/CHR W/BS
         BNE      %+2               B/NOT BS
         AI,T1    -2                BACKSPACE; DEC POSITION
         AI,T1    1                 INC POSITION
         AI,X4    1
         CW,X4    RECSIZE
         BL       TABX4             B/MORE CHARACTERS IN BUFFER
*
TABX7    LW,X3    RECSIZE           L/RECORD SIZE
         AI,X3    -1                DEC SIZE; G/MAX BTD
         STW,X3   EODCLMN           S/MAX BTD
         PULL     (X3,LNK)          PULL REGS FOR EXIT
         B        0,LNK
*
TABX9    LI,X3    0                 L/INDEX INTO TABS
TABX10   LW,X1    OUT%DCB%ADR
         AI,X1    15
         LB,X1    *X1,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    T1                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.
*
         AI,T1    1
         SW,X1    T1                COMPUTE NUMBER OF BLANKS TO INSERT.
         BEZ      TABX4             IF ZERO, ITERATE.
         LW,T1    OUT%DCB%ADR
         AI,T1    15
         LB,T1    *T1,X3            L/TAB VALUE
         AI,T1    -2                ADJUST
         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    TABC%FLAG
         BNEZ     TABC02            B/FORCE-TAB-COMPRESSION SET
         MTW,0    TABCFLAG          IF NO COMPRESSION NEEDED, EXIT.
         BEZ      0,LNK
         MTW,0    TABX%FLAG
         BEZ      0,LNK             B/ 'TABX OFF' CMND ISSUED
TABC02   ;
         PUSH     (X3,T1)
         LI,X1    0                 L/OLD BUFFER POSITION
         LI,X2    0                 L/NEW BUFFER POSITION
         LI,P1    0                 L/LOGICAL POSITION
TABC10   ;
         LB,T1    CARDIMG,X1        L/CHR OF CARD
         AI,P1    1                 INC LOCIGAL POSITION
         CI,T1    ' '               C/CHR W/BLANK
         BE       TABC45            B/BLANK; TRY TO COMPRESS
         CI,T1    X'08'             C/CHR W/BACKSPACE
         BNE      %+2               B/NOT BACKSPACE
         AI,P1    -2                DEC LOCICAL POSITION FOR BACKSPACE
         STB,T1   CARDIMG,X2        S/CURRENT CHR
         AI,X2    1                 INC NEW BUFFER POINTER
TABC20   ;
         AI,X1    1                 INC OLD BUFFER POINTER
         CW,X1    RECSIZE           C/OLD BUFFER POINTER W/SIZE
         BL       TABC10            B/MORE TO PROCESS
         STW,X2   RECSIZE           S/NEW RECORD SIZE
         MTW,0    RP%FLAG
         BEZ      TABC35            B/NOT RECORD SIZE PRESERVATION MODE
         LW,X3    TRECSIZE          L/'TRUE' RECORD SIZE
         STW,X3   RECSIZE           S/ABSOLUTE RECORD SIZE (TRUE)
         LI,P1    ' '               L/BLANK
TABC30   ;
         CW,X2    TRECSIZE          C/NEW POINTER W/NEW RECORD SIZE
         BGE      TABC35            B/NO MORE TO BLANK
         STB,P1   CARDIMG,X2        C/BLANK
         AI,X2    1                 INC POINTER
         B        TABC30            B
TABC35   ;
         PULL     (X3,T1)
         B        0,LNK
TABC45   ;
         LI,X4    0                 L/INDEX INTO TABS
TABC50   ;
         LW,P2    OUT%DCB%ADR
         AI,P2    15
         LB,P2    *P2,X4            L/TAB VALUE
         BEZ      TABC55            B/NO MORE TABS
         CW,P1    P2                C/CURRENT POSITION W/TAB VALUE
         BL       TABC60            B/FOUND THE NEXT TAB STOP
         AI,X4    1                 INC TAB INDEX
         CI,X4    16                C/TAB INDEX W/MAX
         BL       TABC50            B/MORE TABS
TABC55   LW,X4    X1                SAVE OLD BUF POINTER
         LW,X1    RECSIZE           L/RECORD SIZE; COPY REST OF RECORD
         AI,X1    -1                ADJUST SIZE TO GET INDEX
         B        TABC80            COPY REST OF REC FROM OLD TO NEW
TABC60   ;
         AI,P2    -1                G/VALUE OF TAB - 1
         LW,X4    X1                SAVE OLD INDEX
         AI,X1    1                 INC OLD INDEX
         LI,T1    ' '               L/BLANK
TABC65   ;
         CB,T1    CARDIMG,X1        C/BLANK W/OLD CHR
         BNE      TABC75            B/NOT BLANK
         AI,P1    1                 INC LOGICAL POSITION
         CW,P1    P2                C/LOGICAL POSITION W/TAB STOP VALUE
         BNE      TABC70            B/NOT AT TAB STOP
         LI,T1    X'05'             L/TAB CHR
         STB,T1   CARDIMG,X2        L/TAB IN NEW POSITION
         AI,X2    1                 INC NEW POSITION
         B        TABC20            B
TABC70   ;
         AI,X1    1                 INC OLD POSITION
         CW,X1    RECSIZE           C/OLD POS W/SIZE
         BL       TABC65            B/MORE LEFT TO PROCESS
         B        TABC80            B/END OF REC; COPY REST OF REC
TABC75   ;
         LB,T1    CARDIMG,X1        L/CHR OF CARD (OLD)
         CI,T1    X'08'             C/CHR W/BACKSPACE
         BNE      %+2               B/NOT BACKSPACE
         AI,P1    -2                BACKSPACE; DEC LOGICAL POSITION
         AI,P1    1                 INC LOGICAL POSITION
TABC80   ;
         LB,T1    CARDIMG,X4        L/CHR FROM OLD (SAVED) POSITION
         STB,T1   CARDIMG,X2        S/CHR INTO NEW POSITION
         AI,X2    1                 INC NEW POSITION
         AI,X4    1                 INC SAVED OLD POSITION
         CW,X4    X1                C/SAVE OLD POS W/CURRENT OLD POS
         BLE      TABC80            B/MORE TO COPY
         B        TABC20            B
         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
         LC       *79               IF BATCH, JUST OPEN TO CR
         BCS,8    %+3
         M:OPEN   M:C,(DEVICE,'C')
         B        0,LNK
         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 #
         LH,R0    FLAG,X1           L/FLAGS FOR THIS CMD
         CI,R0    COMPRESSED
         BAZ      TC4               B/NOT TO TYPE IN COMPRESSED FORMAT
         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      %
         LH,R0    FLAG,X1           L/FLAGS FOR THIS CMD
         CI,R0    TYPE%SEQ#
         BAZ      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
         LC       *79               IF NOT ONLINE,
         BCR,8    TC18              NO CR
         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 ;
         MTB,1    LNK               SET FLAG
*
*
TYPEPERR EQU      %
         PUSH     (X1,P1),LNK
         LI,X1    2
         LB,D0    *CDTADR,X1        GET # OF CURRENT CMND
         LW,X2    0,LNK             ADDR OF ERRC/P
         SLS,X2   2
         LW,P1    TPMOV
         MBS,X2   0                 MOVE TO TEMP AREA
         LI,P1    'C'
         LB,X1    LNK               IF P..
         BNEZ     TP10              AND..
         MTW,-1   *CDTBAS%          MORE THAN ONE CMND..
         BLEZ     TP5
         LW,P1    TPMOV             PUT CN BEFORE PN
         AI,P1    2
         MBS,X2   -(TEMPBLCKSZ-4)
         AI,D0    'C0'
         XW,D0    TEMPBLCK
         AI,D0    X'200'
         STH,D0   TEMPBLCK
TP5      LI,P1    'P'
         LW,D0    PARAMPSN          CALC POSITION OF CURRENT PARAMETER
         AI,D0    -2
         SLS,D0   -1
*
*  SEARCH FOR FIRST 'C(P)'
*
TP10     LI,X1    BA(TEMPBLCK)+1
         CB,P1    0,X1
         BIR,X1   %+1
         BNE      %-2
         OR,D0    XF0               CONVERT COUNT TO EBCDIC (MOD 10)
         STB,D0   0,X1               AND PUT IN STRING
         BAL,LNK  TYPEMSG
         DATA     TEMPBLCK
         PULL     (X1,P1),LNK
         B        1,LNK             EXIT
TPMOV    GEN,8,24 TEMPBLCKSZ-4,BA(TEMPBLCK)
         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    X'BF'
         LB,X2    *LNK
*                                   NOW RUN DOWN TO FIRST NON-ZERO
*                                   CHARACTER
         CB,X1    *LNK,X2
         BANZ     %+2               B/NOT BINARY 0 OR BLANK
         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
*
         LC       *79               IF BATCH, NO CR
         BCR,8    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)
         AW,P2    CONSEC%FILE
         BAL,LNK  BINTODEC          CONVERT SEQ # TO EBCDIC: ' DDDDDDD'
         LW,D0    TEMPBLCK+1        PUT A '.' BETWEEN 4TH AND 5TH
         LW,P2    0,X2              SAVE 4-CHARS TO APPEND
         MTW,0    CONSEC%FILE
         BNEZ     TS10
         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
         LI,X1    4                 NOW MOVE IN THE 4-CHARS
         STB,P2   TEMPBLCK,P1
         AI,P1    -1
         SLS,P2   -8
         BDR,X1   %-3
         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 ;
         LI,D1    0
         STW,D1   RL:CHG:STG:CNT
         XW,D1    DONT%WRITE%SE%CONDT RESET DON'T-WRITE-SE-REC FLAG
         BEZ      WRSC10            B/FLAG NOT SET
         LW,T1    SAVED:CHG:STG:CNT
         STW,T1   CHG:STG:CNT       RESET CHANGE COUNTER
         B        0,LNK             DON'T WRITE REC
WRSC10   ;
         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
         MTW,0    TRUNC%REC%FLG     WAS RECORD TRUNCATED?
         BE       %+2               B/ NO
         MTW,1    TRUNC%REC%CNT     COUNT TRUNCATED RECORD
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)
         MTW,1    INPUTSAVER        TRUNC EVERY 15 RECORDS
         BLZ      %+4
         MTW,-8   INPUTSAVER
         MTW,-7   INPUTSAVER
         M:TRUNC  F:EI
         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

