*M*      PCL      EXECUTIVE ROUTINE OF PCL PROCESSOR
VERSION  EQU      2                 1=BPM,2=UTS
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU       12
D2       EQU      13
D3       EQU      14
D4       EQU      15
         TITLE    'PCL'
         SYSTEM   SIG7
*
*P*      NAME:    PCL
*P*
*P*      PURPOSE: PCL PROVIDES FOR PROCESSING OF USER COMMANDS WHICH
*P*               DIRECT INFORMATION MOVEMENT BETWEEN INPUT AND OUTPUT
*P*               DEVICES.  THE EXECUTIVE ROUTINE IS THE MAIN DRIVING
*P*               ROUTINE FOR THE PCL SUBSYSTEM.
*P*
*
*DO*
*P*
* INPUT
*        ARGBUF   ARGUMENT BUFFER
*        NCHAR    LENGTH OF CURRENT ARGUMENT
*        TERM     TERMINATOR OF CURRENT ARGUMENT
*        D2       MAXIMUM ERROR SEVERITY
*        PCL CONTRL COMMANDS FROM TTYS OR CR
*       R0        ZERO REGISTER
* OUTPUT
*        D1       CURRENT ACTION CODE
*        PREVACT  PREVIOUS ACTION COD%
*        CMDBUF   CONTROL COMMAND BUFFER
*        CMBX     -CMDBUF- INDEX OF FIRST ARGUMENT
*        MAXCMBX  MAXIMUM -CMDBUF- INDEX
*        DIAGADD  INITIALIZED DIAGNOSTIC ADDRESS
*        CALL TO APPROPRIATE COMMAND PROCESSOR
*
*
*FIN*
*                 **********
*                 *  DEFS  *
*                 **********
         DEF      PCL               MAIN ENTRY POINT
         DEF      TRANSACT
         DEF      CMDBUF,CMBX,MAXCMBX
         DEF      ARGBUFF,NCHAR,TERM
         DEF      ARGTBL,DEVICE,FILE,CODE,MODE,SEQUENCE,SELECT
         DEF      DVLARG,TOSWT
         DEF      PRTBUF
         DEF      ERRFLAG
         DEF      DCBS              DCB FLAGS
         DEF      IOABORTS          ERRORS THAT TERMINATE COPYALL/STD
         DEF      PRTERR            PRINT ERRORS
         DEF      DCBADD,INSWT,IOBUF,NPAGE,OPNFPT,PREVACT
         DEF      TOARG,RDFPT,WRTFPT,FPARAM
         DEF      ARGBUF4
         DEF      TOVER
         DEF      PRNTBUF,RECNUM
         DEF      FPTCONSL
         DEF      TLABEL,SYNFLAG
         DEF      BUFSIZE
         DO1      VERSION=2
         DEF      FPTPROMT
         DEF      SAVCMBX
         DEF      ATTRB
         DEF      TLBLSIZE
         DEF      #DELIM
         DEF      CIBUSED,CIBLEFT,CIBTOTAL,CIWORD,RECSIZE,CISEQ
         DEF      COBUSED,COBLEFT,COWORD
         DEF      KEY,CARDSEQ
         DEF      TABSET
         DEF      RSSAVE
         DEF      SYNONYM
         DEF      COPYSTDF,STRDFPT
         DEF      LINENO
         DEF      SFARG,SFCNT,SFACCT
         DEF      SFDEV,EATTRB,COPYSK,DATETBL
         DEF      RDTBL,WRTBL
         DEF      EXTBL,UNTBL
         DEF      DENSITY
         DEF      LTSTCMBX          PTR TO START OF CURRENT ARG
         DEF      SUPERR            SUPRESS ERRORS FLAG
         DEF      INCRPT
         DEF      OUTCRPT           OUTPUT ENCRYPTION SEED
         REF      CLRARG
         REF      HEX2BIN
         DEF      ERROR
         REF      HEX2BCD
         REF      CLOSEI
         DEF      INSER             CURRENT INPUT SERIAL#
         DEF      OUTSER            CURRENT OUTPUT SERIAL#
         DEF      DEL%CT
         DEF      BOG
         DEF      FROMFILE,TOFILE,REVIEW,DELETEF
         DEF      SFTEMP
         DEF      SCRATCH
         DEF      GRANCNT
         DEF      SEQNUM
         DEF      COPYPHY
         DEF      FROMCMBX
         DEF      LISTCMBX,LISTTERM
         DEF      ANSBLK
         DEF      BLKBUFF
         DEF      BLKSIZE
         DEF      UNBADR
         DEF      CONTINUE
         DEF      EXPIRE
         DEF      IN%ARG,OUT%ARG
         DEF      DEV%SAV
         DEF      DEV%SAV1     SIDR# PRE7-0744
         DEF      CMBXHLD      SIDR#SIG7-11335
*
         REF      GETARG
         REF      COPYTO
         REF      FIXARG
         REF      OV:NMSZ
         REF      OH:NM
         REF      COPYALL
         REF      M:SI,M:UC,M:LO
         DO1      VERSION=2
         REF      J:JIT
         DO1      VERSION=1
         DEF      J:JIT
         REF      DELETEAL,DELETE,LIST
         DO1      VERSION=2
         REF      J:CCBUF
         REF      REW,SPF,SPE,WEOF
         REF      INTARG
         DEF      CMBX1             INDEX OF START OF COMMAND
         REF      REVRP             BREAK HERE IS BUMP RETURN
         REF      FILTRAN           GET NAME FOR RANGE STUFF
         REF      M:DO
         REF      M:LL
         REF      DEVTRAN
         REF      JB:CCARS          BYTE COUNT OF J:CCBUF
*
*
         DEF      PATCH             PROCEDURE PATCH AREA
         PAGE
PCL      CSECT    1
PLSECT   CSECT    1                 PLIST AREA
         USECT    PCL
         LI,R7    STACK             STACK POINTER
         LI,R1    #DCBS             OPEN ALL THE DCBS
DCB0     LW,R2    DCBNS,R1
         LC       J:JIT             IF BATCH, NO M:UC
         CI,R2    M:UC
         BCS,11   %+3               ONLINE OR NOT M:UC
         LI,R2    M:LO              USE LO IF BATCH
         STW,R2   DCBNS,R1
         BE       %+3               NEVER TRY OPEN TO M:UC
         CAL1,1   SETABN0           CLEAR ABN IN CASE OPEN
         CAL1,1   OPNDCB
         BDR,R1   DCB0
         BAL,R6   LPCHK             LAST OPENED IS M:LL
         MTW,1    DCBS              =LP, CLEAR FLAG
         LI,R2    M:LO              CHECK LO TOO
         BAL,R6   LPCHK
         STH,R1   DCBS              =LP, CLEAR ITS FLAG
         LI,R4    4                 NOW SET CCS
DCB1     LD,R2    DCBNS-2,R4        FOR UC=DO,UC=LL,SI=LL AND DO=LL
         LI,SR1   X'2B'             MAKE  COMPARE FPT
         STB,SR1  R2                IN REGS
         CAL1,1   2                 SINCE INDIRECT IS NOT WORK
         OR,R1    SR1
         SCS,R1   -1
         BDR,R4   DCB1
         STS,R1   DCBS
         CAL1,8   FPTGP
         USECT    PLSECT
         DO1      VERSION=2
FPTGP    DATA     X'08000002'       REQUEST 2 PAGES
         DO1      VERSION=1
FPTGP    DATA     X'08000100'       REQUEST ALL OF MEMORY
         USECT    PCL
         BCR,8    BASEREG           GOT TWO, OK
         MTW,1    ERRFLAG           NOT TWO, GIVE UP
         LI,D2    4                 ABORT ON THIS ONE
         BAL,SR4  PRTERR
         B        ENDPCL
