         PAGE
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
*
* COPYTRAN        COPY COMMAND TRANSLATOR
*
* 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 ID
*        MODE     +0 - BYTE 0       BCD/BIN ID CODE
*                      BYTE 1       BLK ID CODE
*                      BYTE 2       REC ID CODE
*                      BYTE 3       FMT ID CODE
*                 +1 - BYTE 0       CAT ID CODE
*                      BYTE 1       EXP
*                      BYTE 2       UNUSED
*                      BYTE 3       7T/9T 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
*
         REF      CLRARG
         REF      DEV%IN,DEV%OUT
         REF      #DELIM
         REF      ERROR,FIXARG,INTARG,GETARG,BCD2BIN
         REF      DEVTRAN,FILTRAN,COMBINE
         REF      NCHAR,TERM,ARGBUFF,ARGBUF4
         REF      ARGTBL,DVLARG
         REF      CODE,MODE,SEQUENCE,SELECT
         REF      CMBX
         REF      SAVCMBX,DEVICE
         REF      FILE
         REF      CARDSEQ
         REF      MBS
         REF      TABSET,J:JIT
         REF      M:UC
         REF      COPYSTDF,SFARG
         REF      SFDEV
         REF      RDTBL,WRTBL,TEXTARG
         REF      ANSBLK
         REF      EXPIRE
         REF      LISTTERM
         REF      UNTBL,EXTBL
         REF      DENSITY
         DEF      RWACCT
*
         USECT    COPYTRAN
         LCI      7                 SAVE REGISTERS
         PSM,R5   *R7
*
         STW,R1   SR1               SAVE LEVEL  1-DEVICE, 2-FILE
*
         CI,SR1   1                 DEVICE ARGUMENT LEVEL
         BNE      FILE1             NO-FILE ARGUMENT LEVEL
         BAL,SR4  CLRARG            CLEAR -ARGTBL-
         LW,R4    TERM,R7
         CI,R4    X'40'
         BE       DEV1
         CI,R4    X'15'
         BE       DEV1
         CI,R4    ';'
         BE       DEV1
         LI,R1    17                SYNTAX ERROR
         BAL,SR4  ERROR
DEV1     LW,R5    CMBX,R7
         STW,R5   SAVCMBX,R7        SAVE CURRENT CMBX
*
         BAL,SR4  DEVTRAN           TRANLATE DEVICE ID
         MTW,0    COPYSTDF,R7       ARE WE COPYING A STD FILE
         BLEZ     DEV3              NO
         LW,R5    CMBX,R7
         CW,R5    SAVCMBX,R7        WAS DEVICE PRESENT
         BNE      DEV3              YES
         LW,R5    SFARG
         BEZ      DEV3
         LW,R5    SFARG+1
         STW,R5   DEVICE+1,R7       BRING UP ARGS FROM STD FILE
         LW,R5    SFDEV
         STW,R5   DEVICE,R7
         LW,R5    SFARG+2
         STW,R5   DEVICE+2,R7
         LW,R5    SFARG+7
         STW,R5   MODE+1,R7
DEV3     EQU      %
         STW,R0   SAVCMBX,R7        ZERO CMBX SAVE FLAG
*
         LW,R5    TERM,R7           TEST FOR TERMINATION ON LT. PAREN
         CI,R5    X'4D'             ARGUMENTS FOR DEVICE
         BE       SPECARG           YES-GO TRANSLATE SPEC. ARGUMENTS
DEVRTN   CI,R5    '/'               FILE FOLLOW
         BNE      TESTEND           NO
*
DEV2     EQU      %
         LI,R1    36                YES-SAVE DEVICE LEVEL ARGUMENTS
         LW,R2    R7
         LW,R3    ARGTBL+35,R2
         STW,R3   DVLARG-1,R1
         AI,R2    -1
         BDR,R1   %-3
         LI,SR1   2                 SET LEVEL TO FILE
         B        FILE2
*
FILE1    LI,R1    36                RESTORE DEVICE LEVEL -ARGTBL-
         LW,R2    R7
         LW,R3    DVLARG-1,R1
         STW,R3   ARGTBL+35,R2
         AI,R2    -1
         BDR,R1   %-3
*
FILE2    BAL,SR4  FILTRAN           GO-TRANSLATE FILE ID N.A.P
*
         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 BAL,SR4  COMBINE           EDIT PARAMETER COMBINATIONS
         B        RETURN
