         TITLE    'PCLCO - COMBINE,COPYTRAN,COPYALL,COPYTO'
*
*        T E L E F I L E   P R O P R I E T A R Y   P R O D U C T
*
*        THIS DOCUMENT INCLUDES DATA AND INFORMATION CONSIDERED
*        PROPRIETARY TO TELEFILE COMPUTER PRODUCTS, INC.  REPRODUCTION,
*        DUPLICATION, DISCLOSURE OR DISSEMINATION, IN WHOLE OR IN PART,
*        TO OTHERS THAN REPRESENTATIVES OF THE UNITED STATES GOVERNMENT
*        SHALL NOT BE MADE WITHOUT PRIOR WRITTEN AUTHORIZATION OF
*        TELEFILE COMPUTER PRODUCTS, INC. NOTWITHSTANDING THE FORGOING,
*        USE OF THE DATA OR INFORMATION IN WHOLE OR IN PART FOR DESIGN,
*        PROCUREMENT OF MANUFACTURE IS STRICTLY FORBIDDEN.
*
*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
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
         PAGE
         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
         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
         REF      DCBS              CHECK DO=LO OR UC
         REF      M:DO              FOR COPYALL/STD ERR MSGS
         REF      EXPIRE
         REF      LISTTERM
         REF      UNTBL,EXTBL
         PAGE
COPYTRAN DSECT    1
         DEF      ALLC              TYPE NAME/ERROR FOR MULTIFILERS
         DEF      LOSPACE           SO PRTNOF CAN UPSPACE
*
         LCI      7                 SAVE REGISTERS
         PSM,R5   *R7
         STW,R1   R8                SAVE LEVEL  1-DEVICE, 2-FILE
         CI,R8    1                 DEVICE ARGUMENT LEVEL
         BNE      FILE1             NO-FILE ARGUMENT LEVEL
         BAL,R11  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,R11  ERROR
DEV1     LW,R5    CMBX,R7
*
         BAL,R11  DEVTRAN           TRANSLATE DEVICE ID
         MTW,0    COPYSTDF,R7       ARE WE COPYING A STD FILE
         BGE      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     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     BAL,R10  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,R8    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,R10  TEST0             SET UP DEV%SAV1
FILE2    BAL,R11  FILTRAN           GO-TRANSLATE FILE ID N.A.P
         LI,R1    1                 TEST LEGALITY OF FILE
         BAL,R10  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,R8    1                 SET LEVEL TO DEVICE
TESTEND  CI,R5    X'5E'             TERM ON ;
         BE       COMBINE1          YES-NEW DEVICE
         LI,R8    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,R11  ERROR
COMBINE1 B        RETURN
*
TEST0    LW,R6    DEVICE,R7         GET DEVICE CODE
         CI,R12   2                 INPUT OR OUTPUT
         BE       %+2
         AI,R6    6
         LW,R2    COPYSTDF,R7       GET COPYSTDF
         AI,R8    0                 COPYALL FLAG (=-1)
         BGE      %+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,R12   2                 OR OUTPUT VALUE
         BNE      %+2
         LI,R1    19
         CI,R6    8
         EXU      TESTDEV,R1
         BAL,R11  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
         BE       *R10
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       *R10
TESTE    XW,R1    R6
         LB,R1    R1                GET ERROR CODE
         BAL,R11  ERROR
         LW,R1    R6
         B        *R10
         PAGE
COPYOPT  LCI      7                 ENTRY FOR OPTIONS ONLY
         PSM,R5   *R7
         LI,R8    -1                SET FLAG
         BAL,R10  TEST0             CHECK DEVICE, ETC.
         LW,R1    TERM,R7           CHECK FOR OPTIONS
         CI,R1    '('
         BNE      RETURN
         PAGE
SPECARG  LI,R11   %+3
GETARG0  LI,R1    0                 FEW DELIMITER
         B        GETARG
*
         LW,R2    NCHAR,R7          NULL SPECIAL ARGUMENT
         BG       CODE1             NO
         LI,R1    29                ERROR 29
         BAL,R11  ERROR
         B        ENDSPEC
