*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       FLAGS FOR EXP,CRPT,JOB,NF
*                      BYTE 3       VOL
*                 +1 - BYTE 0       LC/UC ID CODE
*                      BYTE 1       UNUSED
*                      BYTE 2       BITS FOR BLK/REC/FMT/CAT/DEN
*                      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      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
         REF      NCHAR,TERM,ARGBUFF,ARGBUF4
         REF      ARGTBL,DVLARG
         REF      CODE,MODE,SEQUENCE,SELECT
MODEX4   EQU      MODE+MODE+MODE+MODE
         REF      CMBX
         REF      DEVICE            PCL DEVICE TYPE
         REF      FILE
         REF      CARDSEQ
         REF      MBS
         REF      TABSET,J:JIT
         REF      M:UC
         REF      COPYSTDF,SFARG
         REF      RDTBL,WRTBL,TEXTARG
         REF      ANSBLK
         REF      BLKIN
         REF      RDWRTX            LAST ENTRY TO RDWRT
         REF      PRTERR            OUTPUT ERROR MESSAGES
         REF      LISTPOS           TO STRING COPYALL/STD NAMES HORIZ
         REF      RANGEOUT          HEADER FOR FILES TO LP/UC
         REF      JB:PCW
         DEF      LOSPACE           SO PRTNOF CAN UPSPACE
         REF      DCBS              CHECK DO=LO OR UC
         REF      M:DO              FOR COPYALL/STD ERR MSGS
         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    '.'               . ( ) ARE POOR CHOICES
         BE       %+2
         CI,R4    '('
         BE       %+2
         CI,R4    ')'
         BNE      DEV1
         LI,R1    17                SYNTAX ERROR
         BAL,SR4  ERROR
DEV1     LW,R5    CMBX,R7
*
         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
*
         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    16                YES, SAVE DEVICE ARGS
         LW,R2    R7
         LW,R3    ARGTBL+15,R2
         STW,R3   DVLARG-1,R1
         AI,R2    -1
         BDR,R1   %-3
         LI,SR1   2                 SET LEVEL TO FILE
         B        FILE2
*
FILE1    LI,R1    16                RESTORE DEVICE ARGS
         LW,R2    R7
         LW,R3    DVLARG-1,R1
         STW,R3   ARGTBL+15,R2
         AI,R2    -1
         BDR,R1   %-3
         BAL,SR3  TEST0             SET UP DEV%SAV1
*
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
         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      %+2
         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
         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
         BEZ      %+4
         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'0A363636',X'36393400'
ANSL     DATA     X'00010001',X'02FF0000'
ANS3     LB,R1    ANSL,R6           GET LOWER LIMIT
         LI,R2    32767             MAX VALUE
         BAL,SR4  INTARG            CONVERT AND TEST
*        CI,R2    1
         BGE      ANS4              INCALID, OUT OF RANGE
         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
         LI,SR4   1                 CHECK PRESENCE BIT
         SLS,SR4  8,R6
         CW,SR4   MODE+1,R7
         BANZ     ANS4+1
         STS,SR4  MODE+1,R7
         CI,D1    2                 IF INPUT, USE BLKIN INSTEAD
         BNE      %+2
         AI,R6    BLKIN-ANSBLK
         STW,R3   ANSBLK-1,R6
ANS8     LW,R2    TERM,R7
         CI,R2    ')'
         BE       ENDSPL24
ANS9     LI,R1    17
         B        ENDSPL26          SYNTAX ERROR
*
CRPT     BAL,SR4  HEX2BIN
         LI,R6    6                 SET ERROR INDEX
         AI,R4    0
         BNE      ANS4              NO GOOD
         CI,D1    2                 IN OR OUT
         BE       %+2
         AI,R6    1                 OUTCRPT
         STW,R3   INCRPT-6,R6
         B        ANS8
DEN1     CI,R3    800               MUST BE 800 OR 1600
         BE       %+3
         AI,R3    -1600
         BNE      ANS4
         SLS,R3   -9                MAKE IT 1 OR 0
         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
         B        SPECL2
*
SPEC1    AI,R1    -SEQEND+1
         LW,R2    SPEC2,R1          GET WHERE TO STORE
         SLS,R1   4
         XW,R1    0,R2
         CI,R1    X'70'             HAVE WE BEEN HERE
         BANZ     DUPERR
         B        ENDSPEC