*
SPECARG  STW,R0   SELECT,R7         RESET RECORD SELECTION
SPECARG2 LI,SP    1                 INITIALIZE TO LEVEL ONE
         PAGE
NEXTARG  BAL,SR4  GETARG            GET NEXT ARGUMENT
         STW,R0   #DELIM,R7
         MTW,0    COPYSTDF,R7
         BNEZ     MODE1             COPYSTD
         CI,SP    1                 FIST LEVEL SPEC. ARGUMENT
         BNE      SPECL2            NO-LEVEL CS OR LN
*
         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       MODE1             NO
*
         STW,R1   CODE,R7           STORE DATA CODE ID
         B        ENDSPEC           CHECK PROPER TERMINATION
*
MODE1    LI,R1    MODETBL           SEARCH MODE TABLE FOR MATCH
         BAL,SR4  FIXARG
         MTW,0    COPYSTDF,R7
         BEZ      %+3               NOT COPYSTD
         CI,R1    3                 IS OPTION 7T
         BNE      STDFERR           NO - ERROR
         CI,R1    0
         BNE      MODE3
         LW,R2    ARGBUFF,R7
         LI,R1    14           SET CODE FOR DEOD.
         CW,R2    =X'04C4C5D6'
         BE       MODE3        BRANCH IF DEOD.
         CW,R2    =X'04C1E2C3'  TEST FOR ASCI.
         BNE      CK%EBCD      NOT ASCII.
         LW,R1    =X'10000000'
         STS,R1   MODE,R7
         B        SET%MODE
CK%EBCD  EQU      %
         CW,R2    =X'04C5C2C3'  TEST FOR EBCDIC.
         BNE      ANS1         NO
SET%MODE EQU      %
         LW,R1    =X'80000000'  SET CODE TO INDICATE ASCI OR
         STS,R1   MODE,R7       EBCDIC AS OPTION.
         LI,R1    2
         B        MODE3+3
MODE3    EQU      %
*
         LB,R2    MODEDPL,R1        STORE MODE ID CODE
         AI,R2    MODE+MODE+MODE+MODE
         STB,R1   *R7,R2
         CI,R1    17
         BE       EXPARG            EXPIRE OPTION
         CI,R1    13                TX OPTION
         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
ANS1     LI,R1    ANSTBL            SEARCH FOR ANS OPTION
         BAL,SR4  FIXARG
         AI,R1    0
         BE       SEQ1              NOT AN ANS OPTION
         LW,R6    R1                SAVE INDEX
         LW,R3    TERM,R7
         CI,R3    '('
         BNE      ANS9              VALUE MUST BE PRESENT
         BAL,SR4  GETARG            GET VALUE OF ANS OPTION
         CI,R6    3                 IS IT FMT OPT
         BNE      ANS3              NO
         LI,R3    2                 VALUE FOR 'D'
         LW,R2    ARGBUFF,R7
         CW,R2    =X'01C44040'      MUST BE 'D'
         BE       ANS6
         LI,R3    3
         CW,R2    =X'01E54040'      OR 'V' TO BE VALID
         BE       ANS6
ANS4     LI,R1    54                INVALID VALUE
         BAL,SR4  ERROR
         B        ANS8
ANS3     LI,R1    1                 MIN VALUE
         LI,R2    32767             MAX VALUE
         BAL,SR4  INTARG            CONVERT AND TEST
         AI,R2    0
         BNE      ANS4              INVALID
         CI,R6    2                 TEST IF BLK OR REC
         BLE      ANS6              YES - OK
         CI,R1    2                 TEST RANGE FOR CAT OPTION
         BL       ANS4
         CI,R1    128
         BG       ANS4              OUT OF RANGE VALUE
ANS6     STW,R3   ANSBLK-1,R6       ENTER VALUE IN ANS VALUE TABLE
         LW,R2    R6                SAVE INDEX
         AI,R2    23                COMPUTE ARGTBL ID CODE
         LW,R1    R7
         AI,R1    MODE
         STB,R2   *R1,R6            ENTER CODE IN ARGTBL
ANS8     LW,R2    TERM,R7
         CI,R2    ')'
         BE       ENDSPL24
ANS9     LI,R1    17
         B        ENDSPL26          SYNTAX ERROR
*
SEQ1     LI,R1    SEQTBL            SEARCH SEQUENCE TABLE FOR MATCH
         BAL,SR4  FIXARG
         CI,R1    0                 FIND A SEQUENCE CODE
         BE       CK%DEN
