//FCMD###  JOB CLASS=F,MSGCLASS=1,NOTIFY=KIMU,TIME=1440
//A       EXEC PGM=IEV90,PARM=OBJECT,REGION=2000K
//SYSIN    DD  *
         START
* -----------------------------------------------------------------
         DC   C'<< @CMD .. Enter MVS Command >>'
         DC   C'  Version '
@VERSION DC   CL6'v1r2m0'
         DC   C' ) _ Kimu  // Compiled Date : &SYSDATE _ &SYSTIME '
         PRINT NOGEN
* --- Start of Process --------------------------------------------
@CMD     CSECT
@CMD     AMODE 31
@CMD     RMODE ANY
*        --- Start of AR-Mode Program ( Initialize ) ---
         SAVE  (14,12),T,*             Save Reg.
         BAKR  R14,0                   Branch and Stack ( Stack Only )
* set CPPL Base Reg.
         LR    R06,R01
         SAC   512                     AccessRegister(AR) Mode
         SYSSTATE ASCENV=AR
         LAE   R03,0(R15,0)            Load Address 31 Bit
         USING @CMD,R03                Base Reg. R03 ,
*        For Re-Entrant Process
         STORAGE OBTAIN,LENGTH=R2ENTAL Getmain Storage
         LAE   R04,0(0,R01)            R04 <- Dynamic Stor. Base
         LAE   R08,R2ENTA              Copied Dinamic Stor.
         L     R09,=A(R2ENTAL)
         LAE   R10,0(0,R04)
         LR    R11,R09
         MVCL  R10,R08
         USING R2ENTA,R04              R04 <- Dynamic Stor.
         MVC   4(4,R13),=C'F1SA'       set acro in save area            06150000
         LR    R12,R13
         LAE   R13,SA#001              Load New-R13
         ST    R13,8(R12)              Store New-R13 SA+8(Thd Word)
*        --- Start of AR-Mode Program ( End-Initialize ) ---
* set CPPL Base Reg.
         USING CPPL,R06                CPPL Base Reg. R06
*
         USING MCSCOMM,R05             Set Communication DSECT
         LA    R05,MCSENT               Base Reg R03
*
         SAC   0                       Primary Mode
         SYSSTATE ASCENV=P