SPEC2    EQU      %-1
         DATA     COPYSK,COPYSK,COPYSK
         DATA     COPYPHY
         PAGE
EXPARG   LW,R6    R1                SAVE INDEX
         LI,SR4   1
         SLS,SR4  7,R6
         CW,SR4   MODE,R7
         BANZ     DUPERR
         STS,SR4  MODE,R7
         CI,R6    3                 IS IT JOB OR NF
         BG       ENDSPEC           YUP.
         LW,R1    TERM,R7
         AI,R1    -'('
         BNE      ERR11             BAD SYNTAX
         BAL,SR4  GETARG            GET FIRST ARGUMENT
         LW,R4    TERM,R7
         CI,R4    ')'
         BDR,R6   VOLARG            VOLUME OR CRPT
         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
         BDR,R6   CRPT              NOT VOLUME AFTER ALL
         LI,R1    1                 LIMITS FOR VOL
         LI,R2    MAXSN
         BAL,SR4  INTARG
*        CI,R2    1
         BGE      ANS4              OUTOF RANGE
         LI,R1    MODEX4+3
         STB,R3   *R7,R1
         B        ANS8
         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    1
         BG       ERR11             OVERFLOW
         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   RES
         STW,R0   SEQUENCE+1,R7     SET NCHAR IN ID TO ZERO
         LW,R2    ='0000'
         STW,R2   CARDSEQ,R7        INITIALIZE SEQUENCE INFO
         STW,R2   CARDSEQ+1,R7
         LI,R2    1                 DEFAULT K
         LW,R3    =99999999         DEFAULT MAX
         AI,R1    -3                CSOPTIO..DEFAULTN = 0
         BE       CSID3             YES
         LI,R1    1000
         LI,R1    1000              DEFAULT N FOR LN
         LI,R2    1000              DEFAULT INCR
         LW,R3    =9999999          DEFAULT MAX
         MTW,4    SEQUENCE+1,R7     SET MAX CHARS IN N,K
CSID3    EQU      %
         LCI      3                 STORE DEFAULTS
         STM,R1   SEQUENCE+2,R7
         LW,R1    TERM,R7           ARE THERE VALUES
         CI,R1    '('
         BNE      ENDSPEC           NO.
         LI,ID    SEQUENCE+1        SET POINTER
         LW,R1    SEQUENCE,R7       IS THIS LN OR CS
         CI,R1    4                 LN
         BE       NEXTARG           YES
         LI,R1    12                YES, GET IT
         BAL,SR4  GETARG
*
         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.
         DW,R5    =10
         BDR,R2   %-1
         STW,R5   SEQUENCE+4,R7     STORE MAX VALUE-RECYCLE VALUE
ENDSPL2  LW,R5    TERM,R7
         CI,R5    ','               DO WE HAVE N VALUE
         BNE      ENDSPL23
NEXTARG  AI,ID    1                 TO NEXT VALUE
         CI,ID    SEQUENCE+3        IS IT STILL OK
         BG       ENDSPL23          NO, ENDSPL23 WILL GO TO ERR14
         BAL,SR4  GETARG0           GET A NUMBER
         BAL,SR4  INTARG            WHAT IS IT
*        CI,R2    1
         BE       ERR13             NO GOOD
         LI,R2    8
         SW,R2    SEQUENCE+1,R7     CHECK VALUE
         CW,R2    NCHAR,R7
         BGE      %+3
ERR13    LI,R1    13
         BAL,SR4  ERROR
         STW,R1   *ID,R7            STORE IT
         LW,R5    TERM,R7
         LW,R2    SEQUENCE,R7       PERMIT DOT IF LN
         CI,R2    4
         BNE      ENDSPL2           MUST BE COMMA OR )
         MI,R1    1000              MAKE INTEGER PORTION BIG ENOUGH
         STW,R1   *ID,R7
         CI,R5    '.'               DO WE HAVE A DOT
         BNE      ENDSPL2
         BAL,SR4  GETARG0           GET FRACTION
         LI,R1    0
         LI,R2    999
         BAL,SR4  INTARG
*        CI,R2    1
         BGE      ERR13             BAD #
         LW,R2    NCHAR,R7
         MH,R1    FMULT,R2
         AWM,R1   *ID,R7
         B        ENDSPL2