OPNDCB   GEN,8,24 X'94',R2
         DATA     0
SETABN0  GEN,8,24 X'86',R2
         DATA     X'40000000',0
LPCHK    LI,R3    3                 FIRST MUST BE DEVICE
         CS,R3    0,R2
         BNE      1,R6              NOPE
         LI,R3    X'4000'
         CW,R3    1,R2
         BAZ      1,R6
         B        0,R6              GOT ONE
*
BASEREG  LW,R7    SR2               DEFINE BASE REGISTER
         LD,0     STACK
         STD,0    *7
*
         LI,R2    511
         SD,0     0
         STD,R0   *R7,R2
         BDR,R2   %-2
         SLS,SR1  11                CONVERT PAGES TO BYTES
         AI,SR1   -2048             RESERVE PAGE FOR DATA
         STW,SR1  BUFSIZE,R7        INITIALIZE I/O BUFFER SIZE
*
         DO       VERSION=2
         LI,R1    4*CONTINUE
         STW,R1   CONTPTR,R7   INITIALIZE CONTINUATION PTR
         CAL1,1   FPTPROMT          SET PROMPT CHAR
         USECT    PLSECT
FPTPROMT GEN,8,16,8   X'2C',0,'<'
         USECT    PCL
         LW,R0    R7                STACK ADDR FOR BREAK CONTROL
         CAL1,8   FPTINT
         USECT    PLSECT
FPTINT   GEN,8,7,17      X'0E',0,INT
         USECT    PCL
         LI,R0    0                 RESTORE R0
*
         LI,R4    80                BATCH COMMAND LENGTH
         LC       J:JIT             SET UP BOG
         STCF     BOG               THIS MAY BE RIGHT
         BCR,12   ENDBOG            BATCH IS NEVER INTERACTIVE
         BCS,4    NXCMD             GHOST ALWAYS IS, SINCE SI IS OC
         LI,R3    3                 ONLINE IS ONLY IF SI IS UC
         CS,R3    M:SI              MUST BE DEVICE
         BNE      NXCMD             NOPE, NO INTERACTIVE BIT
         LW,R3    M:SI+1
         CI,R3    X'6F00'           COC IN 90XX, NO IS 80XX
         BANZ     NXCMD             WE'LL LET THE NO CASE SLIP BY
         LCI      12                GOT INTERACTIVE ONLINE USER
         STCF     BOG
         LB,R4    JB:CCARS          ONLINE COMMAND LENGTH
         AI,R4    -1                LESS CARRIAGE RETURN
ENDBOG   RES
         LI,R3    CMDBUF
         AW,R3    R7                ADDR OF CMDBUF
         LI,R2    J:CCBUF           ADDRESS OF COMMAND
         SLD,R2   2                 IN BYTES FOR MBS
         STB,R4   R3
         MBS,R2   0                 MVE IT
         SD,D1    D1                CLEAR COMMAND/SEVLEV
         BAL,SR4  CONTCHK           TEST FOR CONTINUATION LINE
         B        PCL88             CONTINUED LINE RETURN
         NOP                        LAST OF CONTINUATION
         NOP                        ERROR RETURN
PCL82    EQU      %
         BAL,SR4  TRANSACT          GO TRANSLATE FIRST VERB
         CI,D1    0                 UNDEFINED COMMAND FROM TEL IS
         BE       PCL3              DONT ABORT, IS PROLLY S PCL
PCL8     EQU      %
         BAL,SR4  ACTION            GO-DO THE COMMAND
         BAL,SR4  PRTERR            YES-PRINT THE MESSAGES
         B        ENDPCL       CLOSE DCBS BEFORE RETURN TO TEL.
PCL88    MTW,1    TELCONT,R7        SET FLAG FOR TEL CONTINUATION
         B        NXCMD             GET NEXT LINE
*
PCL3     MTW,0    J:JIT             ONLINE MODE
         BGEZ     NXCMD             NO-RREAD FIRST COMMAND
         CAL1,1   FPTHERE           PRINT 'PCL HERE'
         USECT    PLSECT
FPTHERE  GEN,8,7,17      X'11',0,M:UC
         DATA     X'34000000'
         DATA     %+3
         DATA     13
         DATA     0
         TEXT     'PCL '
         TEXT     'E00'             VERSION
         TEXT     'HERE
'
         USECT    PCL
         FIN
*
NXCMD    LW,R1    R7                READ NEXT COMMAND
         AI,R1    CMDBUF
         LI,R6    M:SI
         CAL1,1   FPTPROMT
NXCMD1   EQU      %
         CAL1,1   FPTCONSL          READ COMMAND
         USECT    PLSECT
FPTCONSL GEN,8,7,17      X'90',0,R6
         DATA     X'F4000010'
         DATA     TERMPCL           TERMINATE ON ERROR
         DATA     TERMPCL           TERMINATE ON ABNORMAL
         PZE      *R1
         DATA     140               SIZE
         DATA     0                 NO BYTE DISPLACEMENT
         USECT    PCL
         STW,R0   BREAK             CLEAR BREAK
         LW,R2    M:SI+4
         SLS,R2   -17               GET COUNT
         LC       BOG
         BCS,12   PCL1              BRANCH IF NOT BATCH
         AI,R2    1
         CI,R2    73
         BLE      PCL4
         LI,R2    73                CHARS/CARD PLUS ONE
         B        PCL4
*
PCL1     EQU      %
         DO       VERSION=2
         BCS,4    PCL4              IF NOT INTERACTIVE, TYPE COMMAND
         LI,R4    CMDBUF
         AW,R4    R7
         SLS,R4   2                 BYTE ADDRESS OF COMMAND BUFFER
         AW,R4    R2
         AI,R4    -1                GET LOC OF LAST CHAR
         LB,R3    0,R4
         CI,R3    X'15'             TEST IF LAST CHAR IS CR
         BE       PCL7              YES
         CI,R3    X'0D'
         BE       PCL7              YES
         AI,R4    1
         LI,R3    X'15'
         STB,R3   0,R4              SET CARRIAGE RETURN IN LINE
         AI,R2    1
PCL7     EQU      %
         CAL1,1   FPTCOMD3          WRITE PROMPT
         LI,SR4   M:UC
         CAL1,1   FPTCOMD           AND COMMAND
         FIN
PCL4     EQU      %
         LB,R3    *R1
         CI,R3    '*'
         BNE      PCL5
         LW,R1    R3                NO RECORD SIZE
         BAL,SR4  CALLGET           PRINT IF ECHOEING
         B        NXCMD
PCL5     RES
         LW,R4    R2                SAVE STMT LENGTH
         AI,R2    4*CMDBUF-1        MAX COMMAND BUFFER INDEX
         STW,R2   MAXCMBX,R7
*
         LI,R2    4*CMDBUF          INITIALIZE COMMAND BUFFER INDEX
         STW,R2   CMBX,R7
         STW,R0   ERRFLAG           CLEAR ERROR COUNT
         SD,D1    D1                CLEAR COMMAND/SEV LEV
*
         BAL,SR4  CONTCHK           TEST FOR CONTINUATION
         B        PCL42             CONTINUED LINE RETURN
         B        PCL43                  NON-CONTINUATION LINE
         BAL,SR4  CALLGET
         B        ENDCMD1
PCL42    EQU      %
         LI,SR4   NXCMD             NEED TO CHECK FOR PASSWORD
CALLGET  RES
         XW,R1    CMBX,R7
         XW,R3    MAXCMBX,R7
         PSW,R1   *R7               SAVE A FEW REGS/VALUES
         PSW,R3   *R7
         PSW,SR4  *R7