*
CODE1    LI,R1    CODETBL           SEARCH DATA CODE TABLE FOR MATCH
         BAL,R11  FIXARG
         CI,R1    0                 FIND A DATA CODE
         BE       RCDSEL1           NOT RECOGNIZABLE, MUST BE A NUMMER
         BAL,R10  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
         BNE      DUPERR
         B        ENDSPEC           CHECK PROPER TERMINATION
*
MODE1    CI,R1    MODEEND           GOT A MODE TYPE
         BGE      ANS1              NO, MAYBE ANS TYPE
         AI,R1    -CODEEND+1        GET MODE CODE
         LB,R2    MODEDPL,R1        STORE MODE ID CODE
         BE       KGC0%4
         MTB,0    *R7,R2            DO WE HAVE THIS TYPE ALREADY
         BNE      DUPERR
         STB,R1   *R7,R2
KGC0%4   AI,R1    -(TXOPT-CODEEND+1)
         BG       EXPARG            EXP OR VOL
         BNE      ENDSPEC           NO
         MTW,0    TABSET+4,R7       ARE THERE PCL TABS IN EFFECT
         BNE      ENDSPEC           YES
         MTW,0    J:JIT
         BL       MODE2             ON-LINE MODE
MODE4    LI,R1    48                TX OPTION USED WITHOUT TABS CMD
         BAL,R11  ERROR
         B        ENDSPEC
MODE2    MTB,0    M:UC+15
         BE       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,R11  GETARG0
         CI,R6    3                 IS IT FMT OPT
         BNE      ANS3              NO
         LW,R2    ARGBUFF,R7
         MTB,-1   R2                MUST BE ONE CHAR
         BNE      ANS4              BAD ONE
         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,R11  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,R11  INTARG            CONVERT AND TEST
*        CI,R2    1
         BGE      ANS4              INVALID, 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,R11   1                 CHECK PRESENCE BIT
         SLS,R11  8,R6
         CW,R11   MODE+1,R7
         BANZ     ANS4+1
         STS,R11  MODE+1,R7
         CI,R12   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,R11  HEX2BIN
         LI,R6    6                 SET ERROR INDEX
         AI,R4    0
         BNE      ANS4              NO GOOD
         CI,R12   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
         BNE      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,R11   1
         SLS,R11  7,R6
         CW,R11   MODE,R7
         BANZ     DUPERR
         STS,R11  MODE,R7
         CI,R6    3                 IS IT JOB OR NF
         BG       ENDSPEC           YUP.
         LW,R1    TERM,R7
         AI,R1    -'('
         BNE      ERR11             BAD SYNTAX
         BAL,R11  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,R8    EXPIRE
         AW,R8    R7                ADDRESS OF EXPIRE BUFFER
EXP1     LW,R2    ARGBUFF,R7        GET ARGUMENT
         LB,R1    R2                GET LENGTH
         BE       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   *R8,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,R11  ERROR
EXP4     BAL,R11  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
         BE       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,R11  ERROR
         B        ENDSPL24
EXPERR1  LI,R1    17
         BAL,R11  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,R11  INTARG
*        CI,R2    1
         BGE      ANS4              OUT OF RANGE
         LI,R1    MODEX4+3
         STB,R3   *R7,R1
         B        ANS8
         PAGE
RCDSEL1  LI,R5    1                 INITIALIZE X
         LI,R6    2                 LOOP COUNTER
         LI,R1    ARGBUF4+1
         LW,R2    NCHAR,R7
RCDSEL3  BAL,R11  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     BAL,R11  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,R10  TESTARG
         LI,R1    9                 ARE THERE SLOTS LEFT
         LW,R2    SELECT,R7
         CI,R2    10                RSMAX=10
         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   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,R11  GETARG            GET ACCT
         MTW,0    NCHAR,R7
         BE       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,R11  TEXTARG           EDIT ACCOUNT
RWACCT1  LW,R2    TERM,R7
         CI,R2    ','               ANOTHER ACCOUNT
         BE       RWACCT2           YES - GO SCAN
         CI,R2    ')'               END OF ACCOUNTS
         BE       RWACCT3           YES