*
         STW,R1   SEQUENCE,R7       STORE SEQUENCE ID CODE
*
         CI,R1    3                 CS OR NL
         BL       ENDSPEC           NEITHER- CHECK PROPER TERMINATION
         LI,ID    0                 INITIALIZE IN CASE NO ARGUMENTS
         AI,R1    -1                SET SPEC LEVEL 2-CS 3-LN
         STW,R1   SP
         LW,R2    TERM,R7           TERM ON (
         CI,R2    X'4D'
         BNE      SPECL2            NO
         LI,ID    1                 SET FIRST ARG CS OR LN
         LI,R1    12
         STW,R1   #DELIM,R7         ALLOW CHAR STRING ID
         B        NEXTARG
         PAGE
EXPARG   LW,R1    TERM,R7           SCAN EXPIRE ARGUMENTS
         CI,R1    '('
         BNE      ERR11             BAD SYNTAX
         BAL,SR4  GETARG            GET FIRST ARGUMENT
         LW,R4    TERM,R7
         CI,R4    ')'
         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  GETARG            GET NEXT ARGUMENT
         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
CK%DEN   EQU      %
         LW,R2    ARGBUFF,R7
         CW,R2    =X'03C4C5D5'
         BNE      RCDSEL1           NOT DENSITY OPTION.
         LW,R3    TERM,R7
         CI,R3    '('
         BNE      DENER        TAPE DENSITY IS IN ERROR
         LI,D4    17
         BAL,SR4  GETARG       GET DENSITY.
         LI,R1    ARGBUF4+1
         LW,R2    NCHAR,R7     PREPARE TO CONVERT DENSITY.
         BAL,SR4  BCD2BIN      CONVERT DENSITY.
         CI,R4    0            CONVERSION VALID.
         BNE      DENER        TAPE DENSITY IS IN ERROR.
         CI,R3    800
         BNE      CK1600       NOT 800 BPI.
         LI,R2    1            800 BPI=STORE 1 FOR DSF BIT.
         STW,R2   DENSITY,R7
         B        CK%DEND
CK1600   EQU      %
         CI,R3    1600
         BNE      DENER        TAPE DENSITY IS IN ERROR.
         LI,R2    2
         STW,R2   DENSITY,R7        1600 BPI
CK%DEND  EQU      %
         LI,R2    36
         LW,R3    TERM,R7
         CI,R3    ')'
         BE       ENDSPL24
DENER    EQU      %
         LI,R1    56
         B        ENDSPL26
         PAGE
RCDSEL1  EQU      %
         LI,SR4   ENDSPL24          RETURN ADR FROM RWACCT
         LI,R2    1                 INDICATE RD TO RWACCT
         LW,R1    ARGBUFF,R7
         CW,R1    =X'02D9C440'
         BE       RWACCT            IT IS RD - GO SCAN
         LI,R2    2                 INDICATE WR TO RWACCT
         CW,R1    =X'02E6D940'
         BE       RWACCT            IT IS WR - GO SCAN
         LI,R2    3            INDICATE EXECUTE TO RWACCT.
         CW,R1    =X'02C5E740'
         BE       RWACCT       IT IS EX--GO SCAN.
         LI,R2    4            INDICATE UN TO RWACCT.
         CW,R1    =X'02E4D540'   CHECK VEHICLE.
         BE       RWACCT       IT IS UN--GO SCAN.
         LW,R6    SELECT,R7
         CI,R6    RSMAX             MAXIMUM RS ENTRY COUNT
         BL       RCDSEL2           NO
         LI,R1    9                 ERROR 09
         BAL,SR4  ERROR
         B        ENDSPEC
*
RCDSEL2  SLS,R6   1                 INITIALIZE RS PARAMETERS
         AI,R6    SELECT+1
         LI,R1    1
         STW,R1   *R7,R6            INITIALIZE X
         LI,R5    2
         LI,R1    ARGBUF4+1
         LW,R2    NCHAR,R7
*
RCDSEL3  BAL,SR4  BCD2BIN           CONVERT SELECTION INTEGER TO BINARY
*
         CI,R4    2                 OVERFLOW
         BNE      RCDSEL4           NO
ERR10    LI,R1    10                ERROR 10
         BAL,SR4  ERROR
         B        ENDRSEL
*
RCDSEL4  CW,R3    *R7,R6            TEST ORDER OF RS VALUES
         BL       ERR11
*
STORSEL  STW,R3   *R7,R6            STORE RECORD SELECTION VALUE
*
         BDR,R5   RCDSEL5           TEST FOR SECOND VALUE
         CI,R4     0                NORMAL CONVERSION OF Y(NO TERMINATOR
         BE       ENDRSEL           YES
ERR11    LI,R1    17
         BAL,SR4  ERROR
         B        ENDSPEC
*
RCDSEL5  AI,R6    1                 POINT TO Y
         STW,R3   *R7,R6            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  MTW,1    SELECT,R7         COUNT THIS RECORD SELECTION
         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   PSW,SR4  *R7
         LW,R3    TERM,R7
         CI,R3    '('
         BNE      RWACCT5           INVALID SYNTAX
         LI,R3    23                MODE CODE FOR COMBINE
         LI,R5    MODE+2
         AW,R5    R7
         STB,R3   *R5               ENTER CODE IN ARGTBL
         LW,R5    ACCTBL,R2         GET ACCT TBL ADR
         LW,R2    CMBX,R7
         STW,R2   1,R5              SET POINTER TO FIRST ACCT
         LI,R6    0                 INITIALIZE COUNT
RWACCT2  BAL,SR4  GETARG            SCAN ACCOUNT
         MTW,0    NCHAR,R7
         BEZ      RWACCT6           NULL FIELD
         AI,R6    1                 BUMP COUNT
         LW,R1    =X'05000108'      VALUE FOR TEXTARG
         LW,R2    ARGBUFF,R7
         LW,R3    =X'00FFFF00'
         CW,R5    ACCTBL+4          CHECK IF VEHICLE.
         BNE      NOT%UN            NOT VEHICLE.
         LW,R1    =X'0500010B'
         CS,R2    =X'00E77D00'      IS IT A HEX ACCT
         BNE      %+2               NO
         AI,R1    X'30B'            CHANGE LENGTH.
         BAL,SR4  TEXTARG           EDIT ACCOUNT.
         LW,R2    TERM,R7
         B        RWACCT1A
NOT%UN   EQU      %
         CS,R2    =X'00E77D00'      IS IT A HEX ACCT
         BNE      %+2               NO
         AI,R1    X'30B'            CHANGE LENGTH ALLOWED
         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  CI,R6    8                 MORE THAN 8 ACCOUNTS
         BLE      %+4               NO
         LI,R6    8                 USE ONLY FIRST 8
         LI,R1    50
         BAL,SR4  ERROR
         STW,R6   0,R5              PUT COUNT IN TABLE
RWACCT4  EQU      %
         PLW,SR4  *R7
         B        *SR4              EXIT
RWACCT6  LI,R1    29
         BAL,SR4  ERROR
         B        RWACCT1
*
ACCTBL   EQU      %-1
         DATA     RDTBL             READ ACCT TABLE
         DATA     WRTBL             WRITE ACCT TABLE
         DATA     EXTBL        EXECUTE ACCT TABLE.
         DATA     UNTBL        UNDER ACCT TABLE.
         PAGE
SPECL2   CI,ID    1                 FIRST SEQUENCE ARGUMENT
         BG       CSID1             NO
         STW,R0   SEQUENCE+1,R7     SET NCHAR IN ID TO ZERO
         STW,R0   SEQUENCE+2,R7     INITIAL VALUE TO ZERO
         LW,R2    ='0000'
         STW,R2   CARDSEQ,R7        INITIALIZE SEQUENCE INFO
         STW,R2   CARDSEQ+1,R7
         LI,R1    1
         STW,R1   SEQUENCE+3,R7     INCREMENT (K) TO ONE
         LW,R1    =99999999         MAX CS SEQUENCE NO.
         CI,SP    2                 CS OPTION
         BE       CSID3             YES
         LI,R1    1000
         STW,R1   SEQUENCE+2,R7     DEFAULT INITIAL VALUE
         STW,R1   SEQUENCE+3,R7     DEFAULT INCREMENT
         LI,R1    9999              MAX EDIT LINE NUMBER
CSID3    EQU      %
         STW,R1   SEQUENCE+4,R7     MAX SEQUENCE VALUE
         AI,ID    0                 ANY ARGUMENTS PRESENT
         BEZ      ENDSPEC           NO - USE DEFAULT VALUES
         STW,R0   LISTTERM          INITIALIZE PREVIOUS TERMINATOR
*
CSID1    CI,SP    2                 CARD SEQUENCING  (CS)
         BNE      SEQV              NO-LN HAS NO ID
         CI,ID    1                 CS ID
         BNE      SEQV              NO
*
         LW,R1    NCHAR,R7          LENGTH OF ID ARGUMENT
         BEZ      ENDSPL2           NULL ID
         CI,R1    4                 4 CHARS OR LESS
         BLE      CSID2             YES
         LI,R1    12                ERROR 12
         BAL,SR4  ERROR
         LI,R1    4                 TRUNCATE TO 4 CHARS
CSID2    LI,R2    ARGBUF4+1
         STW,R1   SEQUENCE+1,R7     NO. OF CHARS IN ID
         LI,R3    CARDSEQ+CARDSEQ+CARDSEQ+CARDSEQ
         BAL,SR4  MBS               MOVE SEQ ID TO CARDSEQ
         LW,R2    SEQUENCE+1,R7     GET NO. CHARS IN ID
         LW,R5    =99999999         COMPUTE MAXIMUM SEQUENCE NO.
         LI,R4    0
         DW,R4    =10
         BDR,R2   %-2
         STW,R5   SEQUENCE+4,R7     STORE MAX VALUE-RECYCLE VALUE
         B        ENDSPL2
*
SEQV     LI,R1    0                 EDIT AND CONVERT (N OR K)-MIN VALUE
         MTW,0    NCHAR,R7
         BEZ      STORSV            NULL FIELD - STORE ZERO
         CI,SP    2                 CS OPTION
         BE       SEQV2             YES
         CI,ID    1                 LN - IS THIS N VALUE
         BE       SEQV2             YES
         LI,R2    100               MAX FOR INTEGER
         CI,ID    3                 INTEGER PORTION OF INCR
         BE       SEQV3             YES
         LI,R2    999               SET MAX FOR FRACTIONAL PART
         B        SEQV3
SEQV2    LW,R2    SEQUENCE+4,R7     MAX VALUE
SEQV3    BAL,SR4  INTARG
         CI,R2    0                 ERROR RETURN
         BE       STORSV            NO
         LI,R1    13                ERROR 13
         BAL,SR4  ERROR
         B        ENDSPL2
*
STORSV   LW,R3    ID                1-LN, 2-N, 3-K
         AW,R3    SP                LEVEL: 2-CS,  3-LN
         AI,R3    SEQUENCE-2
         CI,SP    3                 LN OPTION
         BNE      STORSV2+1         NO
         CI,ID    3                 IS INDEX OK
         BL       %+2               YES
         AI,R3    -1                ADJUST INDEX
         LW,R5    LISTTERM          GET PREVIOUS TERMINATOR
         CI,R5    '.'               IS THIS FRACTIONAL PART
         BNE      STORSV2           NO
         CI,ID    3
         BE       %+2
         AI,R3    -1                ADJUST INDEX
         LW,R5    NCHAR,R7
         MH,R1    FMULT,R5          ADJUST FRACTIONAL PART
         AWM,R1   *R7,R3            ADD TO INTEGER PART
         B        ENDSPL2
STORSV2  MI,R1    1000              INTEGER PART OF INCREMENT
         STW,R1   *R7,R3            STORE N OR K VALUE
*
ENDSPL2  LW,R5    TERM,R7           TEST FOR TERMINATION COMMA
         CI,R5    X'6B'             TERMINATING ,
         BNE      ENDSPL22          NO-TRY FOR )
         CI,ID    3                 TEST FOR VALID COMMA
         BGE      ERR14             NO - ERROR-SHOULD BE ')'
         CI,ID    2                 N CONVERSION
         BNE      NXSPL2            NO-CONVERT N
         CI,SP    2                 CS TYPE
         BE       NXSPL2            YES-CONVERT K
         LW,R1    LISTTERM          GET PREVIOUS TERMINATOR
         CI,R1    '.'               IS THIS FRACTIONAL PART
         BE       NXSPL2            YES - OK
ERR14    LI,R1    14                ERROR 14
         BAL,SR4  ERROR
         B        RETURN
STDFERR  LI,R1    49
         B        ERR14+1
NXSPL2   AI,ID    1                 PREPARE FOR NEXT SPEC LEVEL 2 ARG.
         LW,R1    TERM,R7
         STW,R1   LISTTERM          SAVE TERMINATOR
         B        NEXTARG
*
ENDSPL22 CI,R5    '.'               TERM ON '.'
         BNE      ENDSPL23          NO
         CI,SP    3                 LN OPTION
         BNE      ERR14             NO-ERROR
         CI,ID    1                 TEST IF INTEGER PART
         BE       NXSPL2            YES
         LW,R1    LISTTERM
         CI,R1    ','               INTEGER PART OF INCR
         BE       NXSPL2            YES - OK
         B        ERR14             ERROR
ENDSPL23 CI,R5    X'5D'             TERM ON )
         BNE      ERR14             NO-ERROR
         LI,SP    1                 SET BACK TO LEVEL ONE