*
ENDSPL23 LI,R1    14                SET UP FOR ERROR 14
         CI,R5    ')'               MUST BE ) HERE
         BNE      ENDSPL26          NOPE
         MTW,0    SEQUENCE+3,R7     IS INCREMENT ZERO
         BNEZ     %+3
         LI,R1    47                NO, ERROR 47
         BAL,SR4  ERROR
*
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       SPECARG           YES, GET NEXT OPTION
         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
         MTW,0    NCHAR,R7          DID WE GET SOMETHING
         BEZ      ENDSPEC3          NO, LEAVE NEW DELIMITER, PLACE
         LI,R1    ' '               YES, SET BLANK DELIMITER
         STW,R1   TERM,R7
         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,D1    2
         BE       %+2
         AI,R1    -6
         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
*
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'85110018'   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'00FF8019',1
         OPT      'LC',X'00FF8019',4
         OPT      'UC',X'00FF8019',4
TXOPT    OPT      'TX',X'00FF8019',10
         OPT      'EXP',X'00E80019'
         OPT      'VOL',X'16580019',3
         OPT      'CRPT',X'28A00019'
         OPT      'JOB',X'28A00019'
         OPT      'NF',X'00060019'
MODEEND  OPT      'BLK',X'FFFF8019'
         OPT      'REC',X'FFFF8019'
         OPT      'FMT',X'FFFF8019'
         OPT      'CAT',X'02000019'
         OPT      'DEN',X'00580019'
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
*        TERM     TERMINATOR OF LAST ARGUMENT TRANSLATED
* OUTPUT
*        TOSWT    DEFINED -TO- SWITCH
*
*FIN*
         REF      TRANSACT
         REF      REVARG            SWITCH ARGTBLS
         REF      RDWRT             COPY A FILE
         REF      CLOSEI,CLOSEO
         REF      TOSWT
         REF      TOVER
         REF      BREAK
         REF      BLDCB
         REF      M:EI
         REF      STDBUF            COMMAND BUFFER FOR COPYSTD
         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
         STW,R0   TOSWT,R7          CLEAR OUTPUT SWITCH
         B        SCAN3
*
SCAN2    LW,SR2   CMBX,R7           SAVE CMBX OF FIRST -COPY- DEVICE
         LW,SR4   TERM,R7           SAVE TERMINATOR TOO
         STW,SR4  LISTTERM          IN CASE # OR -
*
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
         BNEZ     %+2
         MTW,-1   ERRFLAG           NO VERB, BAD MESSAGE GOES
         LI,D1    1                 SET OUTPUT FOR DEVTRAN
         LI,R1    X'20041'          MUST BE 1,12 OR 18
         SLS,R1   13,R2
         BIR,R1   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
         BAL,SR4  CLRARG
         MTW,5    DEVICE,R7         CLRARG SETS DC DEFAULT(3)
         LI,R1    'ME'
         LC       J:JIT             IF BATCH, 'ME' DOESN'T WORK TOO EWLL
         BCS,8    %+3
         LI,R1    'LP'
         MTW,1    DEVICE,R7
         STW,R1   OUT%ARG,R7
*
TO11     EQU      %
         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
         LW,SR4   LISTTERM          RESTORE TERM
         STW,SR4  TERM,R7
         BAL,SR4  COPYTRAN          GO-TRANSLATE CURRENT INPUT DEV/FILE
         LW,R5    R1                SAVE NEXT ARG LEVEL 1-DEV,2-FILE,0--
         LI,R1    X'402'            OPN 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       COPYX             GIVE UP IF SEV 3 ERROR
         BDR,SR3  COPYEND           NO INPUT HERE
         LW,R1    TOSWT,R7          HAVE WE GOT OUTPUT YET
         BNEZ     COPY4             YES, JUST COPY
*
         BAL,SR4  REVARG            BRING UP -TO- ARGUMENTS
*
         LI,R1    1                 BUILD OUTPUT DCB
         BAL,SR4  BLDCB
         BAL,SR4  REVARG            BRING BACK COPY ARGUMENTS
         LH,SR4   M:EO              IF EO'S NOT OPEN
         CI,SR4   X'20'             GIVE UP
         BAZ      RETRN
