*M*      COPYTRAN COPY COMMAND TRANSLATOR
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
         PAGE
         TITLE    'COPYTRAN'
COPYTRAN DSECT    1
         SYSTEM   SIG7
*
*P*      NAME:    COPYTRAN
*P*
*P*      PURPOSE: TO TRANSLATE ALL ARGUMENTS SPECIFIED IN EITHER THE INPUT OR
*P*               THE OUTPUT FIELD OF A COPY COMMAND.  THE RESULTS OF THE
*P*               TRANSLATION ARE ENTERED IN THE ARGUMENT TABLE, ARGTBL.
*P*               COPYTRAN IS ALSO CALLED TO TRANSLATE THE INPUT FIELD OF A
*P*               COPYSTD COMMAND.
*P*
*DO*
*P*
*
* INPUT
*        R1       ARGUMENT LEVEL (1-DEVICE,2-FILE)
*        ARGBUFF  ARGUMENT BUFFER
*        NCHAR    LENGTH OF CURRENT ARGUMENT
*        TERM     TERMINATOR FOR CURRENT ARGUMENT
* OUTPUT
*        R1       NEXT ARGUMENT LEVEL (0-NONE,1-DEVICE,2-FILE)
*        ARGTBL   ARGUMENT TABLE (SEE DEVICE-SELECT BELOW)
*
*        DEVICE   +0    DEVICE ID CODE
*                 +1    NUMBER OF REEL NO.
*                 +2    COMMAND BUFFER INDEX OF FIRST REEL NO.
*        FILE     +0    FILE ID INDICATOR (1=N,2=N.A,3=N.A.P,6=A)
*                 +1    COMMAND BUFFER INDEX OF FILE NAME
*        CODE     +0    DATA CODE/FORMAT ID
*        MODE     +0 - BYTE 0       BCD/BIN ID CODE
*                      BYTE 1       NB ID CODE
*                      BYTE 2       UNUSED
*                      BYTE 3       VOL
*                 +1 - BYTE 0       UNUSED
*                      BYTE 1       EXP
*                      BYTE 2       UNUSED
*                      BYTE 3       7T/9T/ASCI/EBCD ID CODE
*                 +2 - BYTE 0       RD/WR
*                      BYTE 1       K ID CODE
*                      BYTE 2       TX ID CODE
*                      BYTE 3       PK/UPK ID CODE
*                 +3 - BYTE 0       SSP/DSP/VFC ID CODE
*                      BYTE 1       NC/CR ID CODE
*                      BYTE 2       FA/NFA ID CODE
*                      BYTE 3       DEOD ID CODE
*        SEQUENCE +0    SEQUENCE ID CODE
*                 +1    NCHAR IN ID
*                 +2    INITIAL VALUE
*                 +3    INCREMENT
*                 +4    MAXIMUM VALUE
*        SELECT   +0    NO. OF SELECTIONS
*                 +1    LOW VALUE OF FIRST SELECTION
*                 +2    HIGH VALUE OF FIRST SELECTION
*                 +20   HIGH VALUE OF LAST SELECTION
*
*FIN*
         REF      CLRARG
         REF      #DELIM
         REF      ERROR,FIXARG,INTARG,GETARG,BCD2BIN
         REF      DEVTRAN           TRANSLATE DEVICE SPECIFICATION
         REF      FILTRAN           TRANSLATE FILE SPECIFICATION
         REF      DEV%SAV1          SAVE DEVICE CODE FOR TESTARG
         REF      COPYSK            SELECTIVE COPYALL ON FILE ORG
         REF      COPYPHY           COPYALL RANGE IN PHYSICAL TAPE ODER
         REF      ERRFLAG           ERROR CODES
         REF      HEX2BIN           CONVERT STR FROM HEX
         REF      IN%ARG            SET RESOURCE TYPE FOR COPYSTD
         REF      OUT%ARG           DEFAULT COPY TO ME
         REF      INCRPT            INPUT ENCRYPTION
         REF      MAXSN             UPPER LIMIT FOR VOL OPT
         DEF      ALLC              TYPE NAME/ERROR FOR MULTIFILERS
         DEF      SKIPTXT           TEXT FOR SPE MESSAGE
         REF      NCHAR,TERM,ARGBUFF,ARGBUF4
         REF      ARGTBL,DVLARG
         REF      CODE,MODE,SEQUENCE,SELECT
MODEX4   EQU      MODE+MODE+MODE+MODE
         REF      CMBX
         REF      SAVCMBX,DEVICE
         REF      FILE
         REF      CARDSEQ
         REF      MBS
         REF      TABSET,J:JIT
         REF      M:UC
         REF      COPYSTDF,SFARG
         REF      RDTBL,WRTBL,TEXTARG
         REF      ANSBLK
         REF      EXPIRE
         REF      LISTTERM
         REF      UNTBL,EXTBL
*
         USECT    COPYTRAN
         LCI      7                 SAVE REGISTERS
         PSM,R5   *R7
*
         STW,R1   SR1               SAVE LEVEL  1-DEVICE, 2-FILE
*
         CI,SR1   1                 DEVICE ARGUMENT LEVEL
         BNE      FILE1             NO-FILE ARGUMENT LEVEL
         BAL,SR4  CLRARG            CLEAR -ARGTBL-
         LW,R4    TERM,R7
         CI,R4    X'40'
         BE       DEV1
         CI,R4    X'15'
         BE       DEV1
         CI,R4    ';'
         BE       DEV1
         LI,R1    17                SYNTAX ERROR
         BAL,SR4  ERROR
DEV1     LW,R5    CMBX,R7
         STW,R5   SAVCMBX,R7        SAVE CURRENT CMBX
*
         BAL,SR4  DEVTRAN           TRANLATE DEVICE ID
         MTW,0    COPYSTDF,R7       ARE WE COPYING A STD FILE
         BGEZ     DEV3              NO
         LI,R1    12                MOVE NON-DEVICE ARGS
         LI,R2    DEVICE+3
         AW,R2    R7
         LW,R3    SFARG+3,R1
         STW,R3   *R2,R1            FROM COMMAND LINE
         BDR,R1   %-2
         CW,R5    CMBX,R7           DID WE GET A DEVICE CODE
         BE       DEV2              NO, USE STD FILE ONE
         LI,R1    '/'               WILLWE GET A FILE NAME
         CW,R1    TERM,R7
         BE       DEV3              YES, DONT USE OLD DEVICE
         STW,R1   TERM,R7           NO, MAKE SURE WE DO
         STW,R5   CMBX,R7
DEV2     RES
         STW,R3   IN%ARG,R7         NO, SAVE COMMAND LINE ONE
         LI,R1    -3                AND MOVE REST OF ARGS
         LW,R3    SFARG+3,R1
         STW,R3   *R2,R1
         BIR,R1   %-2
DEV3     EQU      %
         BAL,SR3  TEST0             SET UP DEV%SAV1
         STW,R0   SAVCMBX,R7        ZERO CMBX SAVE FLAG
*
         LW,R5    TERM,R7           TEST FOR TERMINATION ON LT. PAREN
         CI,R5    X'4D'             ARGUMENTS FOR DEVICE
         BE       SPECARG           YES-GO TRANSLATE SPEC. ARGUMENTS
DEVRTN   CI,R5    '/'               FILE FOLLOW
         BNE      TESTEND           NO
*
         LI,R1    36                YES-SAVE DEVICE LEVEL ARGUMENTS
         LW,R2    R7
         LW,R3    ARGTBL+35,R2
         STW,R3   DVLARG-1,R1
         AI,R2    -1
         BDR,R1   %-3
         LI,SR1   2                 SET LEVEL TO FILE
         B        FILE2
*
FILE1    LI,R1    36                RESTORE DEVICE LEVEL -ARGTBL-
         LW,R2    R7
         LW,R3    DVLARG-1,R1
         STW,R3   ARGTBL+35,R2
         AI,R2    -1
         BDR,R1   %-3
*
FILE2    BAL,SR4  FILTRAN           GO-TRANSLATE FILE ID N.A.P
         LI,R1    1                 TEST LEGALITY OF FILE
         BAL,SR3  TESTARG
