         PAGE
R0       EQU      0
R1       EQU      1
VERSION  EQU      2                 1=BPM, 2=UTS
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
DEVTRAN  DSECT    1
         TITLE    'DEVTRAN'
         SYSTEM   SIG7
*
* DEVTRAN         DEVICE ID TRANSLATOR
*
* INPUT
*        CMBX     COMMAND BUFFER INDEX OF NEXT ARGUMENT
*        TERM     TERMINATOR OF CURRENT ARGUMENT
* OUTPUT
*        DEVICE   +0    DEVICE ID CODE
*                 +1    NUMBER OF REEL NO.S
*                 +2    COMMAND BUFFER INDEX OF FIRST REEL NO.
*
*
         DEF      DEVTBL
         REF      GETARG,FIXARG,TEXTARG,ERROR
         REF      CMBX,TERM,DEVICE
         REF      FILE
         REF      #DELIM
         REF      ARGBUFF
         REF      COPYSTDF
         REF      MAXSN
         DO       VERSION=2
         REF      SV:RSIZ
         REF      SH:RNM
         REF      SB:RTY
         REF      TB:FLGS
         REF      DEV%IN
         REF      DEV%OUT
         REF      IN%ARG
         REF      OUT%ARG
         FIN
         REF      MODE
*
         LCI      7                 SAVE REGISTERS
         PSM,R5   *R7
*
         LI,R5    0                 INITIALIZE
         LW,R2    TERM,R7
         CI,R2    X'4B'             ACCOUNT NO. WITHOUT DC
         BNE      NEXTARG           NO
         MTW,0    COPYSTDF,R7
         BEZ      DEV2              GO SET CODE FOR DC
*
NEXTARG  LW,R6    CMBX,R7
         LI,R1    6
         LW,R2    TERM,R7
         CI,R2    X'7B'             DOES SERIAL NO. FOLLOW
         BNE      NEXT1             NO
         LW,R2    DEVICE,R7
         CI,R2    7                 IS THIS ANS TAPE
         BNE      NEXT1             NO
         LI,R1    12                ALLOW OPTIONAL CHAR STRING
NEXT1    EQU      %
         STW,R1   #DELIM,R7         ENABLE # AS DELIMITER
         BAL,SR4  GETARG            GET NEXT ARGUMENT
*
         CI,R5    0                 TEST FOR DEVICE CODE
         BNE      REELNO
         LW,R1    =X'02000000'+DEVTBL   EDIT DEVICE CODE
         BAL,SR4  FIXARG
         STW,R1   DEVICE,R7         STORE DEVICE ID CODE
         B        ENDDEV
DEV2     EQU      %
         LI,R1    3
         STW,R1   DEVICE,R7
         B        ENDDEV4
*
REELNO   LW,R1    =X'03000104'      EDIT REEL NO.
         LW,R2    DEVICE,R7
         CI,R2    7                 TEST IF ANS TAPE
         BNE      %+2               NO
         LW,R1    =X'03000606'      MUST BE 6 CHAR FOR ANS
         BAL,SR4  TEXTARG
         CI,R5    1                 TEST FOR FIRST REEL NO.
         BNE      %+2
         STW,R6   DEVICE+2,R7       STORE CMBX OF FIRST REEL NO
         STW,R5   DEVICE+1,R7       STORE REEL NO. COUNT
*
ENDDEV   LW,R1    TERM,R7           TEST FOR TERMINATION ON NO. SIGN
         CI,R1    X'7B'
         BNE      ENDDEV3
         CI,R5    MAXSN             CHECK FOR MAX SERIAL NUMBERS
         BL       ENDDEV2
         LI,R1    35                TOO MANY REEL NUMBERS
         BAL,SR4  ERROR
         B        NEXTARG
ENDDEV2  AI,R5    1                 INCREMENT REEL NO. COUNTER
         B        NEXTARG
ENDDEV3  STW,R0   #DELIM,R7         DISABLE # AS A DELIMITER
         DO       VERSION=2
         CI,R1    '-'          DOES DEVICE TYPE FOLLOW?
         BNE      ENDDEV3K     NO
         MTW,0    DEVICE+1,R7  WAS A SERIAL NUMBER PRESENT?
         BEZ      ERR          NO
         BAL,SR4  GETARG
         LI,R2    0
         LW,R3    ARGBUFF,R7   GET ARGUMENT FROM BUFFER.
         SLD,R2   8            ISOLATE LENGTH.
         AI,R2    -2
         BNEZ     ERR
         SLS,R3   -16
         LI,R2    SV:RSIZ+1
         LI,R5    X'FFFF'
CK%AGN   EQU      %
         LH,R4    SH:RNM,R2
         CS,R4    R3
         BE       ENDDEV3A     DEVICE TYPE FOUND.
         BDR,R2   CK%AGN
ERR      EQU      %
         LI,R1    17
         BAL,SR4  ERROR
         B        ENDDEV3K
ENDDEV3A EQU      %
         CI,R3    '7T'
         BNE      %+3          NOT 7T
         LI,R1    3
         STW,R1   MODE+1,R7    ENTER CODE FOR 7T IN ARGTBLE
         LW,R1    DEVICE,R7
         CI,D1    1
         BE       ENDDEV3D     OUTPUT DEVICE.
         CI,D1    12           CHECK FOR INPUT.
         BE       ENDDEV3D     NO.
         STW,R1   DEV%IN,R7
         STW,R3   IN%ARG,R7
         B        ENDDEV3G
ENDDEV3D EQU      %
         STW,R1   DEV%OUT,R7   SAVE OUTPUT INFORMATION.
         STW,R3   OUT%ARG,R7
ENDDEV3G EQU      %
         STW,R0   DEVICE,R7
         LW,R1    TERM,R7
         FIN
ENDDEV3K EQU      %
         CI,R1    X'4B'             TEST FOR TERMINATION ON PERIOD
         BNE      RETURN
ENDDEV4  EQU      %
         LI,R1    6
         STW,R1   FILE,R7           SET CODE FOR ACCT ONLY
         LW,R1    CMBX,R7
         STW,R1   FILE+1,R7         SET CMBX OF ACCT NUMBER
         BAL,SR4  GETARG            GET ACCT NO
          STCF      SR1
         LW,R1    =X'05000108'
         LC       SR1
         BCS,1    ENDDEV5           ARGUMENT IS CHARACTER STRING
         LW,R2    =X'00E77D00'
         LW,R3    =X'00FFFF00'
         CS,R2    ARGBUFF,R7        IS ACCT A HEX VALUE
         BNE      %+2               NO
         AI,R1    X'30B'            CHANGE LENGTH ALLOWED
ENDDEV5  EQU      %
         BAL,SR4  TEXTARG           EDIT ACCT NO
*
RETURN   LCI      7                 RESTORE REGISTERS
         PLM,R5   *R7
         B        *SR4
*
DEVTBL   DATA     11                DEVICE CODE TABLE
         TEXTC    'CR'
         TEXTC    'PR'
         TEXTC    'DC'
         TEXTC    'LT'
         TEXTC    'DP'
         TEXTC    'FT'
         TEXTC    'AT'
         DO1      VERSION=2
         TEXTC    'ME'
         DO1      VERSION=1
         TEXTC    '  '
         TEXTC    'LP'
         TEXTC    'CP'
         TEXTC    'PP'
         END