RWACCT5  LI,R1    17                INVALID SYNTAX
         BAL,R11  ERROR
         B        RWACCT4
RWACCT3  XW,R6    0,R5              PUT COUNT IN TABLE
         BE       RWACCT4
         EXU      DUPERR
         BAL,R11  ERROR
RWACCT4  B        ENDSPL24
RWACCT6  LI,R1    29
         BAL,R11  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   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       CSIR14            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
CSIR14   LCI      3                 STORE DEFAULTS
         STM,R1   SEQUENCE+2,R7
         LW,R1    TERM,R7           ARE THERE VALUES
         CI,R1    '('
         BNE      ENDSPEC           NO.
         LI,R10   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,R11  GETARG
         LW,R1    NCHAR,R7          LENGTH OF ID ARGUMENT
         BE       ENDSPL2           NULL ID
         CI,R1    4                 4 CHARS OR LESS
         BLE      CSIR13            YES
         LI,R1    12                ERROR 12
         BAL,R11  ERROR
         LI,R1    4                 TRUNCATE TO 4 CHARS
CSIR13   LI,R2    ARGBUF4+1
         STW,R1   SEQUENCE+1,R7     NO. OF CHARS IN ID
         LI,R3    CARDSEQ+CARDSEQ+CARDSEQ+CARDSEQ
         BAL,R11  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,R10   1                 TO NEXT VALUE
         CI,R10   SEQUENCE+3        IS IT STILL OK
         BG       ENDSPL23          NO, ENDSPL23 WILL GO TO ERR14
         BAL,R11  GETARG0           GET A NUMBER
         BAL,R11  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,R11  ERROR
         STW,R1   *R10,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   *R10,R7
         CI,R5    '.'               DO WE HAVE A DOT
         BNE      ENDSPL2
         BAL,R11  GETARG0           GET FRACTION
         LI,R1    0
         LI,R2    999
         BAL,R11  INTARG
*        CI,R2    1
         BGE      ERR13             BAD #
         LW,R2    NCHAR,R7
         MH,R1    FMULT,R2
         AWM,R1   *R10,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
         BNE      %+3
         LI,R1    47                NO, ERROR 47
         BAL,R11  ERROR
*
ENDSPL24 BAL,R11  GETARG0
         LW,R1    NCHAR,R7          TEST FOR NULL FIELD
         BE       ENDSPEC
         LI,R1    15                ERROR 15
ENDSPL26 BAL,R11  ERROR
         B        RETURN            TERMINATOR MISSING AFTER LN OR CS
*
DUPERR   LI,R1    50                CONFLICTING0OR DUPLICATE OPTION
         BAL,R11  ERROR
         LW,R1    TERM,R7           IF (, FIND )
         CI,R1    '('
         BNE      ENDSPEC
         BAL,R11  GETARG0
         LW,R1    TERM,R7
         CI,R1    ')'
         BNE      GETARG0
         BAL,R11  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,R11  GETARG0
         MTW,0    NCHAR,R7          DID WE GET SOMETHING
         BE       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,R8    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,R12   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
         BNE      RETURN2           YES-OK
         LI,R1    4
         BAL,R11  ERROR
RETURN2  LW,R1    R8
         LCI      7
         PLM,R5   *R7
         B        *R11
*                                   1=ID,2=N,3=K
MODEDPL  DO1      7
         DATA     0
CODETBL  DATA     NOPTS
* BITS 00-07=INPUT DEVICES:   CR,PR,DC,LT,DP,FT,AT,ME
* BITS 08-16=OUTPUT DEVICES:  DC,LT,DP,FT,AT,ME,LP,CP,PP
* BITS 17-23=COMMAND FLAGS:   COPY, COPYALL, COPYSTD
* BITS 24-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
         PAGE