*
         LW,R5    TERM,R7           TEST FOR TERMINATION ON LT. PAREN
         CI,R5    X'4D'             (
         BE       SPECARG           YES-GO TRANSLATE SPEC. ARGS.FOR FILE
FILRTN   CI,R5    X'6B'             TERM ON ,
         BE       COMBINE1          YES-NEW FILE
         LI,SR1   1                 SET LEVEL TO DEVICE
*
TESTEND  CI,R5    X'5E'             TERM ON ;
         BE       COMBINE1          YES-NEW DEVICE
         LI,SR1   0                 CLEAR ARG. LEVEL
         CI,R5    X'40'             TERM ON BLANK
         BE       COMBINE1          YES-END OF INPUT FILES
         CI,R5    X'15'             END OF COMMAND
         BE       COMBINE1          YES-END OF COMMAND
         LI,R1    17                ERROR 17
         BAL,SR4  ERROR
*
COMBINE1 RES
         B        RETURN
*
*
TEST0    LW,R6    DEVICE,R7         GET DEVICE CODE
         CI,D1    2                 INPUT OR OUTPUT
         BE       %+2
         AI,R6    6
         LW,R2    COPYSTDF,R7       GET COPYSTDF
         BNEZ     %+4               1=> STD FILE, -1=> SELECTED NAME
         AI,SR1   0                 COPYALL FLAG (=-1)
         BGEZ     %+2
         LI,R2    2
         LW,R2    CMNDFLGS,R2
         AW,R2    R6
         STW,R2   DEV%SAV1,R7       SAVE FOR TESTARG
         LI,R1    21                CHECK CODE FOR LEGAL INPUT
         CI,D1    2                 OR OUTPUT VALUE
         BNE      %+3
         STW,R0   INCRPT            CLEAR ONLY NONARG PARAMETER
         LI,R1    19
         CI,R6    8
         EXU      TESTDEV,R1
         BAL,SR4  ERROR
TESTDEV  EQU      %-19
         BLE      TEST2
         B        TEST2
         BG       TEST2
CMNDFLGS EQU      %+1
         GEN,8,24 49,X'800'
         GEN,8,24 39,X'4000'
         GEN,8,24 39,X'1000'
         GEN,8,24 39,X'2000'
TEST2    LI,R1    0                 CHECK FOR REEL# LEGALITY
         MTW,0    DEVICE+1,R7
         BEZ      *SR3
TESTARG  LW,R6    DEV%SAV1,R7       DEVICE CODE
         LI,R2    X'7F00'           CHECK FOR LEGALITY WITH
         AND,R2   EDITBL,R1
         CW,R2    R6                COMMAND TYPE
         BANZ     TESTE             NO GOOD
         LW,R2    EDITBL,R1         LOCATE DEFINING BIT FOR COMBINATION
         STB,R2   R6                SAVE ERROR CODE
         SLS,R2   -1,R6
         CI,R2    0                 TEST FOR LEGAL COMBINATION
         BL       *SR3
TESTE    XW,R1    R6
         LB,R1    R1                GET ERROR CODE
         BAL,SR4  ERROR
         LW,R1    R6
         B        *SR3
         PAGE
COPYOPT  LCI      7                 ENTRY FOR OPTIONS ONLY
         PSM,R5   *R7
         LI,SR1   -1                SET FLAG
         BAL,SR3  TEST0             CHECK DEVICE, ETC.
         LW,R1    TERM,R7           CHECK FOR OPTIONS
         CI,R1    '('
         BNE      RETURN
SPECARG  RES
SPECARG2 LI,SP    1                 INITIALIZE TO LEVEL ONE
         PAGE
         LI,SR4   %+3
GETARG0  LI,R1    0                 FEW DELIMITER
         B        GETARG
*
         LW,R2    NCHAR,R7          NULL SPECIAL ARGUMENT
         BGZ      CODE1             NO
         LI,R1    29                ERROR 29
         BAL,SR4  ERROR
         B        ENDSPEC
*
CODE1    LI,R1    CODETBL           SEARCH DATA CODE TABLE FOR MATCH
         BAL,SR4  FIXARG
         CI,R1    0                 FIND A DATA CODE
         BE       RCDSEL1           NOTRECOGNIZABLE, MUST BE A NUMMER
         BAL,SR3  TESTARG           CHECK VALIDITY
         SLS,R1   -1                GET SINGLE INDEX
         CI,R1    CODEEND           IS IT A DATA CODE
         BGE      MODE1             NO TRY A MODE
         XW,R1    CODE,R7           STORE AND TEST PREVIOUS SPEC
         BNEZ     DUPERR
         B        ENDSPEC           CHECK PROPER TERMINATION
*
MODE1    CI,R1    MODEEND           GOT A MOE TYPE
         BGE      ANS1              NO, MEBBE ANS TYPE
         AI,R1    -CODEEND+1        GET MOE CODE
*
         LB,R2    MODEDPL,R1        STORE MODE ID CODE
         MTB,0    *R7,R2            DO WE HAVE THIS TYPE ALREADY
         BNEZ     DUPERR
         STB,R1   *R7,R2
         AI,R1    -(TXOPT-CODEEND+1)
         BG       EXPARG            EXP OR VOL
         BNE      ENDSPEC           NO
         MTW,0    TABSET+4,R7       ARE THERE PCL TABS IN EFFECT
         BNEZ     ENDSPEC           YES
         MTW,0    J:JIT
         BLZ      MODE2             ON-LINE MODE
MODE4    LI,R1    48                TX OPTION USED WITHOUT TABS CMD
         BAL,SR4  ERROR
         B        ENDSPEC
MODE2    EQU      %
         MTB,0    M:UC+15
         BEZ      MODE4             NO TABS IN M:UC
         LI,R1    M:UC+15
         STW,R1   TABSET+4,R7       SET ADR FOR USE IN TAB EXPANSION
         B        ENDSPEC           CHECK PROPER TERMINATION
FMTVAL   TEXTC    'FDVU'
ANS1     CI,R1    ANSEND            IS IT ANS TYPE
         BGE      RW1               NOPE, TRY ACCT/VEHICLE TYPE
         AI,R1    -MODEEND+1
         LW,R6    R1                SAVE INDEX
         LW,R3    TERM,R7
         CI,R3    '('
         BNE      ANS9              VALUE MUST BE PRESENT
         BAL,SR4  GETARG0
         CI,R6    3                 IS IT FMT OPT
         BNE      ANS3              NO
         LW,R2    ARGBUFF,R7
         MTB,-1   R2                MUST BE ONE CHAR
         BNEZ     ANS4              BADDIE
         SLS,R2   -16
         LI,R3    4                 FOUR FORMATS
         CB,R2    FMTVAL,R3
         BE       ANS6              GOT ONE
         BDR,R3   %-2
ANS4     LB,R1    ANSE,R6           GET PROPER ERROR CODE
         BAL,SR4  ERROR
         B        ANS8
ANSE     DATA     X'00363636',X'36393400'
ANSL     DATA     X'00010101',X'02FF0000'
ANS3     LB,R1    ANSL,R6           GET LOWER LIMIT
         BEZ      CRPT              NONE, MUST BE CRPT
         LI,R2    32767             MAX VALUE
         BAL,SR4  INTARG            CONVERT AND TEST
         AI,R2    0
         BNE      ANS4              INVALID
         CI,R6    3                 TEST IF BLK OR REC(1,2)
         BL       ANS6              YUP 1-32767 IS GOOD
         BANZ     DEN1              DENSITY (5)
         CI,R3    128               MAX CAT
         BG       ANS4              OUT OF RANGE VALUE
ANS6     EXU      DUPERR            LOAD R1 FOR DUPERR
         XW,R3    ANSBLK-1,R6       SET/TEST VALLUE
         BNEZ     ANS4+1
ANS8     LW,R2    TERM,R7
         CI,R2    ')'
         BE       ENDSPL24
ANS9     LI,R1    17
         B        ENDSPL26          SYNTAX ERROR
*
CRPT     BAL,SR4  HEX2BIN
         AI,R4    0
         BNE      ANS4              NO GOOD
         CI,D1    2                 IN OR OUT
         BE       %+2
         AI,R6    2                 OUT, USE ITS SPACE
         STW,R3   ANSBLK,R6
         ANLZ,R3  %-1
         B        ANS6
DEN1     CI,R3    800               MUST BE 800 OR 1600
         BE       %+3
         CI,R3    1600
         BNE      ANS4
         SLS,R3   -9                MAKE IT 1 OR 2
         B        ANS6
*
RW1      CI,R1    RWEND             IF NOT RD,WR,EX,UN
         BL       RWACCT            MUST BE SEQ OR SPECIAL TYPE
         CI,R1    SEQEND            DO WE HAVE SEQUENCE TYPE
         BGE      SPEC1             NO
         AI,R1    -RWEND+1          MAKE SEQUENCE TYPE
         MTW,0    SEQUENCE,R7       CHECK CONFILCT
         BNEZ     DUPERR
         STW,R1   SEQUENCE,R7       STORE SEQUENCE ID CODE
*
         CI,R1    3                 CS OR NL
         BL       ENDSPEC           NEITHER- CHECK PROPER TERMINATION
         LI,ID    0                 INITIALIZE IN CASE NO ARGUMENTS
         AI,R1    -1                SET SPEC LEVEL 2-CS 3-LN
         STW,R1   SP
         LW,R2    TERM,R7           TERM ON (
         CI,R2    X'4D'
         BNE      SPECL2            NO
         LI,ID    1                 SET FIRST ARG CS OR LN
NEXTARG  LI,R1    12
         BAL,SR4  GETARG
         B        SPECL2
*
SPEC1    AI,R1    -SEQEND+1
         LW,R2    SPEC2,R1          GET WHERE TO STORE
         AI,R1    X'30000'          SET UP FOR INT..CS ORG+DCB
         SLS,R1   4
         XW,R1    0,R2
         BNEZ     DUPERR
         B        ENDSPEC
SPEC2    EQU      %-1
         DATA     COPYSK,COPYSK,COPYSK
         DATA     COPYPHY
         PAGE
EXPARG   LW,R6    R1                SAVE INDEX
         AI,R1    -'('
         BNE      ERR11             BAD SYNTAX
         BAL,SR4  GETARG            GET FIRST ARGUMENT
         LW,R4    TERM,R7
         CI,R4    ')'
         BDR,R6   VOLARG            VOLUME
         BE       EXP5              ONLY ONE ARGUMENT
         LI,R6    0                 PREPARE FOR SCAN OF MM,DD,YY
         LI,SR1   EXPIRE
         AW,SR1   R7                ADDRESS OF EXPIRE BUFFER
EXP1     LW,R2    ARGBUFF,R7        GET ARGUMENT
         LB,R1    R2                GET LENGTH
         BEZ      EXPERR1           INVALID
         CI,R1    2
         BG       EXPERR1           GR THAN 2
EXP12    LB,R3    R2,R1             TEST FOR NUMERICS
         CLM,R3   LIMIT1
         BCS,9    EXPERR1           NO GOOD
         BDR,R1   EXP12
         LB,R1    R2                GET LENGTH AGAIN
         AND,R2   =X'FFFFFF'        MASK OFF COUNT
         EXU      SHIFT-1,R1        RIGHT JUSTIFY
         OR,R2    =X'F0F0'          INSURE 2 CHARS
         CLM,R2   LIMIT2,R6         TEST VALUE
         BCS,9    EXPERR1           NO GOOD
EXP2     STH,R2   *SR1,R6           ENTER VALUE IN BUFFER
         AI,R6    1
         EXU      BRTAB-1,R6        SELECT BRANCH FOR NEXT ARG
         LI,R2    X'F0F0'           SET HOUR VALUE
         B        EXP2              GO STORE
EXP3     LW,R1    TERM,R7
         CI,R1    ','               TEST FOR CORRECT DELIMITER
         BE       EXP4
         CI,R1    '/'
         BE       EXP4              OK
         LI,R1    17                BAD SYNTAX
         BAL,SR4  ERROR
EXP4     EQU      %
         BAL,SR4  GETARG0
         B        EXP1
EXP9     LW,R2    EXPIRE,R7
EXP92    LI,R3    0                 CONVERT TO TEXTC FORMAT
         SLD,R2   -8
         OR,R2    =X'08000000'      SET 8 CHAR LENGTH
         STW,R2   EXPIRE,R7
         LW,R4    EXPIRE+1,R7
         SLD,R4   -8
         OR,R4    R3
         STW,R4   EXPIRE+1,R7
         STW,R5   EXPIRE+2,R7
         B        ENDSPL24
*
EXP5     LW,R2    ARGBUFF,R7        ONLY ONE ARG PRESENT
         LW,R3    ARGBUFF+1,R7
         CD,R2    NEVER             TEST IF 'NEVER'
         BNE      %+3
         SLD,R2   8                 YES - LEFT JUSTIFY
         B        EXP6
         LB,R1    R2                GET LENGTH
         BEZ      EXPERR            INVALID
         CI,R1    3
         BG       EXPERR            GR THAN 3 - INVALID
EXP52    LB,R3    R2,R1             TEST FOR NUMERICS
         CLM,R3   LIMIT1
         BCS,9    EXPERR            NO GOOD
         BDR,R1   EXP52
         LB,R1    R2                GET LENGTH AGAIN
         AND,R2   =X'FFFFFF'        MASK OFF COUNT
         EXU      SHIFT-1,R1        RIGHT JUSTIFY
         OR,R2    =X'40F0F000'      INSURE LEADING ZEROES
         LW,R3    =X'F0F04040'      HOUR VALUE
EXP6     STW,R2   EXPIRE,R7         PUT VALUE IN BUFFER
         STW,R3   EXPIRE+1,R7
         B        EXP92             GO WIND UP
EXPERR   LI,R1    17
         BAL,SR4  ERROR
         B        ENDSPL24
EXPERR1  LI,R1    17
         BAL,SR4  ERROR
         B        EXP2+1
*
SHIFT    SLS,R2   -16
         SLS,R2   -8
         NOP
         BOUND    8
LIMIT1   DATA     X'F0',X'F9'
LIMIT2   DATA     X'F0F1',X'F1F2'   MONTH
         DATA     X'F0F1',X'F3F1'   DAY
         DATA     0,0
         DATA     X'F0F0',X'F9F9'   YEAR
NEVER    TEXTC    'NEVER'
BRTAB    B        EXP3              GET DAY
         NOP                        PUT IN HOUR
         B        EXP3              GET YEAR
         B        EXP9              WIND UP
         PAGE
VOLARG   BNE      ANS9              MUST BE ( NXT
         LI,R1    1                 LIMITS FOR VOL
         LI,R2    MAXSN
         BAL,SR4  INTARG
         AI,R2    0
         BNEZ     VOLERR
         LI,R1    MODEX4+3
         STB,R3   *R7,R1
         B        ANS8
VOLERR   LI,R6    0                 SET 6 FOR ANS4
         B        ANS4
         PAGE
RCDSEL1  EQU      %
         LI,R5    1                 INITIALIZE X
         LI,R6    2                 LOOP COUNTER
         LI,R1    ARGBUF4+1
         LW,R2    NCHAR,R7
*
RCDSEL3  BAL,SR4  BCD2BIN           CONVERT SELECTION INTEGER TO BINARY
*
         CI,R4    2                 OVERFLOW
         BE       ERR11
         CW,R3    R5                TEST ORDER OF VALUES
         BL       ERR11
         BDR,R6   RCDSEL5           GET END OF RANGE
         CI,R4     0                NORMAL CONVERSION OF Y(NO TERMINATOR
         BE       ENDRSEL           YES
ERR11    LI,R1    17
ERRX     RES
         BAL,SR4  ERROR
         B        ENDSPEC
*
RCDSEL5  STW,R3   R5                SET Y=X
         CI,R4    1                 TEST FOR (-) TERMINATOR
         BNE      ENDRSEL           NO Y VALUE
         LB,R4    *R7,R1
         CI,R4    X'60'
         BNE      ERR11
         AI,R1    1                 ADVANCE PAST TERMINATOR
         AI,R2    -1                REDUCE NO. OF CHARS
         B        RCDSEL3           CONVERT Y
*
ENDRSEL  LI,R1    2                 TEST FOR LEGALITY
         BAL,SR3  TESTARG
         LI,R1    9                 ARE THERE SLOTS LEFT
         LW,R2    SELECT,R7
         CI,R2    RSMAX
         BGE      ERRX              NO
         SLS,R2   1                 TWO WORD ENTRIES
         AW,R2    R7
         STW,R5   SELECT+1,R2
         STW,R3   SELECT+2,R2
         MTW,1    SELECT,R7
         B        ENDSPEC
         PAGE
* SUBROUTINE TO SCAN READ OR WRITE ACCOUNTS ON COPY OR COPYALL.
* ENTERED WITH CMBX POINTING TO FIRST ACCT AND R2=1 FOR RD, R2=2
* FOR WR, R2=3 FOR EXECUTE, R2=4 FOR UNDER.
RWACCT   RES
         LW,R3    TERM,R7
         CI,R3    '('
         BNE      RWACCT5           INVALID SYNTAX
         LW,R5    ACCTBL-ANSEND+1,R1
         LW,R2    CMBX,R7
         STW,R2   1,R5              SET POINTER TO FIRST ACCT
         LI,R6    0                 INITIALIZE COUNT
RWACCT2  LI,R1    12                PERMIT '
         BAL,SR4  GETARG            GET ACCT
         MTW,0    NCHAR,R7
         BEZ      RWACCT6           NULL FIELD
         AI,R6    1                 BUMP COUNT
         LW,R1    =X'05000108'      VALUE FOR TEXTARG
         LW,R2    ARGBUFF,R7
         CW,R5    ACCTBL+4          CHECK IF VEHICLE.
         BNE      %+2
         AI,R1    2                 TEN MAX FOR UNDER
         BAL,SR4  TEXTARG           EDIT ACCOUNT
RWACCT1  EQU      %
         LW,R2    TERM,R7
         CI,R2    ','               ANOTHER ACCOUNT
         BE       RWACCT2           YES - GO SCAN
RWACCT1A EQU      %
         CI,R2    ')'               END OF ACCOUNTS
         BE       RWACCT3           YES
RWACCT5  LI,R1    17                INVALID SYNTAX
         BAL,SR4  ERROR
         B        RWACCT4
RWACCT3  XW,R6    0,R5              PUT COUNT IN TABLE
         BEZ      RWACCT4
         EXU      DUPERR
         BAL,SR4  ERROR
RWACCT4  EQU      %
         B        ENDSPL24
RWACCT6  LI,R1    29
         BAL,SR4  ERROR
         B        RWACCT1
*
ACCTBL   EQU      %-1
         DATA     RDTBL             READ ACCT TABLE
         DATA     WRTBL             WRITE ACCT TABLE
         DATA     EXTBL        EXECUTE ACCT TABLE.
         DATA     UNTBL        UNDER ACCT TABLE.
         PAGE
SPECL2   CI,ID    1                 FIRST SEQUENCE ARGUMENT
         BG       CSID1             NO
         STW,R0   SEQUENCE+1,R7     SET NCHAR IN ID TO ZERO
         STW,R0   SEQUENCE+2,R7     INITIAL VALUE TO ZERO
         LW,R2    ='0000'
         STW,R2   CARDSEQ,R7        INITIALIZE SEQUENCE INFO
         STW,R2   CARDSEQ+1,R7
         LI,R1    1
         STW,R1   SEQUENCE+3,R7     INCREMENT (K) TO ONE
         LW,R1    =99999999         MAX CS SEQUENCE NO.
         CI,SP    2                 CS OPTION
         BE       CSID3             YES
         LI,R1    1000
         STW,R1   SEQUENCE+2,R7     DEFAULT INITIAL VALUE
         STW,R1   SEQUENCE+3,R7     DEFAULT INCREMENT
         LW,R1    =9999999          MAX EDIT LINE NUMBER*1000
CSID3    EQU      %
         STW,R1   SEQUENCE+4,R7     MAX SEQUENCE VALUE
         AI,ID    0                 ANY ARGUMENTS PRESENT
         BEZ      ENDSPEC           NO - USE DEFAULT VALUES
         STW,R0   LISTTERM          INITIALIZE PREVIOUS TERMINATOR
*
CSID1    CI,SP    2                 CARD SEQUENCING  (CS)
         BNE      SEQV              NO-LN HAS NO ID
         CI,ID    1                 CS ID
         BNE      SEQV              NO
*
         LW,R1    NCHAR,R7          LENGTH OF ID ARGUMENT
         BEZ      ENDSPL2           NULL ID
         CI,R1    4                 4 CHARS OR LESS
         BLE      CSID2             YES
         LI,R1    12                ERROR 12
         BAL,SR4  ERROR
         LI,R1    4                 TRUNCATE TO 4 CHARS
CSID2    LI,R2    ARGBUF4+1
         STW,R1   SEQUENCE+1,R7     NO. OF CHARS IN ID
         LI,R3    CARDSEQ+CARDSEQ+CARDSEQ+CARDSEQ
         BAL,SR4  MBS               MOVE SEQ ID TO CARDSEQ
         LW,R2    SEQUENCE+1,R7     GET NO. CHARS IN ID
         LW,R5    =99999999         COMPUTE MAXIMUM SEQUENCE NO.
         LI,R4    0
         DW,R4    =10
         BDR,R2   %-2
         STW,R5   SEQUENCE+4,R7     STORE MAX VALUE-RECYCLE VALUE
         B        ENDSPL2
*
SEQV     LI,R1    0                 EDIT AND CONVERT (N OR K)-MIN VALUE
         MTW,0    NCHAR,R7
         BEZ      STORSV            NULL FIELD - STORE ZERO
         CI,SP    2                 CS OPTION
         BE       SEQV2             YES
         CI,ID    1                 LN - IS THIS N VALUE
         BE       SEQV2             YES
         LI,R2    100               MAX FOR INTEGER
         CI,ID    3                 INTEGER PORTION OF INCR
         BE       SEQV3             YES
         LI,R2    999               SET MAX FOR FRACTIONAL PART
         B        SEQV3
SEQV2    LW,R2    SEQUENCE+4,R7     MAX VALUE
SEQV3    BAL,SR4  INTARG
         CI,R2    0                 ERROR RETURN
         BE       STORSV            NO
         LI,R1    13                ERROR 13
         BAL,SR4  ERROR
         B        ENDSPL2
*
STORSV   LW,R3    ID                1-LN, 2-N, 3-K
         AW,R3    SP                LEVEL: 2-CS,  3-LN
         AI,R3    SEQUENCE-2
         CI,SP    3                 LN OPTION
         BNE      STORSV2+1         NO
         CI,ID    3                 IS INDEX OK
         BL       %+2               YES
         AI,R3    -1                ADJUST INDEX
         LW,R5    LISTTERM          GET PREVIOUS TERMINATOR
         CI,R5    '.'               IS THIS FRACTIONAL PART
         BNE      STORSV2           NO
         CI,ID    3
         BE       %+2
         AI,R3    -1                ADJUST INDEX
         LW,R5    NCHAR,R7
         MH,R1    FMULT,R5          ADJUST FRACTIONAL PART
         AWM,R1   *R7,R3            ADD TO INTEGER PART
         B        ENDSPL2
STORSV2  MI,R1    1000              INTEGER PART OF INCREMENT
         STW,R1   *R7,R3            STORE N OR K VALUE
*
ENDSPL2  LW,R5    TERM,R7           TEST FOR TERMINATION COMMA
         CI,R5    X'6B'             TERMINATING ,
         BNE      ENDSPL22          NO-TRY FOR )
         CI,ID    3                 TEST FOR VALID COMMA
         BGE      ERR14             NO - ERROR-SHOULD BE ')'
         CI,ID    2                 N CONVERSION
         BNE      NXSPL2            NO-CONVERT N
         CI,SP    2                 CS TYPE
         BE       NXSPL2            YES-CONVERT K
         LW,R1    LISTTERM          GET PREVIOUS TERMINATOR
         CI,R1    '.'               IS THIS FRACTIONAL PART
         BE       NXSPL2            YES - OK
ERR14    LI,R1    14                ERROR 14
         BAL,SR4  ERROR
         B        RETURN
NXSPL2   AI,ID    1                 PREPARE FOR NEXT SPEC LEVEL 2 ARG.
         LW,R1    TERM,R7
         STW,R1   LISTTERM          SAVE TERMINATOR
         B        NEXTARG
*
ENDSPL22 CI,R5    '.'               TERM ON '.'
         BNE      ENDSPL23          NO
         CI,SP    3                 LN OPTION
         BNE      ERR14             NO-ERROR
         CI,ID    1                 TEST IF INTEGER PART
         BE       NXSPL2            YES
         LW,R1    LISTTERM
         CI,R1    ','               INTEGER PART OF INCR
         BE       NXSPL2            YES - OK
         B        ERR14             ERROR
ENDSPL23 CI,R5    X'5D'             TERM ON )
         BNE      ERR14             NO-ERROR
         MTW,0    SEQUENCE+3,R7     IS INCREMENT ZERO
         BNEZ     %+3
         LI,R1    47                NO, ERROR 47
         BAL,SR4  ERROR
         LI,SP    1                 SET BACK TO LEVEL ONE
*
ENDSPL24 EQU      %
         BAL,SR4  GETARG0
         LW,R1    NCHAR,R7          TEST FOR NULL FIELD
         BEZ      ENDSPEC
         LI,R1    15                ERROR 15
ENDSPL26 EQU      %
         BAL,SR4  ERROR
         B        RETURN            TERMINATOR MISSING AFTER LN OR CS
*
DUPERR   LI,R1    50                CONFLICTING0OR DUPLICATE OPTION
         BAL,SR4  ERROR
         LW,R1    TERM,R7           IF (, FIND )
         CI,R1    '('
         BNE      ENDSPEC
         BAL,SR4  GETARG0
         LW,R1    TERM,R7
         CI,R1    ')'
         BNE      GETARG0
         BAL,SR4  GETARG0           SKIP )
ENDSPEC  LW,R5    TERM,R7
         CI,R5    ','               TERM ON ' '
         BE       SPECARG2          YES - GET NEXT SPECIAL ARGUMENT
         CI,R5    X'5D'             TERM ON )
         BE       ENDSPEC2          YES-END OF SPECIAL ARGUMENTS
         LI,R1    16                ERROR 16
         B        ENDSPL26