COPY4    EQU      %
         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     COPYX             YES
         CI,D2    2                 IS SEV LESS THAN 3
         BG       COPYX
         LI,D2    0                 SAVE THE OUTPUT
         LW,R1    R5                YES-SET 1-DEVICE, 2-FILE
         BNEZ     COPY3             GO PROCESS IT
COPYX    MTW,0    TOSWT,R7          IF NO OUTPUT,
         BEZ      RETRN             NO LAST RECORD
         BAL,SR4  RDWRTX            GO COMP LAST RECORD
         BAL,R6   ALL8              UPSPACE IF REQ'D
*
RETRN    RES
         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      TLABEL
         REF      TOFILE            IS SELECTION DONE
         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
*
         STW,R0   GRANCNT
         LI,R1    X'80'
         STW,R1   COPYSK            INITIALIZE TO COPY ALL FILES
         MTW,0    COPYSTDF,R7       IS THIS COPYSTD COMMAND
         BEZ      EDITDV1           NO
         LI,R1    1
         BAL,SR4  COPYTRAN          TRANSLATE FID FOR STD FILE
         CI,D2    3
         BGE      RTURN2            CANT EXECUTE
         B        EDITDV3
*
EDITDV1  RES
         BAL,SR4  CLRARG            ZERO -ARGTBL-
         LW,R1    TERM,R7
         CI,R1    '('               OPTION PRESENT
         BE       COPYSEL           YES
EDITDV2  RES
         BAL,SR4  DEVTRAN
         LI,R5    ' '               SET DELIMITER FOR BEFORE ON/TO
         LW,R2    ARGBUFF,R7
         CW,R2    =X'02D6D540'      TEST FOR 'ON' OR 'TO'
         BE       EDITDV5
         CW,R2    =X'02E3D640'      IS INPUT FIELD NULL
         BE       EDITDV5
         LW,R2    TERM,R7
         CI,R2    '('
         BE       COPYSEL           OPTION PRESENT
         CI,R2    X'15'
         BE       EDITDV3           COMMAND IS JUST 'COPYALL'
EDITDVA  EQU      %
         MTW,0    TOFILE            IF ALREADY A RANGE,
         BNEZ     EDITDV6           IT ISN'T PERMITTED AGAIN
         CI,R2    ','               IS FROM FILE NULL
         BE       EDITDV7           YES, GET RANGE
         CI,R2    '/'               DOES FILE NAME FOLLOW
         BNE      EDITDV6           NO
EDITDV7  BAL,SR4  REVIEW            GET FILE NAME(S)
         LW,R2    TERM,R7
         CI,R2    '('
         BE       COPYSEL
EDITDV6  EQU      %
         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
EDITDV5  RES
         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
         MTW,0    DEVICE+2,R7       HAVE WE BEEN TO DEVTRAN
         BEZ      EDITDV2           NO, GO
         LW,R2    TERM,R7           GET DELIMITER
         B        EDITDVA
*
TOCMD1   BAL,SR4  TRANSACT          TRANSLATE -TO- ACTION VERB
         CI,D1    1                 ACTION = -TO-
         BG       ERRTN-1
         BE       %+3
         MTW,-1   ERRFLAG           UNDO "UNDEFINED COMMAND"
         B        ERRTN-1
         MTW,2    DEVICE,R7         MAKE DP DEFAULT (DC NOT OPTIONAL)
         BAL,SR4  DEVTRAN           GET OUTPUT DEVICE
         LW,R5    TERM,R7
         CI,R5    X'15'             END OF COMMAND
         BE       FROM1             YES
         CI,R5    '('
         BNE      ERRTN-1
         BAL,SR4  COPYOPT           GET OPTIONS
*
FROM1    CI,D2    1                 TEST ERROR SEVERITY
         BG       RTURN2            CANNOT EXECUTE
*
         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'80'
         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    2                 MAJOR ERROR
         BG       ALL6              YES
         LW,D4    SR3
         BNEZ     ENDCOPY           GO PRINT MSG-FILE NOT OPEN
*
         BAL,R6   ALL8              OUTPUT HEADING IF NEEDED
         LW,R6    TOARG+12,R7       SAVE SEQ START FOR EACH FILE
         BAL,SR4  RDWRT             COPY M:EI TO M:EO
         STW,R6   TOARG+12,R7
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
         BAL,SR4  PRTERR
