//MARKA    JOB (0),'ASSEMBLE',CLASS=A,MSGCLASS=A,MSGLEVEL=(1,1)
//ASM     EXEC PGM=IFOX00,
//   PARM='DECK,LOAD,TERM,TEST,SYSPARM((NOSP,NODEBUG)),XREF(SHORT)',
//   REGION=4096K,COND=(0,NE)
//SYSLIB   DD  DISP=SHR,DSN=SYS1.MACLIB
//         DD  DISP=SHR,DSN=SYS1.AMODGEN
//         DD  DISP=SHR,DSN=SYS1.ATSOMAC
//         DD  DISP=SHR,DSN=SYS1.HASPSRC
//SYSUT1   DD  SPACE=(CYL,(25,5)),UNIT=3350
//SYSUT2   DD  SPACE=(CYL,(25,5)),UNIT=3350
//SYSUT3   DD  SPACE=(CYL,(25,5)),UNIT=3350
//SYSTERM  DD  SYSOUT=*
//SYSPRINT DD  SYSOUT=*
//SYSIN    DD  DATA,DLM=ZZ
* *******************************************************************
*
* DEVITAPE:
*
* As we now run the hercules program as a daemon without a console
* available we need a way to issue devinit commands for tape mounts
* that are outside the automated tape pool we use.
*
* But as this could be a bit of a risk we will only allow the devinit
* command to be issued, in fact we will provide it.
*
* Input parm must be : CUU tape-image-name
*          CUU - only permitted to be tape units 480 or 481
*          tape-image-name - not checked for validity, BUT...
*                            as a console command its upshifted
*
* *******************************************************************
DEVITAPE CSECT
         STM   R14,R12,12(R13)       SAVE REGISTERS
         BALR  R12,0                    LOAD BASE REGISTER
         USING *,R12                    ESTABLISH ADDRESSABILITY
         ST    13,SAVEAREA+4         STORE CALLER'S S/A @ IN OUR S/A
         LR    14,13                 SAVE CALLER'S S/A @ IN R14
         LA    13,SAVEAREA           POINT R13 TO OUR SAVE AREA
         ST    13,8(14)              STORE OUR S/A @ IN CALLER'S S/A
*
*                                    GET THE PARM VALUE
         L     R1,0(R1)              ADDRESS OF THE PARAMETER LIST
         LH    R3,0(R1)              GET PARM LENGTH
         LTR   R3,R3                 IF LENGTH ZERO WE HAVE NO PARM
         BZ    NOPARM
         LA    R4,2(R1)              ADDRESS OF PARM VALUE
* MAKE SURE PARM NOT > 72 BYTES
         C     R3,=F'72'
         BL    LENOK
         L     R3,=F'72'
LENOK    EX    R3,STORPARM           PARM ADDR IN R4, MOVE LEN IN R3
* CHECK UNIT
         CLC   PARMDATA(3),=CL3'480'
         BE    CUUOK
         CLC   PARMDATA(3),=CL3'481'
         BE    CUUOK
         B     BADUNIT
CUUOK    CNOP  0,4
* WTO COMMAND BEING ISSUED
         MVC   DUMPPARM+8(50),PARMHDR
DUMPPARM WTO   '....+....1....+....2....+....3....+....4....+....5'
* ISSUE THE COMMAND TO THE HMC
         A     R3,=F'8'              ADD THE DEVINIT LEN TO PARM LEN
         STH   R3,CMDHERCL           STOR LEN IN HERCCMD CMD AREA
         LINK  EP=MDDIAG8,PARAM=CMDHERC,ERRET=LINKERR
EXIT00   L     13,SAVEAREA+4         LOAD CALLER'S R13
         LM    14,12,12(13)          RESTORE THE REGISTERS
         LA    15,0(0,0)             LOAD RETURN CODE 0
         BR    14                    RETURN
LINKERR  CNOP  0,4
         WTO   'DEVITAPE:PROGRAM MDDIAG8 NOT FOUND'
         B     EXIT04
BADUNIT  WTO   'DEVITAPE:CUU NOT AUTHORISED, ONLY 480 AND 481 ALLOWED'
         B     EXIT04
NOPARM   WTO   'NO COMMAND WAS PASSED IN THE PARM FIELD'
EXIT04   L     13,SAVEAREA+4         LOAD CALLER'S R13
         LM    14,12,12(13)          RESTORE THE REGISTERS
         LA    15,=F'4'              LOAD RETURN CODE 4
         BR    14                    RETURN
         EJECT
*
*   D A T A   A R E A   B I T S
*
SAVEAREA DS    18F                   SAVE AREA
STORPARM MVC   PARMDATA(0),0(R4)    
*
* THE COMMAND TO BE ISSUED TO MDDIAG8 IS IN THIS AREA
*    DEVINIT WE OF COURSE HARD CODE
*    THE PARM FIELD PASSED CAN SLOT INTO THE NEXT 72 BYTES
*    THE LEN (CMDHERCL) IS SEt TO THE PARM LEN+8 EXTRA (FOR PARMHDR)
CMDHERC  DS    0F
CMDHERCL DC    AL2(0)              BYTES IN COMMAND
PARMHDR  DC    CL8'DEVINIT '
PARMDATA DC    CL72' '
*
* And the register equates
*
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
         END
ZZ
//SYSPUNCH DD  SYSOUT=*
//SYSGO    DD  DISP=(MOD,PASS,DELETE),UNIT=SYSDA,
//    DSN=&&OBJLIB,SPACE=(TRK,(2,2))
//LKED1   EXEC PGM=IEWL,
//             PARM='XREF,LIST,LET,TEST,AC=0',
//             REGION=1024K,COND=(0,NE)
//SYSLMOD  DD  DSN=SYS9.LINKLIB.APFAUTH(DEVITAPE),
//    DISP=(OLD,PASS,DELETE)
//SYSLIN   DD  DSN=&&OBJLIB,DISP=(OLD,PASS,DELETE)
//SYSUT1   DD  UNIT=SYSDA,SPACE=(CYL,(8,1))
//SYSPRINT DD  SYSOUT=*
//LKED2   EXEC PGM=IEWL,
//             PARM='XREF,LIST,LET,TEST,AC=0',
//             REGION=1024K,COND=(0,NE)
//SYSLMOD  DD  DSN=SYS9.LINKLIB.APFAUTH,DISP=(OLD,PASS,DELETE)
//SYSUT1   DD  UNIT=SYSDA,SPACE=(CYL,(8,1))
//SYSPRINT DD  SYSOUT=*
//SYSLIN   DD  *
 SETCODE AC(1)
 INCLUDE SYSLMOD(DEVITAPE)
 ENTRY DEVITAPE
 NAME DEVITAPE(R)
/*
//ADDPROC  EXEC PGM=IEBUPDTE,COND=(0,NE)
//SYSPRINT DD   SYSOUT=*
//SYSUT1   DD   DISP=SHR,DSN=SYS9.PROCLIB
//SYSUT2   DD   DISP=SHR,DSN=SYS9.PROCLIB
//SYSIN    DD   DATA,DLM=ZZ
./ ADD NAME=TAPEUP,LIST=ALL
//TAPEUP   PROC TAPE=
//DEVITAPE EXEC PGM=DEVITAPE,PARM='&TAPE'
./ ENDUP
ZZ
//