*
ENDSPEC2 LW,R5    CMBX,R7           SAVE WHERE YOU ARE ON COMMAND
         BAL,SR4  GETARG0
         LW,R1    TERM,R7
         CI,R1    ' '               BLANK TERMINATOR
         BNE      ENDSPEC3          NO-ANOTHER DEVICE/FILE FOLLOWS
         STW,R5   CMBX,R7           YES-BACKUP SCAN DONT BURN TO/OVER
*
ENDSPEC3 LW,R5    TERM,R7           TERM OF DUMMY CHAR. D(S)/FID(S)
         CI,SR1   1                 TEST FOR DEVICE OR FILE LEVEL
         BE       DEVRTN            TRANSLATE FIRST FILE
         BG       FILRTN            SET NEXT ARG LEVEL
*
RETURN   LI,R1    X'20FF'           FILE DEVICE MUST HAVE NAME
         AND,R1   DEV%SAV1,R7       EXCEPT FOR COPYALL AND COPYSTD DEST
         CI,R1    3                 IS DEVICE DC
         BL       RETURN2           NO
         CI,R1    5                 OR LT OR DP
         BG       RETURN2           NO
         MTW,0    FILE,R7           FID SPECIFIED
         BNEZ     RETURN2           YES-OK
         LI,R1    4
         BAL,SR4  ERROR
