*M*      BATCH2   STRING REPLACEMENT EDITOR FOR BATCH SUBSYSTEM
         PCC      0
         TITLE    'B A T C H - E X E C'
         SPACE
*P*      NAME:    BATCH2
*P*      DESCRIPTION:
*DO*
*P*
*        THIS LOAD MODULE WHEN LINKED TO BATCH PROVIDES
*        OPTIONAL FIELD AND STRING REPLACEMENT WITHIN
*        THE FILE BEING ENTERED INTO THE SYMBIONT JOB
*        STREAM.  THIS VERSION ALSO ALLOWS IMMEDIATE
*        EXPANSION OF THE EXEC COMMAND IF DETECTED IN
*        THE FILE.
*FIN*
         SPACE
         SPACE
         SPACE    2
*        PURE PROCEDURE DEFINITION
         SPACE    1
BATCH2PP CSECT    1
         DEF      BATCH2PP
         SPACE    2
*        DYNAMIC DATA DEFINITION
         SPACE    1
BATCH2DD CSECT    0
         SPACE    2
         DEF      BATCH2DD
         SYSTEM   BPM
*        FPTS IN PURE PROCEDURE
         SPACE    1
,,       M:PT     1
         SYSTEM   SIG7
         SPACE
         SPACE
*        ALTERNATE FILE DCB FOR EXEC EXPANSION
         SPACE
F:ALT    DSECT    1
F:ALT    M:DCB    (KEYED),(SEQUEN),(IN),(SAVE),(FILE),(PASS);
                  ,(SN,4)
         SPACE
         SPACE
*        P R O C   A R E A
         SPACE
EXITC    CNAME
         PROC
EX%R     EQU      AF(1)
         BOUND    8
EX%D     DATA     EX%B
         GEN,1,15,1,15  0,AF(2),0,0
EX%D2    GEN,1,15,1,15  0,AF(2),0,0 TO RESET
EX%B     RES      AF(2)
         PEND
         SPACE
CALL     CNAME
         PROC
LF       BAL,EX%R AF
         PEND
         SPACE
ENTER    CNAME
         PROC
LF       PSW,EX%R EX%D
         PEND
         SPACE
RETURN   CNAME
         PROC
LF       PLW,EX%R EX%D
         LIST     0
         DO       AF(1)>1
         AI,EX%R  AF(1)-1
         FIN
         B        *EX%R
         LIST     1
         PEND
         SPACE
         SPACE
*        PROC FOR RESETTING EXIT CONTROL
         SPACE
EXITCR   CNAME
         PROC
         LIST     0
         LI,AF    EX%B
         STW,AF   EX%D
         LW,AF    EX%D2
         STW,AF   EX%D+1
         LIST     1
         PEND
STEP     CNAME
         PROC
         LIST     0
LF       AI,AF(1) AF(2)
         CW,AF(1) AF(3)
         BG       AF(4)
         LIST     1
         PEND
         SPACE
         PAGE
         SPACE
*        SYNTAX SCANNING PROCEDURE
         SPACE
SCAN     CNAME    1                 FORWARD SCAN
SCANR    CNAME    0                 REVERSE
         PROC
         LIST     0
         DO       NAME
LF       AI,IP    1                 FORWARD
         ELSE
LF       AI,IP    -1                REVERSE
         FIN
         CW,IP    CEND
         BG       CF(2)
         LB,R     *BASE,IP
I        DO       NUM(AF)
         CW,R     SCANL+AF(I,1)
         DO       AFA(I,1)
         BNE      AF(I,2)
         ELSE
         BE       AF(I,2)
         FIN
         FIN
         B        LF
         LIST     1
         PEND
         SPACE
COMMA    EQU      0
PERIOD   EQU      1
LPAREN   EQU      2
RPAREN   EQU      3
BLANK    EQU      4
EQUALS   EQU      5
QUOTE    EQU      6
BANG     EQU      7
E        EQU      8
SS       EQU      9                 'S'
TT       EQU      10
P        EQU      11
         SPACE
         SPACE
         USECT    BATCH2PP          SET TO PURE PROCEDURE
*
*        THIS DATA LIST IS PARALLEL TO ABOVE EQU LIST
         SPACE
SCANL    DATA     ',','.','(',')',' ','=',X'7D','!','E'
         DATA     'S','T'
         DATA     'P'
         PAGE
         SPACE
         USECT    BATCH2DD          SET TO DYNAMIC DATA
*        BUFFER AND CONSTANT AREA TO BE SAVED
*        WHEN PROCESSING AN IMMEDIATE EXEC EXPANSION
         SPACE
         BOUND    8
BSAVE    EQU      %                 BEGIN OF SAVE AREA
         SPACE
DUMMY    RES      2
SLIST    RES      200               REP TABLE
SDATA    RES      470
PDLIST   RES       50
         SPACE
         SPACE
PDX      DATA     -1
BEGDEF   DATA     0
SPEND    DATA     0
COUNT    DATA     0
SPOINT   DATA     0
SPCOUNT  DATA     0
SAVESP   DATA     0
ORIGSP   DATA     0
ORIGSPC  DATA     0
         SPACE
*        THE SAVE AREA TOTALS THREE PAGES
         SPACE
         SPACE
         SPACE
         SPACE
*        B U F F E R   A R E A
         SPACE
         SPACE
CLIST    RES      256               REPLACEMENT MATRIX
SAVEREG  RES      16
OUT      RES      64                256 BYTE OUTPUT AREA
         BOUND    8
COMMAND  RES      64                256 BYTE COMMAND AREA
OPEN     RES      25
         SPACE
         SPACE
*        C O N S T A N T   A R E A
         SPACE
         SPACE