*
*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
*        R12      COMMAND ACTION CODE
*        R13      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
*
COPYTO   DSECT    1
         LCI      7                 SAVE REGISTERS
         PSM,R5   *R7
         LI,R6    0                 INITIALIZE COUNT AT 1ST ACTION VERB
         LI,R8    0                 CLEAR 'TO' CMBX
         LI,R9    0                 CLEAR 'COPY' CMBX
SCAN1    CI,R12   2                 COPY COMMAND
         BE       SCAN2             YES
         LW,R8    CMBX,R7           SAVE CMBX OF -TO- DEVICE
         STW,R0   TOSWT,R7          CLEAR OUTPUT SWITCH
         B        SCAN3
*
SCAN2    LW,R9    CMBX,R7           SAVE CMBX OF FIRST -COPY- DEVICE
         LW,R11   TERM,R7           SAVE TERMINATOR TOO
         STW,R11  LISTTERM          IN CASE # OR -
SCAN3    LI,R1    1                 SET ARG. LEVEL TO DEVICE
SCAN4    BAL,R11  COPYTRAN          TRANSLATE DEVICE/FILE
         CI,R13   3                 TEST ERROR SEVERITY
         BGE      RETRN
         LW,R4    TERM,R7
         CI,R12   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       NXCMR12           YES-END OF INPUT OR OUTPUT
ERR17    LI,R1    17                ERROR 17
         BAL,R11  ERROR
         B        RETRN
*
NXCMR12  CI,R6    0                 EDIT NUMBER OF ACTION VERBS
         BNE      ERR17
         LI,R6    1                 SET SECOND ACTION VERB
         BAL,R11  TRANSACT          TRANSLATE SECOND COMMAND ACTION VERB
         STW,R12  TOVER,R7          SAVE TO OR OVER OUTPUT ACTION VERB
         LW,R2    R12               NO SUCH VERB
         BNE      %+2
         MTW,-1   ERRFLAG           NO VERB, BAD MESSAGE GOES
         LI,R12   1                 SET OUTPUT FOR DEVTRAN
         LI,R1    X'20041'          MUST BE 1,12 OR 18
         SLS,R1   13,R2
         BIR,R1   SCAN1
         LI,R1    32                ERROR 32
         BAL,R11  ERROR
         B        RETRN
         PAGE
TO1      CI,R13   1                 TEST ERROR SEVERITY
         BG       RETRN
         CI,R8    0                 -TO- COMMAND PRESENT
         BNE      TO11
         MTW,0    TOSWT,R7          IF WEVE GOT A OUTPUT, USE IT
         BNE      COPY1
         BAL,R11  CLRARG
         MTW,5    DEVICE,R7         CLRARG SETS DC DEFAULT(3)
         LI,R1    'ME'
         LC       J:JIT             IF BATCH, 'ME' DOESN'T WORK TOO WELL
         BCS,8    %+3
         LI,R1    'LP'
         MTW,1    DEVICE,R7
         STW,R1   OUT%ARG,R7
*
TO11     BAL,R11  REVARG            SAVE -TO- ARGUMENT TABLE
*
COPY1    CI,R9    0                 -COPY- COMMAND
         BE       RETRN             NO-JUST -TO- COMMAND
         STW,R0   2,R7              RESET HEADER PRINTED FLAG
         LI,R12   2                 SET AT COPY VERB(FOR COMBINE)
         LI,R1    1                 SET AT DEVICE
COPY3    STW,R9   CMBX,R7           CMBX OF CURRENT INPUT DEVICE/FILE
         LW,R11   LISTTERM          RESTORE TERM
         STW,R11  TERM,R7
         BAL,R11  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
         BE       COPY9             NO
         LI,R1    2                 SET FPARAM BIT FOR BLDCB
COPY9    LW,R9    CMBX,R7           SAVE CMBX OF NEXT INPUT DEV/FILE
         LW,R11   TERM,R7           AND TERMINATOR
         STW,R11  LISTTERM
         BAL,R11  BLDCB
         CI,R13   2
         BG       COPYX             GIVE UP IF SEV 3 ERROR
         BDR,R10  COPYEND           NO INPUT HERE
         LW,R1    TOSWT,R7          HAVE WE GOT OUTPUT YET
         BNE      COPY4             YES, JUST COPY
         BAL,R11  REVARG            BRING UP -TO- ARGUMENTS
         LI,R1    1                 BUILD OUTPUT DCB
         BAL,R11  BLDCB
         BAL,R11  REVARG            BRING BACK COPY ARGUMENTS
         LH,R11   M:EO              IF EO'S NOT OPEN
         CI,R11   X'20'             GIVE UP
         BAZ      RETRN