RETURN2  LW,R1    SR1
         LCI      7
         PLM,R5   *R7
         B        *SR4
*
SP       EQU      SR2               2=CS, 3=LN
ID       EQU      SR3               1=ID,2=N,3=K
RSMAX    EQU      10
MODEDPL  DO1      7
         DATA     0
CODETBL  DATA     NOPTS
* BITS0-7=INPUT DEVICES: CR,PR,DC,LT,DP,FT,AT,ME
* BITS8-16=OUTPUT DEVICES: DC,LT,DP,FT,AT,ME,LP,CP,PP
* BITS17-23=COMMAND FLAGS: COPY, COPYALL, COPYSTD
* BITS24-31=ERROR CODE IF NOT PERMITTED
EDITBL   DATA     X'1E780016',X'3AE80017',X'FF00001B'
OPT      CNAME
         PROC
LF       EQU      DA(%)-DA(CODETBL)
TXC      SET      S:UT(AF(1)),' ',' '
         GEN,8,8,8,8 S:NUMC(AF(1)),TXC(1),TXC(2),TXC(3)
         DATA     AF(2)
         DO       NUM(AF)=3
TXC      SET      %
         RES,1    BA(MODEDPL)-BA(%)+(TXC-CODETBL)/2-CODEEND
         DATA,1   AF(3)+MODEX4
         ORG      TXC
         FIN
         PEND