*
ALL4     MTW,0    BREAK             BREAK SET
         BNEZ     RTURN             YES
         LI,D2    0
         STW,D2   ERRFLAG
         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    ALL5              ALL DONE
         BNE      TO00              GOT A NEW NAME, GO DO IT
STDERR   RES
ALL6     EQU      %
         LI,R1    0                 REPORT I/O ERROR
         BAL,SR4  ERROR
RTURN    BAL,R6   ALL8              UPSPACE IF REQ'D
         LI,R5    COPTEXT           ADDR OF MESSAGE
         BAL,SR4  PRTNOF
RTURN2   RES
         LCI      7                 RESTORE REGISTERS
         PLM,R5   *R7
         B        *SR4              RTURN
*
ALL5     LB,R2    NOFILES
         CI,SR2   0                 IF NOT NO FILES,
         BNEZ     RTURN1            DONT SAY SO
         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       ALL4              TRY ONCE OMRE LEST LT OR AT
         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,R1    36
         LW,R2    ='    '
         STW,R2   TLABEL-1,R1
         BDR,R1   %-1
         LI,D3    TLABEL            BUFFER
         LI,R1    M:EI+23
         BAL,SR4  UNPRINT           ENTER FILE NAME IN BUFFER
         LI,R1    X'60'             NO POST SPACE
         STB,R1   TLABEL
         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
         LI,R1    0                 IF SEVERITY THREE
         CI,D2    3                 COMMAND WILL ABORT
         BGE      ALLE              SO PRINT FULL MESSAGE
         STW,R1   LISTPOS
         LI,R1    'B'               2SPACE BEFORE
         STB,R1   TLABEL
         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
         CI,SR3   X'FFF0'           IO ERR OR PCL ERR
         BANZ     %+2               IO
         AI,R2    '1'-' '           PCL
         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
         MTW,0    2,R7              SHOULD WE DO THIS
         BNEZ     ALLP              YES IF FLAG LEFT BY ALL8
         AI,SR3   0                 IS IT AN ERROR MESSAGE
         BEZ      ALLD              NO, NOTHING
         CI,SR2   X'FFFF'           IF NO FILES YET, NO PAGE
         BAZ      ALLP
         LI,R1    '1'               YES, NEW PAGE
         STB,R1   TLABEL
ALLP     RES
         LI,R3    M:LO
         LI,R4    1
         LI,R1    3
         CS,R1    M:LO
         BNE      ALLW
         LI,R1    108               LP WIDTH
         LI,SR4   X'FF00'
         AND,SR4  M:LO+1
         CI,SR4   X'9000'
         BNE      %+4
         LI,R1    BA(JB:PCW)
         LB,R1    0,R1
         STW,R1   TLABEL+35         SET FLAG
         LW,SR4   LISTPOS
         MI,SR4   12
         SW,R1    SR4               SPACE REMAINING
         CW,R1    R2
         BGE      %+3               LOTS
         CAL1,1   LOSPACE
         LI,SR4   0
         AW,R2    SR4               SLIDE OVER TO THE NEXT CLOUMN
         LW,R4    SR4
         SLS,SR4  -2
         AI,SR4   TLABEL
         LB,R1    TLABEL,R6
         STB,R1   *SR4,R6
         BDR,R6   %-2
         LI,R1    ' '
         AI,R4    0
         BEZ      %+3
         STB,R1   TLABEL,R4
         BDR,R4   %-1
         AI,R2    1                 INCLUDE VFC CHAR
         LI,R1    X'100'            SET VFC IF NOT THERE
         AND,R1   M:LO
         BNEZ     %+2
         CAL1,1   LOVFC
         LC       TLABEL
         BCS,8    ALLW
         LW,R1    R2
         AI,R1    11
         DW,R1    =12
         STW,R1   LISTPOS
         LC       TLABEL+35         IF TERM, WRITE WITH SYNC TERM
         BCS,4    ALLW
         MI,R1    12                LIMIT WRITE TO PLATEN SIZE
         CW,R1    TLABEL+35
         BLE      %+2
         LW,R1    TLABEL+35
         LW,R2    R1
         AI,R2    1
         LI,R1    22
         STB,R1   TLABEL,R2
         AI,R2    1
         SW,SR4   D3                WRITE FROM *D3 INSTEAD
         AW,D3    SR4
         MI,SR4   4
         SW,R2    SR4