COPY4    MTW,1    TOSWT,R7          GOT AN OUTPUT FILE
         BAL,R6   ALL8              GO PRINT FILE NAME
         BAL,R11  RDWRT             COPY M:EI TO M:EO
COPYEND  BAL,R11  CLOSEI            CLOSE CURRENT INPUT FILE
         MTW,0    BREAK             BREAK SET
         BNE      COPYX             YES
         CI,R13   2                 IS SEV LESS THAN 3
         BG       COPYX
         LI,R13   0                 SAVE THE OUTPUT
         LW,R1    R5                YES-SET 1-DEVICE, 2-FILE
         BNE      COPY3             GO PROCESS IT
COPYX    MTW,0    TOSWT,R7          IF NO OUTPUT,
         BE       RETRN             NO LAST RECORD
         BAL,R11  RDWRTX            GO COMP LAST RECORD
         BAL,R6   ALL8              UPSPACE IF REQ'D
RETRN    BAL,R11  CLOSEO            GO CLOSE OUTPUT
         LCI      7                 RESTORE REGISTERS
         PLM,R5   *R7
         B        *R11
*
WRTCOPY  GEN,8,24 X'11',M:UC
         DATA     X'34000000'
         DATA     COPYMSG
         DATA     10
         DATA     0
COPYMSG  TEXT     '..COPYING
'
         PAGE
*
*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
*        R12      COMMAND ACTION VERB
*        R13      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
*
COPYALL  DSECT    1
         LCI      7                 SAVE REGISTERS
         PSM,R5   *R7
         STW,R0   TOSWT,R7
         STW,R0   GRANCNT
         LI,R1    X'80'
         STW,R1   COPYSK            INITIALIZE TO COPY ALL FILES
         MTW,0    COPYSTDF,R7       IS THIS COPYSTD COMMAND
         BE       EDITDV1           NO
         LI,R1    1
         BAL,R11  COPYTRAN          TRANSLATE FID FOR STD FILE
         CI,R13   3
         BGE      RTURN2            CANT EXECUTE
         B        EDITDV3
*
EDITDV1  BAL,R11  CLRARG            ZERO -ARGTBL-
         LW,R1    TERM,R7
         CI,R1    '('               OPTION PRESENT
         BE       COPYSEL           YES
EDITDV2  BAL,R11  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  MTW,0    TOFILE            IF ALREADY A RANGE,
         BNE      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,R11  REVIEW            GET FILE NAME(S)
         LW,R2    TERM,R7
         CI,R2    '('
         BE       COPYSEL
EDITDV6  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
         BL       EDITDV3
         LI,R1    34                ERROR-NOT A VALID DEVICE
         BAL,R11  ERROR
*
EDITDV3  LW,R5    TERM,R7           GET TERM. CHARACTER
EDITDV5  BAL,R11  REVARG            SAVE INPUT ARGS
         BAL,R11  CLRARG            CLEAR OUTPUT ARGS
         CI,R5    X'40'             TERM. ON BLANK
         BE       TOCMR12           YES
         CI,R5    X'15'             OUTPUT FIELD NULL
         BE       FROM1
         LI,R1    17                ERROR 17
ERRTN    BAL,R11  ERROR
         B        RTURN2
*
COPYSEL  BAL,R11  COPYOPT           GET OPTIONS
         MTW,0    DEVICE+2,R7       HAVE WE BEEN TO DEVTRAN
         BE       EDITDV2           NO, GO
         LW,R2    TERM,R7           GET DELIMITER
         B        EDITDVA