*
         DATA     0,0               DUMMY ENTRY
         OPT      'C',X'FEF98018'
         OPT      'H',X'BEF90018'   FBCD
         OPT      'A',X'7EF88018'   ASCII
         OPT      'X',X'00060018'   HEXDUMP
CODEEND  OPT      'BCD',X'86FF8019',0
         OPT      'BIN',X'96FF8019',0
         OPT      '7T',X'16580019',7
         OPT      '9T',X'16580019',7
         OPT      'PK',X'16580019',11
         OPT      'UPK',X'04100019',11
         OPT      'SSP',X'160019',12
         OPT      'DSP',X'160019',12
         OPT      'VFC',X'160019',12
         OPT      'NC',X'00FF8019',13
         OPT      'FA',X'00E00019',14
         OPT      'NFA',X'00E00019',14
         OPT      'DEOD',X'04000019',15
         OPT      'K',X'00060019',9
         OPT      'CR',X'00FF8019',13
         OPT      'EBCD',X'16580019',7
         OPT      'ASCI',X'16580019',7
         OPT      'NB',X'00F80019',1
TXOPT    OPT      'TX',X'00FF8019',10
         OPT      'EXP',X'00E80019',5
         OPT      'VOL',X'16580019',3
MODEEND  OPT      'BLK',X'00080019'
         OPT      'REC',X'00080019'
         OPT      'FMT',X'00080019'
         OPT      'CAT',X'02000019'
         OPT      'DEN',X'00580019'
         OPT      'CRPT',X'28A00019'
ANSEND   OPT      'RD',X'00E00019'
         OPT      'WR',X'00E00019'
         OPT      'EX',X'00E00019'
         OPT      'UN',X'00E00019'
RWEND    OPT      'NCS',X'00FF801A'
         OPT      'NLN',X'00E0001A'
         OPT      'CS',X'00FF801A'
         OPT      'LN',X'00E0001A'
SEQEND   OPT      'SEQ',X'FF005819'
         OPT      'KEY',X'FF005819'
         OPT      'RAN',X'FF005819'
         OPT      'PHY',X'12005819'
NOPTS    EQU      %-CODETBL-1
*
FMULT    DATA,2   0,100,10,1
         TITLE    'COPYTO'
COPYTO   DSECT    1
*
*P*      NAME:    COPYTO
*P*
*P*      PURPOSE: TO PERFORM A SYNTAX ANALYSIS OF THE COPY COMMAND.  COPYTO
*P*               CALLS THE RDWRT ROUTINE TO PERFORM THE FILE COPY.  FOR
*P*               COPYING FILES IN A STANDARD FILE, ENTRY IS MADE AT COPYSF
*P*               FROM COPYALL.
*P*
*DO*
*P*
*
* INPUT
*        D1       COMMAND ACTION CODE
*        D2       MAXIMUM ERROR SEVERITY
*        CMBX     COMMAND BUFFER INDEX OF NEXT ARGUMENT
*        PREVACT  PREVIOUS COMMAND ACTION CODE
*        TERM     TERMINATOR OF LAST ARGUMENT TRANSLATED
* OUTPUT
*        INSWT    FIRST INPUT FILE SWITCH
*        TOSWT    DEFINED -TO- SWITCH
*
*FIN*
         REF      TRANSACT
         REF      REVARG,RELPAGES,RDWRT
         REF      CLOSEI,CLOSEO
         REF      INSWT
         REF      TOSWT
         REF      TOVER
         REF      BREAK
         REF      BLDCB
         REF      PREVACT
         REF      M:EI
         REF      PRNTBUF
         REF      TOARG
*
         LCI      7                 SAVE REGISTERS
         PSM,R5   *R7
*
         LI,R6    0                 INITIALIZE COUNT AT 1ST  ACTION VERB
         LI,SR1   0                 CLEAR 'TO' CMBX
         LI,SR2   0                 CLEAR 'COPY' CMBX
*
SCAN1    CI,D1    2                 COPY COMMAND
         BE       SCAN2             YES
         LW,SR1   CMBX,R7           SAVE CMBX OF -TO- DEVICE
         LI,R1    0                 CLEAR DEFINED -TO- SWITCH
         STW,R1   TOSWT,R7
         STW,R1   INSWT,R7          CLEAR FIRST INPUT FILE SWITCH
         B        SCAN3
*
SCAN2    LW,SR2   CMBX,R7           SAVE CMBX OF FIRST -COPY- DEVICE
*
SCAN3    LI,R1    1                 SET ARG. LEVEL TO DEVICE
SCAN4    BAL,SR4  COPYTRAN          TRANSLATE DEVICE/FILE
*
         CI,D2    3                 TEST ERROR SEVERITY
         BGE      RETRN
*
         LW,R4    TERM,R7
         CI,D1    2                 -COPY- COMMAND
         BNE      SCANEND           NO
         CI,R1    0                 ANOTHER DEVICE/FILE FOLLOW
         BNE      SCAN4             YES
*
SCANEND  CI,R4    X'15'             END OF COMMAND
         BE       TO1               YES-END OF COMMAND
         CI,R4    X'40'             BLANK TERMINATOR
         BE       NXCMD1            YES-END OF INPUT OR OUTPUT
ERR17    EQU      %
         LI,R1    17                ERROR 17
         BAL,SR4  ERROR
         B        RETRN
*
NXCMD1   CI,R6    0                 EDIT NUMBER OF ACTION VERBS
         BNE      ERR17
NXCMD2   LI,R6    1                 SET SECOND ACTION VERB
         BAL,SR4  TRANSACT          TRANLATE SECOND COMMAND ACTION VERB
         STW,D1   TOVER,R7          SAVE TO OR OVER OUTPUT ACTION VERB
         LW,R2    D1                NO SUCH VERB
         BEZ      ERR32             YES
         LI,D1    1                 SET OUTPUT FOR DEVTRAN
         AW,R2    PREVACT,R7        COPY-TO
         CI,R2    3
         BE       SCAN1             YES
         CI,R2    14                COPY-OVER
         BE       SCAN1             YES
         CI,R2    18+2              INTO
         BE       SCAN1
ERR32    LI,R1    32                ERROR 32
         BAL,SR4  ERROR
         B        RETRN
         PAGE
TO1      CI,D2    1                 TEST ERROR SEVERITY
         BG       RETRN
         CI,SR1   0                 -TO- COMMAND PRESENT
         BNE      TO11
         MTW,0    TOSWT,R7          IF WEVE GOT A OUTPUT, USE IT
         BNEZ     COPY1
         LI,R1    'ME'              NO-JUST COPY
         STW,R1   OUT%ARG,R7        (TO ME)
         BAL,SR4  CLRARG
         MTW,5    DEVICE,R7         CLRARG SETS DC DEFAULT(3)
*
TO11     EQU      %
         LI,R1    1                 SET DEFINED -TO- SWITCH
         STW,R1   TOSWT,R7
         STW,R1   INSWT,R7          SET NEW OUTPUT FILE
*
         BAL,SR4  REVARG            SAVE -TO- ARGUMENT TABLE
*
COPY1    CI,SR2   0                 -COPY- COMMAND
         BE       RETRN             NO-JUST -TO- COMMAND
         STW,R0   2,R7              RESET HEADER PRINTED FLAG
         LI,D1    2                 SET AT COPY VERB(FOR COMBINE)
         LI,R1    1                 SET AT DEVICE
COPY3    STW,SR2  CMBX,R7           CMBX OF CURRENT INPUT DEVICE/FILE
         BAL,SR4  COPYTRAN          GO-TRANSLATE CURRENT INPUT DEV/FILE
         LW,R5    R1                SAVE NEXT ARG LEVEL 1-DEV,2-FILE,0--
         LI,R1    6                 OPEN NXT, FPARAM
         MTW,0    FILE,R7           INPUT FILE TYPE
         BEZ      COPY9             NO
         LI,R1    2                 SET FPARAM BIT FOR BLDCB