*
ENDSPL24 EQU      %
         CI,D2    1
         BG       RETURN
         BAL,SR4  GETARG            GET DUMMY ARGUMENT
         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
*
ENDSPEC  LW,R5    TERM,R7
         CI,R5    ','               TERM ON ' '
         BE       SPECARG2          YES - GET NEXT SPECIAL ARGUMENT
         CI,R5    X'5D'             TERM ON )
         BE       ENDSPEC2          YES-END OF SPECIAL ARGUMENTS
         LI,R1    16                ERROR 16
         B        ENDSPL26
*
ENDSPEC2 LW,R5    CMBX,R7           SAVE WHERE YOU ARE ON COMMAND
         BAL,SR4  GETARG            GO-SCAN AHEAD TO CHECK NEXT FIELD
         LW,R1    TERM,R7
         CI,R1    ' '               BLANK TERMINATOR
         BNE      ENDSPEC3          NO-ANOTHER DEVICE/FILE FOLLOWS
         STW,R5   CMBX,R7           YES-BACKUP SCAN DONT BURN TO/OVER
*
ENDSPEC3 LW,R5    TERM,R7           TERM OF DUMMY CHAR. D(S)/FID(S)
         CI,SR1   1                 TEST FOR DEVICE OR FILE LEVEL
         BE       DEVRTN            TRANSLATE FIRST FILE
         B        FILRTN            SET NEXT ARG LEVEL