*
TOCMR12  BAL,R11  TRANSACT          TRANSLATE -TO- ACTION VERB
         CI,R12   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,R11  DEVTRAN           GET OUTPUT DEVICE
         LW,R5    TERM,R7
         CI,R5    X'15'             END OF COMMAND
         BE       FROM1             YES
         CI,R5    '('
         BNE      ERRTN-1
         BAL,R11  COPYOPT           GET OPTIONS
*
FROM1    CI,R13   1                 TEST ERROR SEVERITY
         BG       RTURN2            CANNOT EXECUTE
*
         STW,R0   2,R7              RESET ACCESS HEAD NOT PRINTED
         BAL,R11  REVARG            RESTORE INPUT ARGUMENTS
         LI,R9    0                 INITIALIZE FILE COUNT
         MTW,0    COPYSTDF,R7
         BNE      COPYSTD           COPYSTD COMMAND
*
         LI,R1    6                 BUILD INPUT DCB
         BAL,R11  BLDCB
         STW,R0   SYNFLAG,R7        INITIALIZE NO SYNONYM NAMES
*
TO00     LB,R1    R10
         BE       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,R11  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
         BNE      %+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,R11  CLOSEI            NO - CLOSE M:EI
         B        ALL4
TO010    BAL,R11  REVARG            SAVE INPUT ARGTBL IN TOARG
         LI,R1    7                 BUILD OUTPUT DCB
         BAL,R11  BLDCB
         BAL,R11  REVARG
         CI,R13   2                 MAJOR ERROR
         BG       STDERR            YES
         LW,R15   R10
         BNE      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,R11  RDWRT             COPY M:EI TO M:EO
         STW,R6   TOARG+12,R7
ENDCOPY  BAL,R11  CLOSEI            CLOSE INPUT DCB
         BAL,R11  CLOSEO            CLOSE OUTPUT DCB
         LW,R10   R15
         BAL,R11  ALLC              OUTPUT MESSAGE
         CI,R13   2                 TEST ERROR SEVERITY
         BG       RTURN
         BAL,R11  PRTERR
*
ALL4     MTW,0    BREAK             BREAK SET
         BNE      RTURN             YES
         LI,R13   0
         STW,R13  ERRFLAG
         MTW,0    COPYSTDF,R7       GO GET NEXT STD FILE
         BL       COPYSTR15         IF IN THAT MODE
         MTW,0    TOFILE            ANY MORE FILES WANTED
         BL       RTURN1            NO
         BAL,R11  OPNNXT
         BCS,8    ALL5              ALL DONE
         BNE      TO00              GOT A NEW NAME, GO DO IT
STDERR   LI,R1    0                 REPORT I/O ERROR
         BAL,R11  ERROR
RTURN    BAL,R6   ALL8              UPSPACE IF REQ'D
         LI,R5    COPTEXT           ADDR OF MESSAGE
         BAL,R11  PRTNOF
RTURN2   LCI      7                 RESTORE REGISTERS
         PLM,R5   *R7
         B        *R11              RETURN
*
ALL5     LB,R2    NOFILES
         CI,R9    0                 IF NOT NO FILES,
         BNE      RTURN1            DONT SAY SO
         LI,R3    M:UC              SELECT ONLINE OR BATCH
         MTW,0    J:JIT
         BL       %+3
         LI,R3    M:LO
         AI,R2    -1                REMOVE NL CHAR
         LI,R14   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 MORE LEST LT OR AT
         LI,R1    X'FF00'
         CW,R1    M:EI+22           IS FILE NAME PRESENT
         BAZ      STDERR            NO
         BAL,R11  TESTFNC           TEST IF FILE WANTED
         B        ALL4              NO - DON'T PRINT ANYTHING
         LI,R11   ALL4              RETURN FROM ALLC