COPY9    LW,SR2   CMBX,R7           SAVE CMBX OF NEXT INPUT DEV/FILE
         LW,SR4   TERM,R7           AND TERMINATOR
         STW,SR4  LISTTERM
         BAL,SR4  BLDCB
         CI,D2    2
         BG       COPYEND           DONT CONTINUE IF SEVERITY 3 ERROR
         LW,R1    INSWT,R7          NEW OUTPUT FILE
         BEZ      COPY4             NO
         STW,R0   INSWT,R7          CLEAR NEW OUTPUT FILE
         STW,R0   TOSWT,R7          NO OUTPUT UNTIL IT'S OPEN
*
         BAL,SR4  REVARG            BRING UP -TO- ARGUMENTS
*
         LI,R1    1                 BUILD OUTPUT DCB
         BAL,SR4  BLDCB
         BAL,SR4  REVARG            BRING BACK COPY ARGUMENTS
COPY4    EQU      %
         CI,D2    1                 TEST ERROR SEVERITY
         BG       COPYEND
         MTW,1    TOSWT,R7          GOT AN OUTPUT FILE
         BAL,R6   ALL8              GO PRINT FILE NAME
         BAL,SR4  RDWRT             COPY M:EI TO M:EO
COPYEND  EQU      %
*
         BAL,SR4  CLOSEI            CLOSE CURRENT INPUT FILE
*
         MTW,0    BREAK             BREAK SET
         BNEZ     RETRN             YES
         CI,D2    1                 TEST ERROR SEVERITY
         BG       RETRN
         LW,R1    LISTTERM          YES. RESTORE TERMINATOR
         STW,R1   TERM,R7
         LW,R1    R5                YES-SET 1-DEVICE, 2-FILE
         BNEZ     COPY3             GO PROCESS IT
*
RETRN    BAL,SR4  RELPAGES          GO-RELEASE EXCESS RD/WR BUFFER SPACE
         BAL,SR4  CLOSEO            GO CLOSE OUTPUT
*
         LCI      7                 RESTORE REGISTERS
         PLM,R5   *R7
         B        *SR4
*
WRTCOPY  GEN,8,24 X'11',M:UC
         DATA     X'34000000'
         DATA     COPYMSG
         DATA     10
         DATA     0
COPYMSG  TEXT     '..COPYING
'
COPYALL  DSECT    1
         TITLE    'COPYALL'
*
*P*      NAME:    COPYALL
*P*
*P*      PURPOSE: TO SCAN THE COPYALL OR COPYSTD COMMAND FOR CORRECT
*P*               SYNTAX.  IF THE COMMAND IS COPYALL, ALL FILES OR A
*P*               SPECIFIED SUBSET OF THE FILES ON RAD (IN USER'S
*P*               ACCOUNT OR ANOTHER ACCOUNT), ON LABELED TAPE, OR
*P*               ON DISK PACK ARE COPIED TO THE SPECIFIED OUTPUT
*P*               DEVICE.  IF THE COMMAND IS COPYSTD, THE FILE
*P*               ITSELF AND ALL FILES NAMED WITHIN THE FILE WILL BE
*P*               COPIED FROM RAD, LABELED TAPE, OR DISK PACK TO THE
*P*               SPECIFIED OUTPUT DEVICE.
*
*DO*
*P*
* INPUT
*        D1       COMMAND ACTION VERB
*        D2       MAXIMUM ERROR SEVERITY
*        ARGTBL   TABLE OF TRANSLATED ARGUMENTS FOR DEVICE
*        CMBX     COMMAND BUFFER INDEX OF NEXT ARGUMENT
*        TERM     TERMINATOR OF LAST ARGUMENT TRANSLATED
* OUTPUT
*        TOSWT    DEFINE -TO- SWITCH (CLEARED)
*
*
*FIN*
         REF      PRTNOF
         REF      UNPRINT
         REF      F:STD
         REF      M:EO,M:LO
         REF      FPARAM,TLABEL
         REF      FROMFILE,TOFILE
         REF      TESTFNC
         REF      OPNNXT
         REF      REVIEW
         REF      SYNFLAG
         REF      GRANCNT
         REF      HEX2BCD
*
         LCI      7                 SAVE REGISTERS
         PSM,R5   *R7
*
*
         STW,R0   TOSWT,R7          CLEAR DEFINED -TO- SWITCH
*
         LI,R6    -1                INITIALIZE FOR COMMAND EDIT
         STW,R0   GRANCNT
         LI,R1    X'40'
         STW,R1   COPYSK            INITIALIZE TO COPY ALL FILES
         MTW,0    COPYSTDF,R7       IS THIS COPYSTD COMMAND
         BEZ      EDITDV1           NO
         LW,SR1   CMBX,R7
         LI,R1    1
         BAL,SR4  COPYTRAN          TRANSLATE FID FOR STD FILE
         CI,D2    3
         BGE      RTURN2            CANT EXECUTE
         B        EDITDV3
*
EDITDV1  LW,SR1   CMBX,R7           TRANSLATE DEVICE
         BAL,SR4  CLRARG            ZERO -ARGTBL-
         AI,R6    0
         BEZ      EDITDVB           OUTPUT
         LW,R1    TERM,R7
         CI,R1    ','               IS FROM FILE NULL
         BE       EDITDV7           YES
         CI,R1    '('               OPTION PRESENT
         BE       COPYSEL           YES
         STW,SR1  SAVCMBX,R7        INDICATE DC IS OPTIONAL
EDITDVB  EQU      %
         BAL,SR4  DEVTRAN
         AI,R6    0
         BEZ      EDITDV6           OUTPUT
         STW,R0   SAVCMBX,R7
         LW,R2    ARGBUFF,R7
         CW,R2    =X'02D6D540'      TEST FOR 'ON' OR 'TO'
         BE       %+3
         CW,R2    =X'02E3D640'      IS INPUT FIELD NULL
         BNE      EDITDVC           NO
         BAL,SR4  REVARG            REVERSE ARGTBL AND TOARG
         LW,SR2   SR1               SAVE CMBX VALUE
         BAL,SR4  GETARG0           SKIP TO/ON
         LI,D1    1
         AI,R6    1                 INDICATE OUTPUT
         B        EDITDV1           SCAN OUTPUT
EDITDVC  EQU      %
         LW,R2    TERM,R7
         CI,R2    '('
         BE       COPYSEL           OPTION PRESENT
         CI,R2    X'15'
         BE       EDITDV3           COMMAND IS JUST 'COPYALL'
EDITDVA  EQU      %
         CI,R2    '/'               DOES FILE NAME FOLLOW
         BNE      EDITDV6           NO
EDITDV7  BAL,SR4  REVIEW            GET FILE NAME(S)
         LI,R6    -1                RESTORE R6
EDITDV6  EQU      %
         AI,R6    0
         BEZ      EDITDV3      SYSTEM OUTPUT LABEL.
         LW,R2    DEVICE,R7
         LI,R1    X'3A'             INPUT DEVICE MUST HAVE FILES
         SCS,R1   -9,R2
         AI,R1    0                 I.E. DC,DP,LT,AT
         BLZ      EDITDV3
         LI,R1    34                ERROR-NOT A VALID DEVICE
         BAL,SR4  ERROR
*
EDITDV3  LW,R5    TERM,R7           GET TERM. CHARACTER
         AI,R6    1                 TEST FOR LAST DEVICE
         BNEZ     EDITDV4           LAST DEVICE
         LW,SR2   SR1               SAVE CMBX OF FROM DEVICE
         BAL,SR4  REVARG            SAVE INPUT ARGS
         BAL,SR4  CLRARG            CLEAR OUTPUT ARGS
         CI,R5    X'40'             TERM. ON BLANK
         BE       TOCMD1            YES
         CI,R5    X'15'             OUTPUT FIELD NULL
         BE       FROM1
         LI,R1    17                ERROR 17
ERRTN    BAL,SR4  ERROR
         B        RTURN2
*
COPYSEL  BAL,SR4  COPYOPT           GET OPTIONS
         LW,R5    CMBX,R7           SAVE CURRENT POINTER
         BAL,SR4  GETARG0           GET NEXT ARGUMENT
         LW,R2    TERM,R7           GET DELIMITER
         MTW,0    NCHAR,R7          NULL FIELD
         BEZ      EDITDVA           YES
         STW,R5   CMBX,R7           BACK UP TO CURRENT ARGUMENT
         B        EDITDV6
*
TOCMD1   BAL,SR4  TRANSACT          TRANSLATE -TO- ACTION VERB
         CI,D1    1                 ACTION = -TO-
         BE       EDITDV1           YES
         B        ERRTN-1
*
EDITDV4  CI,R5    X'15'             END OF COMMAND
         BE       FROM1             YES
         CI,R5    '('
         BNE      EDITDV8           BAD SYNTAX
         BAL,SR4  COPYOPT           GET OPTIONS
         B        FROM1