CALLGETA LI,R1    12                USE FILE TYPE FORMAT
         BAL,SR4  GETARG            START LOOKING FOR A PASSWORD IN
         LW,R1    CMBX,R7           THE BATCH INPUT
         CW,R1    MAXCMBX,R7        ALL THRU WITH INPUT LINE
         BE       TPERIOD
         LW,R2    TERM,R7           GET THE PREVIOUS DELIMITER
         CI,R2    '.'               CHECK IF IT'S A  PERIOD
         BNE      CHK4NDB1
         MTW,0    INSWT,R7
         BEZ      SAVIT
         MTW,1    INSWT,R7          INSWT IS KEEPING TRACK OF THE # OF
*                                   PERIODS, FOR THE TIME BEING
GETPW    LI,R1    12
         BAL,SR4  GETARG            GO GET PASSWORD
         LW,R2    TERM,R7           GET TERMINATOR FOR CHK4NDB1
         LW,R1    NCHAR,R7          GET SIZE OF PASSWORD
         BEZ      CHK4NDB1
         LI,R2    X'40'
         LW,R3    LTSTCMBX          GET DISP. OF PASSWORD IN BUF
         STB,R2   *R7,R3            BLANK OUT PASSWORD 1 BYTE AT A
         AI,R3    1                 TIME
         CW,R3    CMBX,R7
         BL       %-3
STZINSWT STW,R0   INSWT,R7
         B        CALLGETA
SAVIT    MTW,1    INSWT,R7          COUNT '.' IN TEMP STORAGE
         B        CALLGETA
CHK4NDB1 CI,R2    ','               A COMMA MARKS END OF CHECK FOR P.W.
         BE       STZINSWT
         CI,R2    ';'               ALL DONE IF ';'
         BE       PRINTIT1
         CI,R2    ' '               PASSWORD ENDS WITH BLANK DELIM TOO
         BE       STZINSWT
         LW,R2    INSWT,R7
         CI,R2    2
         BNE      CALLGETA
1MORTIME LI,R2    4*CMDBUF          RESTORE BEGINNING OF BUFFER
         STW,R2   CMBX,R7           POINTER
         B        GETPW             FIRST ARG. SHOULD BE THE PASSWORD
TPERIOD  LW,R2    INSWT,R7          COUNT OF PERIODS IN COMMAND LINE
         CI,R2    2
         BE       1MORTIME
PRINTIT1 EQU      %
         LC       BOG               IF ONLINE,
         BCR,8    %+3                  DONT OUTPUT UNLESS
         LC       DCBS              SI AND LL ARE DIFFERENT
         BCS,6    FPTEND            AND LL IS NOT UC
         LW,R1    R7                PT R1 TO BUFFER
         AI,R1    CMDBUF
         LW,R2    M:SI+4            GET ACTUAL INPUT(SI) RECORD SIZE
         SLS,R2   -17               AND RIGHT ADJUST IT
         CI,R2    120               IS IT A BINARY CARD
         BE       FPTEND
         LI,SR4   M:LL              OUTPUT TO LL
         CAL1,1   FPTCOMD           PRINT THE BATCH COMMAND
         USECT    PLSECT
FPTCOMD  GEN,8,7,17      X'91',0,SR4
         DATA     X'34000010'
         PZE      *R1
         PZE      *R2               SIZE
         DATA     0                 NO BYTE DISPLACEMENT
         USECT    PCL
         LC       DCBS              IS LL=LO
         BCS,2    FPTEND            YES
         LI,SR4   M:LO
         CAL1,1   FPTCOMD           NO-PRINT COMMAND AGAIN ON M:LO
         USECT    PLSECT
         DO       VERSION=2
FPTCOMD3 GEN,8,24 X'11',M:UC
         DATA     X'34000010'
         DATA     FPTPROMT
         DATA     1
         DATA     3
         FIN
         USECT    PCL
FPTEND   LCI      3
         PLM,SR2  *R7
         STW,SR2  CMBX,R7
         STW,SR3  MAXCMBX,R7
         B        *SR4
PCL43    EQU      %
         BAL,SR4  CALLGET
         STW,R0   INSWT,R7          CLEAR INSWT
         MTW,0    TELCONT,R7        WAS TEL COMMAND CONTINUED
         BNEZ     PCL82             YES GO PROCESS
GETCOM   EQU      %
         BAL,SR4  TRANSACT          TRANSLATE COMMAND ACTION VERB
         CI,D1    0                 TEST FOR ERROR RETURN
         BNE      PCL2              NO-DO THE COMMAND
PCL6     EQU      %
         LI,R1    18                ERROR-ILLEGAL ACTION VERB
         BAL,SR4  ERROR
         B        ENDCMD1
PCL2     BAL,SR4  ACTION            GO-DO THE COMMAND
ENDCMD1  RES
         BAL,SR4  PRTERR            YES-PRINT ERROR LINES
         LC       BOG
         BCS,4    %+3               DONT ABORT IF INTERACTIVE
         CI,D2    4                 TEST IF ABORT WANTED
         BE       TERMPCL2          YES
         MTW,0    TELCONT,R7        WAS TEL CMD CONTINUED
         BEZ      NXCMD             NO-READ NEXT COMMAND
         B        ENDPCL            GO BACK TO TEL
*
ACTION   EQU      %                 DO THE COMMAND
         PSW,SR4  *R7
         STW,R0   IN%ARG,R7    ZERO AREAS IN WHICH
         STW,R0   OUT%ARG,R7   SYSTEM DEVICE
         STW,R0   2,R7              RESET HEADING PRINTED FLAG
         STW,R0   COPYSTDF,R7       ZERO COPYSTD FLAG
         STW,R0   SFACCT,R7         ZERO STD FILE ACCT FLAG
         STW,R0   DEL%CT,R7
         LI,R1    #WDSINIT0         CLEAR COMMAND INFORMATION
         STW,R0   INIT0,R1
         BDR,R1   %-1
         BAL,SR4  CLRARG
         CAL1,1   FPTPROMT1         SET . PROMPT
         LW,R1    D1
         EXU      ACTTBL,R1
ENDCMD   PLW,SR4  *R7
         B        *SR4              RETURN FROM COMMAND PROCESSING
FPTPROMT1 GEN,8,24 X'2C','.'
*
ACTTBL   EQU      %-1
         B        PCL6              TO - ERROR
         B        COPY1             COPY OR COPYALL
         B        DEL1              DELETE OR DELETEALL
         B        TERMPCL           END
         BAL,SR4  LIST
         BAL,SR4  REW               REMOVE
         BAL,SR4  REW               REW
         BAL,SR4  SPF               SPF
         BAL,SR4  SPE               SPE
         BAL,SR4  WEOF              WEOF
         B        PCL6              ON - ERROR
         B        PCL6              OVER - ERROR
         BAL,SR4  TABS              TABS
         BAL,SR4  REVIEW0           REVIEW
         B        PCL3              PCL, ENTER NON-TEL MODE
         B        PCL3              BATCH PCL, DITTO
         BAL,SR4  SPF               SPR
         B        PCL6              INTO - ERROR
         B        ERONOFF
         CAL1,9   6                 PRINT
         BAL,SR4  REW               MOUNT
*
COPY1    LW,R1    ARGBUFF+1,R7      TEST FOR COPYALL COMMAND
         CW,R1    =C'YALL'
         BE       COPY3             YES
         CW,R1    =C'YSTD'          TEST FOR COPYSTD
         BNE      COPY2             NO
         MTW,1    COPYSTDF,R7       SET COPYSTD FLAG
COPY3    EQU      %
         BAL,SR4  COPYALL           EDIT AND EXECUTE COPYALL COMMAND
         B        ENDCMD
COPY2    BAL,SR4  COPYTO            EDIT AND EXECUTE COPY COMMAND
         B        ENDCMD