ALLW     RES
         CAL1,1   FPTLFILE          PRINT FILE NAME
         LC       TLABEL            IF ERROR MSG, PUT THRU DO TOO PERHAPS
         BCR,8    ALLV
         LC       J:JIT
         BCR,8    %+3
         LC       TLABEL+35         IF ONLINE WASNT UC, ALWAYS DO IT
         BCS,4    %+3
         LC       DCBS
         BCS,1    ALLV
         LI,R4    1                 NO VFC
         LI,R3    M:DO
         CAL1,1   FPTLFILE
ALLV     RES
         CW,SR2   =X'FFFFF'         16 WITH NO GOOD ONES GIVES UP
         BANZ     ALLD
         STW,SR2  CMBX,R7           GARBAGE POINTER
         LI,R1    44
ALLE     RES
         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
         LI,R3    X'1000'           CHECK NF OPTION
         AND,R3   TOARG+6,R7
         BNEZ     0,R6
         CW,R2    COPYSK            CHECK LP AND COPYALL
         BCR,7    0,R6              UC, NOT COPYALL
         BL       ALL9
         BDR,R4   ALL95             BATCH TO LP NEEDS SPACES
         LW,R3    M:EO+1            IF LO IS LP TOO,
         SW,R3    M:LO+1            THEN NO LIST
         MTW,0    2,R7
         BLEZ     %+2               IF NOT COPYALL/STD,NO CHANGE
         STW,R3   2,R7
         LW,R2    M:EO              ONLINE TO LP, IS IT VFC
         CI,R2    X'100'
         BANZ     0,R6              YES, NO HEADER
ALL9     RES
         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,R2    X'20'             IF EI ISNT OPEN, NO NAME
         CH,R2    M:EI
         BAZ      0,R6
         CAL1,8   TIMECAL
         LI,D4    BA(TLABEL)
         LI,D3    15
         BAL,SR4  RANGEOUT
         LW,R2    D3                PRINT THE RESULT
         LI,D3    TLABEL
         AI,R2    1
         LI,R4    0
         LI,R3    M:EO
         CAL1,1   FPTLFILE          WRITE LINE
         CAL1,1   FPTSPACE
         B        0,R6
ALL95    CAL1,1   FPTSPACE
         CAL1,1   FPTSPACE
         B        0,R6              GO COPY FILE
COPTEXT  TEXT     '.. % FILES COPIED, % FILES SKIPPED
'
NOFILES  TEXTC    'NO FILES IN DIRECTORY
'
FPTSPACE GEN,8,24 17,M:EO
         DATA     X'30000010'
         DATA     ='    ',1
TIMECAL  GEN,8,24 16,TLABEL
LOVFC    GEN,8,24 5,M:LO
         DATA     X'10'
LOSPACE  GEN,8,24 17,M:LO
         DATA     X'30000010',='    ',1
BUFINIT  DATA     X'40160040','    ','    '
BUFDUP   GEN,8,24 132,BA(TLABEL+3)
         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
         LI,R1    3
         CS,R1    M:EI              IF DEVICE, DONT COPY TWICE
         BE       COPYSTD1
         BAL,SR4  REVARG            SETUP TO OPEN OUTPUT DCB
         LI,R1    7
         BAL,SR4  BLDCB             BUILD M:EO
         CI,D2    1
         BG       ALL6
         BAL,SR4  PRTERR
         BAL,SR4  REVARG            BRING BACK INPUT ARGUMENTS
         BAL,R6   ALL8              OUTPUT HEADING IF NEEDED
         LW,R6    TOARG+12,R7       SAVE SEQ START
         BAL,SR4  RDWRT             COPY STD FILE
         STW,R6   TOARG+12,R7       RESTORE IT
         LW,SR3   D4
         BAL,SR4  ALLC              LIST NAME
         B        %+2
COPYSTD1 STW,3    DEVICE,R7
         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
         BAL,SR4  CLOSEO
         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
         XW,R2    SFARG+4
         STW,R2   SFARG+3           AND REPOSITION ACCOUNT FLAG
COPYSTD2 LI,SR4   RTURN
         LI,R1    STDBUF
         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,' ',STDBUF,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
         B        ALL6              REPORT ERROR
PFIL%STD GEN,8,7,17   X'1C',0,M:EI
         DATA     X'10'
         END