ALLC     PSW,R11  *R7
         LI,R1    36
         LW,R2    ='    '
         STW,R2   TLABEL-1,R1
         BDR,R1   %-1
         LI,R14   TLABEL            BUFFER
         LI,R1    M:EI+23
         BAL,R11  UNPRINT           ENTER FILE NAME IN BUFFER
         LI,R1    X'60'             NO POST SPACE
         STB,R1   TLABEL
         LW,R6    R2                SAVE NAME LENGTH
         AI,R9    1                 COUNT THE FILE
         AI,R10   0
         BLE      ALLX              NO ERRORS
         AI,R9    X'FFFF'           COUNT NONCOPIED FILES
         LI,R1    0                 IF SEVERITY THREE
         CI,R13   3                 COMMAND WILL ABORT
         BGE      ALLE              SO PRINT FULL MESSAGE
         STW,R1   LISTPOS
         LI,R1    'B'               2SPACE BEFORE
         STB,R1   TLABEL
         LB,R1    R10
         SLS,R1   8
         AH,R1    R10
         SLS,R1   -1
         BAL,R11  HEX2BCD           CONVERT ERR/ABN TO BCD
         LW,R2    ='    '           SURROUND CODE WITH 2 BLANKS
         CI,R10   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,R10  15
         SLS,R10  -15
         CI,R10   M:EO
         BNE      %+2
         LW,R4    TEXTOUT
         LI,R1    -12
         AI,R6    1
         LB,R11   R5,R1
         STB,R11  TLABEL,R6
         BIR,R1   %-3
ALLX     LW,R2    R6
         MTW,0    2,R7              SHOULD WE DO THIS
         BNE      ALLP              YES IF FLAG LEFT BY ALL8
         AI,R10   0                 IS IT AN ERROR MESSAGE
         BE       ALLD              NO, NOTHING
         CI,R9    X'FFFF'           IF NO FILES YET, NO PAGE
         BAZ      ALLP
         LI,R1    '1'               YES, NEW PAGE
         STB,R1   TLABEL
ALLP     LI,R3    M:LO
         LI,R4    1
         LI,R1    3
         CS,R1    M:LO
         BNE      ALLW
         LI,R1    108               LP WIDTH
         LI,R11   X'FF00'
         AND,R11  M:LO+1
         CI,R11   X'9000'
         BNE      KGC1%4
         LI,R1    BA(JB:PCW)
         LB,R1    0,R1
         STW,R1   TLABEL+35         SET FLAG
KGC1%4   LW,R11   LISTPOS
         MI,R11   12
         SW,R1    R11               SPACE REMAINING
         CW,R1    R2
         BGE      %+3               LOTS
         CAL1,1   LOSPACE
         LI,R11   0
         AW,R2    R11               SLIDE OVER TO THE NEXT CLOUMN
         LW,R4    R11
         SLS,R11  -2
         AI,R11   TLABEL
         LB,R1    TLABEL,R6
         STB,R1   *R11,R6
         BDR,R6   %-2
         LI,R1    ' '
         AI,R4    0
         BE       %+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
         BNE      %+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,R11   R14               WRITE FROM *R14 INSTEAD
         AW,R14   R11
         MI,R11   4
         SW,R2    R11
ALLW     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 WASN'T 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     CW,R9    =X'FFFFF'         16 WITH NO GOOD ONES GIVES UP
         BANZ     ALLD
         STW,R9   CMBX,R7           GARBAGE POINTER
         LI,R1    44
ALLE     BAL,R11  ERROR
         MTW,-1   BREAK
         LI,R13   3                 DONT ABORT THE JOB THOUGH
ALLD     PLW,R11  *R7               RESTORE RETURN ADDR
         B        *R11
TEXTOUT  TEXT     'OUT'
TEXTIN   TEXT     'IN '
FPTLFILE GEN,8,7,17      X'91',0,R3
         DATA     X'34000010'
         PZE      *R14
         PZE      *R2
         PZE      *R4
FPTTOF   GEN,8,24 4,M:EO            TOP OF FORM FOR NEW FILE
ALL8     EQU,0    %
*        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
         BE       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
         BNE      %+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
         BNE      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
         BLE      %+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     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 ISN'T OPEN, NO NAME
         CH,R2    M:EI
         BAZ      0,R6
         CAL1,8   TIMECAL
         LI,R15   BA(TLABEL)
         LI,R14   15
         BAL,R11  RANGEOUT
         LW,R2    R14               PRINT THE RESULT
         LI,R14   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
         DATA     X'40160040','    ','    '
         GEN,8,24 132,BA(TLABEL+3)
         PAGE