*
DEL1     LW,R1    ARGBUFF+1,R7
         CW,R1    =C'ETEA'          DELETE
         BNE      DEL2              YES
         LW,R1    ARGBUFF+2,R7
         AND,R1   =X'FFFFFF00'
         CW,R1    =X'D3D34000'   CHECK IF REALLY DELETEALL.
         BNE      PCL6         NOT DELETEALL
         BAL,SR4  DELETEAL          NO-DELETEALL
         B        ENDCMD
DEL2     BAL,SR4  DELETE
         B        ENDCMD
*
REVIEW0  LC       BOG               IF NOT INTERACTIVE, JUST LIST
         BCR,8    LIST              NO REVIEW IN GHOST
         BCR,4    LIST
         MTW,1    DELETEF
         MTW,1    FROMFILE
         B        LIST
*
TERMPCL2 EQU      %
         CAL1,1   FPTABORT          PRINT ABORT MESSAGE
         B        ENDPCL
TERMPCL  EQU      %
         LCF      J:JIT
         BCS,12   ENDPCL            BRANCH IF ONLINE OR GHOST
         LB,R2    TXTRMPCL          MESSAGE SIZE
         CAL1,1   FPTRMPCL          PRINT 'PCL PROCESSING TERMINATE'
         USECT    PLSECT
FPTRMPCL GEN,8,7,17     X'11',0,M:LO
         DATA     X'34000000'
         DATA     TXTRMPCL
         PZE      *R2
         DATA     1
TXTRMPCL TEXTC    'PCL PROCESSING TERMINATED'
FPTABORT GEN,8,24 17,M:LO
         DATA     X'34000000'
         DATA     TXTABORT
         DATA     9
         DATA     0
TXTABORT TEXT     'PCL ABORT'
         DATA     X'E3150000'
         USECT    PCL
ENDPCL   EQU      %
         LI,R2    M:LO
         BAL,SR4  CLOSDCB           CLOSE M:LO
         LI,R2    M:LL
         BAL,SR4  CLOSDCB           CLOSE M:LL
         LI,R2    M:DO
         BAL,SR4  CLOSDCB           CLOSE M:DO
         LC       J:JIT
         BCR,12   %+2               JUST EXIT IF ONLINE
         CAL1,9   1
         LW,D2    MAXSEV            SET STEP CCS FROM MAX SEVLEV
         SLS,D2   8
         AI,D2    X'10001'
         CI,D2    X'10301'
         BL       %+2
         AI,D2    1                 ERROR IF SEV 3 OR 4
         CAL1,9   *D2
*
CLOSDCB  LW,R1    0,R2              CLOSE DCB WHOSE ADR IS IN R2
         CW,R1    =X'00200000'
         BAZ      *SR4              NOT OPEN - EXIT
         CAL1,1   CLOSFPT
         USECT    PLSECT
CLOSFPT  GEN,8,24 X'95',R2
         DATA     X'80000000'
         DATA     2                 SAVE
         USECT    PCL
         B        *SR4              EXIT
         PAGE
*CONTCHK TESTS IF A COMMAND IS CONTINUED OR IS A CONTINUATION.
*IF NEITHER, EXIT IS TO C(SR4)+3. IF CONTINUED, EXIT IS TO C(SR4).
*IF LAST OF CONTINUATION LINES, EXIT IS TO C(SR4)+1. IF TOO MANY
*CONTINUATIONS, EXIT IS TO C(SR4)+2. LINES ARE CONCATENATED IN THE
*BUFFER BEGINNING AT LOCATION CONTINUE + C(R7).
CONTCHK  EQU      %
         LI,R2    CMDBUF
         AW,R2    R7                COMMAND BUFFER LOCATION
         AI,R4    -2                ADJUST LENGTH FOR INDEXING
         BEZ      CONT33
         BLZ      CONT5
CONT2    EQU      %
         LB,R3    *R2,R4
         CI,R3    X'40'             TEST END OF STMT
         BE       CONT3
         CI,R3    ';'               FOR PRESENCE OF CONT CHAR
         BNE      CONT5
         BAL,R6   MVSTMT            GO MOVE TO CONCAT AREA
CONT1    MTW,1    CONTMODE,R7       SET CONTINUATION MODE
         CI,D2    2                 TEST IF ERROR
         BGE      CONT6             YES GO BACK TO START OF BUFFER
         BDR,SR4  CONT65            NO, RETURN
CONT3    BDR,R4   CONT2             LOOP THROUGH STMT
CONT33   LB,R3    *R2               ONE SIGNIFICANT CHAR IN STMT
         CI,R3    ';'
         BE       CONT1
CONT5    AI,R4    2                 RESTORE STMT LENGTH
         BAL,R6   MVSTMT            GO MOVE LAST STMT
CONT6    LI,R1    4*CONTINUE
         STW,R1   CONTPTR,R7        RESET CONT STMT POINTER
         STW,R0   CONTMODE,R7       TURN OFF CONTINUATION MODE
         CI,D2    2                 TEST IF ERROR
         BGE      CONT7             YES
CONT65   RES
         AI,R3    -1
         XW,R3    MAXCMBX,R7        SET MAX COMMAND BUFFER INDEX
         XW,R1    CMBX,R7           SET NEW COMMAND CURRENT INDEX
         AI,SR4   1                 LAST STMT RETURN
         B        *SR4
CONT7    AI,SR4   2                 ERROR RETURN
         B        *SR4
*
MVSTMT   LW,R3    R7
         SLD,R2   2                 BYTW ADR OF CMDBUF
         AW,R3    CONTPTR,R7        COMPUTE ADR IN CONCAT AREA
         AWM,R4   CONTPTR,R7        BUMP FOR NEXT STMT
         SLS,R4   24                POSITION COUNT
         AW,R3    R4
         MBS,R2   0                 CONCATENATE STMT
         LW,R3    CONTPTR,R7
         CI,R3    4*IOBUF           TEST IF TOO MANY STMTS
         BLE      0,R6              NO - RETURN
         LI,R1    53                TOO MANY CONTINUATION LINES
         PSW,SR4  *R7
         BAL,SR4  ERROR             REPORT ERROR
         PLW,SR4  *R7
         B        0,R6
         PAGE
REVIEW   PSW,SR4  *R7
         MTW,1    FROMFILE          INITIALIZE FOR NULL FIELD
         MTW,1    TOFILE
         LI,R5    1                 FLAG FOR FILE NAME
         LCI      2                 SAVE FILE ARGS
         LM,R1    FILE,R7
         STM,R1   SFARG
         LW,R1    TERM,R7
         CI,R1    X'40'
         BE       REV1
         CI,R1    ','
         BE       REV8              NULL FROM FIELD
         CI,R1    X'15'
         BE       REV6              END OF COMMAND
REV1     LW,SR1   CMBX,R7           SAVE START
         BAL,SR4  FILTRAN           GET FILE NAME
         XW,SR1   CMBX,R7
         LW,R5    TERM,R7
         LI,R1    12                GET FILE NAME
         BAL,SR4  GETARG
         STW,R5   TERM,R7           RESTORE AS IF END OF FID
         STW,SR1  CMBX,R7
         MTW,0    NCHAR,R7
         BEZ      REV9              NULL FROM FIELD
         MTW,0    SFARG             IF PREV FILE ARGS, PUT
         BEZ      %+4               THEM IN INSTEAD
         LCI      2
         LM,R1    SFARG
         STM,R1   FILE,R7
         LCI      4
         LM,R1    ARGBUFF,R7        MOVE FILE NAME
         STM,R1   FROMFILE
         LM,R1    ARGBUFF+4,R7
         STM,R1   FROMFILE+4
         STW,SR1  FROMCMBX          SAVE POINTER TO END OF FIELD
REV9     LW,R1    TERM,R7
         CI,R1    ','               IS 'TO' FIELD PRESENT
         BNE      REV6              NO