*
RETURN   LW,R1    DEVICE,R7
         BNEZ     RETURN1      PCL DEVICE.
         LW,R1    DEV%IN,R7
         CI,D1    2            TEST IF INPUT.
         BE       %+2          YES.
         LW,R1    DEV%OUT,R7   LOAD SYSTEM OUTPUT DEVICE.
RETURN1  EQU      %
         CI,R1    3                 IS DEVICE DC
         BL       RETURN2           NO
         CI,R1    5                 OR LT OR DP
         BG       RETURN2           NO
         MTW,0    FILE,R7           FID SPECIFIED
         BNEZ     RETURN2           YES-OK
         LI,R1    4
         BAL,SR4  ERROR
RETURN2  LW,R1    SR1
         LCI      7
         PLM,R5   *R7
         B        *SR4
*
SP       EQU      SR2               2=CS, 3=LN
ID       EQU      SR3               1=ID,2=N,3=K
RSMAX    EQU      10
*                                   MAX NO. X-Y PAIRS
CODETBL  DATA     6                 DATA FORMAT CODE TABLE
         DATA     0                 (DUMMY ENTRY)
         TEXTC    'E'               EBCDIC
         TEXTC    'C'               METASYM COMPRESSED
         TEXTC    'H'               HOLLERITH
         TEXTC    'A'               ASCII
         TEXTC    'X'               HEX DUMP
*
MODETBL  DATA     18
         TEXTC    'BCD'
         TEXTC    'BIN'
         TEXTC    '7T'
         TEXTC    '9T'
         TEXTC    'UPK'
         TEXTC    'PK'
         TEXTC    'SSP'
         TEXTC    'DSP'
         TEXTC    'VFC'
         TEXTC    'NC'
         TEXTC    'FA'
         TEXTC    'NFA'
         TEXTC    'TX'
         TEXTC    ' '
         TEXTC    'K'
         TEXTC    'CR'
         TEXTC    'EXP'
MODEDPL  DATA,1   0,0,0,7,7,11,11,12,12,12,13,14,14,10,15,9,13,5,0,0
*
ANSTBL   DATA     4
         TEXTC    'BLK'
         TEXTC    'REC'
         TEXTC    'FMT'
         TEXTC    'CAT'
*
SEQTBL   DATA     4
         TEXTC    'NCS'
         TEXTC    'NLN'             NO EDIT LINE NUMBERS
         TEXTC    'CS'              (ID,N,K)
         TEXTC    'LN'              LN(N,K) EDIT LINE NUMBER SEQUENCING
*
FMULT    DATA,2   0,100,10,1
         END

