!JOB
!LIMIT (CORE,14),(TIME,5)
!METASYM LO,DC,SI,GO
         SYSTEM   BPM
         SYSTEM   SIG7
         DEF      DEVRUN
         REF      J:CCBUF           COMMAND BUFFER
         REF      J:JIT             WHERE TO PICK UP SYSID
*
*        DEVRUN DESCRIPTION
*
*        DEVRUN ALLOWS USERS TO START LOAD MODULES ON PRIVATE
*        PACK AND XEROX LABELED TAPE INTO EXECUTION.  LIKE
*        THE !RUN COMMAND ALL ASSIGNMENTS AND/OR SETS MUST BE
*        PERFORMED BEFORE CALLING DEVRUN.
*
*        EXAMPLE:
*
*        !DEVRUN DP#DISK/FID.ACCOUNT.PASSWORD
*        !DEVRUN LT#TAPE/FID.ACCOUNT.PASSWORD
*        !DEVRUN /FID.ACCOUNT.PASSWORD
*
*        1)  THE FIRST EXAMPLE WILL PICK UP FILE(FID) IN ACCOUNT
*            (ACCOUNT OPTIONAL) WITH A PASSWORD (PASSWORD OPTIONAL)
*            FROM PRIVATE PACK(DISK).
*
*        2)  THE SECOND EXAMPLE WILL PICK UP FILE(FID) IN ACCOUNT
*            (ACCOUNT OPTIONAL) WITH A PASSWORD(PASSWORD OPTIONAL)
*            FROM XEROX LABELED TAPE.
*
*        3)  THE THIRD EXAMPLE WILL PICK UP FILE(FID) IN ACCOUNT
*            (ACCOUNT OPTIONAL) WITH A PASSWORD(PASSWORD OPTIONAL)
*            FROM PUBLIC STORAGE.
*
*
*        !!!!! A T T E N T I O N !!!!!
*
*        THIS PROGRAM WILL RUN ON A CP-V SYSTEM ONLY DUE TO THE
*        FACT THAT IT USES THE M:MOVE CAL TO COPY THE LOAD MODULE
*        TO THE TEMPORARY IDL FILE.  IF IT IS DESIRED FOR USAGE
*        ON PREVIOUS SYSTEMS PLEASE CHANGE THE SYMBOL CPV TO ZERO.
*
CPV      SET      1                 SET FOR M:MOVE CAL
         PAGE
*
*        RESOURCE TYPE SPECIFICATION
*
RTDP     EQU      'DP'              PRIVATE PACK
RTLT     EQU      'LT'              LABELED TAPE
RESNM9T  EQU      '9T'
RESNMSP  EQU      'SP'
*
*        REGISTER DEFINITION
*
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      6
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
         CSECT    1
DEVRUN   EQU      $
         DO       CPV=1
         M:GP     32                GET 16 K FOR MOVE BUFFER
         STW,R9   BUFADDR           STORE ADDRESS
         LW,R9    R8                CALCULATE BUFFER SIZE IN BYTES
         MI,R9    2048
         STW,R9   BUFSIZE           STORE SIZE OF BUFFER
         ELSE
         LI,R9    BUFFER            LOAD ADDRESS OF BUFFER
         STW,R9   BUFADDR           STORE ADDRESS
         LI,R9    65536             LOAD SIZE OF BUFFER
         STW,R9   BUFSIZE           STORE SIZE OF BUFFER
         FIN
         LI,R1    1                 INITIALIZE INDEX TO J:CCBUF
MOVCMD1  EQU      $
         LB,R9    J:CCBUF,R1        FIND THE FIRST BLANK CHARACTER
         CI,R9    X'40'
         BE       MOVCMD2
         CI,R9    X'0D'             IF IT IS A CARRIAGE RETURN
         BE       NONAME            NO FILE NAME PRESENT
         AI,R1    1
         B        MOVCMD1           GO TEST AGAIN