REV8     LI,R1    12
         BAL,SR4  GETARG            GET SECOND FILE NAME
         CI,D2    1
         BG       REV3              ERROR
         MTW,0    NCHAR,R7
         BEZ      REV5              NULL TO FIELD
         LCI      4
         LM,R1    ARGBUFF,R7        MOVE FILE NAME
         STM,R1   TOFILE
         LM,R1    ARGBUFF+4,R7
         STM,R1   TOFILE+4
         LB,R2    FROMFILE
         BEZ      REVA              NULL FROM FIELD
         MTW,0    COPYPHY           WAS PHY OPTION USED
         BNEZ     REVA              YES - NOT SORT ORDER
         LI,R3    1
REV7     LB,R4    FROMFILE,R3       TEST IF 'FROM' GR THAN 'TO'
         CB,R4    TOFILE,R3
         BL       REVA              OK
         BG       REV5              YES - ERROR
         AI,R3    1
         BDR,R2   REV7
REVA     EQU      %
         LW,R1    TERM,R7           GET DELIMITER
REV6     MTW,0    COPYSK
         BGZ      REV3              COPYALL
REV4     CI,R1    X'15'
         BNE      REV2              BAD TERMINATOR
REV3     PLW,SR4  *R7
         B        *SR4
REV5     LI,R1    8                 FILE RANGE SPECIFICATION INVALID
         PLW,SR4  *R7
         B        ERROR
REV2     LI,R1    17
         B        REV5+1
         PAGE
ERONOFF  RES
         LW,R2    TERM,R7           MUST BE BLANK
         CI,R2    ' '
         BNE      REV2
         LI,R1    6                 ALL DELIMITERS
         BAL,SR4  GETARG
         LW,R2    TERM,R7
         CI,R2    X'15'
         BNE      REV2
         LW,R2    ARGBUFF,R7
         STB,R0   R2                CLEAR COUNT
         CW,R2    TCSAVE            IS IT SAVE
         BE       %+3               YUP
         SW,R2    TCREL             OR REL
         BNE      %+3               NO,..EH
         STW,R2   SUPERR
         B        ENDCMD
         LI,R1    ARGBUF4+1         CONVERT INPUT
         LW,R2    NCHAR,R7
         BAL,SR4  HEX2BIN
         AI,R4    0
         BNEZ     REV2
         MTB,0    R3                IS IT PROPER VALUE
         BNEZ     REV2              NO
         MTB,-1   R3                SET NO PLACE CODE
         STW,R3   ERRFLAG+1
         MTW,1    ERRFLAG
         BAL,SR4  PRTERR0
         B        ENDCMD
TCREL    DATA     'REL'
TCSAVE   DATA     'SAV'
         PAGE
TABS     LCI      7
         PSM,R5   *R7
         LI,R5    TABSET
         AW,R5    R7                ADDRESS OF TAB TABLE
         LI,R6    0
         LI,R1    3
         STW,R6   *R5,R1            ZERO TABLE
         BDR,R1   %-1
         STW,R6   0,R5
TABS2    CI,R6    16                MORE THAN 16 TABS SPECIFIED
         BE       TABSERR2          YES
         LI,R1    6
         BAL,SR4  GETARG            GET NEXT VALUE
         LI,R1    0                 MIN VALUE
         LI,R2    255               MAX VALUE
         BAL,SR4  INTARG            CONVERT TO BINARY
         AI,R2    0
         BNE      TABSERR           CONVERSION OR RANGE ERROR
         STB,R1   *R5,R6            ENTER TAB VALUE IN TABLE
         AI,R6    1                 INCREMENT TAB COUNT
         LW,R1    TERM,R7
         CI,R1    ','
         BE       TABS2             ANOTHER VALUE
         CI,R1    X'15'
         BE       TABSEND           END OF COMMAND
         LI,R1    17                DELIMITER OUT OF SYNTAX
         BAL,SR4  ERROR
TABSEND  STW,R5   TABSET+4,R7       SET ADDRESS OF TAB TABLE
         LCI      7
         PLM,R5   *R7
         B        *SR4
TABSERR  LI,R1    45                INVALID TAB SPECIFICATION
         B        TABSEND-1
TABSERR2 LI,R1    51                MORE THAN 16 VALUES ON TABS CMD
         B        TABSEND-1
         PAGE
TRANSACT PSW,SR4  *R7
*
         STW,D1   PREVACT,R7        SAVE PREVIOUS ACTION CODE
*
         LI,R1    6                 USE ALL DELIMITERS
         BAL,SR4  GETARG            GET ACTION VERB
*
         LI,R1    ARGBUF4           FORCE LENGTH TO 3 CHARACTERS
         LI,R2    1
         CB,R2    *R7,R1            TEST IF ONE CHAR CMD
         BNE      %+3               NO
         LW,R1    =X'12000000'+CMDTBLX
         B        ACTION3+1
         LI,R2    3
         STB,R2   *R7,R1
*
ACTION3  LW,R1    =X'12000000'+CMDTBL   EDIT ACTION VERB
         BAL,SR4  FIXARG
         CI,R1    11                -ON- THE ACTION VERB
         BNE      %+2               NO
         LI,R1    1                 YES-SET-TO-
         STW,R1   D1                SAVE ACTION CODE
          PLW,SR4 *R7
         B        *SR4
*
         TITLE    'PRTERR'
*P*      NAME:    PRTERR
*P*
*P*      PURPOSE: TO PRINT THE ERROR MESSAGES CORRESPONDING TO THE
*P*               ERROR CODES PROCESSED BY THE ERROR ROUTINE.  PRTERR IS
*P*               CALLED AFTER PROCESSING IS COMPLETED, OR HAS BEEN
*P*               TERMINATED, FOR EACH COMMAND.  IT IS CALLED IF THE
*P*               MAXIMUM ERROR SEVERITY LEVEL EXCEEDS ONE.
*P*
*DO*
*P*
*P*
*
* INPUT
*        ERRFLAG  ERROR FLAG BUFFER
*        D2       MAXIMUM ERROR SEVERITY
* OUTPUT
*        PRINTED ERROR CODES AND MAXIMUM SEVERITY CODE ON LO DEVICE
*
*
*FIN*
*
PRTERR   RES
*
         CI,D2    1                 CHECK SEV LEV
         BLE      *SR4
         CW,D2    MAXSEV            AND OVERALL LEVEL
         BLE      %+2
         STW,D2   MAXSEV
PRTERR0  LCI      7                 SAVE REGISTERS
         PSM,R5   *R7
         LI,D3    M:UC
         LC       BOG
         BCS,12   PERR1             BATCH IF ONLINE OR GHOST
         LI,D3    M:DO              NO-ERROR OUTPUT ON M:DO
*
         LC       DCBS              IS DO = LL OR LO
         BCS,9    PERR1             YES, NO NEED TO OUTPUT COMMAND
         LI,R1    CONTINUE          NO-MUST OUTPUT COMMAND TO DO
         MTB,1    D3                SET DUAL OUTPUT FLAG
         AW,R1    R7
         CAL1,1   FPTCOMDP
         USECT    PLSECT
FPTCOMDP GEN,8,7,17      X'11',0,M:DO
         DO1      VERSION=1
         DATA     X'34000010'
         DO1      VERSION=2
         DATA     X'30000010'
         PZE      *R1               BUFFER
         DATA     80                SIZE
         DO1      VERSION=1
         DATA     0
         USECT    PRTERR
PERR1    EQU      %
M:MSG    DSECT    2
         DATA     1,0
         GEN,8,24 10,TLABEL+1
         GEN,15,17 80,ABNPCLER
         DATA     ABNPCLER,0,M:MSG+22
         DATA     0,0,0,M:MSGK
         DO1      11
         DATA     0
         DATA     X'1000202'
         TEXTC    'ERRMSG'
         DATA X'02010202'
         TEXT     ':SYS    '