EDITDV8  EQU      %
         LI,R1    30                ERROR 30
         BAL,SR4  ERROR
*
FROM1    CI,D2    1                 TEST ERROR SEVERITY
         BG       RTURN2            CANNOT EXECUTE
*
         STW,SR2  CMBX,R7           TRANSLATE INPUT DEVICE
         STW,R0   2,R7              RESET ACCESS HEAD NOT PRINTED
         BAL,SR4  REVARG            RESTORE INPUT ARGUMENTS
         LI,SR2   0                 INITIALIZE FILE COUNT
         MTW,0    COPYSTDF,R7
         BNEZ     COPYSTD           COPYSTD COMMAND
*
         LI,R1    6                 BUILD INPUT DCB
         BAL,SR4  BLDCB
         STW,R0   SYNFLAG,R7        INITIALIZE NO SYNONYM NAMES
*
TO00     LB,R1    SR3
         BEZ      TO01              NO ERROR
         CI,R1    8                 SYNONYM FILE NAME
         BNE      ALL7              NO-SOME OTHER ABNORMAL OR ERROR
         MTW,1    SYNFLAG,R7        YES-SET SYNONYM FILE NAME PRESENT
         B        ALL4              OPEN NEXT FILE
*
TO01     BAL,SR4  TESTFNC           TEST IF FILE WANTED
         B        TO012             NO
         LW,R3    COPYSK
         CI,R3    X'40'
         BE       TO010             ALL FILES ARE WANTED
         LI,R3    X'F0'
         AND,R3   M:EI+5            GET ORG
         BNEZ     %+2
         LI,R3    X'10'             IF 0, SET FOR CONSEC
         LW,R1    TLABEL+1
         CW,R1    ='RFIL'           RANDOM FILE ON TAPE
         BNE      %+2               NO
         LI,R3    X'30'             SET ORG FOR RANDOM
         CW,R3    COPYSK            DO WE WANT THIS FILE
         BE       TO010             YES
TO012    BAL,SR4  CLOSEI            NO - CLOSE M:EI
         B        ALL4
TO010    BAL,SR4  REVARG            SAVE INPUT ARGTBL IN TOARG
         LI,R1    7                 BUILD OUTPUT DCB
         BAL,SR4  BLDCB
         BAL,SR4  REVARG
         CI,D2    1                 TEST ERROR SEVERITY
         BG       ENDCOPY
         LW,D4    SR3
         BNEZ     ENDCOPY           GO PRINT MSG-FILE NOT OPEN
*
         BAL,R6   ALL8              OUTPUT HEADING IF NEEDED
         BAL,SR4  RDWRT             COPY M:EI TO M:EO
         BAL,SR4  RELPAGES          RELEASE EXCESS BUFFER AREA
ENDCOPY  BAL,SR4  CLOSEI            CLOSE INPUT DCB
         BAL,SR4  CLOSEO            CLOSE OUTPUT DCB
         LW,SR3   D4
         BAL,SR4  ALLC              OUTPUT MESSAGE
         CI,D2    2                 TEST ERROR SEVERITY
         BG       RTURN
*
ALL4     MTW,0    BREAK             BREAK SET
         BNEZ     RTURN             YES
         MTW,0    COPYSTDF,R7       GO GET NEXT STD FILE
         BLZ      COPYSTD4          IF IN THAT MODE
         MTW,0    TOFILE            ANY MORE FILES WANTED
         BLZ      RTURN1            NO
         BAL,SR4  OPNNXT
         BCS,8    RTURN1            ALL DONE
         BNE      TO00              GOT A NEW NAME, GO DO IT
ALL6     EQU      %
         LI,R1    0                 REPORT I/O ERROR
         BAL,SR4  ERROR
RTURN    LI,R5    COPTEXT           ADDR OF MESSAGE
         INT,SR1  SR2               SEPARATE COPIED AND SKIPPED FILES
         BAL,SR4  PRTNOF
         LI,R5    SKIPTXT
         LW,SR2   SR1
         BAL,SR4  PRTNOF            PRINT 'NNN FILES COPIED'
RTURN2   RES
         LCI      7                 RESTORE REGISTERS
         PLM,R5   *R7
         B        *SR4              RTURN
*
ALL5     LB,R2    NOFILES
         LI,R3    M:UC              SELECT ONLINE OR BATCH
         MTW,0    J:JIT
         BLZ      %+3
         LI,R3    M:LO
         AI,R2    -1                REMOVE NL CHAR
         LI,D3    NOFILES
         LI,R4    1                 BTD
         CAL1,1   FPTLFILE          PRINT - NO FILES IN DIRECTORY
         B        RTURN2            EXIT
*
ALL7     CI,R1    2                 END OF DIRECTORY
         BE       ALL5              NO FILES COPIED
         LI,R1    X'FF00'
         CW,R1    M:EI+22           IS FILE NAME PRESENT
         BAZ      ALL6              NO
         BAL,SR4  TESTFNC           TEST IF FILE WANTED
         B        ALL4              NO - DON'T PRINT ANYTHING
         LI,SR4   ALL4              RETURN FROM ALLC
ALLC     EQU      %
         PSW,SR4  *R7
         LI,D3    TLABEL            BUFFER
         LI,R1    M:EI+23
         BAL,SR4  UNPRINT           ENTER FILE NAME IN BUFFER
         LW,R6    R2                SAVE NAME LENGTH
         AI,SR2   1                 COUNT THE FILE
         AI,SR3   0
         BLEZ     ALLX              NO ERRORS
         AI,SR2   X'FFFF'           COUNT NONCOPIED FILES
         LB,R1    SR3
         SLS,R1   8
         AH,R1    SR3
         SLS,R1   -1
         BAL,SR4  HEX2BCD           CONVERT ERR/ABN TO BCD
         LW,R2    ='    '           SURROUND CODE WITH 2 BLANKS
         SCD,R2   16
         LW,R4    TEXTIN            OUT IN/OUT CR AFTER
         SLS,SR3  15
         SLS,SR3  -15
         CI,SR3   M:EO
         BNE      %+2
         LW,R4    TEXTOUT
         LI,R1    -12
         AI,R6    1
         LB,SR4   R5,R1
         STB,SR4  TLABEL,R6
         BIR,R1   %-3
ALLX     LW,R2    R6
         LI,R3    M:LO              SELECT BATCH OR ONLINE
         MTW,0    J:JIT
         BGEZ     %+5
         LI,R3    M:UC
         AI,R2    1                 REMOVE NL CHAR GOING TO PRINTER
         LI,R4    13                PUT CR
         STB,R4   TLABEL,R2
         LI,R4    1                 BTD
         MTW,0    2,R7              SHOULD WE DO THIS
         BNEZ     %+4               INDUBITABLY
         AI,SR3   0                 IS IT AN ERROR MESSAGE
         BEZ      ALLD              NO, NOTHING
         CAL1,1   FPTTOF            YES, NEW PAGE
         CAL1,1   FPTLFILE          PRINT FILE NAME
         CW,SR2   =X'FFFFF'         16 WITH NO GOOD ONES GIVES UP
         BANZ     ALLD
         STW,SR2  CMBX,R7           GARBAGE POINTER
         LI,R1    44
         BAL,SR4  ERROR
         MTW,-1   BREAK
         LI,D2    3                 DONT ABORT THE JOB THO
ALLD     RES
         PLW,SR4  *R7               RESTORE RETURN ADDR
         B        *SR4
TEXTOUT  TEXT     'OUT'
TEXTIN   TEXT     'IN '
FPTLFILE GEN,8,7,17      X'91',0,R3
         DATA     X'34000010'
         PZE      *D3
         PZE      *R2
         PZE      *R4
FPTTOF   GEN,8,24 4,M:EO            TOP OF FORM FOR NEW FILE
ALL8     RES
*        WRITE ..COPYING TO UC IF EI AND EO
*        ARENT THE UC DEVICE. THEN DETERMINE IF A LIST OF
*        COPIED (COPYALL OR COPYSTD) OR DELETED (DELETEALL)
*        FILES IS TO BE OUTPUT TO UC (ONLINE) OR LP (BATCH).
*        THIS OCCURS IF EI AND EO ARE NOT UC OR LP.
*        THEN PREFACE EACH FILE WITH ITS NAME IF PROPER.
*        ONLINE THIS OCCURS IF EO IS LP FOR ALL COPIES, IF EO IS UC
*        FOR COPYALL AND COPYSTD.
*        BATCH THIS OCCURS IF EO IS LP ONLY FOR COPYALL AND COPYSTD.
         LI,R2    7                 MME(UC) IS 8 DEVICE, LP IS 9
         CW,R2    DEVICE,R7         ZERO IS ILLEGAL
         BAZ      0,R6              IF INPUT IS UC, NOTHING HAPPENS.
         LW,R4    J:JIT             GET JOBTYPE FLAG
         LW,R3    COPYSK            NONZERO IF COPYSTD OR COPYALL.
         AND,R2   TOARG,R7          GET OUTPUT DEVICE
         BEZ      ALL85             UC OUTPUT, NO COPYING OR LIST
         BDR,R3   ALL81             MULTIFILE COPY, LIST INSTEAD OF COPYING
         BDR,R4   ALL82             BATCH, NO COPYING MSG
         MTW,0    2,R7              HAVE WE BEEN HERE ALREADY
         BNEZ     %+2               YES
         CAL1,1   WRTCOPY           NO, ..COPYING