MOVCMD2  EQU      $
         LI,2     0
         AI,R1    1                 SET UP TO MOVE COMMAND INTO BUFFER
         LB,R9    J:CCBUF,R1
         CI,R9    X'0D'
         BE       MOVCMD5
         CI,R9    X'40'
         BE       MOVCMD4
         STB,R9   CMDBUF,R2
         AI,R2    1
MOVCMD4  EQU      $
         AI,R1    1                 INCREMENT INDEX TO J:CCBUF
         CI,R1    80                TEST FOR END OF BUFFER
         BL       MOVCMD3
MOVCMD5  EQU      $
         AI,R2    -1                DECREMENT COUNT
         STW,R2   CMDEND            STORE END OF COMMAND POINTER
*
*        SETUP DEVICE TYPE
*
         LI,R9    RTDC
         STW,R9   INDEV             STORE DEFAULT DEVICE TYPE
         LI,R9    0
         STW,R9   INSN              STORE DEFAULT SERIAL NUMBER
         LI,R1    0
FNDDEV1  EQU      $
         LB,R9    CMDBUF            LOAD FIRST BYTE
         CI,R9    '/'               NO DEVICE TYPE SPECIFIED
         BE       FNDNAM1           NOPE!!
         LH,R9    CMDBUF            LOAD DEVICE TYPE
         AND,R9   =X'FFFF'          STRIP OFF HIGH HALFWORD
         CI,R9    RTDP              IS IT A DISC PACK
         BE       FNDDEV2
         CI,R9    RTLT              IS IT A LABELED TAPE
         BE       FNDDEV3
         M:PRINT  (MESS,ILLDEV)     ILLEGAL DEVICE
         M:XXX
FNDDEV2  EQU      $
         LI,R8    9                 FILE PARAMETERS
         B        FNDDEV4
FNDDEV3  EQU      $
         LI,R8    10                LABEL TAPE PARAMETERS
FNDDEV4  EQU      $
         STW,R9   INDEV             STORE DEVICE TYPE
         LI,R1    3
         STB,R8   INFBITS,R1        STORE FBITS IN FPT+1
         LI,R1    3                 SET UP INDEX TO CMDBUF
         LW,R9    ='    '           BLANK OUT THE SERIAL NUMBER
         STW,R9   INSN
FNDDEV5  EQU      $
         LB,R9    CMDBUF,R1         PICK UP A CHARACTER
         CI,R9    '/'               ARE WE DONE
         BE       FNDNAM1           YES!!
         STB,R9   INSN,R2           STORE CHARACTER IN SERIAL NUMBER
         AI,R1    1                 INCREMENT CMDBUF INDEX
         AI,R2    1                 INCREMENT INSN INDEX
         CI,R2    4                 TEST FOR OVERFLOW
         BLE      FNDDEV5
         M:PRINT  (MESS,ILLSN)      SERIAL NUMBER TOO LONG
         M:XXX                      ABORT
FNDNAM1  EQU      $
         AI,R1    1                 INCREMENT CMDBUF INDEX
         LI,R2    1                 SET UP FILE NAME INDEX
FNDNAM2  EQU      $
         LB,R9    CMDBUF,R1         PICK UP A CHARACTER
         CI,R9    X'40'             IS THIS CHARACTER A BLANK
         BE       FNDACC1           YES!
         CI,R9    '.'               IS IT A PERIOD
         BE       FNDACC1           YES!
         CI,R9    '('               HAVE WE HIT THE RELEASE OPTION
         BE       FNDACC1           YES!
         STB,R9   INNAM,R2          OTHERWISE PUT IT IN THE NAME
         AI,R1    1                 INCREMENT CMDBUF INDEX
         AI,R2    1                 INCREMENT FILE NAME INDEX
         CI,R2    32                TEST FOR OVERFLOW
         BLE      FNDNAM2           NOT YET!
         M:PRINT  (MESS,ILLFIL)     FILE NAME IS TOO LONG
         M:XXX