M:MSGK   RES      8
         USECT    PRTERR
         PAGE
         LW,R2    ERRFLAG           ANY ERRORS TO PRINT
         BEZ      RETURN            NO
         LI,SR4   -1                LOGICAL SORT
         ANLZ,SR2 %+2               LAST ENTRY ADDRESS
PRT01    LW,R1    R2
         LW,SR3   ERRFLAG,R2
         B        %+4
         CS,SR3   ERRFLAG,R1
         BG       %+2
         XW,SR3   ERRFLAG,R1
         BDR,R1   %-3
         STW,SR3  ERRFLAG,R2
         BDR,R2   PRT01
         LI,R3    65                FIRST BLANK THER BUTTER
         LI,R2    '  '
         STH,R2   TLABEL,R3
         BDR,R3   %-1
         LI,R2    '%'
PRT2     LB,R1    *SR2
         BEZ      PRT1
         AI,R1    1
         STB,R2   TLABEL+1,R1
         CI,R1    256
         BE       %+4
         CW,R3    R1
         BG       %+2
         LW,R3    R1
         BDR,SR2  PRT2
PRT1     LI,R5    2                 BTD FOR NON-UC
         AI,R3    0                 IF NOTHING TO PUT
         BEZ      PRTERR1           DONT
         CI,D3    M:UC
         BNE      PRT3
         AI,R3    1
         LI,R2    X'15'             WRITE CR ALSO
         STB,R2   TLABEL+1,R3
         LI,R5    1
PRT3     CAL1,1   FPTMESS
         MTB,0    D3                DO WE NEED LL TOO
         BEZ      %+4
         LI,D3    M:LL
         CAL1,1   FPTMESS
         LI,D3    M:DO+X'80000'
PRTERR1  AI,SR2   1                 TO NEXT MESSAGE KEY
         LI,R3    3
         STB,R3   *SR2              SET BYTE COUNT
         CAL1,1   FPTERORD          READ ERROR MESSAGE
         USECT    PLSECT
FPTERORD GEN,8,7,17      X'10',0,M:MSG
         DATA     X'C8000010'
         DATA     ABNPCLER
         DATA     ABNPCLER          ABNORMAL FOR PCL ERROR CODE
         PZE      *SR2
         USECT    PRTERR
         LW,R3    M:MSG+13
PRTERR2  CI,D3    M:UC              REMOVE CR IF NOT UC
         BE       %+2
         AI,R3    -1                NO-REMOVE NL GOING PRINTER
         LI,R5    0                 BTD 0
PRTERR4  CAL1,1   FPTMESS           PRINT PCL ERROR MESSAGE
         USECT    PLSECT
FPTMESS  GEN,8,7,17      X'91',0,D3
         DATA     X'34000010'
         PZE      TLABEL+1
         PZE      *R3
         PZE      *R5
CLSMSG   GEN,8,24 21,M:MSG
         DATA     0
         USECT    PRTERR
         MTW,-1   ERRFLAG           COUNT DOWN
         BGZ      PRTERR1
         CAL1,1   CLSMSG            CLOSE DCB
         B        RETURN
ABNPCLER LI,SR3   X'10000'
         AND,SR3  *SR2
         LCI      5
         LM,R1    TXPCLERR
         BDR,SR3  %+2
         STW,R5   R1
         STM,R1   TLABEL+1          MOVE MESSAGE TO BUFFER
*
         INT,R1   *SR2              GET KEY
         BAL,SR4  HEX2BCD
         SLD,R2   16                XXXXCODE SBCD0000
         AI,R3    X'15'             CR IF PCL ERROR
         BDR,SR3  %+2
         AI,R3    X'1560'-X'15'     DASH AND NEWLINE
         SCS,R3   -8
         SLD,R2   16
         STW,R2   TLABEL+4+1
         STW,R3   TLABEL+5+1
         LI,R3    19                PCL ERROR COUNT
         BDR,SR3  %+2
         LI,R3    24                NO-TYPE NL CHAR
         B        PRTERR2
*
RETURN   LCI      7                 RESTORE REGISTERS
         PLM,R5   *R7
         B        *SR4
*
TXPCLERR TEXT     ' PCL ERROR CODE'
         TEXT     ' I/O'
         DO       VERSION=1
         PAGE