ALL81    BIR,R4   %+3               ONLINE, ALWAYS LIST IF NOT UC OUT
ALL82    CI,R2    1                 BATCH, LIST IF OUTPUT NOT LP
         BE       %+2
         STW,R3   2,R7
ALL85    CI,R2    1                 OUTPUT FILENAME HEADER IF LP ONLINE
         BG       0,R6              OR BATCH MANYFILE
         BDR,R4   %+2
         BE       %+3               OR UC ONLINE MANYFILE
         MTW,0    COPYSK
         BEZ      0,R6
         LD,R2    NAME
         STM,R2   TLABEL            MOVE 'NAME=' TO PRINT BUFFER
         STW,R3   TLABEL+2
         LI,R1    M:EI+23
         LI,R3    3                 USE A DCB WITH A NAME IN IT
         CS,R3    M:EI
         BE       0,R6              NO NAME, NO MESSAGE
         CAL1,1   FPTTOF            NEW PAGE
         LI,R3    M:EO
         LI,R4    0                 BTD
         LI,D3    TLABEL+2
         LI,R2    1
         CAL1,1   FPTLFILE          WRITE BLANK LINE
         BAL,SR4  UNPRINT           PUT FILE NAME IN PRINT BUFFER
         AI,R2    9                 LENGTH OF LINE
         AI,D3    -2                ADDRESS OF BUFFER
         CAL1,1   FPTLFILE          WRITE LINE
         LI,R2    1
         CAL1,1   FPTLFILE          WRITE BLANK LINE
         B        0,R6              GO COPY FILE
SKIPTXT  TEXT     ' FILES SKIPPED 
'
COPTEXT  TEXT     ' FILES COPIED  
'
NOFILES  TEXTC    'NO FILES IN DIRECTORY
'
         BOUND    8
NAME     TEXT     '  NAME ='
         PAGE
RTURN1   EQU      %
         MTW,0    SYNFLAG,R7        SYNONYM FILE NAME(S) PRESENT
         BEZ      RTURN             NO-RETURN
         LW,R1    TOARG,R7
         CI,R1    5                 IS OUTPUT TO A DEVICE
         BG       RTURN             YES - DONT COPY SYNONYMS
         LW,R1    COPYSK
         CI,R1    X'40'             ARE WE COPYING BY ORG
         BL       RTURN             YES - DONT COPY SYNONYMS
         LI,R2    0
         LW,R3    =X'80000000'      RESET END OF RANGE FLAG
         STS,R2   TOFILE
         LI,R1    6                 OPEN NEXT, FPARAM,INPUT
         BAL,SR4  BLDCB             GO-BUIL INPUT DCB
         BAL,SR4  REVARG            BACK TO OUTPUT
         AI,SR3   0                 ABLE TO OPEN FIRST FILE
         BNEZ     SYNERROR          NO-CHECK FOR SYNONYM FILE NAME
SYN4     BAL,SR4  CLOSEI            YES - GO CLOSE IT
         BAL,SR4  OPNNXT            OPEN NEXT FILE
         BCS,8    RTURN             ALL DONE
         BE       RTURN             NOT GETTING ANYWHERE
*
SYNERROR RES
         BAL,SR4  TESTFNC           IF NOT WANTED, SKIP IT
         B        SYN3
         LB,R1    SR3
         CI,R1    8                 SYNONYM FILE NAME
         BNE      SYN4              NO-OPEN NEXT FILE
         LI,R1    7                 OPEN NEXT,FPARAM,OUTPUT
         BAL,SR4  BLDCB             PUT SYNONYM FILE ON OUTPUT ACCT.
         BAL,SR4  CLOSEO            CLOSE NEW SYNONYM FILE
         BAL,SR4  ALLC              LIST NAME OR ERROR
SYN3     MTW,0    TOFILE            END OF RANGE
         BLZ      RTURN             YES
         B        SYN4              OPEN NEXT FILE
         PAGE
COPYSTD  EQU      %
         LI,R1    2
         BAL,SR4  BLDCB
         CI,D2    1
         BG       RTURN2
         BAL,SR4  REVARG            SETUP TO OPEN OUTPUT DCB
         LI,R1    7
         BAL,SR4  BLDCB             BUILD M:EO
         CI,D2    1
         BLE      %+3
         BAL,SR4  CLOSEI
         B        RTURN2
         BAL,SR4  REVARG            BRING BACK INPUT ARGUMENTS
         BAL,R6   ALL8              OUTPUT HEADING IF NEEDED
         BAL,SR4  RDWRT             COPY STD FILE
         LW,SR3   D4
         BAL,SR4  ALLC              LIST NAME
COPYSTD8 BAL,SR4  CLOSEO
         LH,SR4   M:EI              IF EI IS OPEN, WE CAN GO ON
         CI,SR4   X'20'
         BAZ      RTURN2
         CAL1,1   PFIL%STD
         CAL1,1   OPNSTD            MAKE SCRATCH FILE
         LI,R1    TLABEL            SET UP FOR RED PLIST
         LI,R2    M:EI
         LI,SR4   COPYSTD3
COPYSTD6 CAL1,1   SRDFPT
         LW,R3    M:EI+4            GE SIZE
         SLS,R3   -17
         CAL1,1   SWRFPT
         B        COPYSTD6
COPYSTD3 CAL1,1   SPFFPT            PFILE BOF
         BAL,SR4  CLOSEI
         MTW,-2   COPYSTDF,R7       SET PHASE2 FLAG
         LI,R1    16
         LW,R5    R7                SAVE STD FILE ARGUMENTS
         AI,R5    ARGTBL-1
         LW,R2    *R5,R1
         STW,R2   SFARG-1,R1
         BDR,R1   %-2
         LW,R2    IN%ARG,R7         SAVE RESOURCE TYPE INFO TOO
         STW,R2   SFARG+4
COPYSTD2 LI,SR4   EOF2              SET RETURN FROM EOF ON F:STD
         LI,R1    PRNTBUF
         AW,R1    R7
         LW,R2    =X'15151515'
         LI,R3    19
         STW,R2   *R1,R3            BLANK BUFFER
         BDR,R3   %-1
         STW,R2   0,R1
         LI,R2    F:STD             READ F:STD
         CAL1,1   SRDFPT            READ STANDARD FILE
         LW,SR1   COPYSTD0          GET INITIAL FLAG WORD
COPYSTD4 RES
         INT,R2   SR1               GET COE WORD FOR NEXT NAME
         STW,R3   CMBX,R7           RIGHT 16 BITS IS CMBX
         AND,R2   =X'FF'            TERM IN BYTE 1
         STW,R2   TERM,R7
         LB,R1    SR1               DEVICE,FILE FLAG IN BYTE0
         BEZ      COPYSTD2          NO MORE HERE
         LI,D1    2                 SET INPUT FLAG FOR COPYTRAN
         BAL,SR4  COPYTRAN
         LW,SR1   CMBX,R7           SAVE WHERE WE ARE
         LW,R2    TERM,R7           AND ON WHICH DELIMITER
         STH,R2   SR1
         STB,R1   SR1               AND WHETHER THERES MORE HERE
         LI,R1    2
         BAL,SR4  BLDCB
         B        TO00
COPYSTD0 GEN,8,8,14,2 1,' ',PRNTBUF,1
SRDFPT   GEN,8,24       X'90',R2
         DATA     X'F0000010'
         DATA     STDERR            ERROR ADR
         DATA     EOF               ABNORMAL ADR
         PZE      *R1               BUFFER ADDRESS
         DATA     80                BUFFER SIZE
SWRFPT   GEN,8,24 17,F:STD
         DATA     X'F0000010'
         DATA     STDERR,STDERR
         DATA     TLABEL
         PZE      *R3
OPNSTD   GEN,8,24 20,F:STD
         DATA     X'C0000000'
         DATA     STDERR,STDERR
SPFFPT   GEN,8,24 28,F:STD          M:PFIL,BOF
         DATA     X'10'
EOF      LB,R1    SR3
         CI,R1    6
         BE       *SR4
         CI,R1    5
         BE       *SR4
STDERR   LI,R1    0
         BAL,SR4  ERROR             REPORT I/O ERROR
EOF2     LW,R1    F:STD
         CW,R1    =X'00200000'
         BAZ      RTURN             FILE ALREADY CLOSED
         CAL1,1   CLSTD        CLOSE STANDARD FILE..
         B        RTURN
CLSTD    GEN,8,24 X'15',F:STD
         DATA     0
PFIL%STD GEN,8,7,17   X'1C',0,M:EI
         DATA     X'10'
         END