FNDACC1  EQU      $
         AI,R2    -1                DECREMENT FILE NAME COUNT
         STB,R2   INNAM             STORE COUNT
         LB,R9    CMDBUF,R1         PICK UP LAST CHARACTER
         BE       FNDDON            YES!
         CI,R9    '('               HAVE WE HIT THE RELEASE OPTION
         BE       FNDDON            YES!
         AI,R1    1                 INCREMENT CMDBUF INDEX
         LI,R2    0                 SET UP ACCOUNT INDEX
FNDACC2  EQU      $
         LB,R9    CMDBUF,R1         PIC UP A CHARACTER
         CI,R9    ' '               TEST FOR BLANK
         BE       FNDDON            WE ARE THROUGH
         CI,R9    '.'               TEST FOR PERIOD - PASSWORD
         BE       FNDPAS1           YES!
         CI,R9    '('               HAVE WE HIT THE RELEASE OPTION
         BE       FNDDON            YES!
         STB,R9   INACC,R2          STORE IN ACCOUNT
         LI,R3    2                 SETUP SIGNIFICANCE IN FPT
         STB,R3   INACC-1,R3
         AI,R1    1
         AI,R2    1                 INCREMENT ACCOUNT INDEX
         CI,R2    8
         BLE      FNDACC2           NO OVERFLOW YET!
         M:PRINT  (MESS,ILLACC)     ACCOUNT IS TOO LONG
         M:XXX                      ABORT!
FNDPAS1  EQU      $
         LI,R2    0                 SET UP PASSWORD INDEX
         AI,R1    1                 INCREMENT CMDBUF INDEX
FNDPAS2  EQU      $
         LB,R9    CMDBUF,R1         PICK UP A CHARACTER
         CI,R9    ' '               ARE WE THROUGH
         BE       FNDDON            YEP!
         CI,R9    '('               HAVE WE HIT THE RELEASE OPTION
         BE       FNDDON            YES!
         STB,R9   INPAS,R2          STORE THE CHARACTER
         LI,R3    2
         STB,R3   INPAS-1,R3
         AI,R1    1                 INCREMENT CMDBUF INDEX
         AI,R2    1                 INCREMENT PASSWORD INDEX
         CI,R2    8                 TEST FOR OVERFLOW
         BLE      FNDPAS2           NOT YET!
         M:PRINT  (MESS,ILLPAS)     PASSWORD TOO LONG
         M:XXX                      ABORT!
FNDDON   EQU      $
         LB,R9    CMDBUF,R1         CHECK TO SEE IF REL OPTION SPECIFIED
         CI,R9    '('
         BNE      COPY              NO IT WAS NOT!
         AI,R1    1                 PICK UP THE FIRST CHARACTER AND
         LB,R9    CMDBUF,R1         STORE IT FOR LATER TESTS
         STB,R9   RELCMD            IN THE PROGRAM
COPY     EQU      $
         LI,R1    1                 LOAD INDEX INTO J:JIT FOR SYSID
         LH,R9    J:JIT,R1          PICK UP SYSID FOR IDL FILE NAME
         SLS,R9   8                 MOVE TO THE MIDDLE
         AI,R9    'L'               PUT 'L' IN NAME
         OR,R9    =X'03000000'      OR IN TEXTC COUNT
         STW,R9   OTNAM             STORE THE NAME
         STW,R9   LDNAM
         M:SETDCB F:DEVIN,(ABN,OPINERR),(ERR,OPINERR)
         M:SETDCB F:DEVOUT,(ABN,OPOTERR),(ERR,OPOTERR)
         CAL1,1   INOPN             OPEN INPUT FILE
         CAL1,1   OTOPN             OPEN OUTPUT FILE
         M:SETDCB F:DEVIN,(ABN,MOVERR),(ERR,MOVERR)
         M:SETDCB F:DEVOUT,(ABN,MOVERR),(ERR,MOVERR)
         DO       CPV=1
         M:MOVE   F:DEVIN,(OUT,F:DEVOUT),(BUF,*BUFADDR),;
                  (SIZE,*BUFSIZE),(ERR,MOVERR),(ABN,MOVERR)
         ELSE