CEND     RES      1
BASE     DATA     COMMAND           POINTER
FCODE    DATA     X'0F000000'
NULL     DATA     X'FF'
SUB      DATA     0
BG       DATA     0
ABORT    DATA     0
ALLOWEX  DATA     0                 SWITCH FOR (E)
MEISET   DATA     0                 (S( OPTION SWITCH
TYPSET   DATA     0                 FOR TYP OPTION
PRINTSET DATA     0                 SET FOR PRINT OPTION
EXECCNT  DATA     0                 RECORD COUNT FOR EXEC FILE
MAINCNT  DATA     0                 RECORD COUNT FOR MAIN FILE
GREPREQ  DATA     0                 SET IF STRING REP ON BATCH COM
REPREQ   DATA     0                 SET IF DEFAULT OR EXEC
REPMADE  DATA     0                 SET IF STRING REP MADE
BADRET   DATA     0
EXSW     DATA     0
FIRFID   DATA     0
DIAG     DATA     COMMAND           POINTER
ESDATA   DATA     470
EDIAG    DATA     0                 LENGTH OF IMAGE
MODE     DATA     0                 0=BATCH OR ONLINE.1=GHOST
EDATA    DATA     0
SPAGE    DATA     0
HIP      DATA     0
COMMAX   DATA     255               MAX CHAR IN COMMAND
CARDMAX  DATA     255               MAX CHAR IN CARD
TELARS   DATA     0
ARG      DATA     0
MODSW    DATA     0
FROM     DATA     BA(COMMAND)
ONLINE   DATA     -1
         BOUND    8
RANDR1SAVE RES    2
         SPACE    1
*        THE NEXT TWO TEXT LINES MUST BE TOGETHER. THEY
*        ARE LINKED BEFORE PRINTING
ERMS     TEXTC    '***** WHILE PROCESSING FILE '
ERM2     TEXT     '                              '
         TEXT     '            '    FOR THE ACCOUNT # AND .
DATALOST DATA     X'1CC4C1E3'
         TEXT     'A LOST ON RECORD'
RECNUM   DATA     '    ','    '
QMSG     TEXTC    '***** JOB ABORTED'
GPMSG    TEXTC    '***** CANT GET DYNAMIC PAGE'
SM1      TEXTC    '***** SYNTAX ERROR IN ABOVE LINE'
OLM      TEXTC    '***** MODIFIED DATA RECORD EXCEEDS 80 BYTES'
SLM      TEXTC    '***** TOO MANY DATA REPLACEMENT REQUESTS'
COMSG    TEXTC    '***** COMMAND TOO LONG'
NOREPMADE TEXTC   'NO REPLACEMENTS MADE '
NOEIM    TEXTC    '***** M:EI FILE NOT SPECIFIED'
         SPACE    2
         USECT    BATCH2PP          SET TO PURE PROCEDURE
         SPACE    2
CPOINT   GEN,8,24 X'01',BA(CARD)
         BOUND    8
BANGB    TEXT     '!BATCH  '
MVCD     GEN,8,24 255,BA(CARD)
EOF      TEXT     'EOF '
DEFAULT  TEXT     'DEFAULT '
EOFEX    TEXT     'EOF EXEC '
EXX      TEXT     '!EXEC '          BANG EXEC
         SPACE
         BOUND    4
         SPACE
RU1EOF   GEN,8,24 3,BA(EOF)
RU1EX    GEN,8,24 6,BA(EXX)
RU1DEF   GEN,8,24 7,BA(DEFAULT)
RU1EOFX  GEN,8,24 8,BA(EOFEX)
         SPACE
SDSP     LB,R     SDATA,X           FOR ANLZ INSTR ONLY
SPMAX    DATA     100               NR OF 2 WD ITEMS
INEND    DATA     254               MAX INPUT LENGTH
         PAGE
         SPACE
         SPACE
*        R E G I S T E R   A S S I G N M E N T
         SPACE
IP       EQU      1
SP       EQU      2
CP       EQU      3
X        EQU      4
OP       EQU      X
X1       EQU      5
R        EQU      6                 MUST BE EVEN
R1       EQU      7                 MUST FOLLOW R
R3       EQU      8
TREG     EQU      9
         SPACE
         SPACE
         USECT    BATCH2DD          SET TO DYNAMIC DATA
*
*        SUBROUTINE ENTER/EXIT CONTROL
         SPACE
         EXITC    15,7              REG 15, NEST=5
         SPACE
         REF      CARD
         REF      J:JIT             JOB INFORMATION TABLE
         REF      J:CCBUF           CMND IMAGE IN JIT
         REF      M:C               DCB USED TO READ COMMAND
         REF      ARS
         REF      READREC
         REF      M:UC
         REF      M:EI
         REF      F:BATCH
         REF      J:ACCN
         REF      ALTBACK
         REF      ABNADD2
         REF      FLAG
         REF      PRIOR
         REF      BIN2BCD
         SPACE
         DEF      MOD1,MOD2,ABORT,COMMAND
         DEF      ALTREAD,EXSW,MODE,TYPSET
         DEF      OPEN:ERR
         DEF      PRINTSET
         DEF      EXECCNT
         DEF      MAINCNT
         DEF      DATALOST
         DEF      RECNUM
         DEF      PRINT
         DEF      GREPREQ
         DEF      REPREQ
         DEF      REPMADE
         DEF      NOREPMADE
         USECT    BATCH2PP          SET TO PURE PROCEDURE
*
*
         SPACE
         SPACE
         TITLE    'BATCH MODIFICATION ROUTINE #1'
         SPACE
*        MOD1 IS CALLED FROM BATCH WHEN THE BATCH
*        COMMAND IS IN J:CCBUF BETWEEN R1 AND R3
         SPACE
MOD1     LCFI     0
         STW,15   BADRET
         STM,0    SAVEREG           SAVE EVERYTHING
         LI,R     0
         STW,R    MODSW             FOR ERRET ROUTINE
         M:PC     '%'
         EXITCR                     RESET EXIT CONTROL
         LI,SP    0                 RESET SP POINTER
         SPACE
*        CHECK IF IN GHOST MODE AND GET OPERATORS COMMAND
         SPACE
         LCF      J:JIT
         BCR,4    NONGHOST
AGAIN    LI,R     -1
         STW,R    HIP               FLAG FOR KEYIN
         M:KEYIN  (MESS,GPROMPT),(REPLY,COMMAND+2),;
                  (SIZE,130),(ECB,HIP)
         LI,R     1
         STW,R    MODE              MODE=GHOST
         LW,R     HIP
         BLZ      %-1               WAIT FOR KEYIN
         LB,3     COMMAND+2         COUNT BYTE
         BEZ      AGAIN             IF COUNT=0
         AI,3     7                 TRUNC CAR RET AND CONV TO INDEX
         STW,3    SAVEREG+3         FOR BATCH
         MTW,1    SAVEREG+3
         LI,R     ' '
         STB,R    COMMAND+2         BLANK OUT CHAR 1
         LD,R     BANGB             8 CHAR PRE-COMMAND
         STD,R    COMMAND
         SPACE
*        OPEN F:BATCH TO OC IF GHOST
         M:CLOSE  F:BATCH,(SAVE)
         SPACE
         M:OPEN   F:BATCH,(DEVICE,'OC')
         B        MOD1A
         SPACE
GPROMPT  TEXTC    'ENTER BATCH REQUEST '
NONGHOST EQU      %
         BCS,8    NONBATCH          IT'S ON-LINE...
* READ (INSTEAD OF MOVE) FIRST COMMAND IN BATCH
         M:READ   M:C,(BUF,COMMAND),(SIZE,80),(ABN,ABREAD)
         B        ANYMODE           SKIP COMMAND MOVE
NONBATCH EQU      %
         SPACE
         SPACE
* MOVE RECORD FROM J:CCBUF INTO COMMAND SO IT CAN BE
* TEMPORARILY MODIFIED
         SPACE
         LI,R     BA(J:CCBUF)
         LI,R1    BA(COMMAND)
         STW,R1   FROM
         AW,R1    =X'50000000'      COUNT=80
         MBS,R    0
         SPACE
         SPACE
ANYMODE  EQU      %
         LI,R     0
         LCF      J:JIT             ON/OFF LINE BIT
         BCR,8    %+2
         AI,R     -1
         STW,R    ONLINE            -1 IF ON-LINE; 0 IF OFF
         LI,R     COMMAND
         STW,R    BASE
         STW,R    DIAG
         AW,3     ONLINE            ELIM CAR RET IF ONLINE
         STW,3    CEND              TEMPORARY LAST CHAR
         SPACE
*        IF LAST NON-BLANK CHARACTER IN COMMAND IS
*        SEMICOLON, READ NEXT RECORD AS CONTINUATION.
*        CONTINUE UNTIL RECORD WITHOUT SEMICOLON IS READ
         SPACE
MCC      LB,12    COMMAND,3
         CI,12    ' '
         BNE      MC2
         BDR,3    MCC
         B        MOD1A
MC2      CI,12    ';'
         BNE      MOD1A
         ANLZ,6   MCC
         SLD,6    -2                6= WA(NEXT READ)
         SLS,7    -30               7= DISPLACEMENT FOR READ
         M:READ   M:C,(BUF,*6),(BTD,*7),(SIZE,80),(ABN,ABREAD)
         LCF      J:JIT
         BCS,12   MC3               DON'T NEED TO PRINT THE RECORD
*                                   FOR THE ONLINE USER
         M:WRITE  F:BATCH,(BUF,*6),(BTD,*7),(SIZE,80)
MC3      EQU      %
         LW,R     M:C+4
         SLS,R    -17
         AW,R     ONLINE            TRUNC CAR RET IF ONLINE
         AW,3     R                 NEW LENGTH OF COMMAND
         AI,3     -1                CONVERT TO INDEX
         CW,3     COMMAX            BUFFER FULL?
         BL       MCC               OK. IS THIS CONTINUE TOO?
         B        COMMER            TYPE MESSAGE
         PAGE
         SPACE
MOD1A    STW,3    CEND              INDEX OF LAST NON BLANK
         AI,3     1
         STW,3    EDIAG             IN CASE DIAG ERR
         SPACE
*        CHECK FOR SPECIAL PARAMETERS FOLLOWING THE
*        BATCH COMMAND.  THESE ARE ENCLOSED IN PARENS
*        AND MAY BE 'E' TO ALLOW IMMEDIATE EXPANSION
*        OF EXEC COMMANDS, OR 'S' INDICATING THE USER
*        HAS SPECIFIED HIS INPUT FILE VIA A SET OR
*        ASSIGN COMMAND, OR 'T' TO REQUEST PRINTING
*        OF ANY MODIFIED RECORDS.
         SPACE
         LI,R1    ' '
         LI,IP    0                 SCANNER
         SPACE
LE1      SCAN,S   (*BLANK,LE2) IP TO 'B' OF 'BATCH'
LE2      SCAN,S   (BLANK,LE3),(LPAREN,LE4) TO BLANK OR '('
LE3      SCAN,S   (LPAREN,LE4),(*BLANK,MOD1B) IP TO '('
LE4      STB,R1   *BASE,IP          CLEAR OUT '('
LE5      SCAN,S   (E,LEE),(SS,LES),(TT,LET),(P,LEP),(COMMA,LE6),;
                  (RPAREN,LE7),(*BLANK,S)  CHECK FOR 'E' OR 'S'
*                                      OR 'T' OR 'P'
LE6      STB,R1   *BASE,IP          CLEAR IT OUT
         B        LE5               CHECK AGAIN
LE7      STB,R1   *BASE,IP          CLEAR ')'
         STW,IP   HIP               SAVE SCANNER
         B        MOD1B
         SPACE
*        'E' WAS FOUND. SET ALLOWEX SWITCH
         SPACE
LEE      LI,R     -1
         STW,R    ALLOWEX
         B        LE6               CHECK FOR 'S'
         SPACE
*        'S' WAS FOUND. SET MEISET SWITCH
         SPACE
LES      LI,R     -1
         STW,R    MEISET
         B        LE6               CHECK FOR 'E'
         SPACE
LET      MTW,1    TYPSET            SET SWITCH FOR TEST MODE
         B        LE6
         SPACE    2
*
*        'P' WAS FOUND  SET PRINTSET SWITCH
*
LEP      MTW,1    PRINTSET          SET SWITCH FOR PRINT MODE
         B        LE6
         SPACE
         SPACE
*        IF 'S' OPTION WAS SPECIFIED ON COMMAND LINE,
*        CHECK THE M:EI DCB TO INSURE USER HAS IN FACT
*        SPECIFIED A FILE.
         SPACE
MOD1B    LW,R     MEISET            -1 IF SET
         BEZ      MOD1C             NOT SET
         SPACE
         LI,1     1
         LI,3     3
         LI,2     M:EI+22           FIRST OF VARIABLE PARAS
         SPACE
MML      LB,R     *2                CODE BYTE
         CI,R     1                 IS IT CODE 1
         BNE      MMNZ              NO, TRY TYPE 7
MMGOT    LW,R     *2,1              FIRST DATA WORD
         BNEZ     MMOK              THERE IS A NAME THERE
MMCL     LB,R     *2,1              MORE VARIABLE PARAS
         BGZ      NOEI              ERROR MESSAGE,ABORT
         LB,R     *2,3              COUNT
         AW,2     R                 STEP POINTER TO NEXT
         AI,2     1
         B        MML               LOOP
MMNZ     CI,R     7                 CODE 7
         BE       MMGOT             YES
         B        MMCL              NO, CHECK NEXT
         SPACE
*        M:EI HAS BEEN SET BY USER
         SPACE
MMOK     LW,IP    HIP               RESTORE SCANNER
         LI,R     READREC-1         TO RETURN TO BATCH AFTER OPEN
         STW,R    SAVEREG+15
         LI,R     -1
         STW,R    FLAG              SO BATCH WONT LOOK FOR MORE
         STW,R    PRIOR
         LI,SP    0                 RESET SP (REG 2)
MMOK1    SCAN,MSAVE (*BLANK,M4)     TO M4 IF REP REQUESTS
         SPACE
MOD1C    EQU      %
         SPACE
         SPACE
*        POSITION IP AFTER ALL FILE NAMES, TO FIRST
*        CHARACTER OF REPLACEMENT DATA IF ANY. ELSE RETURN.
         SPACE
         CALL     LOCFID
         B        NOREPS            IF NO REPLACEMENTS
         MTW,1    GREPREQ           INDICATE A GLOBAL REPLACEMENT REQUEST
         SPACE
*        ALTER SAVED R3 TO FOOL BATCH INTO THINKING
*        THE COMMAND CARD ENDS BEFORE ANY REQUESTS
         SPACE
         STW,IP   SAVEREG+3
         LW,R     MODE              1 IF GHOST
         BNEZ     %+2
         MTW,-1   SAVEREG+3
         LW,R     FIRFID
         STW,R    SAVEREG+1
M4       CALL     PEXEC             PROCESS ARGUMENTS
         B        MSAVE
         SPACE
         SPACE
ABREAD   LI,X     1
         LB,R     M:C,X
         SPACE
         CI,R     6
         BE       MSAVE             IF END DATA
         M:MERC                     IF ANYTHING ELSE
         SPACE
*        RETURN TO BATCH AFTER RESTORING EVERYTHING
         SPACE
SKIP     LI,R     READREC
         STW,R    SAVEREG+15        TO BYPASS THIS RECORD
MDONE    STW,SP   SAVESP
         LCFI     0
         LM,0     SAVEREG
         B        *15
         SPACE
*        HOLD DATA TO RESTORE DEFAULTS LATER
         SPACE
MSAVE    STW,SP   ORIGSP
         LW,R     SPCOUNT
         STW,R    ORIGSPC
         B        MDONE
         SPACE
         SPACE
NOREPS   LW,R     FIRFID
         STW,R    SAVEREG+1         ADJUST FOR BATCH
         STW,IP   SAVEREG+3         SET CMND END FOR BATCH
         B        MDONE
         TITLE    'BATCH MODIFICATION #2'
         SPACE
*        MOD2 IS ENTERED FROM BATCH IMMEDIATELY AFTER
*        READING A LINE FROM USER'S FILE.  THE RECORD
*        IS IN CARD BETWEEN 0 AND ARS.  CHECK FOR ANY
*        SPECIAL COMMANDS FOR REPLACEMENT
         SPACE
MOD2     LCFI     0
         STM,0    SAVEREG           SAVE EVERYTHING
         EXITCR                     RESET EXIT CONTROL
         LI,R     1
         STW,R    MODSW             FOR ERRET ROUTINE
         LW,R     ARS               END OF LINE
         STW,R    EDIAG
         AI,R     -1                CONVERT COUNT TO INDEX
         STW,R    CEND
         LI,R     READREC
         STW,R    BADRET
         LW,SP    SAVESP            RESTORE POINTER
         SPACE
         SPACE
         LI,R     CARD
         STW,R    DIAG              IN CASE ERROR
         STW,R    BASE
         LI,R     BA(CARD)
         STW,R    FROM
         LB,R     CARD
         CI,R     X'5A'             BANG?
         BNE      NBANG
         SPACE
*        WE HAVE A BANG CARD. COLLECT THE FIRST FOUR
*        NON-BLANKS FOLLOWING THE BANG.  IF THEY ARE
*        'EXEC' OR 'DEFA(ULT)' CHECK FOR COMMAND
*        CONTINUATION, ELSE DON'T.
         SPACE
         LI,R     4                 INDEX
         LI,X     1                 CHAR FOLLOWING BANG
PAK      LB,R3    CARD,X            GET NEXT BYTE
         AI,X     1                 STEP INDEX
         CI,R3    ' '               IS IT BLANK
         BE       PAK               YES, GET NEXT
         STB,R3   R1                NO, TAKE THE BYTE
         SCS,R1   8                 PACK IT
         BDR,R    PAK               AND GO FOR MORE UNLESS DONE
         CW,R1    ='EXEC'
         BE       EICON             CONTINUATION POSSIBLE
         CW,R1    ='DEFA'
         BE       EICON             CONTINUATION POSSIBLE
         B        MOD2A             NO CONTINUATION
         SPACE
EICON    LW,X     CEND
LBCX     LB,R     CARD,X
         CI,R     ' '
         BNE      %+2
         BDR,X    %-3
         CI,R     ';'
         BNE      MOD2A
         SPACE
*        READ NEXT AS CONTINUATION (OVER SEMICOLON)
         SPACE
         ANLZ,R   LBCX
         SLD,R    -2
         SLS,R1   -30
         SPACE
*        SEE WHICH FILE WAS BEING READ
         SPACE
         LW,X     EXSW
         BNEZ     XALT              GO READ F:ALT
         SPACE
         M:READ   M:EI,(BUF,*R),(BTD,*R1),(SIZE,80),(ABN,ABREAD)
         LW,R     M:EI+4
XDUN     SLS,R    -17
         AI,R     -1                CONVERT TO INDEX
         AW,R     CEND              NEW LENGTH
         STW,R    CEND
         CW,R     CARDMAX
         BL       EICON             LOOP TO CHECK THIS REC
         B        COMMER            TOO LONG
         SPACE
*        READ F:ALT
         SPACE
XALT     M:READ   F:ALT,(BUF,*R),(BTD,*R1),(SIZE,80),(ABN,ABREAD)
         LW,R     F:ALT+4
         B        XDUN
         SPACE
         SPACE
MOD2A    EQU      %
         LW,R     CEND
         AI,R     1
         STW,R    EDIAG             IN CASE ERROR
         LI,R     BA(CARD)
         AI,R     1
         LB,R1    0,R
         CI,R1    ' '               SKIP LEADING BLANKS
         BE       %-3
         STW,R    EDATA             HOLD FOR CBS
MOD2B    LW,R     EDATA
         LW,R1    RU1DEF
         CBS,R    0                 DEFAULT?
         BE       XPDEF
         LW,R     EDATA
         LW,R1    RU1EOFX
         CBS,R    0                 EOF FROM INIT REQ
         BE       XPEOFEX
         LW,R     EDATA
         LW,R1    RU1EOF
         CBS,R    0                 EOF?
         BE       XPEOF
         SPACE
NBANG    EQU      %
         SPACE
*        WE HAVE A REGULAR DATA CARD
         SPACE
*        BLANK OUT CARD FROM CEND+1 THRU 255
         SPACE
         LW,R     CEND
         AI,R     1
         LI,R1    ' '
         STB,R1   CARD,R
         AI,R     1                 STEP INDEX
         CI,R     300
         BL       %-3               LOOP
         SPACE
         CALL     PI                GO TO PROCESS CARD
         AI,OP    1                 CONVERT INDEX TO COUNT
         STW,OP   ARS               NEW COUNT FOR BATCH
         STW,OP   CEND
         SPACE
*        MOVE MODIFIED CARD IMAGE INTO CARD AREA
         SPACE
         LI,R     BA(OUT)
         LW,R1    MVCD              255,CARD FOR MBS
         MBS,R    0                 MOVE OUT TO CARD
*        SEE IF MODIFIED CARD IS EXEC REQUEST IF ALLOWED
         SPACE
PIDUN    EQU      %                 COME HERE AFTER PI IF NONE
         LW,R     ALLOWEX           SWITCH
         BEZ      MDONE             NOT ALLOWED
         LW,R1    EXSW
         BNEZ     MDONE
         LI,R     BA(CARD)
         SPACE
         SPACE
         LW,R1    RU1EX
         CBS,R    0
         BE       EXEC
         B        MDONE
         SPACE
         PAGE
         SPACE
*        WE HAVE A DEFAULT COMMAND
         SPACE
XPDEF    LI,IP    8
XXZ      SCAN,SERR (COMMA,SERR),(EQUALS,SERR),(*BLANK,XPD1)
XPD1     EQU      %
         MTW,1    REPREQ            INDICATE THAT WE FOUND A DEFAULT
         LW,R     BEGDEF
         LW,X     PDX
         MTW,1    X
         STW,X    PDX
         STB,R    PDLIST,X
         STW,R    SP
         CALL     PEXEC
         B        SKIP
         PAGE
*        PROCESS EXEC COMMAND
         SPACE
EXEC     CALL     LOCFID            IP TO FIRST OF FID
         NOP                        IF NO REP REQUESTS
         STW,IP   3
         STW,IP   DUMMY
         LW,1     FIRFID
         STW,1    ARG
         SW,3     1
         BLZ      SERR
         STW,3    TELARS
         CALL     OPENALT           OPEN ALT FILE
         CALL     SAVE              SAVE FOR RE-ENTERANCE
         LI,R     -1
         STW,R    EXSW              SET SWITCH - IGNORE EXECS
         STW,R    PDX               RESET FOR NEW REPS
         LI,R     0
         STW,R    BEGDEF
         STW,R    SPEND
         STW,R    COUNT
         STW,R    SPCOUNT
         STW,R    SPOINT
         STW,R    SP
         STW,R    SAVESP
         STW,R    ORIGSP
         STW,R    ORIGSPC
         LW,IP    DUMMY
         CW,IP    CEND              ANY REQUESTS?
         BGE      SKIP              NO
         MTW,1    REPREQ            INDICATE THAT WE FOUND EXEC WITH REP
*
*        ELIMINATE CARRIAGE RETURN FROM EXEC CARD IF THERE
*
         LW,R     CEND              INDEX OF LAST CHAR
         LB,R1    *BASE,R           LAST CHAR
         CI,R1    X'0D'
         BNE      %+2               NO, GO ON
         BDR,R    %-3               YES, REDUCE CEND
         STW,R    CEND              SANS CARET
*
         CALL     PEXEC             PROCESS REQUESTS IF ANY
         B        SKIP              GO TO READ ALT FILE
         TITLE    'INTERPRET REPLACEMENT REQUESTS'
         SPACE
         SPACE
PEXEC    ENTER
         MTW,1    SPOINT            STEP TO NEXT EMPTY BYTE
         LW,X     SPOINT
         ANLZ,R1  SDSP              R1= 00:SDATA,SPOINT
         LW,X     CEND              COUNT
         MTW,1    X                 INDEX+1=COUNT
         STB,X    R1                R1=CC:SDATA,SPOINT
         LW,R     FROM              BA(WHERE IT IS)
         MBS,R    0                 INTO NEXT AREA OF SDATA
         LW,R     SPOINT
         AWM,R    IP                ADJUST FOR SDATA
         AW,R     CEND
         STW,R    CEND
         STW,R    SPOINT
         CW,R     ESDATA            BUFFER FULL?
         BG       SLOVFLW           YES   ABORT
         SPACE
*        PROCESS ARG FIELDS BUILDING SLIST
         SPACE
*        ARGUMENTS BETWEEN SDATA(IP) AND SDATA(CEND)
         SPACE
         LI,R     SDATA
         STW,R    BASE
         SPACE
         AI,IP    -1                BACKSPACE IP
P0       SCAN,SERR   (COMMA,SERR),(EQUALS,SERR),;
                     (LPAREN,SERR),(RPAREN,SERR),;
                  (QUOTE,P1),(*BLANK,P4)
         SPACE
*        IP IS AT LEFT QUOTE
         SPACE
P1       CALL     SETBS             SET BEGIN STRING
P1X      SCAN,SERR (QUOTE,P2)
P2       CALL     SETE              SET END
         SPACE
*        IP IS AT END OF LEFT ARG
         SPACE
P3       SCAN,SERR (COMMA,SERR),(QUOTE,SERR),;
                   (EQUALS,P10),(*BLANK,SERR)
         SPACE
*        IP IS AT BEGINNING OF LEFT FIELD
         SPACE
P4       CALL     SETBF             SET BEGIN FIELD
P4X      SCAN,SERR (EQUALS,P5),(BLANK,P2),(COMMA,SERR),;
                   (LPAREN,SERR),(RPAREN,SERR)
P5       CALL     SETE
         SPACE
*        IP IS ON EQUALS BEFORE RIGHT ARG
         SPACE
P10      SCAN,SERR (EQUALS,SERR),(COMMA,SERR),;
              (LPAREN,SERR),(RPAREN,SERR),(QUOTE,P11),(*BLANK,P13)
         SPACE
*        IP IS ON QUOTE AT FIRST OF RIGHT STRING
         SPACE
P11      CALL     SETBS
P11X     SCAN,SERR (QUOTE,P12)
P12      CALL     SETE
P12X     SCAN,P14A   (COMMA,P0),(*BLANK,SERR)
P13      CALL     SETBF
P13X     SCAN,P14 (EQUALS,SERR),(BLANK,P12),(COMMA,P15),;
                  (LPAREN,SERR,),(RPAREN,SERR)
P14      CALL     SETE
P14A     STW,SP   SPEND
         STW,SP   BEGDEF            BEG OF DEFAULT AREA
         MTW,-1   SPEND             FOR NEXT TIME THRU
RETURN   RETURN
RET      EQU      RETURN
P15      CALL     SETE
         B        P0
         PAGE
         SPACE
         SPACE
*        SUBROUTINES TO SET UP SLIST
         SPACE
SETBF    ENTER
         LI,R1    0                 FIELD SWITCH
         ANLZ,R   BIP
         AW,R     FCODE
SETX     STW,R    SLIST,SP
         STW,IP   BG
         AWM,R1   BG                MODIFY IF STRING
         RETURN
         SPACE
SETBS    ENTER
         LI,R1    1                 STRING SWITCH
         ANLZ,R   BIP
         AI,R     1                 CHAR AFTER QUOTE
         B        SETX
         SPACE
SETE     ENTER
         LW,R     IP
         SW,R     BG
         S,R      24
         STW,R    SLIST+1,SP
SETZ     STEP     SP,2,SPMAX,SLOVFLW
         MTW,1    SPCOUNT
         RETURN
         SPACE
BIP      LB,R     *BASE,IP          FOR ANLZ INSTR ONLY
         PAGE
         SPACE
*        REMOVE LAST SET OF DEFAULT REQUESTS
         SPACE
XPEOF    LW,X     PDX
         BLZ      SKIP
         LB,R     PDLIST,X
         STW,R    BEGDEF
         MTW,-1   R
         STW,R    SPEND
         MTW,-1   X
         STW,X    PDX
         MTW,-1   SPCOUNT
         B        SKIP
         SPACE
XPEOFEX  LW,R     PDX
         BGEZ     PFX1              NO DEFAULTS ACTIVE
         SPACE
*        CLEAR OUT ALL EXEC SUBBSTITUTIONS
         SPACE
         LI,R     0
         STW,R    SP
         STW,R    SPOINT
         STW,R    SPCOUNT
         STW,R    SPEND
         B        SKIP
         SPACE
*        GET INDEX OF FIRST DEFAULT ITEM IN SLIST
*        AND ZERO OUT EXEC ITEMS UP TO THAT POINT
         SPACE
PFX1     LI,R1    0
         LB,R     PDLIST            FIRST ITEM PDLIST
         LI,X     0
         B        PFX3
PFX2     STW,R1   SLIST,X           CLOBBER SLIST
         AI,X     1
PFX3     CW,X     R                 DONE?
         BL       PFX2              NO
         SPACE
*        SHIFT INDEX TO GET ADJUSTMENT FOR SPCOUNT
         SPACE
         SLS,R    -2
         LW,R1    SPCOUNT
         SW,R1    R
         STW,R    SPCOUNT           SPCOUNT MODIFIED
         B        SKIP
         SPACE
         SPACE
         SPACE
         TITLE    'MAKE REPLACEMENTS IN DATA IMAGE'
         SPACE
*        CALL     PI                ENTRY BAL
         SPACE
PI       ENTER
         LW,R     SPEND
         BLEZ     PIDUN             IF NO ACTIVE REQUESTS
         LW,R     ABORT             IF ANY ERRORS SO FAR,
         BNEZ     PIDUN             DON'T PROCESS
         LW,R     CPOINT
         LI,IP    CLIST
         STW,R    0,IP
         AI,IP    1
         AI,R     1
         CI,IP    CLIST+256
         BL       %-4
         LI,SP    0
         LI,IP    0                 RESET IP INDEX
         STW,IP   SUB               RESET SUBSTITUTION
         SPACE
PI1      LI,IP    0                 RESET IP INDEX
         SPACE
PI2      LB,R     *BASE,IP          NEXT CHAR
         CW,R     NULL              ALREADY BEEN CHANGED?
         BNE      PI2A
         STEP     IP,1,CEND,PI7
         B        PI2
         SPACE
PI2A     ANLZ,R   PI2               R=00:TO
         LW,R1    SLIST+1,SP        R1=CC:XXX
         BEZ      PI7               IF ZEROED OUT
         LB,R1    R1
         S,R1     24
         AW,R1    R                 R1=CC:TO
         LW,R     SLIST,SP          R=FF:FOR
         LI,R3    0
         STB,R3   R                 R=00:FOR
         CBS,R    0                 COMPARE STRINGS
         STW,R1   CP                POINTS TO TRAILING CH
         BE       PI5
         SPACE
PI6      STEP     IP,1,CEND,PI7
         B        PI2
         SPACE
PI7      STEP     SP,4,SPEND,PI10
         B        PI1
         SPACE
PI5      LW,R     SLIST,SP
         CW,R     FCODE
         BGE      PI8
         SPACE
PI11     LW,R     SLIST+3,SP        R=CC:XXX
         LB,R     R                  R=XX:CC
         LW,R1    SLIST+2,SP         R1=XX:REP
         STB,R    R1                 R1=CC:REP
         STW,R1   CLIST,IP           INTO CLIST
         SPACE
*        ZERO OUT (COUNT-1) ITEMS IN CLIST AND
*        NULL CORRESPONDING INPUT CHARACTERS
         SPACE
         MTW,1    SUB               INC. SUB CTR
         LI,R1    0
         LW,R3    NULL              GET THE NULL CHAR
         LB,R     *BASE,IP          GET THE CHAR
         CALL     DELIMIT           SEE WHAT IT IS
         AI,R3    1                 MAKE IT BINARY ZERO INDICATING THAT
*                                   WAS NOT A DELIMITER
         STB,R3   *BASE,IP
         SPACE
*        GET LENGTH OF SEARCH STRING
         SPACE
         LW,R     SLIST+1,SP        R=CC:XXX
         SLS,R    -24
         STW,R    COUNT             AND SAVE IT
PI12     MTW,1    IP
         MTW,-1   R
         BEZ      PI2
         STW,R1   CLIST,IP
         STW,R    RANDR1SAVE        SAVE R
         LW,R3    NULL              RESTORE THE NULL
         LB,R     CARD,IP           GET THE CURRENT CHARACTER TO CHECK
         CALL     DELIMIT           SEE IF A DELIMITER
         AI,R3    1                 MAKE IT ZERO IF NOT
         STB,R3   *BASE,IP
         LW,R     RANDR1SAVE        RESTORE R
         B        PI12
         SPACE
*        DETERMINE IF CURRENT THING ON INPUT IMAGE IS
*        FIELD OR STRING.  IF STRING, CONSIDER IT NON-HIT
*        SINCE FIELD IS BEING SOUGHT
         SPACE
PI8      LW,X     IP
         MTW,-1   X                 WERE WE AT FIRST CHAR?
         BLZ      PI9
         LB,R     *BASE,X
         CALL     DELIMIT           IS IT A DELIMITER?
         B        PI6               NO
PI9      LB,R     0,CP              TRAILING CHARACTER
         CALL     DELIMIT
         B        PI6
         B        PI11
         SPACE
         SPACE
*        PROCESS TRANSLATE ITEMS FROM 'CLIST'
*        BUILDING NEW CARD IMAGE IN 'OUT'
         SPACE
         SPACE
PI10     LI,CP    0                 INDEX FOR CLIST
         LI,OP    0                 INDEX FOR OUT
         LW,R     SUB
         BEZ      PIDUN             NO MODIFICATION DONE
         MTW,1    REPMADE           INDICATE THAT WE MADE A REPLACEMENT
         SPACE
PI13     LW,R     CLIST,CP
         BEZ      PI15              NULL STRING
         LB,R     R                 R=:CC
         STW,R    COUNT             COUNT ALONE
         ANLZ,R1  OUTBA             R1= 00:OUTBYTE
         STB,R    R1                R1= CC:OUTBYTE
         LW,R     CLIST,CP          R=  CC:FROMBYTE
         LI,R3    0
         STB,R3   R                 R=  00:FROMBYTE
         MBS,R    0                 MOVE STRING INTO OUT
         AW,OP    COUNT
         CI,OP    500               MAX INTERNAL LENGTH
         BG       OUTLERR           TOO LONG
PI15     STEP     CP,1,INEND,PI20
         B        PI13
OUTBA    LB,R     OUT,OP            ONLY FOR ANLZ
         SPACE
         SPACE
*        SEE IF NEW IMAGE IS TOO LONG EXCLUDING
*        EXTENDED TRAILING BLANKS
         SPACE
PI20     AI,OP    -2                TO AIM AT LAST CH
         LB,R     OUT,OP
         CI,R     ' '
         BNE      %+2
         BDR,OP   %-3
         CI,OP    79
         BG       EXEXEC            TOO BIG
         SPACE
*        IF 'T' OPTION SPECIFIED, TYPE OUT EACH
*        LINE THAT IS ALTERED.
         SPACE
         MTW,0    TYPSET            0=NOT SPECIFIED
         BEZ      RETURN            NOT SPEC
         MTW,0    PRINTSET          ARE WE PRINTING EVERYTHING
         BNEZ     RETURN            GET OUT IF WE ARE
         LW,R     OP                INDEX TO LAST CHAR
         AI,R     1
         MTW,0    ONLINE
         BEZ      TYP               BRANCH IF IN BATCH MODE
         LI,R1    X'0D'             CAR RET
         STB,R1   OUT,R             APPEND TO LINE
         AI,R     1                 CONVERT TO LENGTH
TYP      M:WRITE  F:BATCH,(BUF,OUT),(SIZE,*R)
         RETURN
         SPACE
*        IF CARD TOO LONG, CHECK FOR BANG-EXEC
         SPACE
EXEXEC   LW,R     ALLOWEX
         BEZ      OUTLERR
         LI,R     BA(CARD)
         LW,R1    RU1EX
         CBS,R    0
         BNE      OUTLERR           NOT EXEC. ERROR
         RETURN                     CATCH IT LATER
         TITLE    'SUBROUTINE TO CHECK FOR DELIMITER'
         SPACE
* IF CHAR IN R IS A DELIMITER, EXIT TO CALL+2; ELSE CALL+1
         SPACE
         SPACE
*        CALL     DELIMIT           ENTRY
DELIMIT  ENTER
         LI,X     7
         LW,X1    =BA(DLIST)
D1       CB,R     0,X1
         BL       D2
         AI,X1    1
         CB,R     0,X1
         BG       D3
         RETURN                     FOUND NON-DELIMITER
D2       AI,X1    1
D3       AI,X1    1
         BDR,X    D1
         RETURN   2                 R IS A DELIMITER
         SPACE
*        BYTE TABLE OF NON-DELIMITER PAIRS
         SPACE
DLIST    TEXT     'AIJRSZ09:@%%'
         DATA     0                 ADD 00 AS A NON-DELIMITER
         PAGE
         SPACE
*        SUBROUTINE TO POSITION IP AFTER FIDS
         SPACE
LOCFID   ENTER
         LI,IP    0
F00      SCAN,SERR (*BLANK,F0)
         SPACE
*        POSITION TO BLANK AFTER 'BATCH'
         SPACE
F0       SCAN,SERR (BLANK,F1)
         SPACE
F1       SCAN,RET (COMMA,SERR),(PERIOD,SERR),(LPAREN,SERR),;
                  (RPAREN,SERR),(*BLANK,F1A)
F1A      STW,IP   FIRFID
F2       SCAN,RET   (BLANK,F3)
F3       SCAN,RET   (COMMA,F2),(PERIOD,F2),;
                    (LPAREN,SERR),(RPAREN,SERR),(*BLANK,F4)
         SPACE
F4       STW,IP   HIP
F4A      SCANR,SERR (PERIOD,F6),(COMMA,F6),(*BLANK,F5)
         SPACE
F5       LW,IP    HIP
         B        FDUN
         SPACE
F6       LW,IP    HIP
         B        F2
         SPACE
         SPACE
*        IP IS POSITIONED
FDUN     RETURN   2                 NORMAL EXIT
         TITLE    'ALT FILE ROUTINES'
         SPACE
OPENALT  ENTER
         SPACE
         LI,X     -24
         LW,R     ='    '
         STW,R    OPEN+24,X         BLANK OPEN CAL AREA
         BIR,X    %-1
         SPACE
         LCI      6
         LM,0     OPENFILE          OPEN CAL FIXED LENGTH PARAMETERS
         STM,0    OPEN              ARE TRANSFERED TO PAGE
         LW,0     =X'01000808'      GET CONTROL WORD FOR FID
         STW,0    OPEN+6            APPEND TO FIXED LENGTH PARAMETERS
         LW,0     =X'02000202'      GET CONTROL WORD FOR ACCOUNT
         STW,0    OPEN+15           APPEND TO FIXED LENGTH PARAMETERS
         LW,0     =X'03010202'      GET CONTROL WORD FOR PASSWORD
         STW,0    OPEN+18           APPEND TO FIXED LENGTH PARAMETERS
         LW,1     ARG
         LI,2     7
         LI,4     OPEN
         AI,4     7
         LI,3     OPEN
         SLS,3    2                 MAKE BYTE INDEX
         STW,3    6                 SAVE IT
         AI,3     1                 SAVE BYTE FOR TEXTC FORMAT
         LI,5     31                31 CHAR MAX FILENAME
         LI,0     0
         STB,0    *4                ZERO BYTE COUNT
         CALL     TELSCAN           GET FILE NAME
         B        OPENCAL+3
         LW,3     6                 RESTORE BYTE INDEX
         AI,2     9                 ADD POINTER TO ACCOUNT ENTRY
         AI,4     14                ADD POINTER TO DUMMY LOCATION
         LI,5     8                 MAXIMUM ACCOUNT 8 CHACACTERS
         LI,0     0
         STB,0    *4                ZERO BYTE COUNT
         CALL     TELSCAN           GET ACCOUNT
         B        OPENCAL+6
         LW,3     6                 RESTORE BYTE INDEX
         AI,2     3                 ADD POINTER TO PASSWORD ENTRY
         AI,4     1                 ANOTHER DUMMY LOCATION
         LI,5     8                 MAXIMUM PASSWORD 8 CHARACTERS
         LI,0     0
         STB,0    *4                ZERO BYTE COUNT
         CALL     TELSCAN           GET PASSWORD
         B        OPENCAL
         B        SERR                                                 RL3
OPENCAL  EQU      %
         AI,4     -1                DROP BACK TO EXAMINE ACCOUNT
         MTB,0    *4                ACCOUNT PRESENT IN CARD    LINE
         BNEZ     %+4
         LCI      2
         LM,0     J:ACCN            NO: THE LOG-IN ACCOUNT IS USED
         STM,0    OPEN+16
         CAL1,1   OPEN              M:OPEN
         LI,0     0                 SET THE EXEC COUNT TO ZERO
         STW,0    EXECCNT
         RETURN
         SPACE
         PAGE
TELSCAN  ENTER
T1       MTW,-1   TELARS
         BLZ      RETURN
         LB,0     CARD,1            SCAN TEL CMND LINE
         AI,1     1                                                    RL3
         CI,0     ','                MULTIPLE JOBS
         BE       SERR
         CI,0     ' '               IGNORE BLANKS
         BE       T1
         CI,0      X'05'            IGNORE TABS
         BE       T1
         CI,0     '.'               PERIODS ARE DELIMITERS
         BNE      T2
         RETURN   2                 NORMAL EXIT
T2       STB,0    *2,3
         AI,3     1                 INCREMENT INDEX
         MTB,1    *4                KEEP BYTE COUNT
         CB,5     *4                CHECK FOR TRUNCATION
         BGE      T1                CONTINUE
         B        SERR
         PAGE
         SPACE
*        ALTERNATE INPUT CAL (ENTERED BROM BATCH MODULE)
         SPACE
ALTREAD  MTW,1    EXECCNT           COUNT 1 EXEC FILE RECORD
         CAL1,1   READALT           F:ALT
         LI,14    CARD
         LW,1     F:ALT+13
         B        ALTBACK           RETURN TO BATCH
         SPACE
*        END FILE ON F:ALT
         SPACE
EOFALT   M:CLOSE  F:ALT
         CALL     RESTORE
         LI,R     0
         STW,R    EXSW
         LCFI     0
         LM,0     SAVEREG
         B        READREC           RETURN TO BATCH
         PAGE
         SPACE
*        PARAMETER LISTS
         SPACE
OPENFILE GEN,8,7,17 X'14',0,F:ALT
         DATA     X'47000209'
         DATA     ABOPEN
         DATA     1
         DATA     1
         DATA     1
         SPACE
         SPACE
READALT  GEN,8,7,17 X'10',0,F:ALT
         DATA     X'F4000000'
         DATA     ABOPEN
         DATA     ABALTREAD
         DATA     CARD
         DATA     120
         DATA     0                 BTD=0
         SPACE
         SPACE
         SPACE
*        ERROR RETURNS FROM OPENING AND READING F:ALT
         SPACE
ABALTREAD LCFI    0
         STM,0    SAVEREG
         STW,R    BADRET
         LB,10    10                ERROR CODE
         CI,10    X'06'             END FILE HUH?
         BE       EOFALT
         LI,1     0
         LW,5     EXECCNT
         LI,14    RECNUM
         CALL     BIN2BCD
         LI,0     DATALOST          PRINT THE DATA LOST MESSAGE
         CALL     PRINT
         LI,0     QUIT
         STW,0    BADRET            TO QUIT
         LI,12    OPEN+7
         B        ER3
         SPACE
ABOPEN   EQU      %
         LI,R     -1
         STW,R    FLAG              SO BATCH WILL EXIT
         LI,12    F:ALT+23
         CALL     OPEN:ERR          CALL OPEN ERR TO PRINT THE MESS
         CALL     PRINT
         B        ABNADD2           GO TO PRINT THE ERRMSGE
         SPACE
QUIT     LH,R     F:ALT
         CI,R     X'20'
         BAZ      Q2
         M:CLOSE  F:ALT
Q2       LH,R     M:EI
         CI,R     X'20'
         BAZ      Q3
         M:CLOSE  M:EI
Q3       LI,0     QMSG
         CALL     PRINT
         B        MEXIT             TO M:EXIT ETC
         SPACE
         PAGE
*        SAVE AND RESTORE ROUTINES FOR EXEC EXPANSION
         SPACE
SAVE     ENTER
         M:GP     3                 GET THREE PAGES
         BCS,8    GPERR             GOT PAGES OK?
         STW,9    SPAGE             SAVE PAGES
         LI,X     383               THIS MANY DOUBLE WDS
         LD,R     BSAVE,X
         STD,R    *SPAGE,X
         BDR,X    %-2
         RETURN
         SPACE
         SPACE
RESTORE  ENTER
         LI,X     383
         LD,R     *SPAGE,X
         STD,R    BSAVE,X
         BDR,X    %-2
         M:FP     3                 RELEASE DYNAMIC PAGES
         RETURN
         SPACE
GPERR    LI,0     GPMSG
         CALL     PRINT
         B        QUIT
         TITLE    'ERROR ROUTINES'
         SPACE
*        ERROR RECOVERY AND ABORT ROUTINES
         SPACE
*        WHEN CALLED, DIAG POINTS TO OFFENDING IMAGE
*        AND BADRET IS WHERE TO RETURN
         SPACE
S        EQU      SERR
SERR     MTW,2    CEND
*****TEMP PATCH
         LW,R     MODE
         BEZ      %+4
         LW,R     CEND
         STB,R    COMMAND
         M:TYPE   (MESS,COMMAND)
*****END PATCH
         LW,0     EDIAG
         STB,0    *DIAG
         LI,0     DIAG
         CALL     PRINT
         LI,0     SM1
         CALL     PRINT
ERRET    MTW,1    ABORT             INCREMENT ERROR CT
         SPACE
*        IF IN MOD2, PRINT OUT OFFENDING FILE NAME
         SPACE
         LW,R     MODSW
         BEZ      ER2               IF IN MOD1
         SPACE
*        WHICH FILE IS BEING READ?
         SPACE
         LW,R     EXSW
         BNEZ     SETALT            IF F:ALT
         SPACE
         LW,12    SAVEREG+7
ER1      AI,12    7                 REG 12 TEXTC OF FILENAME
         SPACE
ER3      EQU      %
         CALL     OPEN:ERR          CALL THE ERR MESSAGE BUILDER
         LI,0     ERMS
         CALL     PRINT
         SPACE
ER2      EQU      %
         LI,R     0
         STW,R    BEGDEF
         STW,R    SAVESP
         STW,R    SPOINT
         STW,R    ORIGSP
         STW,R    ORIGSPC
         LI,R     -1
         STW,R    PDX
         LCFI     0
         LM,0     SAVEREG
         B        *BADRET
OPEN:ERR EQU      %
         ENTER
         STD,R    RANDR1SAVE        SAVE R AND R1
         LI,X     1
         ANLZ,R   XS7
         LI,R1    BA(ERM2)
         LB,X     *12
         STB,X    R1                COUNT OF FILE NAME
         MBS,R    0
LBANLZ   LB,R     *12               GET THE
         AI,R     31
         STB,R    ERMS              LENGTHEN MESSAGE FOR NAME
         LI,X     -1                GET THE LENGTH OF THE FILE PARAM
         ANLZ,R   XS7
         LB,X     0,R               GET THE # OF WORDS
         AI,X     1                 ADD IN ONE MORE FOR THE CONTROL WORD
         AW,12    X                 POINT THE THE ACCN
         LW,15    *12               GET THE FIRST WORD
         CW,15    J:ACCN            IS IT THE SAME
         BNE      OPEN:ACN          MOVE THE ACCN
         LI,X     1
         LW,15    *12,X             GET THE NEXT WORD
         CW,15    J:ACCN+1          COMPARE TO THE SECOND WORD OF ACCN
         BE       OPEN:EX           GET OUT IF THE SAME
OPEN:ACN EQU      %
         LI,X     '.'               MOVE IN A PERIOD
         STB,X    0,R1              MOVE IT
         AI,R1    1                 POINT TO NEXT BYTE
         ANLZ,R   LBANLZ            GET THE BYTE ADDRESS OF THE ACN
         OR,R1    =X'08000000'      PUT IN THE SIZE
         MBS,R    0                 MOVE IN THE ACCOUNT
         LB,R     ERMS              GET THE SIZE
         AI,R     9                 ADD IN FOR THE PERIOD AND ACN
         STB,R    ERMS              STORE IT AWAY
OPEN:EX  EQU      %
         LD,R     RANDR1SAVE        RESTORE REGS
         LI,0     ERMS              LOAD THE ERROR MESSAGE ADDRESS
         RETURN                     GET OUT
         SPACE
SETALT   LI,12    OPEN
         B        ER1
XS7      LB,R     *12,X             FOR ANLZ
OUTLERR  AI,OP    1                 INDEX TO NO. BYTES
         MTW,0    ONLINE            SKIP CR IF BATCH
         BEZ      TYPX
         LI,0     X'0D'             SET CR AT END OF LINE
         STB,0    OUT,OP
         AI,OP    1                 ONE MORE CHARACTER
TYPX     M:WRITE  F:BATCH,(BUF,OUT),(SIZE,*OP)
         LI,0     OLM
         CALL     PRINT
         B        ERRET
SLOVFLW  LI,0     SLM
         CALL     PRINT
         B        ERRET
COMMER   LI,0     QUIT
         STW,0    BADRET
         LI,0     COMSG
         CALL     PRINT
         B        ERRET
MEXIT    M:CLOSE  F:BATCH,(SAVE)
         M:EXIT
         SPACE
         SPACE
*        ENTERED IF USER HAS SPECIFIED (S) ON BATCH
*        COMMAND, BUT M:EI WASN'T SET TO A FILE
         SPACE
NOEI     LI,0     NOEIM
         CALL     PRINT
         B        QUIT
*        SUBROUTINE TO PRINT TEXTC MESSAGE SPECIFIED IN 0
         SPACE
PRINT    ENTER
         MTW,0    MODE              IN GHOST MODE
         BEZ      PR1               NO
         M:TYPE   (MESS,*0)         ONTO OC
         RETURN
         SPACE
PR1      EQU      %
         STD,R    RANDR1SAVE
         LI,R1    ' '
         LB,R     *0                TEXTC COUNT BYTE
         AI,R     1
         STB,R1   *0                OVER COUNT
         M:WRITE  F:BATCH,(BUF,*0),(SIZE,*R)
         AI,R     -1                RESTORE COUNT VALUE
         STB,R    *0
         LD,R     RANDR1SAVE        RESTORE THE REGS
         RETURN
         SPACE    3
         END

