./ ADD NAME=VMCP        01 07 91213 97344 101131 0553 0538 0000 IBMUSER
++USERMOD(UMODXXX) REWORK(97120201)                                     NONUMBER
  /* USERMOD TO ADD CP COMMAND TO MVS */.                               NONUMBER
++VER(Z038) FMID(HBB6604).                                              NONUMBER
++MAC(DIAG)     DISTLIB(DUMMY) ASSEM(VMCPSSIN,VMCPSSCM) .               NONUMBER
         MACRO                                                          00000100
&LBL     DIAG   &RX,&RY,&CODE                                           00000200
.*--------------------------------------------------------------------* 00000300
.*                                                                    * 00000400
.* DIAG macro issues DIAGNOSE instruction   J.Jaeger, PA3EFU 17/04/87 * 00000500
.*                                                                    * 00000600
.*--------------------------------------------------------------------* 00000700
&LBL     DC     0H'0',X'83',AL.4(&RX,&RY),Y(&CODE)                      00000800
.*--------------------------------------------------------------------* 00000900
.*                                                                    * 00001000
.*   The machine language format of DIAGNOSE is:                      * 00001100
.*                                                                    * 00001200
.*          <------ 4 bytes ------>                                   * 00001300
.*          +---------------------+                                   * 00001400
.*          | 83 | RxRy | B | DDD |                                   * 00001500
.*          +---------------------+                                   * 00001600
.*          0    8      16  20    31                                  * 00001700
.*                                                                    * 00001800
.*   where (in general):                                              * 00001900
.*                                                                    * 00002000
.*    83:                                                             * 00002100
.*         is X'83', the machine language operation code for the      * 00002200
.*          DIAGNOSE instruction.                                     * 00002300
.*                                                                    * 00002400
.*    RxRy:                                                           * 00002500
.*         are the general purpose registers that contain the operand * 00002600
.*         values or operand storage addresses that will be passed    * 00002700
.*         through the DIAGNOSE interface. If Rx or Ry contains an    * 00002800
.*         address, it must be a second-level address (that is, an    * 00002900
.*         address in the storage that appears real to the issuing    * 00003000
.*         virtual machine.                                           * 00003100
.*                                                                    * 00003200
.*    B:                                                              * 00003300
.*         is the base register. IBM recommends that you specify the  * 00003400
.*         base register as zero.                                     * 00003500
.*                                                                    * 00003600
.*    DDD:                                                            * 00003700
.*         is the displacement value.                                 * 00003800
.*                                                                    * 00003900
.*                                                                    * 00004000
.* Notes:                                                             * 00004100
.*    1.   The effective address is not used to address data. The     * 00004200
.*         DIAGNOSE code equals the contents of the base reg plus     * 00004300
.*         the displacement. However, if the base reg is the reg      * 00004400
.*         0, its contents are not added to the displacement; the     * 00004500
.*         wish to remain  compatible with VM/SP when you issue a     * 00004600
.*         DIAGNOSE code from a virtual machine, IBM recommands that  * 00004700
.*         you always specify the base register as register 0.        * 00004800
.*         The DIAGNOSE code, or displacement, must always be a       * 00004900
.*         multiple of four.                                          * 00005000
.*                                                                    * 00005100
.*    2.   If the guest is an XA guest, VM/XA SF processes the        * 00005200
.*         addresses that you specify in Rx, Ry, Rx+1, and Ry+1 as    * 00005300
.*         31-bit addresses. If the guest is a 370 guest and running  * 00005400
.*         in EC mode, the addresses are also processed as 31-bit     * 00005500
.*         addresses. However, if the guest is a 370 guest and        * 00005600
.*         running in BC mode, VM/XA SF processes the address as      * 00005700
.*         24-bit addresses. To determine which registers contain     * 00005800
.*         second-level addresses (that is, addresses is storage that * 00005900
.*         appears real to the guest), see descriptions of the        * 00006000
.*         individual DIAGNOSE codes.                                 * 00006100
.*                                                                    * 00006200
.*    3.   Because DIAGNOSE instructions execute differently in a     * 00006300
.*         virtual machine than in a real machine, your program       * 00006400
.*         should determine that it is operating in a virtual machine * 00006500
.*         before issuing a DIAGNOSE instruction, and prevent         * 00006600
.*         execution of a DIAGNOSE when in a real machine. The only   * 00006700
.*         exeption to this is the execution of the MSSFCALL          * 00006800
.*         DIAGNOSE X'80' instruction. Refer to the discription of    * 00006900
.*         DIAGNOSE x'80' for a complete description of its use.      * 00007000
.*                                                                    * 00007100
.*         The Store Processor ID (STIDP) instruction provides your   * 00007200
.*         program with information about the processor in wich it is * 00007300
.*         executing, including the processor version number. If      * 00007400
.*         STDIP is issued from a virtual machine, the version number * 00007500
.*         will be X'FF' in the first byte of the CPUID field.        * 00007600
.*                                                                    * 00007700
.*    4.   A virtual machine issuing an I/O DIAGNOSE instruction      * 00007800
.*         should run with interrupts disabled. This prevents the     * 00007900
.*         loss of status information pertaining to the DIAGNOSE      * 00008000
.*         operation such as condition codes and sense data.          * 00008100
.*                                                                    * 00008200
.*                                                                    * 00008300
.*   For more information regarding the DIAGNOSE Instruction, refer   * 00008400
.*   to GC19-6215 "VM/XA SF CP Command and DIAGNOSE Code Reference",  * 00008500
.*   section 3.                                                       * 00008600
.*                                                                    * 00008700
.*--------------------------------------------------------------------* 00008800
         MEND                                                           00008900
++SRC(VMCPSSIN) DISTLIB(DUMMY) .                                        NONUMBER
VMCPSSIN CSECT ,                                                        00000100
VMCPSSIN AMODE 31                                                       00000200
VMCPSSIN RMODE ANY                                                      00000300
         SAVE  (14,12),,VMCPSSIN-&SYSDATE-&SYSTIME-J.JAEGER             00000400
         LR    R12,R15                                                  00000500
         USING VMCPSSIN,R12                                             00000600
*                                                                       00000700
         L     R11,0(,R1)              Pointer to SSCT                  00000800
         USING SSCT,R11                                                 00000900
         L     R10,4(,R1)              Pointer to JSIPL                 00001000
         USING JSIPL,R10                                                00001100
*                                                                       00001200
         STORAGE OBTAIN,                                               X00001300
               LENGTH=CORELEN,                                         X00001400
               BNDRY=PAGE,                                             X00001500
               SP=239                                                   00001600
         ST    R13,4(,R1)              Chain save areas                 00001700
         ST    R1,8(,R13)                                               00001800
         LR    R13,R1                                                   00001900
         USING CORE,R13                                                 00002000
*                                                                       00002100
         STIDP CPUID                   Check if we are running          00002200
         CLI   CPUID,X'FF'             in a virtual machine             00002300
         BNE   NOTVM                                                    00002400
*                                                                       00002500
         STNSM SYSMASK,255-IEMASK      Disable external, I/O interrupt  00002800
         NI    SYSMASK,IEMASK          Save only I & E bits             00002900
         LRA   R2,SEICAREA             Real address of output area      00002600
         BC    CC1+CC2+CC3,SSINLRAE                                     00002602
         LA    R4,SEICLEN              Length of area                   00002700
         DIAG  R2,R4,SEIC              Store Extended ID code           00003000
         IC    R1,SYSMASK              Load I & E bits                  00003100
         EX    R1,STOSM                Reload I & E bits is psw         00003200
*                                                                       00003300
         LOAD  EP=VMCPSSSM,            Load subsystem support module   X00003400
               GLOBAL=(YES,F),                                         X00003500
               EOM=YES,                                                X00003600
               ERRET=SSINFAIL                                           00003700
         SLR   R1,R1                   Activate subsystem               00003800
         CS    R1,R0,SSCTSSVT                                           00003900
         BNE   SSINFAIL                                                 00004000
*                                                                       00004100
         MVC   WORKWTO,CP01I           Prepare for INIT OK message      00004200
         MVC   CP01S,VMSYSNAM          Copy VM product name             00004300
         MVC   CP01U,VMUSERID          Copy guest userid                00004400
         WTO   CART=JSICART,                                           X00004500
               CONSID=JSICNSID,                                        X00004600
               LINKAGE=BRANCH,                                         X00004700
               MF=(E,WORKWTO)                                           00004800
*                                                                       00004900
         SLR   R3,R3                                                    00005000
         ICM   R3,B'0001',JSILGTPR     Get lenght of user parm          00005100
         BZ    NOPARM                  Does a parameter exist??         00005200
         L     R2,JSIADRPR             Get info addr                    00005300
*                                                                       00005400
         MVC   WORKMGCR,MGCR00I        Initialize MGCR                  00005500
         MVC   CMDTEXT(L'CPCMD),CPCMD  Insert 'CP '                     00005600
         STCK  CMDCART                 Generate CART                    00005700
         BCTR  R3,0                    Decrement R3 for EX/MVC          00005800
         EX    R3,CMDCOPY              Copy parm                        00005900
         LA    R3,L'CPCMD+1(,R3)       Increment to cmd len + token     00006000
         STH   R3,CMDLEN               Store length                     00006100
         LA    R2,CMDLEN                                                00006200
         MGCRE TEXT=(2),               Issue command                   X00006300
               CONSID=JSICNSID,                                        X00006400
               CART=CMDCART,                                           X00006500
               CMDFLAG=NOHCPY,                                         X00006600
               MF=(E,WORKMGCR)                                          00006700
NOPARM   DS    0H                                                       00006800
*                                                                       00006900
RETURN   DS    0H                                                       00007000
         LR    R1,R13                                                   00007100
         L     R13,4(,R13)             Recall R13 from savearea         00007200
         STORAGE RELEASE,                                              X00007300
               LENGTH=CORELEN,                                         X00007400
               SP=239,                                                 X00007500
               ADDR=(1)                                                 00007600
         RETURN (14,12),RC=0           Recall registers & return        00007700
*                                                                       00007800
NOTVM    DS    0H                                                       00007900
         MVC   WORKWTO(CP00Z),CP00I    Issue NOT VM message             00008000
         WTO   CART=JSICART,                                           X00008100
               CONSID=JSICNSID,                                        X00008200
               LINKAGE=BRANCH,                                         X00008300
               MF=(E,WORKWTO)                                           00008400
         B     RETURN                                                   00008500
*                                                                       00008600
SSINFAIL DS    0H                                                       00008700
         SDUMP HDR='VMCP SUBSYSTEM INITIALIZATION FAILED'               00008800
         B     RETURN                                                   00008900
*                                                                       00008600
SSINLRAE DS    0H                                                       00008700
         IC    R1,SYSMASK              Load I & E bits                  00003100
         EX    R1,STOSM                Reload I & E bits is psw         00003200
         SDUMP HDR='VMCP LRA ERROR DURING INITIALIZATION'               00008800
         B     RETURN                                                   00008900
*                                                                       00009000
CMDCOPY  MVC   CMDTEXT+L'CPCMD(0),0(R2)                                 00009100
STOSM    STOSM SYSMASK,0                                                00009200
*                                                                       00009300
CPCMD    DC    C'CP '                                                   00009400
*                                                                       00009500
CP00I    WTO   'VMCP00I Not running in a Virtual Machine',             X00009600
               MCSFLAG=(BRDCST,RESP),                                  X00009700
               DESC=(4,5),                                             X00009800
               CART=,                                                  X00009900
               CONSID=,                                                X00010000
               LINKAGE=,                                               X00010100
               MF=L                                                     00010200
CP00Z    EQU   *-CP00I                                                  00010300
*                                                                       00010400
CP01I    WTO   'VMCP01I Running under vmsystem as user vmuserid',      X00010500
               MCSFLAG=(BRDCST,RESP),                                  X00010600
               DESC=(4,5),                                             X00010700
               CART=,                                                  X00010800
               CONSID=,                                                X00010900
               LINKAGE=,                                               X00011000
               MF=L                                                     00011100
CP01S    EQU   WORKWTO+4+22,8,C'C'                                      00011200
CP01U    EQU   WORKWTO+4+39,8,C'C'                                      00011300
CP01Z    EQU   *-CP01I                                                  00011400
*                                                                       00011500
MGCR00I  MGCRE MF=L                                                     00011600
MGCR00Z  EQU   *-MGCR00I                                                00011700
*                                                                       00011800
         LTORG ,                                                        00011900
*                                                                       00012000
         YREGS ,                                                        00012100
CC0      EQU   B'1000'                                                  00611300
CC1      EQU   B'0100'                                                  00611400
CC2      EQU   B'0010'                                                  00611500
CC3      EQU   B'0001'                                                  00611600
*                                                                       00012200
SEIC     EQU   0                       Store Extended ID code           00012300
*                                                                       00012400
CORE     DSECT ,                                                        00012500
SAVEAREA DS    18F                     Savearea MUST be first in DSECT  00012600
CPUID    DS    1D                                                       00012700
CMDCART  DS    1D                      MGCRE CART                       00012800
CMDLEN   DS    1H                      Command length                   00012900
CMDTEXT  DS    CL126                   Command text                     00013000
WORKWTO  DS    XL(CP01Z)               WTO work area                    00013100
WORKMGCR DS    XL(MGCR00Z)             MGCR work area                   00013200
SYSMASK  DS    X                       Area for STxSM                   00013300
IEMASK   EQU   3                       Mask external and I/O            00013400
*                                                                       00013500
         DS    0D                      Allign on double word boundary   00013600
SEICAREA EQU   *                                                        00013700
VMSYSNAM DS    CL8                     VM/XA system name (VM/XA SF)     00013800
VMRESV   DS    3X                      Reserved                         00013900
VMVERS   DS    1X                      Version code (from STIDP)        00014000
VMMCEL   DS    1H                      MCEL for 370 resv. for XA        00014100
VMPADDR  DS    1H                      Proc addr. (from STAP)           00014200
VMUSERID DS    CL8                     UserID virtual machine           00014300
VMPRODM  DS    1D                      PP map (resv IBM)                00014400
VMTIMEZ  DS    1F                      GMT offset in seconds            00014500
VMSYSV   DS    4X                      VM/XA system version             00014600
SEICLEN  EQU   *-SEICAREA                                               00014700
*                                                                       00014800
CORELEN  EQU   *-CORE                                                   00014900
*                                                                       00015000
         IEFJSIPL ,                                                     00015100
         IEFJSCVT ,                                                     00015200
*                                                                       00015300
         END   VMCPSSIN,(JAN JAEGER,0101,91213)                         00015400
++SRC(VMCPJSVT) DISTLIB(DUMMY) .                                        NONUMBER
VMCPJSVT CSECT ,                                                        00000100
VMCPJSVT AMODE 31                                                       00000200
VMCPJSVT RMODE ANY                                                      00000300
         EXTRN VMCPSSCM                                                 00000400
*                                      The CSECT VMCPJSVT is not        00000500
         ENTRY VMCPSSVT                used but its entry point         00000600
*                                      VMCPSSVT is used instead         00000700
*                                      This is to provide an            00000800
*                                      eye catcher in front of          00000900
*                                      the SSVT which is usefull        00001000
*                                      for debugging purposes.          00001100
JSVTID   DC    CL4'SSVT'                                                00001200
*                                                                       00001300
* This CSECT is the Subsystem Vector Table, it relates functions to     00001400
* function routines. The subsystem is active from the moment the        00001500
* address of the SSVT is nonzero in the SSCVT                           00001600
*                                                                       00001700
VMCPSSVT DS    0D                                                       00001800
JSVTRSV1 DC    H'0'                    Reserved                         00001900
JSVTFNUM DC    AL2(1)                  Number of functions supported    00002000
JSVTFCOD DC    XL256'00'               Function matrix                  00002100
*                                                                       00002200
         ORG   JSVTFCOD+SSOBCMND-1     SVC34 (operator command)         00002300
         DC    AL1((4+JSVTSSCM-JSVTFRTN)/4)                             00002400
*                                                                       00002500
         ORG   ,                                                        00002600
JSVTFSIZ EQU   *-VMCPSSVT                                               00002700
JSVTFRTN DS    0F                                                       00002800
JSVTSSCM DC    A(VMCPSSCM+X'80000000')                                  00002900
JSVTSIZE EQU   *-VMCPSSVT                                               00003000
*                                                                       00003100
         IEFJSSOB CM                                                    00003200
*                                                                       00003300
         END   VMCPSSVT,(JAN JAEGER,0101,91213)                         00003400
++SRC(VMCPSSCM) DISTLIB(DUMMY) .                                        NONUMBER
VMCPSSCM CSECT ,                                                        00000100
VMCPSSCM AMODE 31                                                       00000200
VMCPSSCM RMODE ANY                                                      00000300
*                                                                       00000400
* This routine is called by the subsystem interface if the function     00000500
* id in the SSOB contains 10: the master subsystem notifies all         00000600
* other subsystems of the issuance of an operator command.              00000700
* The SSOB extension contains a pointer to the command input buffer.    00000800
*                                                                       00000900
         SAVE  (14,12),,VMCPSSCM-&SYSDATE-&SYSTIME-J.JAEGER             00001000
         LR    R12,R15                 Set up our own program base      00001100
         USING VMCPSSCM,R12            and make program relocatable     00001200
*                                                                       00001300
         LR    R11,R1                  Save pointer to the SSOB         00001400
         USING SSOB,R11                                                 00001500
*                                                                       00001600
         L     R10,SSOBINDV            Pointer to extension             00001700
         USING SSCMBGN,R10                                              00001800
*                                                                       00001900
         L     R9,SSCMBUFF             Pointer to MGCR parm list        00002000
         USING MGCRPL,R9                                                00002100
*                                                                       00002200
         CLI   MGCRLGTH,L'CPCMD+4      Is the command lenght valid      00002300
         BNH   NOCPCMD                                                  00002400
         CLC   CPCMD,MGCRTEXT          Is this a CP command             00002500
         BNE   NOCPCMD                                                  00002600
*                                                                       00002700
         STORAGE OBTAIN,                                               X00002800
               LENGTH=CORELEN,                                         X00002900
               BNDRY=PAGE,                                             X00003000
               SP=239                                                   00003100
         LR    R8,R1                   Obtain work area & chain         00003200
         LA    R1,2048(,R8)            save areas                       00003300
         LA    R1,2048(,R1)                                             00003400
         ST    R13,4(,R1)                                               00003500
         ST    R1,8(,R13)                                               00003600
         LR    R13,R1                                                   00003700
         USING CORE,R8,R13                                              00003800
*                                                                       00003900
         CMDAUTH ENTITY=CPPROF,        Profile name                    X00004005
               ATTR=READ,              ACCESS(READ)                    X00004105
               CNTLBLK=(10),           SSCM base                       X00004205
               CBLKTYPE=SSCM,                                          X00004305
               MF=(E,CMDAUTH)                                           00004405
         LTR   R15,R15                                                  00004505
         BZ    AUTHOK                                                   00004605
         CH    R15,=H'4'               RACF could not determine         00004900
         BP    CMDNOTEX                Higher means no access or worse  00005000
*                                                                       00005100
         TM    SSCMDISP,SSCMMC         Test for master console          00005200
         BZ    CMDNOTEX                No master then do not execute    00005300
*                                                                       00005400
AUTHOK   DS    0H                                                       00005500
         IC    R6,MGCRLGTH             Copy CP command to buffer        00005600
         SL    R6,=A(L'CPCMD+1+4)      Go to machine length             00005700
         EX    R6,MGCRCPY              Copy command                     00005800
         LA    R6,1(,R6)               Back to real length              00005900
*                                                                       00006000
         ICM   R6,B'1110',=AL3(X'400000')  Request response             00006100
         L     R7,=A(L'RESPBUFF)       Size of response buffer          00006200
*                                                                       00006300
         STNSM SYSMASK,255-IEMASK      Issue DIAGNOSE disabled          00006400
         NI    SYSMASK,IEMASK          Save I & E bits only             00006500
         LRA   R4,CMDBUFF              Real address of cmd buff         00006600
         BC    CC1+CC2+CC3,SSCMLRAE                                     00006602
         LRA   R5,RESPBUFF             Real address of resp buff        00006700
         BC    CC1+CC2+CC3,SSCMLRAE                                     00006702
         SLR   R2,R2                   Zero to indicate buff ok         00006800
         DIAG  R4,R6,VCON              Call CP                          00006900
         BZ    BUFFOK                                                   00007000
         LA    R2,1                    Buffer overflow indicator        00007100
         L     R7,=A(L'RESPBUFF)                                        00007200
BUFFOK   DS    0H                                                       00007300
*                                                                       00007400
         IC    R1,SYSMASK              Load I & E bits                  00007500
         EX    R1,STOSM                Enable External & I/O ints       00007600
*                                                                       00007700
* R5 contains number of bytes lost                                      00007800
* R6 contains the return code from CP                                   00007900
* R7 contains the number of bytes is the response buffer                00008000
*                                                                       00008100
         LTR   R2,R2                   Check buffer overflow            00008200
         BNZ   BUFFOVF                                                  00008300
         MVC   WTOWORK(CP10Z),CP10I                                     00008400
         WTO   CART=SSCMCART,          Issue command accepted msg      X00008500
               CONSID=SSCMCNID,                                        X00008600
               LINKAGE=BRANCH,                                         X00008700
               MF=(E,WTOWORK)                                           00008800
         B     CLDONE                                                   00008900
BUFFOVF  DS    0H                                                       00009000
         MVC   WTOWORK(CP11Z),CP11I                                     00009100
         WTO   CART=SSCMCART,          Issue buffer overflow msg       X00009200
               CONSID=SSCMCNID,                                        X00009300
               LINKAGE=BRANCH,                                         X00009400
               MF=(E,WTOWORK)                                           00009500
CLDONE   DS    0H                                                       00009600
         ST    R1,WTOID                Store WTOID for MLWTO            00009700
*                                                                       00009800
         LA    R3,RESPBUFF             Virtual address of resp buff     00009900
         LA    R7,0(R7,R3)             Add length of buffer             00010000
         BCTR  R7,0                    Point to last character          00010100
WTOLOOP  DS    0H                                                       00010200
         LR    R1,R7                   Load end-of-buff address         00010300
         SLR   R1,R3                   Subtract start-of-buffer         00010400
         CH    R1,=Y(WLEN-1)           Too long for one line?           00010500
         BL    LLENOK                  If so,                           00010600
         LA    R1,WLEN-1                 then limit the length          00010700
LLENOK   DS    0H                                                       00010800
         LA    R6,1(,R1)               Set R6 to real length            00010900
         EX    R1,EOLTRT               Find end-of-line character       00011000
         BZ    NOEOL                                                    00011100
         SLR   R1,R3                   If end-of-line character         00011200
         LA    R6,1(,R1)                 then set R6 to line-length     00011300
         BCTR  R1,0                      and set R1 to mach length      00011400
NOEOL    DS    0H                                                       00011500
         LTR   R1,R1                   Ignore null lines                00011600
         BM    SKIPLINE                                                 00011700
         MVC   WTOWORK,WTOBODY         Initialize WTO work area         00011800
         EX    R1,LINECPY              Copy line                        00011900
         WTO   CONNECT=WTOID,          Write to operator               X00012000
               CART=SSCMCART,                                          X00012100
               LINKAGE=BRANCH,                                         X00012200
               MF=(E,WTOWORK)                                           00012300
SKIPLINE DS    0H                                                       00012400
         BXLE  R3,R6,WTOLOOP           Loop thru resp buffer            00012500
*                                                                       00012600
         MVC   WTOWORK(CP12Z),CP12I                                     00012700
         WTO   CONNECT=WTOID,          Terminate MLWTO                 X00012800
               CART=SSCMCART,                                          X00012900
               LINKAGE=BRANCH,                                         X00013000
               MF=(E,WTOWORK)                                           00013100
*                                                                       00013200
* Set returncode indicating command was executed.                       00013300
*                                                                       00013400
CMDCMPLT DS    0H                                                       00013500
         LA    R15,SSCMSUBC            Indicate subsystem processed cmd 00013600
         B     EXIT                    Return to caller                 00013700
*                                                                       00013800
* LRA error                                                             00013900
*                                                                       00014000
SSCMLRAE DS    0H                                                       00014012
         IC    R1,SYSMASK              Load I & E bits                  00014022
         EX    R1,STOSM                Enable External & I/O ints       00014032
         SDUMP HDR='VMCP LRA ERROR DURING COMMAND PROCESSING'           00014042
         B     SSCMNEXE                                                 00014052
*                                                                       00014062
* Set returncode indicating command was not executed                    00014072
*                                                                       00014082
CMDNOTEX DS    0H                                                       00014100
         MVC   WTOWORK(CP13Z),CP13I                                     00014200
         WTO   CART=SSCMCART,          Issue no auth message           X00014300
               CONSID=SSCMCNID,                                        X00014400
               LINKAGE=BRANCH,                                         X00014500
               MF=(E,WTOWORK)                                           00014600
SSCMNEXE DS    0H                                                       00014602
         LA    R15,SSCMIMSG            Indicate error                   00014700
         B     EXIT                    Return to caller                 00014800
*                                                                       00014900
* Set returncode indicating command not CP command (let SVC34           00015000
* handle it).                                                           00015100
*                                                                       00015200
NOCPCMD  DS    0H                                                       00015300
         LA    R15,SSCMSCMD            Give command back to SVC34       00015400
         ST    R15,SSOBRETN            Save in SSOB                     00015500
         B     RETURN                  Return to SSI caller             00015600
*                                                                       00015700
* Store the returncode in the SSOB returncode field and exit.           00015800
*                                                                       00015900
EXIT     DS    0H                                                       00016000
         ST    R15,SSOBRETN            Put returncode in SSOB           00016100
*                                                                       00016200
OPEXIT   DS    0H                                                       00016300
         L     R13,4(,R13)             Recall R13 from savearea         00016400
         STORAGE RELEASE,                                              X00016500
               LENGTH=CORELEN,                                         X00016600
               SP=239,                                                 X00016700
               ADDR=(8)                                                 00016800
RETURN   DS    0H                                                       00016900
         RETURN (14,12),RC=0           Recall registers & return        00017000
*                                                                       00017100
MGCRCPY  MVC   CMDBUFF(0),MGCRTEXT+L'CPCMD                              00017200
EOLTRT   TRT   0(0,R3),EOLTAB                                           00017300
LINECPY  MVC   WTOWORK+4(0),0(R3)                                       00017400
STOSM    STOSM SYSMASK,0                                                00017500
*                                                                       00018400
CPPROF   DC    CL39'MVS.CP'            SAF profile name                 00018505
CPPREF   EQU   CPPROF,4,C'C'           SAF PREFIX                       00018605
CPCMD    EQU   CPPROF+4,3,C'C'         CP command                       00018705
*                                                                       00018800
CP10I    WTO   ('VMCP10I CP command accepted',C),                      X00018900
               MCSFLAG=RESP,DESC=(4,5),CART=,CONSID=,LINKAGE=,MF=L      00019000
CP10Z    EQU   *-CP10I                                                  00019100
*                                                                       00019200
CP11I    WTO   ('VMCP11I CP response buffer overflow',C),              X00019300
               MCSFLAG=RESP,DESC=(4,5),CART=,CONSID=,LINKAGE=,MF=L      00019400
CP11Z    EQU   *-CP11I                                                  00019500
*                                                                       00019600
CP12I    WTO   ('VMCP12I All data displayed',E),                       X00019700
               CONNECT=,CART=,LINKAGE=,MF=L                             00019800
CP12Z    EQU   *-CP12I                                                  00019900
*                                                                       00020000
CP13I    WTO   'VMCP13I Insufficient authority',                       X00020100
               MCSFLAG=RESP,DESC=(4,5),CART=,CONSID=,LINKAGE=,MF=L      00020200
CP13Z    EQU   *-CP13I                                                  00020300
*                                                                       00020400
WTOBODY  WTO   ('                                                      X00020500
                                ',D),                                  X00020600
               CONNECT=,CART=,LINKAGE=,MF=L                             00020700
WTOLEN   EQU   *-WTOBODY                                                00020800
*                                                                       00020900
EOLTAB   DC    256X'00'                Translate table to find EOL      00021000
         ORG   EOLTAB+X'15'              character                      00021100
         DC    X'15'                                                    00021200
         ORG   ,                                                        00021300
*                                                                       00021400
         LTORG ,                                                        00021500
*                                                                       00021600
VCON     EQU   8                       Virtual Console Function code    00021700
WLEN     EQU   71                      Max linelength for WTO           00021800
*                                                                       00021900
CORE     DSECT ,                                                        00022000
RESPBUFF DS    CL4096                                                   00022100
SAVEAREA DS    18F                     Savearea MUST be at loc. 4096    00022200
CMDBUFF  DS    CL140                                                    00022300
WTOID    DS    1F                                                       00022400
WTOWORK  DS    XL(WTOLEN)                                               00022500
SYSMASK  DS    X                                                        00022600
IEMASK   EQU   3                                                        00022700
         CMDAUTH MF=(L,CMDAUTH,NODSECT)                                 00022805
CORELEN  EQU   *-CORE                                                   00023000
*                                                                       00023100
         YREGS ,                                                        00023200
CC0      EQU   B'1000'                                                  00611300
CC1      EQU   B'0100'                                                  00611400
CC2      EQU   B'0010'                                                  00611500
CC3      EQU   B'0001'                                                  00611600
         IEZMGCR ,                                                      00023300
         IEFJSSOB CM                                                    00023400
*                                                                       00023500
         END   VMCPSSCM,(JAN JAEGER,0101,91213)                         00023600
++JCLIN .                                                               NONUMBER
//LINKSSIN JOB ,                                                        NONUMBER
//VMCPSSIN EXEC PGM=IEWL,                                               NONUMBER
//          PARM='LIST,XREF,NCAL,REFR'                                  NONUMBER
//SYSLMOD  DD  DSN=LINKLIB                                              NONUMBER
//SYSLIN   DD  *                                                        NONUMBER
  INCLUDE SYSLIB(VMCPSSIN)                                              NONUMBER
  ENTRY VMCPSSIN                                                        NONUMBER
  NAME VMCPSSIN(R)                                                      NONUMBER
//LINKSSSM EXEC PGM=IEWL,                                               NONUMBER
//          PARM='LIST,XREF,NCAL,REFR,OL'                               NONUMBER
//SYSLMOD  DD  DSN=LINKLIB                                              NONUMBER
//SYSLIN   DD  *                                                        NONUMBER
  INCLUDE SYSLIB(VMCPJSVT)                                              NONUMBER
  INCLUDE SYSLIB(VMCPSSCM)                                              NONUMBER
  ORDER VMCPJSVT,VMCPSSCM                                               NONUMBER
  ENTRY VMCPSSVT                                                        NONUMBER
  NAME VMCPSSSM(R)                                                      NONUMBER