M:MOVE   EQU      $
         M:READ   F:DEVIN,(BUF,*BUFADDR),(SIZE,*BUFSIZE),(WAIT),;
                  (ABN,MOVERR),(ERR,MOVERR)
         LH,9     F:DEVIN+4         PICK UP SIZE
         SLS,9    -1                SHIFT PROPERLY
         M:WRITE  F:DEVOUT,(BUF,*BUFADDR),(SIZE,*9),(WAIT),;
                  (NEWKEY)
         B        M:MOVE
         FIN
MOVERR   EQU      $
         LB,R1    R10               PICK UP MAJOR CODE
         CI,R1    7                 CHECK FOR TOO SMALL BUFFER
         BNE      MOVERR1
         M:PRINT  (MESS,SMALBUF)    BUFFER WAS TOO SMALL FOR COPY
         M:XXX
MOVERR1  EQU      $
         CI,R1    6                 CHECK FOR END-OF-FILE
         BE       LDTRC             LET'S GO EXECUTE THE LOAD MODULE
         M:SNAP   'I/O ERR'
         M:XXX
OPINERR  EQU      $
         LB,R1    R10               PICK UP MAJOR CODE
         CI,R1    3                 TEST FOR 300 CODE
         BNE      OPINER1           NOPE
         M:PRINT  (MESS,ERR300)
         M:PRINT  (MESS,ONIN)
         M:XXX
OPINER1  EQU      $
         CI,R1    X'14'             TEST FOR 1400 SERIES
         BNE      OPINER2           NOPE
         M:PRINT  (MESS,ERR1400)
         M:PRINT  (MESS,ONIN)
         M:XXX
OPINER2  EQU      $
         CI,R1    X'49'             LIMIT EXCEEDED
         BNE      OPINER3
         M:PRINT  (MESS,ERR4900)
         M:PRINT  (MESS,ONIN)
         M:XXX
OPINER3  EQU      $
         M:SNAP   'OPEN ERR'
         M:XXX
OPOTERR  EQU      $
         M:PRINT  (MESS,ONOUT)
         M:SNAP   'OPEN ERR'
         M:XXX
NONAME   EQU      $
         M:PRINT  (MESS,ERRNAM)
         M:XXX
LDTRC    EQU      $
         M:CLOSE  F:DEVIN,(SAVE),(REM)
         M:CLOSE  F:DEVOUT,(SAVE)
         DO       CPV=1
         LB,R9    RELCMD            TEST FOR RELEASE OPTION
         CI,R9    'R'
         LW,R9    INDEV             PICK UP THE DEVICE TYPE
         CI,R9    RTDC              MAKE SURE IT IS NOT PUBLIC DISK
         BE       LDTRC1            IT WAS, THAT'S A NO, NO
         CI,R9    RTLT              TEST FOR LABELED TAPE RELEASE
         BNE      $+3               NOPE
         LI,R9    RESNM9T           LOAD PORPER RESOURCE NAME
         AND,R9   =X'FFFF'          STRIP OFF HIGH BITS
         CI,R9    RTDP              TEST FOR DISC PACK
         BNE      $+3               NOPE
         LI,R9    RESNMSP           LOAD PORPER RESOURCE NAME
         AND,R9   =X'FFFF'          STRIP OFF HIGH BITS
         OR,R9    =X'15000000'      OR IN FPT CODE
         STW,R9   RELFPT            STORE IN RELEASE FPT
         LI,R8    1                 SET UP EIGHT FOR 1 RESOURCE
         CAL1,8   RELFPT            RELEASE THE RESOURCE
         FIN