* THE FOLLOWING TABLE MATCHES THE UTS ERRMSG FILE
M1       TEXTC    'ARGUMENT GREATER THAN 31 CHARACTERS'
M2       TEXTC    'ILLEGAL DEVICE CODE'
M3       TEXTC    'INVALID REEL NUMBER SPECIFICATION'
M4       TEXTC    'ILLEGAL FILE NAME SPECIFICATION'
M5       TEXTC    'ILLEGAL ACCOUNT NUMBER SPECIFICATION'
M6       TEXTC    'ILLEGAL PASSWORD SPECIFICATION'
M7       TEXTC    'TOO MANY FIELDS IN A FILE ID SPECIFICATION'
M8       TEXTC    'INVALID FILE RANGE SPECIFICATION'
M9       TEXTC    'MORE THAN TEN RS FIELDS FOR AN INPUT DEVICE'
M10      TEXTC    'VOLUME NUMBER BYEOND END OF SNS'
M11      TEXTC    'INVALID DECIMAL NUMBER'
M12      TEXTC    'CS ID-FIELD GREATER THAN FOUR CHARACTERS'
M13      TEXTC    'ERROR ON N OR K VALUE OF CS OPTION'
M14      TEXTC    'IMPROPER TERMINATION WITHIN RS, LN, OR CS OPTION'
M15      TEXTC    ')) MUST TERMINATE RS, LN, OR CS OPTION'
M16      TEXTC    'SPECIAL ARGUMENTS MUST HAVE ) AS TERMINATOR'
M17      TEXTC    'EH?'
M18      TEXTC    'UNDEFINED COMMAND'
M19      TEXTC    'ILLEGAL INPUT DEVICE'
M20      TEXTC    'NO DEFINED OUTPUT DEVICE'
M21      TEXTC    'ILLEGAL OUTPUT DEVICE'
M22      TEXTC    'REEL NUMBER SPECIFICATION NOT VALID'
M23      TEXTC    'FILE SPECIFICATION NOT VALID'
M24      TEXTC    'DATA CODE SPECIFICATION NOT VALID'
M25      TEXTC    'MODE SPECIFICATION NOT VALID'
M26      TEXTC    'SEQUENCE SPECIFICATION NOT VALID'
M27      TEXTC    'RECORD SELECTION SPECIFICATION NOT VALID'
M28      TEXTC    'PK/BIN/7T COMBINATION NOT VALID'
M29      TEXTC    'NULL ARGUMENT (TWO DELIMITERS IN A ROW)'
M30      TEXTC    'IMPROPER TERMINATION OF THE COMMAND'
M31      TEXTC    'ONE REEL NUMBER MUST BE SPECIFIED ON THIS COMMAND'
M32      TEXTC    'TO, INTO, OR OVER NOT SPECIFIED'
M33      TEXTC    'RECORD SIZE EXCEEDS AVAILABLE MEMORY'
M34      TEXTC    'INVALID DEVICE TYPE FOR THIS COMMAND'
M35      TEXTC    'TOO MANY REEL NUMBERS SPECIFIED'
M36      TEXTC    '''TO'' FILE EXISTS'
M37      TEXTC    'INVALID DIRECTION INDICATOR ON ''SPF'' COMMAND'
M38      TEXTC    'INPUT RECORD SIZE LARGER THAN 32767 BYTES'
M39      TEXTC    'INVALID OPTION FOR THIS COMMAND'
M40      TEXTC    'TOO MANY SN,RD,WR,EX,UN SPECIFICATIONS'
M41      TEXTC    'RS SPECIFICATION BEYOND END OF FILE'
M42      TEXTC    'ERROR IN COMPRESSED INPUT'
M43      TEXTC    'PCL NEEDS AT LEAST TWO DATA PAGES TO RUN'
M44      TEXTC    'TOO MANY ERRORS - PROCESS ABORTED'
M45      TEXTC    'INVALID TAB SPECIFICATION'
M46      TEXTC    'OVERFLOW ON EDIT LINE NUMBER'
M47      TEXTC    'ZERO INCREMENT ON CS OR LN OPTION'
M48      TEXTC    'TX OPTION USED WITHOUT TABS COMMAND'
M49      RES
M50      TEXTC    'CONFLICTING OR DUPLICATE OPTION'
M51      TEXTC    'MORE THAN 16 TAB VALUES'
M52      TEXTC    'INVALID HEXADECIMAL NUMBER'
M53      TEXTC    'TOO MANY CHARACTERS IN THE COMMAND'
M54      TEXTC    'INVALID VALUE FOR ANS OPTION'
M55      TEXTC    'TOO MANY BLANKS IN A DELETE COMMAND'
M56      TEXTC    'ERROR WRITING LISTING OUTPUT'
M57      TEXTC    'TAPE DENSITY SPECIFICATION IS IN ERROR'
         FIN
         TITLE    'ERROR'
ERROR    RES      0
*
*P*      NAME:    ERROR
*P*
*P*      PURPOSE: TO REPORT AN ERROR FOR SUBSEQUENT PRINTING BY PRTERR.
*P*               THIS IS DONE BY ENTERING A '%' POINTER INTO THE ERROR
*P*               FLAG BUFFER AND, IF CPV, ENTERING INTO A TABLE THE
*P*               KEY NEEDED TO READ THE DESIRED MESSAGE FROM THE
*P*               SYSTEM ERROR MESSAGE FILE (ERRMSG.:SYS).  IN BPM, THE
*P*               TABLE ENTRY IS AN INDEX INTO AN INTERNAL ERROR
*P*               MESSAGE TABLE.
*P*
*DO*
*P*
*
* INPUT
*        R1       ERROR TO BE FLAGGED
* OUTPUT
*        ERRFLAG  ERROR FLAG BUFFER
*        D2       MAXIMUM ERROR SEVERITY
*                    (1-WARNING, 2-TERM EXEC, 3-TERM EDIT AND EXEC)
*
*
*FIN*
*
         LCI      2
         PSM,R2   *R7
*
ERR1     CB,D2    SEVERE,R1         UPDATE MAX SEVERITY
         BGE      %+2
         LB,D2    SEVERE,R1
         LW,R2    CMBX,R7
         AI,R2    -CMBX1
         BEZ      RETURN2           BLANK PCL COMMAND.
         CI,R2    X'FFF80'          MUST BE 0-127
         BAZ      %+2               YES
         LI,R2    255
         MI,R1    256               MAKE PCL ERROR MESSAGE KEY
         BNEZ     ERR3              NOT IO ERROR
         LB,R1    SR3               GEN IO KEY
         SLS,R1   8
         AH,R1    SR3
         SLS,R1   -1
         AI,R1    -X'10000'
ERR3     AI,R1    X'10000'
         STB,R2   R1
*
         LW,R2    ERRFLAG
         CI,R2    9                 ROOM FOR ERROR KEY
         BE       RETURN2           NO-CAN NOT REPORT
         STW,R1   ERRFLAG+1,R2
         CW,R1    ERRFLAG,R2        HAVE WE DONE THIS BEFORE
         BE       RETURN2           YES
         BDR,R2   %-2
         MTW,1    ERRFLAG           NO, COUNT IT
         PAGE
RETURN2  SLS,R1   8
         EOR,R1   SAMERR            CHECK FOR 20 SAME ERRORS IN A ROW
         BEZ      ERR44             HAPPENNED, ABORT
         CI,R1    X'FFF00'          IS THIS THE SAME AS LAST ONE
         BAZ      %+4               YES, JUST COUNT DOWN
         EOR,R1   SAMERR            NO, PUT IN NEW ONE
         AI,R1    21                WITH A NEW COUNT
         STW,R1   SAMERR
         MTW,-1   SAMERR
ERR2     LCI      2                 AND EXIT
         PLM,R2   *R7               RESTORE REGISTERS
         B        *SR4              RETURN2
*
ERR44    CI,D2    1                 ONLY ABORT IF MAJOR ERROR
         BLE      ERR2
         STW,R1   ERRFLAG           FORGET OTHER ERRORS
         LI,R1    44                TO ASSURE THIS ONE GET OUT
         B        ERR1
*
*                 I 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1
*                 O 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5
*
SEVERE   DATA,1   2,2,2,2,2,2,2,2,3,2,2,2,1,2,3,3
*                 1 1 1 1 2 2 2 2 2 2 2 2 2 2 3 3
*                 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1
*
         DATA,1   3,3,2,3,3,2,2,2,2,2,2,2,2,1,1,2
*                 3 3 3 3 3 3 3 3 4 4 4 4
*                 2 3 4 5 6 7 8 9 0 1 2 3
*
         DATA,1   3,3,3,3,3,3,3,2,3,1,3,4
*                 4 4 4 4 4 4 5 5 5 5 5 5
*                 4 5 6 7 8 9 0 1 2 3 4 5
*
         DATA,1   4,3,3,2,1,4,2,1,2,3,3,3
*                 5 5 5 5
*                 6 7 8 9
*
         DATA,1   3,3,4,4
*
RSTACK   EQU      0                 USER STORAGE LAYOUT
*        +0
*        +1       STACK POINTER
*        +2       HEADING FLAG
SYNFLAG  EQU      RSTACK+3          HAS A SYNNONYM FILE NAME BEEN ENCOUN
BUFSIZE  EQU      RSTACK+4          BYTE SIZE OF RD/WR BUFFER
ARGBUFF  EQU      BUFSIZE+1         CURRENT ARGUMENT BUFFER
ARGTBL   EQU      ARGBUFF+16
CMBX     EQU      ARGTBL+36
CMDBUF   EQU      CMBX+1
DCBADD   EQU      CMDBUF+35         CURRENT DCB ADDRESS
INSWT    EQU      DCBADD+1
MAXCMBX  EQU      INSWT+1
NCHAR    EQU      MAXCMBX+1
NPAGE    EQU      NCHAR+1
PREVACT  EQU      NPAGE+1
RDFPT    EQU      PREVACT+1
TERM     EQU      RDFPT+7
TOARG    EQU      TERM+1
TOSWT    EQU      TOARG+17
WRTFPT   EQU      TOSWT+1
TOVER    EQU      WRTFPT+8          OUTPUT ACTION VERB
SFACCT   EQU      TOVER+1           STD FILE ACCT FLAG
PRNTBUF  EQU      SFACCT+2          HEX DUMP PRINT BUF (EVEN ADR)
RECNUM   EQU      PRNTBUF+34        NUMBER OF CURRENT RECORD
SAVCMBX  EQU      RECNUM+1          CMBX SAVE WORD
ATTRB    EQU      SAVCMBX+1         ATTRIBUTE FLAG
#DELIM   EQU      ATTRB+1           # DELIMITER FLAG
CARDSEQ  EQU      #DELIM+1          2-WORD SEQUENCE INFORMATION
KEY      EQU      CARDSEQ+2
TABSET   EQU      KEY+1
RSSAVE   EQU      TABSET+5
SYNONYM  EQU      RSSAVE+1          SYNON FLAG
SFTEMP   EQU      SYNONYM+1         NAME OF TEMP STD FILE
SCRATCH  EQU      SFTEMP+1          SCRATCH TAPE SN
COPYSTDF EQU      SCRATCH+1
*
DEVICE   EQU      ARGTBL            ARGUMENT TABLE LAYOUT
FILE     EQU      DEVICE+3
CODE     EQU      FILE+2
MODE     EQU      CODE+1
SEQUENCE EQU      MODE+4
SELECT   EQU      SEQUENCE+5
CIBUSED  EQU      ARGBUFF
CIBLEFT  EQU      CIBUSED+1
CIBTOTAL EQU      CIBLEFT+1
CIWORD   EQU      CIBTOTAL+1
RECSIZE  EQU      CIWORD+1
CISEQ    EQU      RECSIZE+1
COBUSED  EQU      COPYSTDF+1
COBLEFT  EQU      COBUSED+1
COWORD   EQU      COBLEFT+1
CONTPTR  EQU      COWORD+1          CONT STMT POINTER
CONTMODE EQU      CONTPTR+1         CONT STMT FLAG
TELCONT  EQU      CONTMODE+1        TEL CONT STMT FLAG
EXPIRE   EQU      TELCONT+1         EXP DATE -3-WD TEXTC FORMAT
IN%ARG   EQU      EXPIRE+3
OUT%ARG  EQU      IN%ARG+1
DEV%SAV  EQU      OUT%ARG+1
DEV%SAV1 EQU      DEV%SAV+1
CMBXHLD  EQU      DEV%SAV1+1   SIDR#SIG7-11335
DEL%CT   EQU      CMBXHLD+1
*
ARGBUF4  EQU      ARGBUFF*4         BYTE EQUIVALENTS
*
TLBLSIZE EQU      255               BYTE SIZE OF TLABEL
CONTINUE EQU      256               CONT STMT CONCAT AREA
CMBX1    EQU      CONTINUE*4        START OF BUFFER
IOBUF    EQU      512
FPARAM   EQU      IOBUF+35
OPNFPT   EQU      IOBUF+256
PRTBUF   EQU      IOBUF-40
SEQNUM   EQU      IOBUF-5
LINENO   EQU      IOBUF-3
STRDFPT  EQU      PRTBUF            STD FILE READ FPT
*
IOABORTS DATA,2   #IOABTS
         DATA,2   X'D00',X'D02',X'1410',X'1422',X'1424',X'1426'
         DATA,2   X'2002',X'2004',X'2006',X'2008'
         DATA,2   X'4900',X'4902',X'4904',X'5500',X'5700'
         DATA,2   X'7508',X'750A',X'750C'
#IOABTS  EQU      HA(%)-HA(IOABORTS)-1
         BOUND    4
*
CMDTBL   DATA     CMDTBL1-%         COMMAND ACTION VERB TABLE
         TEXTC    'TO '
         TEXTC    'COP'
         TEXTC    'DEL'
         TEXTC    'END'
         TEXTC    'LIS'
         TEXTC    'REM'
         TEXTC    'REW'
         TEXTC    'SPF'
         TEXTC    'SPE'
         TEXTC    'WEO'
         TEXTC    'ON '             11
         TEXTC    'OVE'             12
         TEXTC    'TAB'
         TEXTC    'REV'
         TEXTC    'PCL'
         TEXTC    ' PC'             BURN BATCH PCL COMMAND
         TEXTC    'SPR'
         TEXTC    'INT'             INTO - 18
         TEXTC    'ERR'             ERRORS ON/OFF
         TEXTC    'PRI'             PRINT
         TEXTC    'MOU'             MOUNT
CMDTBL1  EQU      %-1
CMDTBLX  DATA     CMDTBLX1-%
         TEXTC    ' '
         TEXTC    'C'
         TEXTC    'D'
         TEXTC    'E'
         TEXTC    'L'
CMDTBLX1 EQU      %-1
         DO1      VERSION=1
J:JIT    DATA     0                 SIMULATE JIT FOR BATCH MODE
*                                   TESTING UNDER BPM
         PAGE
         DO       VERSION=2
INT      EQU      %                 BREAK CONTROL ROUTINE
         MTW,1    BREAK             SET BREAK
         LI,R3    X'1FFFF'
         AND,R3   0,R1
         CI,R3    REVRP             IF READ1 READ, READ NONE
         BNE      %+2
         MTW,1    0,R1
         CAL1,8   RSTBRK            RESET BREAK COUNT
         CAL1,9   5                 RETURN TO PROGRAM
RSTBRK   DATA     X'6200000',X'80000000',3
         FIN
*
BREAK    DSECT    0
         DATA     0                 BREAK CONTROL FLAG
BOG      DATA     0                 BIT 0 SET FOR ONLINE USER
*                                   BIT 1 SET FOR GHOST JOB INITIATED
*                                   FROM OPERATOR'S CONSOLE
*                                   BIT 2 SET FOR BATCH USER
ERRFLAG  DATA     0,X'FF0110CC'     ERROR CODES AREA(WITH 43 ERR IN)
         RES      8
LTSTCMBX DATA     0                 SAVE OF LATEST CMBX POINTER
SUPERR   DATA     0                 IGNORE MINOR ERRORS FLAG
BLKSIZE  DATA     0                 SIZE OF ANS BLOCK
UNBADR   DATA     0                 POINTER INTO ANS INPUT BLOCK
BLKBUFF  DATA     0                 POINTER INTO ANS OUTPUT BLK
DCBS     DATA     X'FFFFFF'         BIT0=>DO=LL
*        BIT1=>SI=LL,BIT2=>UC=LL,BIT3=>UC=DO
*        BITS4-15=0 OR 1=> LO=LP
*        BITS16-31=0 OR 1 => LL=LP
INIT0    EQU      %-1
ANSBLK   RES      4                 4WD TBL OF ANS OPTIONS
DENSITY  DATA     0                 MUST FOLLOW ANSBLK+3
INCRPT   DATA     0,0
OUTCRPT  DATA     0,0
SFDEV    RES      2                 COPYSTD SAVE AREA
DELETEF  DATA     0                 REVIEW FLAG
FROMFILE RES      8                 START OF RANGE OF FILES
TOFILE   RES      8                 END OF FILE RANGE
         BOUND    8
RDTBL    RES      0                 RD OPTION COUNT+CMBX
STACK GEN,32,16,16 OH:NM+OV:NMSZ,STACKSIZE,0
WRTBL    RES      2                 WR OPTION COUNT + CMBX
EXTBL    RES      2                 EX COUNT+CMBX
UNTBL    RES      2                 UN COUNT+CMBX
DATETBL  RES      0                 DATES FOR LIST
         BOUND    8
DCBNS    DATA     M:DO,M:LL
         DATA     M:SI,M:LL
         DATA     M:UC,M:LL
         DATA     M:UC,M:DO
#DCBS    EQU      %-DCBNS-1
         ORG      DATETBL+12        12 WORDS FOR DATES(OVER DCBS)
COPYSK   RES      1                 COPYALL SELECT FLAG
EATTRB   DATA     0                 EA FLAG
SFARG    RES      16                STANDARD SAVE AREA
LISTCMBX DATA     0                 SAVE CMBX FOR LIST
LISTTERM DATA     0                 SAVE TERM FOR LIST
FROMCMBX DATA     0                 CMBX OF END OF FROM IN RANGE
COPYPHY  DATA     0                 PHY FLAG
SFCNT    DATA     0                 COPYSTD COUNT
GRANCNT  DATA     0                 GRANULE CONT
TLABEL   RES      64                TLABEL BUFFER
DVLARG   RES      36                DEVICE LEVEL ARGS
#WDSINIT0 EQU     %-INIT0-1
SAMERR   DATA     X'14000000'       ABORT AFTER 20 SAME ERRORS
MAXSEV   DATA     0                 SET STEP CCS TO HIGHEST LEVEL
INSER    DATA     0
OUTSER   DATA     0
PATCH    RES      200               PATCH AREA
STACKSIZE EQU 512+BREAK-OV:NMSZ-OH:NM
         USECT    PCL
         END      PCL