* Initialize Communication DSECT
         XC    COM_WTME,COM_WTME
         XC    COM_WLEN,COM_WLEN
         XC    COM_TLEN,COM_TLEN
         MVI   COM_CMD,X'40'               clear COMMAND RESULT AREA
         MVC   COM_CMD+1(L'COM_CMD-1),COM_CMD
         MVI   COM_WAIT,X'40'              clear COMMAND RESULT AREA
         MVC   COM_WAIT+1(L'COM_WAIT+1),COM_WAIT
* Call TSO P-List
         BAL   R14,@PPL                    parse command routine
         LTR   R15,R15
         BNZ   @BYE
*
         CLC   COM_CMD(4),HELPKW           Show Help Message
         BE    @HELP
*
         ST    R06,COM_CPPL                Store CPPL Address to DSECT
         XC    COM_TLEN,COM_TLEN
         CALL  CMDE,((R05))
*
@BYE     EQU   *
         STORAGE RELEASE,              Freemain Storage                X
               LENGTH=R2ENTAL,                                         X
               ADDR=(R04)                                               08650000
         PR                            Program Return Mother
*
*--------------------------------------------------------------------
* --- Sub Routine -------------------------------------------------
* --- PPL ( parse service routine ) -------------------------------
@PPL     EQU   *
         BAKR  R14,0               Branch and Stack ( Stack Only )
         SAC   0                   Primary Mode
         SYSSTATE ASCENV=P
*
         LA    R01,L_PPL
         GETMAIN RU,LV=(1)         getmain PPL comm area
         STM   R00,R01,PPL_LEN     save getmain length and address
         L     R12,PPL_ADR
         USING PPL,R12             PPL Base Reg. R12
         MVC   PPLUPT,CPPLUPT      UPT address from CPPL
         MVC   PPLECT,CPPLECT      ECT address from CPPL
         MVC   PPLCBUF,CPPLCBUF    command buffer from CPPL
         LA    R01,ANS             load answer area address and
         ST    R01,PPLANS           store it in the PPL
         XC    #ECB2,#ECB2         clear ECB ( event control block )
         LA    R01,#ECB2           load ECB address and
         ST    R01,PPLECB           store it in the PPL
         L     R01,PCLADCON        load PCL address and
         ST    R01,PPLPCL           store it in the PPL
*
         CALLTSSR EP=IKJPARS,MF=(E,PPL)
         DROP  R12
         LTR   R15,R15             test IKJPARS
         BNZ   @PPL_ERR             if error goto @PPL_ERR
*
         L     R12,ANS             load PPL answer area
         USING PRDSECT,R12
* --- MVS Command Area ---
         L     R01,PCLCMD          R01 <- Command Result Area
         LH    R02,PCLCMD+4        R02 <- Command Result Length
         BCTR  R02,0
         STC   R02,*+5
         MVC   COM_CMD(0),0(R01)   copy MVS Command
*        ST    R02,@CMDL             Store Length
* --- Wait Message ---
         L     R01,PCLMES          R01 <- Command Result Area
         LH    R02,PCLMES+4        R02 <- Command Result Length
         LTR   R02,R02             if No Input Wait Message
         BZ    @PPL_SP1              goto @PPL_SP1
         CL    R02,=F'80'          if Over 80 Byte
         BH    @PPL_ERR              goto @PPL_ERR ??
         BCTR  R02,0
         STC   R02,*+5
         MVC   COM_WAIT(0),0(R01)  Copy Wait Message
         STH   R02,COM_WLEN          Store Message Length
@PPL_SP1 EQU   *
* --- MCS Console Name ---
         MVC   COM_CONN(8),@CONDFLT
         L     R01,PCLCNM          R01 <- Command Result Area
         LH    R02,PCLCNM+4        R02 <- Command Result Length
         LTR   R02,R02             test IKJPARS
         BZ    @PPL_SP2
         BCTR  R02,0
         STC   R02,*+5
         MVC   COM_CONN(0),0(R01)  Copy Console Name
@PPL_SP2 EQU   *
* --- Timer ---
         L     R01,PCLTM           R01 <- Command Result Area
         LA    R02,PCLTM+6         R02 <- Command Result Flag
         TM    0(R02),X'80'        If No Result
         BNO   @PPL_SP3              goto @PPL_SP3
         L     R01,0(R01)
         STH   R01,COM_WTME
@PPL_SP3 EQU   *
* --- Wait Message ---
         XC    COM_FORM,COM_FORM
         L     R01,PCLMFM          R01 <- Command Result Area
         LH    R02,PCLMFM+4        R02 <- Command Result Length
         LTR   R02,R02             if No Input Wait Message
         BZ    @PPL_SP4              goto @PPL_SP1
@PPL_LP4 EQU   *
         CLI   0(R01),C'J'         If MFORM=(J)
         BNE   @PPL_SP41
         OI    COM_FORM,X'80'
@PPL_SP41 EQU  *
         LA    R01,1(R01)
         BCT   R02,@PPL_LP4
@PPL_SP4 EQU   *
*
         DROP  R12
*
         L     R01,PPL_ADR         free main PPL comm area
         LA    R02,L_PPL           free main PPL comm area
         FREEMAIN RU,LV=(R02),A=(R01)
         LA    R15,0
         PR                        Return Main
*
@PPL_ERR EQU   *
         TPUT  MSG#E001,L'MSG#E001
         L     R01,PPL_ADR         free main PPL comm area
         LA    R02,L_PPL           free main PPL comm area
         FREEMAIN RU,LV=(R02),A=(R01)
         LA    R15,8
         PR
*
* --- Help Message ------------------------------------------------
@HELP    EQU   *
         L     R01,@VER_A
         MVC   MSG#HV(6),0(R01)
         LA    R07,MSG#HELP
         LA    R09,MSG#HPL
         XR    R10,R10
@HELP#L  EQU   *
         CLR   R10,R09
         BNL   @HELP#X
         TPUT  (R07),L'MSG#HELP
         LA    R07,L'MSG#HELP(R07)
         LA    R10,L'MSG#HELP(R10)
         B     @HELP#L
@HELP#X  EQU   *
         B     @BYE
*--------------------------------------------------------------------
* --- Sub Routine ( error routine ) -------------------------------
* --- Define Storage ----------------------------------------------
* --- DYNAMIC AREA ---
R2ENTA   DS    0F
* --- Reg. Save Area ----------------------------------------------
SA#001   DS    18F
* --- IKJPARS ( tso parse service routine ) -----------------------
*        PRINT GEN
PCLADCON DC    A(PCLDEFS)
PCLAREA  DS    0F
PCLDEFS  IKJPARM DSECT=PRDSECT
PCLCMD   IKJPOSIT QSTRING,                                             *
               PROMPT='MVS Command',                                   *
               HELP=('Enter MVS Command ..')
* --- Timer ---
PCLT     IKJKEYWD
         IKJNAME 'T',SUBFLD=PCLTFLD
* --- Wait Message ---
PCLM     IKJKEYWD
         IKJNAME 'M',SUBFLD=PCLMFLD
* --- MCS Console Name ---
PCLCN    IKJKEYWD
         IKJNAME 'CN',SUBFLD=PCLCFLD
* --- MFORM ---
PCLFM    IKJKEYWD
         IKJNAME 'MFORM',SUBFLD=PCLFFLD
* --- Timer ---
PCLTFLD  IKJSUBF
PCLTM    IKJIDENT 'NUMBER',INTEG,DEFAULT='30',MAXLNTH=4
* --- Wait Message ---
PCLMFLD  IKJSUBF
PCLMES   IKJIDENT ALPHANUM,FIRST=ANY,OTHER=ANY
* --- MCS Console Name Field ---
PCLCFLD  IKJSUBF
PCLCNM   IKJIDENT ALPHANUM,MAXLNTH=8,                                  *
               UPPERCASE,FIRST=ALPHA,OTHER=ALPHANUM,                   *
               PROMPT='MCS Console Name.',                             *
               HELP=('Enter MCS Console Name ...')
* --- MFORM ---
PCLFFLD  IKJSUBF
PCLMFM   IKJIDENT ALPHANUM,FIRST=ANY,OTHER=ANY
         IKJENDP
*        PRINT NOGEN
         DS    0F
@CONDFLT DC    CL8'CMDCONS'       Default Console Name
* --- PPL Getmain Area --------------------------------------------
PPL_LEN  DS    F                  PPL length
PPL_ADR  DS    F                  PPL address
* --- PPL answer area ---------------------------------------------
ANS      DS    F
* --- ECB ---------------------------------------------------------
#ECB2    DS    F
@VER_A   DC    A(@VERSION)
HELPKW   DC    CL4'HELP'
MCSENT   DS    (MCSCOMML)X
* --- Error Message -----------------------------------------------
MSG#E001 DC    CL79'> PPL Error Happend .. Bye !!'
* --- messgae -----------------------------------------------------
MSG#HELP DS    0CL79
 DC CL79'# @CMD : Enter MVS Command from Master Auth Console ...      '
 DS 0CL79
*        0....+....1....+....2....+....3....+....4....+....5....+...
 DC CL51'# --------------------------------------------------'
MSG#HV   DC CL06'v@r@m@'
 DC CL22'-- '
 DC CL79'# Usage.                                                     '
 DC CL79'#  @CMD ''command'' T(nn) M(xxxxxxx) CN(consnm)              '
 DC CL79'#                                                            '
 DC CL79'#  command : MVS Command                                     '
 DC CL79'#  nn      : Timeout Sec                                     '
 DC CL79'#  xxxxxxx : Wait Message                                    '
 DC CL79'#  consnm  : MVS Console Name                                '
 DC CL79'#                                                            '
 DC CL79'#                           Thanks for Your use .. Bye !     '
MSG#HPL  EQU   *-MSG#HELP
R2ENTAX  EQU   *
R2ENTAL  EQU   *-R2ENTA                  Re-Entrant Area Length
         LTORG
* -----------------------------------------------------------------
*        --- 31 Bit Addressing Mode ---
CMDE     AMODE 31
CMDE     RMODE 24
CMDE     CSECT
* ---------------------------------------------------------
*        --- Start of AR-Mode Program ( Initialize ) ---
         PRINT NOGEN
         BAKR  R14,0                   Branch and Stack ( Stack Only )
         LR    R05,R01                 Copy Paramater Address .
         SAC   512                     AccessRegister(AR) Mode
         SYSSTATE ASCENV=AR            AR Mode
         LAE   R03,0(R15,0)            Load Address AR Mode
         USING CMDE,R03                Base Reg. R03
*        For Re-Entrant Process
         STORAGE OBTAIN,LENGTH=REENTAL Getmain Storage
         LAE   R04,0(0,R01)            R04 <- Dynamic Stor. Base
         LAE   R08,REENTA              R08 <- Dinamic Stor Adr.
         L     R09,=A(REENTAL)         R09 <- Dynamic Stor Leng.
         LAE   R06,0(0,R04)
         LR    R07,R09
         MVCL  R06,R08
         USING REENTA,R04              R04 <- Dynamic Stor.
         LAE   R13,SAVEAREA            Load New-R13
         MVC   4(4,R13),=C'F1SA'       set acro in save area
*        --- Start of AR-Mode Program ( End-Initialize ) ---
         SAC   0                       Primary Mode
         SYSSTATE ASCENV=P
*        --- Main Process ---
*        --- Start of Argument Parameter ---
         L     R05,0(R05)              R05 <- Parameter Area Dsect
         USING MCSCOMM,R05
* - debug -
*        LA    R01,MSG#0004
*        LA    R02,L'MSG#0004
*        BAL   R14,@PUTL#S             Echo Message
* - debug -
* --- Echo MVS Command ---
         MVC   MSG#0003+02(78),COM_CMD Copy Command to Message Area
         LA    R01,MSG#0003
         LA    R02,L'MSG#0003
         BAL   R14,@PUTL#S             Echo Message
* --- Clear Result Area ---
         XC    COM_RC,COM_RC           Clear Return Code
         XC    COM_RSN,COM_RSN         Clear Reason Code
         XC    COM_FLAG,COM_FLAG       Clear Flag
* --- End of Argument Parameter Initialize ---
* --- MCS Console Activate ---
         BAL   R14,MCS#ACT             MCS Console Activate .
         LTR   R15,R15                 if Comsole Act Error
         BNZ   QUIT1                     goto QUIT
* --- TSO Attention Process ---
         STAX  MCSATTN,OBUF=(ATTNOUTB,79),                             *
               IBUF=(ATTNINB,140),MF=(E,STAXLIST),                     *
               USADDR=(R05)
* --- Timeout Sec Set ---
         LH    R01,=H'100'             1Sec = 0.01Sec * 100
         MH    R01,COM_WTME
         LTR   R01,R01
         BNZ   WAITSET1
         L     R01,=F'3000'            30Sec ( Default )
WAITSET1 EQU   *
         ST    R01,WAITMAX
* - debug -
*        LA    R07,WAITMAX
*        LA    R09,MSG#0014+25-REENTA(R04)
*        CALL  @HC,((R07),(R09),4)
*        LA    R01,MSG#0014
*        LA    R02,L'MSG#0014
*        BAL   R14,@PUTL#S             Echo Message
* - debug -
* --- Wait Timer Set ---
         XC    WMAXFLG,WMAXFLG
         STIMERM SET,BINTVL=WAITMAX,ID=WMAXID,WAIT=NO
* --- Command Response Event Initialize ---
         EVENTS ENTRIES=10             Command Response Events Define
         ST    R01,@EVTBL
* --- Command Issue ---
         BAL   R14,CMDISSUE            MVS Command Enter
* --- All Timer Clear ---
         STIMERM CANCEL,ID=WMAXID
* --- Extended MCS Console De-Activate ---
         BAL   R14,MCS#DEA             MCS Console DeActivate .
* --- End-Main Process ---
* --- Terminate of Program ---
QUIT1    EQU   *
         STORAGE RELEASE,              Freemain Storage                X
               LENGTH=REENTAL,                                         X
               ADDR=(R04)
         PR                            Program Return Mother
*        --- End of Terminate process ---
*        --- MCS Console Activate ---
MCS#ACT  EQU   *
         BAKR  R14,0                   Branch and Stack ( Stack Only )
* --- MCS Console AUTH=MSTR ---
         XC    @MCSOP,@MCSOP           Set MCSOP-MCSOATH1 Field
         USING MCSOPPRM,R15
         LA    R15,@MCSOP
         MVI   MCSOATH1,MCSOMSTR       Master Console
*        OI    MCSOMFM1,MCSOMFT        Display Time Stamp
*        OI    MCSOMFM1,MCSOMFS        Display System Name
         OI    MCSOMFM1,MCSOMFJ        Display JOB-ID/Name
*        OI    MCSOMFM1,MCSOMFM        Without SYSTEM,TIME,JOB(Default)
*        OI    MCSOMFM1,MCSOMFX        Supperss System,JOB
         DROP  R15
* --- Parameter Set ---
         MVC   CONSNM(8),COM_CONN      Copy Console Name
* --- SVC Mode Set ---
         SAC   0                       Primary Mode
         SYSSTATE ASCENV=P
         MODESET KEY=ZERO,MODE=SUP     SVC Mode
         SAC   512                     AccessRegister(AR) Mode
         SYSSTATE ASCENV=AR
* --- Primary | AR and SVC Mode ---
         MCSOPER REQUEST=ACTIVATE,     MCS Console Activate            C
               NAME=CONSNM,              Console Name                  C
               CONSID=CONSID,            Console ID Address            C
               TERMNAME=CONSNM,          Terminal Name                 C
               OPERPARM=@MCSOP,                                        C
               MCSCSA=MCSA,                                            C
               MCSCSAA=MCSCSAA,                                        C
               MSGECB=MCSECB,                                          C
               RTNCODE=RC,                                             C
               RSNCODE=RSN
* --- Problem Mode Set ---
         SAC   0                       Primary Mode
         SYSSTATE ASCENV=P
         MODESET KEY=NZERO,MODE=PROB
* --- Check Condition Code ---
         L     R15,RC                  Check Return Code .
         LTR   R15,R15
         BZ    @MCSACTQ
         L     R15,RSN                 Check Reason Code .
         LTR   R15,R15
         BZ    @MCSACTQ
* --- Error Code Set ---
         MVC   COM_MAC(8),=CL8'MCSOPER'
         MVC   COM_ACT(8),=CL8'ACTIVATE'
         MVC   COM_RC(4),RC
         MVC   COM_RSN(4),RSN
         MVC   ERRMSG01+05(8),=CL8'MCSOPER'
         MVC   ERRMSG01+14(8),=CL8'ACTIVATE'
         BAL   R14,ECHOERR
         LA    R15,8
@MCSACTQ EQU   *
         OI    COM_FLAG,X'40'          Set MCS-Activate Flag
         PR                            Return
*        --- End of MCS Console Activate ---
*        --- File Read and Command Precess Loop ---
CMDISSUE EQU   *
         BAKR  R14,0                   Branch and Stack ( Stack Only )
         XC    MSGWAITF,MSGWAITF
*
CMDENTR  EQU   *
* --- Copy Parameter Set ---
         MVC   CMDBUF(80),COM_CMD      Copy Command Buffer
* --- Mode Set ---
         SAC   0                       Primary Mode
         SYSSTATE ASCENV=P
         MODESET KEY=ZERO,MODE=SUP     SVC Mode
* --- Primary and SVC Mode ---
         LA    R02,TEXTAREA
         MGCRE TEXT=(R02),             Enter MVS Command               C
               CONSID=CONSID,                                          C
               CART=MCART,                                             C
               CMDFLAG=NOHCPY,                                         C
               MF=(E,LMGCRE)
*+       LTR   R15,R15                 If Nomal Complete
*+       BC    B'1000',CMDWAIT           goto CMDWAIT
* --- Problem Mode ---
*+       MODESET KEY=NZERO,MODE=PROB
* --- Error Code Set ---
*+       ST    R15,COM_RC
*+       MVC   COM_MAC(8),=CL8'MGCRE'
*+       MVC   COM_ACT(8),=CL8' '
*
*+       MVC   ERRMSG01+05(8),=CL8'MGCRE'
*+       MVC   ERRMSG01+14(8),=CL8' '
*+       BAL   R14,ECHOERR
*
*+       B     CMDISU#X                Return to Main Routine
CMDWAIT  EQU   *
* --- Primary Mode Set ---
         SAC   0                       Primary Mode
         SYSSTATE ASCENV=P
* --- Problem Mode ---
         MODESET KEY=NZERO,MODE=PROB
* --- Wait to Message ---
         LA    R08,MCSECB              Events Test
         EVENTS TABLE=@EVTBL,ECB=(8),WAIT=NO
         LTR   R01,R01                 if Message Come
         BNZ   MSGGOT
@EVLOP2  EQU   *
         STIMERM SET,DINTVL=WAITXX,ID=WAITID,WAIT=YES
         TM    COM_FLAG,X'80'          If ATTN Key
         BO    CMDISU#X                 De-Activate Console
         STIMERM TEST,ID=WMAXID,TU=WAITTU
         CLC   WAITTU,=F'0'            If Time Over
         BNE   @EVLOP1                   goto @EVLOP1
         LH    R01,COM_TLEN            Time Over Message
         LTR   R01,R01                 Is None
         BZ    @EVSKP2                   goto @EVSKP2
         STC   R01,*+5                 Copy Time Over Message
         MVC   MSG#0015+05(0),COM_TOUT
         LA    R01,MSG#0015
         LA    R02,L'MSG#0015
         BAL   R14,@PUTL#S             Echo Message
         B     CMDISU#X                De-Activate Console
@EVSKP2  EQU   *
         LA    R01,MSG#0016            Default Timeout Message
         LA    R02,L'MSG#0016
         BAL   R14,@PUTL#S             Echo Message
         B     CMDISU#X                De-Activate Console
@EVLOP1  EQU   *
*
         LA    R08,MCSECB              Command Response Test
         EVENTS TABLE=@EVTBL,WAIT=NO
         LTR   R01,R01                 If Come
         BNZ   MSGGOT                    goto MSGGOT
         B     @EVLOP2                 No Time Over
MSGGOT   EQU   *
*
MSGLP    EQU   *
* --- Primary Mode Set ---
         SAC   0                       Primary Mode
         SYSSTATE ASCENV=P
* --- SVC Mode Set ---
         MODESET KEY=ZERO,MODE=SUP     SVC Mode
* --- AR Mode Set ---
         SAC   512                     AccessRegister(AR) Mode
         SYSSTATE ASCENV=AR
* --- Get Messgae ---
         MCSOPMSG REQUEST=GETMSG,                                      C
               CONSID=CONSID,          Console ID                      C
               RTNCODE=RC,             Return Code                     C
               RSNCODE=RSN             Reason Code
* --- Message Data Block Set ---
         LAE   R08,0(0,R01)            put mdb address in R08
         USING MDB,R08                 addressability to the mdb
* --- Primary Mode Set ---
         SAC   0                       Primary Mode
         SYSSTATE ASCENV=P
* --- Problem Mode Set ---
         MODESET KEY=NZERO,MODE=PROB
* --- AR Mode Set ---
         SAC   512                     AccessRegister(AR) Mode
         SYSSTATE ASCENV=AR
         MVI   MDBFLGS,0               clear processing flags
         MVI   CMDRSP,0           assume not issuing command response
         CLC   RC,=F'8'                if any messages
         BL    GOTMDB                    process it (rc<8)
         BNE   GOTERR                    some kind of error (rc>8)
*                                        no mode Messages
         TM    MSGWAITF,X'80'            if no Wait Message
         BO    CMDISU#Q                    goto CMDISU#Q
*
         SAC   0                         Primary Mode
         SYSSTATE ASCENV=P
*
         TM    COM_FLAG,X'80'          If ATTN Key
         BO    CMDISU#X                 De-Activate Console
         STIMERM TEST,ID=WMAXID,TU=WAITTU
         CLC   WAITTU,=F'0'            If No Timeover
         BNE   WAITSKP1                  goto WAITSKP1
         LH    R01,COM_TLEN
         LTR   R01,R01                 If Timeover Message is None
         BZ    WAITSKP2                  goto WAITSKP2
         STC   R01,*+5
         MVC   MSG#0015+05(0),COM_TOUT
         LA    R01,MSG#0015
         LA    R02,L'MSG#0015
         BAL   R14,@PUTL#S             Echo Message
         B     CMDISU#X                De-Activate Console
WAITSKP2 EQU   *
         LA    R01,MSG#0016            Default Timeout Message
         LA    R02,L'MSG#0016
         BAL   R14,@PUTL#S             Echo Message
         B     CMDISU#X                De-Activate Console
WAITSKP1 EQU   *
* -DEBUG-
*        LA    R01,MSG#0018            Timeout Message
*        LA    R02,L'MSG#0018
*        BAL   R14,@PUTL#S             Echo Message
* -DEBUG-
         STIMERM SET,DINTVL=WAITXX,ID=WAITID,WAIT=YES
         B     CMDWAIT
         DS    0D
GOTERR   EQU   *                       GetMessage Error
* --- Error Code Set ---
         MVC   COM_MAC(8),=CL8'MCSOPMSG'
         MVC   COM_ACT(8),=CL8'GETMSG'
         MVC   COM_RC(4),RC
         MVC   COM_RSN(4),RSN
         MVC   ERRMSG01+05(8),=CL8'MCSOPMSG'
         MVC   ERRMSG01+14(8),=CL8'GETMSG'
         BAL   R14,ECHOERR
         B     CMDISU#X                De-Activate Console
CMDISU#Q EQU   *
* -DEBUG-
*        SAC   0                       Primary Mode
*        SYSSTATE ASCENV=P
*        LA    R01,MSG#0017            End of Wait Loop Message
*        LA    R02,L'MSG#0017
*        BAL   R14,@PUTL#S             Echo Message
* -DEBUG-
CMDISU#X EQU   *
* --- Primary Mode Set ---
         SAC   0                       Primary Mode
         SYSSTATE ASCENV=P
         PR
*        --- MCS Console De-Activate ---
MCS#DEA  EQU   *
         BAKR  R14,0                   Branch and Stack ( Stack Only )
* --- Primary Mode Set ---
         SAC   0                       Primary Mode
         SYSSTATE ASCENV=P
* --- SVC Mode Set ---
         MODESET KEY=ZERO,MODE=SUP     SVC Mode
* --- AR Mode Set ---
         SAC   512                     AccessRegister(AR) Mode
         SYSSTATE ASCENV=AR
         MCSOPER REQUEST=DEACTIVATE,                                   C
               CONSID=CONSID
* --- Primary Mode Set ---
         SAC   0                       Primary Mode
         SYSSTATE ASCENV=P
* --- Problem Mode Set ---
         MODESET KEY=NZERO,MODE=PROB
         PR                            Return
*        --- End of Display Command Issue ---
*
*        --- Call Error Message ---
ECHOERR  EQU   *                       Echo Error Message
         BAKR  R14,0                   Branch and Stack ( Stack Only )
* --- Primary Mode Set ---
         SAC   0                       Primary Mode
         SYSSTATE ASCENV=P
         ST    R15,WKF
         LA    R07,WKF-REENTA(R04)
         LA    R09,ERRMSG01+58-REENTA(R04)
         CALL  @HC,((R07),(R09),4)
         LA    R07,RC-REENTA(R04)
         LA    R09,ERRMSG01+32-REENTA(R04)
         CALL  @HC,((R07),(R09),4)
         LA    R07,RSN-REENTA(R04)
         LA    R09,ERRMSG01+45-REENTA(R04)
         CALL  @HC,((R07),(R09),4)
         LA    R01,ERRMSG01
         LA    R02,L'ERRMSG01
         BAL   R14,@PUTL#S             Echo Message
         PR
*        --- Call Error Message ---
*      --------------------------------------------------------------
*                               MDBTYPE
* R08 -> +--------------------+                    ---          ---
*        | MDB Header         | x'0001'(MDBTYP1)    |         MDBHLEN
*        +--------------------+                   MDBLEN  R06-> ---
*        |General Object      | x'0001'(MDBGOBJ)    |
*        +--------------------+                     |
*        |Control Prog Object | x'0002'(MDBCOBJ)    |
*        +--------------------+                     |
*        |Text Object         | x'0004'(MDBTOBJ)    |
*        +--------------------+                     |
*        |Text Object         |                     |
*        +--------------------+                     |
*         ..................                        |
*         .............                             |
*         ........                           R07-> ---
*
GOTMDB   DS      0H
         LR    R07,R08            calc end of mbd in R07
         AH    R07,MDBLEN         start+mdblen in header
         LR    R06,R08            remember start of MDB for pass 2
         LA    R08,MDBHLEN(R08)   bump to 1st object
OBJLP    DS    0H                 loop through the objects
         LH    R12,MDBTYPE        get type
         C     R12,=A(MDBGOBJ)    check for general object
         BNE   NOTG               not general object
         TM    MDBFLGS,MDBFGO     see if first general object
         BO    NXTOBJ             no, skip it
         BAL   R14,GOTMDBG        process general object
         B     NXTOBJ             bump to next object
NOTG     DS    0H
         C     R12,=A(MDBCOBJ)    check for control prog object
         BNE   NOTC               not control prog object
         TM    MDBFLGS,MDBFCO     see if first control prog object
         BO    NXTOBJ             no, skip it
         BAL   R14,GOTMDBC        process control prog object
         B     NXTOBJ             bump to next object
NOTC     DS    0H                 not control prog obj
NXTOBJ   DS    0H                 find next object
         TM    MDBFLGS,MDBFGO+MDBFCO see if we found general and SCP
         BO    FNDTXT             got them, loop through text objs
         AH    R08,MDBLEN         bump to next object
         CR    R08,R07            see if this is the end
         BL    OBJLP              no, get another object
         B     MSGLP              missing necessary objects, skip it
*---------------------------------------------------------------------*
*-                                                                   -*
*- FNDTXT:   ENTRY VIA BRANCH (NOT A SUBROUTINE)                     -*
*- Function: Process all text objects in all MDBs for this message.  -*
*-           Text objects are always ordered, but it cannot be       -*
*-           assumed that they are contiguous.                       -*
*- Operation:                                                        -*
*-     find end of MDB                                               -*
*-     get pointer to next MDB in message                            -*
*-     loop through MDBs                                             -*
*-        loop through objects                                       -*
*-            when text object                                       -*
*-              call GOTMDBT to process text object                  -*
*-            otherwise ignore object                                -*
*-          skip to next object                                      -*
*-            add object length                                      -*
*-            if end of MDB, move to next MDB                        -*
*-                                                                   -*
*---------------------------------------------------------------------*
FNDTXT   DS    0H
         LR    R08,R06            reset R08 to start of MDB
TXTLP    DS    0H
         LR    R07,R08            calc end of mbd in R07
         AH    R07,MDBLEN         start+mdblen in header
         LAE   R06,0(0,R08)       calc prefix address in R06
         SH    R06,=AL2(MDBPLNNO) prefix=start-prefix length
         USING MDBPRFX,R06        get addressability
         L     R06,MDBPNEXT       get forward pointer in R06
         DROP  R06                R06 no longer base for prefix
         LA    R08,MDBHLEN(R08)   bump to 1st object
TOBJLP   DS    0H                 loop through the objects
         LH    R12,MDBTYPE        get type
         C     R12,=A(MDBTOBJ)    check for text object
         BNE   NOTT               not text object
         BAL   R14,GOTMDBT        process text object
NOTT     DS    0H
         AH    R08,MDBLEN         bump to next object
         CR    R08,R07            see if this is the end
         BL    TOBJLP             no, get another object
         LTR   R06,R06            check for more MDBs for message
         BZ    MSGLP              done with message
         LR    R08,R06            next mdb
         B     TXTLP              process the mdb
         DROP  R08
* --- General Object ---
         SYSSTATE ASCENV=AR       let macros know AR mode
GOTMDBG  DS    0H
         BAKR  R14,0              save caller environment
         USING MDBG,R08           addressability to general object
* -DEBUG-
* --- Copy General Information to Message Area ---
*        MVC   MSG#0002+24(4),MDBGDSTP Copy Date Stamp
*        MVC   MSG#0002+29(3),MDBGDSTP+4
*        MVC   MSG#0002+33(8),MDBGTIMH Copy Time Stamp
*        MVC   WK#F,MDBGMID            Copy Messgae-ID to Work Area
* --- Primary Mode ---
*        SAC   0                       Primary Mode
*        SYSSTATE ASCENV=P
* --- Binary Data to Chanacter Convert ---
*        LA    R07,WK#F-REENTA(R04)
*        LA    R09,MSG#0002+45-REENTA(R04)
*        CALL  @HC,((R07),(R09),4)
* --- Show General Messgae ---
*        LA    R01,MSG#0002
*        LA    R02,L'MSG#0002     Write General Object Information
*        BAL   R14,@PUTL#S             Echo Message
* --- AR Mode Set ---
*        SAC   512                     AccessRegister(AR) Mode
*        SYSSTATE ASCENV=AR
* -DEBUG-
         MVC   MDBGJOB(8),MDBGJBNM Copy Job Name
         MVC   MDBGMSG(4),MDBGMID  Copy Message ID
         MVC   MDBGTIM(8),MDBGTIMH Copy Time Stamp
         MVC   MDBGDAT(7),MDBGDSTP Copy Date Stamp
         MVC   MDBGOSN(8),MDBGOSNM Copy OS Name
         OI    MDBFLGS,MDBFGO     set processed general object
         PR
         DROP  R08
*---------------------------------------------------------------------*
*-                                                                   -*
*- GOTMDBC:  BRANCH ENTERED, ASCMODE=AR,R08=ADDR(control prog object)-*
*- Function: process MDB control program object                      -*
*- Operation:                                                        -*
*-     establish addressability to the control program object        -*
*-     if this is an MVS object                                      -*
*-        set flag indicating control prog object found for the msg  -*
*-        save message text offset for text processing               -*
*-        if this is a command response message                      -*
*-           save the CART                                           -*
*-           indicate that the text echo should be command response  -*
*-                                                                   -*
*---------------------------------------------------------------------*
         SYSSTATE ASCENV=AR       let macros know AR mode
GOTMDBC  DS     0H
         BAKR    R14,0              save caller environment
         USING MDBSCP,R08         addressability to control prog object
         CLC   MDBCPNAM,=C'MVS '  make sure it is an MVS object
         BNE   GOTC1              if not, just skip it
         OI    MDBFLGS,MDBFCO     set processed control prog object
         LH    R01,MDBCTOFF       get text offset
         ST    R01,TOFF           save it for text processing
*
* --- Binary Data to Chanacter Convert ---
* --- Primary Mode ---
*        MVC   WKCERC,MDBCERC
*        MVC   WKCDESC,MDBCDESC
* -DEBUG-
*        SAC   0                       Primary Mode
*        SYSSTATE ASCENV=P
*        LA    R07,WKCERC-REENTA(R04)
*        LA    R09,MSG#0007+18-REENTA(R04)
*        CALL  @HC,((R07),(R09),16)
*        LA    R07,WKCDESC-REENTA(R04)
*        LA    R09,MSG#0007+61-REENTA(R04)
*        CALL  @HC,((R07),(R09),2)
*        LA    R01,MSG#0007
*        LA    R02,L'MSG#0007
*        BAL   R14,@PUTL#S             Echo Message
*        SAC   512                     AccessRegister(AR) Mode
*        SYSSTATE ASCENV=AR
* -DEBUG-
* --- Binary Data to Chanacter Convert ---
* --- Reply-ID Get ---
*        TM    MDBMLVL1,MDBMLR
*        BO    GOTCRPLY
         LH    R01,MDBCRPYL
         LTR   R01,R01
         BZ    GOTCRPLY
         MVC   REPLYL,MDBCRPYL    Length of Reply Number
         MVC   REPLYN,MDBCRPYI   Reply Number
         B     GOTCRX
GOTCRPLY EQU   *
         XC    REPLYL,REPLYL      If Not Reply Message. Clear Length
GOTCRX   EQU   *
         TM    MDBCATT1,MDBCMCSC  check if command response
         BZ    GOTC1              not command response
         MVC   MCART,MDBCCART     hold onto cart
         MVI   CMDRSP,1           issue any WTOs as cmd response
GOTC1    DS    0H
         PR
         DROP  R08
*---------------------------------------------------------------------*
*-                                                                   -*
*- GOTMDBT:  BRANCH ENTERED, ASCMODE=AR, R08=ADDR(text object)       -*
*- Function: process MDB text objects                                -*
*- Operation:                                                        -*
*-     establish addressability to the text object                   -*
*-     calculate the length of the text                              -*
*-     move it to a buffer                                           -*
*-     set the length                                                -*
*-     issue text as a single line WTO                               -*
*-                                                                   -*
*---------------------------------------------------------------------*
         SYSSTATE ASCENV=AR       let macros know AR mode
GOTMDBT  DS    0H
         BAKR  R14,0              save caller environment
         USING MDBT,R08           addressability to text object
*
         LAE   R02,MDBTMSGT       get address of text
         A     R02,TOFF           bump past prefix info
         CLC   WTOID,0(R02)       see if this message is my echo
         BE    GOTTX              don't redisplay my text echo
         LH    R01,COM_WLEN
         LTR   R01,R01
         BZ    MDBTWAI2
         STC   R01,*+5
         CLC   COM_WAIT,0(R02)    see if this message is my echo
         BNE   MDBTWAIT           don't redisplay my text echo
*
* -DEBUG-
*        STC   R01,*+5
*        MVC   MSG#0005+17(0),COM_WAIT
*        LA    R01,MSG#0005            Get Buffer Text
*        LA    R02,L'MSG#0005
*        BAL   R14,@PUTL#S             Echo Message
* -DEBUG-
         OI    MSGWAITF,X'80'
         B     MDBTWAIT           don't redisplay my text echo
MDBTWAI2 EQU   *
*?*      SAC   0                       Primary Mode
*?*      SYSSTATE ASCENV=P
*?*      WTO   'STOR-MGR: NO RESPONSE WAIT ...'
*?*      SAC   512                     AccessRegister(AR) Mode
*?*      SYSSTATE ASCENV=AR            AR Mode
         OI    MSGWAITF,X'80'
         B     MDBTWAIT           don't redisplay my text echo
MDBTWAIT EQU   *
*
         LA    R15,WTOTXT
         TM    COM_FORM,X'80'
         BNO   GOTT00
         CLC   MDBGJOB(8),=CL8' '
*        BE    GOTT01
         MVC   0(8,R15),MDBGJOB
*        B     GOTT02
GOTT01   EQU   *
*        MVC   0(4,R15),=CL4' '
*        MVC   4(4,R15),MDBGMSG
*        B     GOTT02
GOTT02   EQU   *
         MVI   8(R15),C' '
         LA    R15,9(R15)
GOTT00   EQU   *
* --- Reply-ID Copy ---
         LH    R01,REPLYL
         LTR   R01,R01
         BZ    GOTT10
         MVI   0(R15),C'*'
         LA    R15,1(R15)
         STC   R01,*+5
         MVC   0(0,R15),REPLYN
         LA    R15,0(R01,R15)
         MVI   0(R15),C' '
         LA    R15,1(R15)
GOTT10   EQU   *
         LH    R01,MDBTLEN        get text object length
         S     R01,=A(MDBTMSGT-MDBTLEN) subtract non-text size
         S     R01,TOFF           take off offset to text
         LA    R14,WTOTXT_E
         LA    R02,L'WTOTXT(R15)
         SR    R02,R14
         LR    R14,R02
         LA    R02,0(R01,R02)
         C     R02,=A(L'WTOTXT)   make sure its not too long for buf
         BNH   GOTT1              ok
*        L     R01,=A(L'WTOTXT)   not ok, truncate at buf length
         LA    R01,WTOTXT_E
         SR    R01,R15
GOTT1    DS    0H
         BCTR  R01,0              set up for MVC
         LAE   R02,MDBTMSGT       get address of text
         A     R02,TOFF           bump past prefix info
         CLC   WTOID,0(R02)       see if this message is my echo
         BE    GOTTX              don't redisplay my text echo
GOTT2    DS    0H
         EX    R01,GOTTMVC        move text to buffer
         A     R01,=A(L'WTOID+1)  calc length for wto
         LA    R02,0(R01,R14)
*        LR    R02,R01
         LA    R01,WTOID
         BAL   R14,@PUTL#S             Echo Message
GOTTX    DS    0H
         PR
GOTTMVC  DS    0H
         MVC   0(0,R15),0(R02)
         DROP  R08
         PR                            Program Return
*--------------------------------------------------
* --- PUTLINE servise routine ( single line ) ---------------------
@PUTL#S  EQU   *
         BAKR  R14,0              save caller environment
         SAC   0                  run in primary mode
         SYSSTATE ASCENV=P        tell macros primary mode
*
         L     R06,COM_CPPL                Load CPPL Address
         USING CPPL,R06                    CPPL Base Reg. R06
*
         STC   R02,*+5
         MVC   PUTL#S_(0),0(R01)           copy message area
         LA    R02,4(R02)                  length + 4
         STH   R02,PUTL#SL                  store length
         XC    #ECB,#ECB                   clear ECB area
         XC    #IOPL(16),#IOPL             clear IOPL area
         L     R09,CPPLUPT
         L     R10,CPPLECT
         PUTLINE PARM=PUTBLOK,UPT=(09),ECT=(10),ECB=#ECB,              *
               OUTPUT=(PUTL#S,TERM,SINGLE,DATA),MF=(E,#IOPL)
         PR                       return to caller
         DROP  R06
MCSATTN  DS    0D
         SAVE  (14,12),T,*
         LR    R03,R15
         USING MCSATTN,R03                 BASE REG. R03
         ST    R13,SA3+4                    SAVE A(OLD SAVEAREA)
         LR    R12,R13
         LA    R13,SA3
         ST    R13,8(R12)                  SAVE A(NEW SAVEAREA)
*
         ICM   R05,15,8(R01)
         USING MCSCOMM,R05             Set Communication DSECT
*
*+       TPUT  MSG#ATTN,L'MSG#ATTN
*
*+       TM    COM_FLAG,X'40'
*+       BNO   ATTNSKP1
         OI    COM_FLAG,X'80'
ATTNSKP1 EQU   *
         L     R13,SA3+4                RETURN
         RETURN (14,12),RC=0
SA3      DS    18F                               SAVEAREA
*SG#ATTN DC    CL80'>>> ATTENTION ! <<<'
* --- ECB ---------------------------------------------------------
#ECB     DS    F
* --- IOPL --------------------------------------------------------
#IOPL    DS    4F
* --- PUTLINE ( mapping macro ) -----------------------------------
PUTBLOK  PUTLINE MF=L
* --- PUTLINE ( single line put ) ---------------------------------
PUTL#S   DS    0D
PUTL#SL  DS    H
         DC    H'0'
PUTL#S_  DS    CL80
         DS    CL100
*--------------------------------------------------
*
LMGCRE   MGCRE MF=L
*        DROP  R04
         LTORG
*
* --- DYNAMIC AREA ---
@EVTBL   DS    F                   Command Response Table Entery
WMAXFLG  DS    XL4                 STIMER ID
WAITMAX  DS    XL4                 Time Out Wait Time
WMAXID   DS    XL4                 STIMER ID
SAVEAREA DS    18F                       Registor Save Area
STAXLIST STAX  MCSATTN,MF=L
MCSECB   DS    F
*                  HHMMSSTT
WAITXX   DC    CL8'00000100'             Delay 2Sec
WAITID   DS    XL4
WAITTU   DS    XL4
REENTA   DS    0F
*                   0....+....1....+....2....+....3....+....4....+...
ERRMSG01 DC    CL80'@TC: ######## @@@@@@@@ ERROR RC:@@@@@@@@ RSN:@@@@@@*
               @@ R15:@@@@@@@@'
*SG#0002 DC    CL80'@TC: MDBG INFORMATION : @@@@.@@@-@@@@@@@@ ID:@@@@@'
*                   0....+....1....+....2....+....3....+....4....+...
MSG#0003 DC    CL80'> @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@*
               @@@@@@'
*                   0....+....1....+....2....+....3....+....4....+...
*SG#0004 DC    CL80'@TC: -- Command Entry From Extended MCS Console --'
*SG#0005 DC    CL80'@TC: MESSAGE ID :'
*                   0....+....1....+....2....+....3....+....4....+....5*
               ....+....6....+....7....+....8
*SG#0007 DC    CL80'@TC: ROUTE CODE : @@@@@@@@ @@@@@@@@ @@@@@@@ @@@@@@ *
               @  DESC : @@@@'
*SG#0014 DC    CL80'@TC: MAXIMAM WAIT TIME : @@@@@@@@ (1/100SEC)'
MSG#0015 DC    CL80'@TC:'
         DS    100C
MSG#0016 DC    CL80'# Command Response Timeout ...'
*SG#0017 DC    CL80'@TC: End of Message Wait Loop ...'
*SG#0018 DC    CL80'@TC: Command Response Wait Loop Continue ...'
*SG#0019 DC    CL80'@TC: Wait Start ..'
*SG#0020 DC    CL80'@TC: Wait End ..'
*SG#0021 DC    CL80'@TC: Wait Got ..'
         DS    0F
ATTNOUTB DC    CL79'>>> ATTENTION ! <<<'
         DS    0F
ATTNINB  DC    CL140'0'
WK#F     DS    F                         Work Space ( 4 Byte )
WK#H     DS    H                         Work Space ( 2 Byte )
CMDFLG   DS    BL1'00000000'
*                  8         : Command Get
*                   4        : Reply Get
*                    2       : End of File
*                     o
*                      o
*
         DS    0F
TEXTAREA DS    0XL82
         DC    H'80'
CMDBUF   DS    CL80
*
CONSNM   DS    CL08                      MCS Console Name
CONSID   DS    A                         MCS Console ID
MCART    DS    CL08
*CSECB   DS    F
MCSA     DS    F
MCSCSAA  DS    F
RC       DS    F
RSN      DS    F
WKF      DS    F
*
MDBFLGS  DC    FL1'0'
MDBFGO   EQU   X'01'              processed general object
MDBFCO   EQU   X'02'              processed control prog object
CMDRSP   DC    FL1'0'
TOFF     DS    F                  offset to message in text object
WTOBUF   DS    FL2                length for dynamic messages
WTOID    DC    CL02'< '           messge id for echoed messages
WTOTXT   DS    CL118              message text
WTOTXT_E EQU   *
MYOPER   DS    F                  console id from last modify command
         DS    0F
MSGWAITF DS    XL1
MDBGJOB  DS    CL8
MDBGMSG  DS    CL4
MDBGTIM  DS    CL8
MDBGDAT  DS    CL7
MDBGOSN  DS    CL8
         DS    0F
*                   0....+....1....+....2....+....3....+....4....+...
MSGPARM  DS    0F
MSGLEN   DC    AL2(0)
MSG      DC    CL80' '
@MCSOP   DS    CL60
*KCERC   DS    XL16
*KCDESC  DS    XL2
REPLYL   DS    H
REPLYN   DS    CL8
REENTAX  EQU   *
REENTAL  EQU   *-REENTA                  Re-Entrant Area Length
         DS    0D
         EJECT
         IEAVG132 ,                mdb prefix
         EJECT
         IEAVM105 ,                mdb
         EJECT
         IEAVG131 ,                console status area
         EJECT
         IEZVG111 ,                operparm parameter area
         EJECT
COM      DSECT
         IEZCOM   ,                COM area
         EJECT
CIB      DSECT
         IEZCIB   ,                CIB and CIBX
* --- CVT ---------------------------------------------------------
CVT      DSECT
         CVT    DSECT=YES,LIST=YES
* --- JESCT -------------------------------------------------------
*        IEFJESCT
* --- DSAB --------------------------------------------------------
*        IHADSAB
* --- UCB ---------------------------------------------------------
*        PRINT GEN
*        DSECT
*        IEFUCBOB LIST=YES
* --- CPPL ( command processor parameter list ) -------------------
         IKJCPPL
L_CPPL   EQU   *-CPPL
* --- PPL ( parse parameter list ) --------------------------------
         IKJPPL
L_PPL    EQU   *-PPL
* --- IKJIOPL ( input / output parameter list ) -------------------
         IKJIOPL
L_IOPL   EQU   *-IOPL
R00      EQU   00
R01      EQU   01
R02      EQU   02
R03      EQU   03
R04      EQU   04
R05      EQU   05
R06      EQU   06
R07      EQU   07
R08      EQU   08
R09      EQU   09
R10      EQU   10
R11      EQU   11
R12      EQU   12
R13      EQU   13
R14      EQU   14
R15      EQU   15
*        --- 31 Bit Addressing Mode ---
@HC      AMODE ANY
@HC      RMODE 24
@HC      CSECT
         SAVE  (14,12),T,*
         BALR  R03,0
         USING *,R03                       Base Reg. R03
         ST    R13,@HC#SA+4                Save A(OLD SaveArea)
         LR    R12,R13
         LA    R13,@HC#SA
         ST    R13,8(R12)                  Save A(NEW SaveArea)
* --- from characher ---
         L     R07,0(R01)
* --- to character ---
         L     R08,4(R01)
* --- convert length ---
         L     R09,8(R01)
*
         BAL   R14,@CO_HEX                     CALL CONVERT HEX-CHAR
         L     R13,@HC#SA+4
         RETURN (14,12),RC=0
@CO_HEX  EQU   *                               CONVERT HEX-CHARACTER
         LA    R15,5
@CO_HC   EQU   *
         LTR   R09,R09
         BZ    @CO_EXIT
         BCT   R15,@CO_SKIP
*
         MVI   0(R08),X'40'
         LA    R08,1(R08)
         LA    R15,4
@CO_SKIP EQU   *
         SR    R01,R01
         IC    R01,0(R07)
         SRL   R01,4
         A     R01,A_TR
         ICM   R02,B'0010',0(R01)
         IC    R01,0(R07)
         N     R01,=F'15'
         A     R01,A_TR
         ICM   R02,B'0001',0(R01)
         STCM  R02,B'0011',0(R08)
         LA    R07,1(R07)
         LA    R08,2(R08)
         BCTR  R09,0
         B     @CO_HC
@CO_EXIT EQU   *
         BR    R14
*
@HC#SA   DS    18F                               WORK SAVEAREA
TR       DC    C'0123456789ABCDEF'               CHAR TRUNC TABLE
A_TR     DC    A(TR)
         LTORG
* ----------------------------------------------------------------
MCSCOMM  DSECT
COM_CONN DS    CL8'STORMGR'
COM_CMD  DS    CL80'D M=STOR'
COM_WTME DS    H'10'
COM_WLEN DS    H'8'
COM_WAIT DS    CL80'IEE712I'
COM_TLEN DS    H'8'
COM_TOUT DS    CL80'STORMGR TIME OUT'
COM_FORM DS    BL1
*                '.... ....'
*                 *          : J > Job Name
* --- CPPL pointer save area --------------------------------------
COM_CPPL DS    F
* Result of SOTRMCS
COM_FLAG DS    XL1
*    .... ....
*    ~          ATTN flag 0:none, 1:attn
*     ~         MCS Activate 0:de-activate, 1:activate
         DS    XL3
COM_MAC  DS    CL8
COM_ACT  DS    CL8
COM_RC   DS    F
COM_RSN  DS    F
MCSCOMML EQU   *-MCSCOMM
         END   @CMD
/*
//SYSLIB   DD  DSN=SYS1.MACLIB,DISP=SHR
//         DD  DSN=SYS1.AMODGEN,DISP=SHR
//         DD  DSN=SYS1.MODGEN,DISP=SHR
//SYSUT1   DD  UNIT=(SYSDA,SEP=SYSLIB),SPACE=(CYL,(10,5)),DSN=&SYSUT1
//SYSPUNCH DD  DUMMY
//SYSPRINT DD  SYSOUT=*,DCB=(BLKSIZE=3509),
//         UNIT=(,SEP=(SYSUT1,SYSPUNCH))
//SYSLIN   DD  DISP=(,PASS),UNIT=SYSDA,SPACE=(CYL,(5,5,0)),
//         DCB=(BLKSIZE=400),DSN=&&LOADSET
//L       EXEC PGM=IEWL,PARM='MAP,LET,LIST,AC=1,AMODE=31,RMODE=24',
//         REGION=1M,COND=(8,LT,A)
//SYSLIB   DD  DSN=your.objlib,DISP=SHR
//*        DD  DSN=SYS1.LINKLIB,DISP=SHR
//SYSLIN   DD  DSN=&&LOADSET,DISP=(OLD,DELETE)
//         DD  DDNAME=SYSIN
//SYSLMOD  DD  DSN=your.loadlib(@CMD),DISP=SHR,
//         UNIT=DASD,VOL=SER=VOLSER
//*YSLMOD  DD  DISP=(,PASS),UNIT=SYSDA,
//*        SPACE=(CYL,(2,1,2)),DSN=&GOSET(GO)
//SYSUT1   DD  UNIT=SYSDA,SPACE=(CYL,(3,2)),DSN=&SYSUT1
//SYSPRINT DD  SYSOUT=*,DCB=(RECFM=FB,BLKSIZE=3509)
//OBJ      DD  DISP=SHR,UNIT=SYSDA,
//         DSN=your.objlib
//SYSIN    DD  *
//G       EXEC PGM=IKJEFT01,COND=((9,LT,A),(9,LT,L))
//STEPLIB  DD DSN=your.loadlib,DISP=SHR,
//         UNIT=DASD,VOL=SER=VOLSER
//SYSTSPRT DD SYSOUT=*
//SYSTSIN  DD *
 @CMD '$DN,ALL' T(10) M(IEE974I) MFORM(J)   CN(BATCH)
/*
//
 @CMD '$DN,ALL' T(10) M(IEE974I) MFORM(J)
 @CMD 'D SMF' T(10) M(IEE974I) CN(CMDTEST)
*      -----                                MVS Command
*               --                          Timeout Sec
*                     -------               Wait Message
*                                 -------   Console Name
 @CMD 'S DEALLOC' T(10) M(IEE974I)