LDTRC1   EQU      $
         CAL1,8   LDFPT
         PAGE
         CSECT    0
         DEF      DATA
DATA     EQU      $
*
*        DATA DIVISION
*
BUFADDR  DATA     0                 BUFFER ADDRESS
BUFSIZE  DATA     0                 BUFFER SIZE
         DO       CPV=0
BUFFER   RES,1    65536            NON-CP-V BUFFER
         FIN
CMDBUF   DO1      10
         TEXT     '    '            FORTY CHARACTER BUFFER FOR COMMAND
CMDEND   DATA     0                 COMMAND END POINTER
ILLDEV   TEXTC    '** ILLEGAL DEVICE TYPE - LEGAL VALUES ARE ',;
                  RTDP,' OR ',RTLT,' **'
ILLSN    TEXTC    '** ILLEGAL SERIAL NUMBER - IT IS TOO LONG **'
ILLFIL   TEXTC    '** ILLEGAL FILE NAME - IT IS TOO LONG **'
ILLACC   TEXTC    '** ILLEGAL ACCOUNT - IT IS TOO LONG **'
SMALBUF  TEXTC    '** NOT ENOUGH CORE TO ALLOCATE BUFFER LARGE ',;
                  'ENOUGH BUFFER TO PERFORM COPY **'
ERR300   TEXTC    '** 300 FILE DOES NOT EXIST **'
ERR1400  TEXTC    '** 1400 FILE ACCESS DENIED DUE TO ACCOUNT, ',;
                  'PASSWORD, OR FILE IS BUSY **'
ERR4900  TEXTC    '** USER''S DISMOUNTABLE RESOURCE LIMIT EXCEEDED **'
ERRNAM   TEXTC    '** NO FILE NAME WAS SPECIFIED **'
ONIN     TEXTC    '** ERROR OCCURRED ON INPUT FILE - CHECK REG 10 **'
ONOUT    TEXTC    '** ERROR OCCURRED ON OUTPUT FILE - CHECK REG 10 **'
RELCMD   DATA     0
RELFPT   DATA     0
LDFPT    DATA     X'03000000'
LDNAM    DATA     0
INOPN    GEN,8,24 X'14',F:DEVIN
INFBITS  DATA     X'CF440009'       PRESENCE BITS
         DATA     OPINERR           ERROR ADDRESS
         DATA     OPINERR           ABN ADDRESS
         DATA     10                TRIES
         DATA     2                 KEYED
         DATA     1                 SEQUENTIAL
         DATA     1                 IN
         DATA     2                 SAVE
INDEV    DATA     0                 DEVICE CODE
         DATA     X'01000808'
INNAM    DO1      8                 FILE NAME
         DATA     '    '
         DATA     X'02000002'
INACC    DATA     '    ','    '     ACCOUNT
         DATA     X'03000002'
INPAS    DATA     '    ','    '     PASSWORD
         DATA     X'07010101'
INSN     DATA     0                 SERIAL NUMBER
OTOPN    GEN,8,24 X'14',F:DEVOUT
         DATA     X'CF480009'       PRESENCE BITS
         DATA     OPOTERR           ERROR ADDRESS
         DATA     OPOTERR           ABN ADDRESS
         DATA     10                TRIES
         DATA     2                 KEYED
         DATA     2                 OUT
         DATA     2                 SAVE
         DATA     31                KEYM
         DATA     X'01010101'
OTNAM    DATA     0                 OUT FILE NAME
F:DEVIN  DSECT    1
F:DEVIN  M:DCB    (FILE),(SN),(IN),(KEYED),(KEYM,31),(SAVE),(SEQUEN)
F:DEVOUT DSECT    1
F:DEVOUT M:DCB    (FILE),(OUT),(KEYED),(KEYM,31),(DIRECT),(SAVE)
         END      DEVRUN
!LOAD (GO),(EF,(:J0,:SYS)),(LMN,DEVRUN),(PERM),(MAP),(CORELIB)