RTURN1   MTW,0    SYNFLAG,R7        SYNONYM FILE NAME(S) PRESENT
         BE       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,R11  BLDCB             GO-BUIL INPUT DCB
         BAL,R11  REVARG            BACK TO OUTPUT
         AI,R10   0                 ABLE TO OPEN FIRST FILE
         BNE      SYNERROR          NO-CHECK FOR SYNONYM FILE NAME
SYN4     BAL,R11  CLOSEI            YES - GO CLOSE IT
         BAL,R11  OPNNXT            OPEN NEXT FILE
         BCS,8    RTURN             ALL DONE
         BE       RTURN             NOT GETTING ANYWHERE
*
SYNERROR BAL,R11  TESTFNC           IF NOT WANTED, SKIP IT
         B        SYN3
         LB,R1    R10
         CI,R1    8                 SYNONYM FILE NAME
         BNE      SYN4              NO-OPEN NEXT FILE
         LI,R1    7                 OPEN NEXT,FPARAM,OUTPUT
         BAL,R11  BLDCB             PUT SYNONYM FILE ON OUTPUT ACCT.
         BAL,R11  CLOSEO            CLOSE NEW SYNONYM FILE
         BAL,R11  ALLC              LIST NAME OR ERROR
SYN3     MTW,0    TOFILE            END OF RANGE
         BL       RTURN             YES
         B        SYN4              OPEN NEXT FILE
         PAGE
COPYSTD  LI,R1    2
         BAL,R11  BLDCB
         CI,R13   1
         BG       RTURN2
         LI,R1    3
         CS,R1    M:EI              IF DEVICE, DONT COPY TWICE
         BE       COPYSTR12
         BAL,R11  REVARG            SETUP TO OPEN OUTPUT DCB
         LI,R1    7
         BAL,R11  BLDCB             BUILD M:EO
         CI,R13   1
         BG       STDERR
         BAL,R11  PRTERR
         BAL,R11  REVARG            BRING BACK INPUT ARGUMENTS
         BAL,R6   ALL8              OUTPUT HEADING IF NEEDED
         LW,R6    TOARG+12,R7       SAVE SEQ START
         BAL,R11  RDWRT             COPY STD FILE
         STW,R6   TOARG+12,R7       RESTORE IT
         LW,R10   R15
         BAL,R11  ALLC              LIST NAME
         B        %+2
COPYSTR12 STW,R3  DEVICE,R7
         LH,R11   M:EI              IF EI IS OPEN, WE CAN GO ON
         CI,R11   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,R11   COPYSTR14
COPYSTD6 CAL1,1   SRDFPT
         LW,R3    M:EI+4            GE SIZE
         SLS,R3   -17
         CAL1,1   SWRFPT
         B        COPYSTD6
COPYSTR14 CAL1,1  SPFFPT            PFILE BOF
         BAL,R11  CLOSEI
         BAL,R11  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
COPYSTR13 LI,R11  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,R8    COPYSTD0          GET INITIAL FLAG WORD
COPYSTR15 INT,R2  R8                GET CODE 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    R8                DEVICE,FILE FLAG IN BYTE0
         BE       COPYSTR13         NO MORE HERE
         LI,R12   2                 SET INPUT FLAG FOR COPYTRAN
         BAL,R11  COPYTRAN
         LW,R8    CMBX,R7           SAVE WHERE WE ARE
         LW,R2    TERM,R7           AND ON WHICH DELIMITER
         STH,R2   R8
         STB,R1   R8                AND WHETHER THERE'S MORE HERE
         LI,R1    2
         BAL,R11  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    R10
         CI,R1    6
         BE       *R11
         CI,R1    5
         BE       *R11
         B        STDERR            REPORT ERROR
*
PFIL%STD GEN,8,7,17   X'1C',0,M:EI
         DATA     X'10'
         END
