04.4 MCS仮想コンソール機能 – 「メインフレーム・コンピューター」で遊ぼう

コンソールをプログラムでハンドリングしたいという要望は古くからありました。SDSFのような対話型の操作ツールに乏しかった当時、コンソールはOSを操作する上で最も基本となるデバイスでした。専門のオペレーターをコンソールに配し、ジョブのSTART/ENDを手作業で起動しながら処理したり、システムの運用状態を示すメッセージを目で追いながら適切なOSコマンドなどで対処するといった運用が行われていた時代から、人に依存するオペレーションを自動化するために多くのユーザーがコンソールに出力されるメッセージをプログラムで検知したり、コマンドの実行結果を取り込んだりといったことを考えてきました。
元々はそのためのプログラムをユーザー自身が作っていましたが、やがては自動運用ソフトウェアに代表されるメーカーやベンダーのプログラム製品に取って代わられました。今日でも、ユーザー固有の自動化処理やモニタリングのためにプログラムによるコンソールへのアクセスは必要とされています。

昔のMVSでは、OSのコンソール・バッファーは共通域に展開されていたのでプログラムで簡単に読み込むことができました。MVS/XAからコンソール・バッファーはコンソール空間へ移ってしまい簡単には見られなくなり、代替としてOSのWTO出口ルーチン（例えばIEECVXIT、現在ならIEAVMXIT）によってメッセージをロギングしたりする方法も使われました。その他、サブシステム・インタフェースによってWTOやWTLをトラップする方法も使われました。出口ルーチンやサブシステムを使えば、新しいメッセージが出たかをOSが教えてくれるので、タイマーなどでバッファーを定期的に見る必要がありません。
しかしながら、今となってはこれらも古典的な方法であって、現在のz/OS（MVS）は、コンソールをアクセスするためのAPI、MCSOPERとMCSOPMSGを提供しています。これらのAPIは、コンソール・システムがMCSコンソールとして実装されたMVS/ESAから利用できるようになりました。出口ルーチンやSSIを使う方法では、プログラムは全てのアドレス空間で動くため、誤りが起きると他の空間をABENDさせてしまうことにもなりますが、APIなら誤りが起きても影響を局所化することにも繋がり安全性の面でも有利です。とは言っても、今日ではメーカーやベンダーのソフトウェア製品経由でのコンソール・アクセスがほとんどでしょう。

拡張MCSコンソール

拡張MCSコンソールは、コンソールとしての役割を果たすプログラムです。このプログラムでは、コンソールに出力されるメッセージを受け取ったり、OSやJESコマンドを発行してその応答を受け取ることができます。代表的なものとして、SDSFのULOGパネルの機能があります。

拡張MCSコンソールの実現には、MCSOPERおよびMCSOPMSGマクロを使用します。コマンドの発行には、MGCREマクロを使用します。いずれもスーパーバイザー・モードが要求されるため、APF許可プログラムでなければなりません。また、通知されるコンソール・メッセージはデータ空間にキューイングされるため、AR（アクセス・レジスター）モードによるプログラミングが必須です。

オペレーター・コマンドを発行して、その実行結果を得る

----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
         MODESET MODE=SUP               SET US TO SUPERVISOR MODE
         SPACE ,
*                                  *----------------------------------*
*                                  *  ACTIVATE MCS CONSOLE            *
*                                  *----------------------------------*
OPENCONS DS    0H
         LA    R1,DMCSOPP               BUILD OPERPARM DEFAULTS
         USING MCSOPPRM,R1              MAP IT
         XC    0(MCSOPLEN,R1),0(R1)     CLEAR OPERPARM PARM LIST
         MVC   MCSOKEY,CONSKEY          SET MCS CONSOLE KEY
         OI    MCSOAUTH,MCSOMSTR        INDICATES MASTER AUTHORITY
         DROP  R1                       FORGET OPERPARM FIELD
         MCSOPER REQUEST=ACTIVATE,      ACTIVATE MCS CONSOLE           +
               OPERPARM=DMCSOPP,         OPER PARAMETER FIELD          +
               NAME=CONSNAME,            CONSOLE NAME                  +
               TERMNAME=CONSTERM,        CONSOLE TERMINAL              +
               CONSID=DMCONSID,          CONSOLE ID                    +
               MCSCSA=DMCSCSA,           CONSOLE CSA                   +
               MCSCSAA=DMCSCSAA,         CONSOLE CSA-ALET              +
               MSGECB=DMCSECB,           CONSOLE ECB                   +
               MSGDLVRY=SEARCH
         STM   RF,R0,DMCSRTCD           SAVE MCS LAST RETCD/REASON
         SPACE ,
*                                  *----------------------------------*
*                                  *  ISSUE OPERATOR COMMAND          *
*                                  *----------------------------------*
ISSUECMD DS    0H
         MVI   DMCSECB,0                CLEAR MSG RECEIVING ECB
         SPKA  0                        CHANGE PSWKEY=0
         LA    RF,XCMDAREA              LOAD COMMAND TEXT AREA ADDRESS
         MGCRE TEXT=(15),               ISSUE JES2 COMMAND             +
               CONSID=DMCONSID,                                        +
               CART=XCMDCART,                                          +
               MF=(E,MGCRELST)
         ST    RF,RCMGCRE               SAVE RETCD FOR DIAGNOSIS
         SPKA  X'80'                    BACK TO SAFE KEY
         SPACE ,
*                                  *----------------------------------*
*                                  *  WAIT CONSOLE RESPONSE           *
*                                  *----------------------------------*
         SLR   R1,R1                    GR1 --> 0
         SAR   AR0,R1                   CLEAR ALL ACCESS REGISTERS
         SAR   AR1,R1                    I
         SAR   AR2,R1                    I
         SAR   AR3,R1                    I
         SAR   AR4,R1                    I
         SAR   AR5,R1                    I
         SAR   AR6,R1                    I
         SAR   AR7,R1                    I
         SAR   AR8,R1                    I
         SAR   AR9,R1                    I
         SAR   ARA,R1                    I
         SAR   ARB,R1                    I
         SAR   ARC,R1                    I
         SAR   ARD,R1                    I
         SAR   ARE,R1                    I
         SAR   ARF,R1                    V
         SYSSTATE ASCENV=AR             LET MVS MACROS KNOW
         L     R2,=A(CMDREPLY)          CMD REPLY MSGS STORE AREA
         SPACE ,
WAITCONS DS    0H
         WAIT  ECB=DMCSECB              WAIT CONSOLE MESSAGES          +
                                            (JES2 COMMAND RESPONSE MSG)+
                                            (EG. $HASP686)
         SAC   512                      CHANGE US TO AR-MODE
GETNXMDB DS    0H
         MCSOPMSG REQUEST=GETMSG,       GET MDB FROM OUR MCS CONSOLE   +
               CONSID=DMCONSID,         (GR1 CONTAIN MDB AT RETURN)    +
               CMDRESP=YES,                                            +
               CART=XCMDCART
         STM   RF,R0,DMCSRTCD           SAVE MCS LAST RETCD/REASON
         LTR   RF,RF                    MCSOPMSG IS SUCCESSFUL ?
         BNZ   CLOSCONS                 NO, IT MAY BE END OF MESSAGES
         SPACE ,
         ST    R1,DMCSMDB               SAVE CURRENT MDB POINTER
         STAM  R1,R1,DMCSMDB+4          SAVE MCS DATA SPACE ALET
         LAE   R3,0(0,R1)               PUT MDB ADDRESS IN R3 AND AR3
         USING MDB,R3                   ADDRESSABILITY TO THE MDB
         SLR   R1,R1                    CLEAR GR1
         SAR   AR1,R1                   CLEAR AR1
         SPACE ,
*                                  *----------------------------------*
*                                  *  GET CONSOLE MESSAGES FROM MDB   *
*                                  *----------------------------------*
NEXTMDB  DS    0H
         LA    R4,MDB+MDBHLEN           LOCATE TO MDBG(GENERAL OBJECT)
         CPYA  AR4,AR3                  SET ALET TO AR4
         AH    R4,MDBGLEN-MDBG(,R4)     SKIP MDBG
         CLC   MDBCTYPE-MDBSCP(L'MDBCTYPE,R4),=AL2(MDBCOBJ)  HERE IS   +
                                                       CONTROL OBJECT ?
         BNE   *+4+4                    NO, ITS MDBT
         AH    R4,MDBCLEN-MDBSCP(,R4)   LOCATE TO 1ST MDBT(TEXT OBJECT)
         USING MDBT,R4                  ADDRESS TO MDBT
         LH    RF,MDBTLEN               GET MDBT LENGTH
         LTR   RF,RF                    INCLUDED ANY MSG TEXT ?
         BZ    TSTNXMDB                 NO, TEST NEXT MDB
GETMTXT  DS    0H
         LH    RF,MDBTLEN               GET MDBT LENGTH
         SH    RF,=Y(MDBTMBOB)          GET MSGTEXT LENGTH
         BCTR  RF,0                     FOR EX OPERATION
         EX    RF,*+4+4                 MOVE MSGTEXT TO MSG BUFFER
         B     *+4+6                    (SKIP MODEL INSTRUCTION)
         MVC   0(0,R2),MDBTMSGT         (MODEL INSTRUCTION)
         LA    RF,1(,RF)                RESTORE ORIGIN LENGTH
         LA    R2,128(,R2)              UPDATE OUR BUFFER POINTER
         SPACE ,
         AH    R4,MDBTLEN               LOCATE TO NEXT MDBT
         LH    RF,MDBLEN                LOAD MDB TOTAL LENGTH
         LA    RF,MDB(RF)               LOAD END OF MDB ADDRESS
         CLR   R4,RF                    EXIST NEXT MDBT ?
         BL    GETMTXT                  YES, GET NEXT CONSOLE MSG
         SPACE ,
TSTNXMDB DS    0H
         SH    R3,=Y(MDBPLNNO)          LOCATE TO MDB PREFIX
         ICM   R3,15,MDBPNEXT-MDBPRFX(R3)  GET NEXT MDB BLOCK
         BZ    GETNXMDB                    NO, DONE
         B     NEXTMDB                  YES, CONTINUE..
         DROP  R3,R4                    FORGET MDBS FOR WORK
         SYSSTATE ASCENV=P              LET MVS MACROS KNOW
         SPACE ,
*                                  *----------------------------------*
*                                  *  DEACTIVATE MCS CONSOLE          *
*                                  *----------------------------------*
CLOSCONS DS    0H
         SAC   0                        BACK TO PRIMARY-MODE
         MCSOPER REQUEST=DEACTIVATE,    DEACTIVATE MCS CONSOLE         +
               CONSID=DMCONSID          CONSOLE ID
         STM   RF,R0,DMCSRTCD           SAVE MCS LAST RETCD/REASON
         SPACE ,
*                                  *----------------------------------*
*                                  *  HANDLE COMMAND REPLY MESSAGES   *
*                                  *----------------------------------*
         L     R1,=A(CMDREPLY)          LOAD OUR MESSAGE BUFFER
         ：
         ：
         ：
         ：
         ：
*                                  *----------------------------------*
*                                  *  COMMAND TOKEN AND MODEL         *
*                                  *----------------------------------*
CONSKEY  DC    CL8'MYCONS'              MCS CONSOLE KEY
XCMDCART DC    CL8'@J2CRSP@'            MCS CMD/RESP CART
         SPACE ,
*                                  *----------------------------------*
*                                  *  MGCRE PLIST                     *
*                                  *----------------------------------*
RCMGCRE  DC    F'0'                     MGCRE RETCD
XCMDAREA DS    0H
         DC    AL2(LCMDAREA-2)          COMMAND TEXT LENGTH
         DC    CL80'$TOJ72,Q=P,OUTDISP=WRITE'  COMMAND TEXT
LCMDAREA EQU   *-XCMDAREA               (LENGTH OF COMMAND TEXT AREA)
MGCRELST MGCRE MF=L                     MGCRE PLIST
LGCRELST EQU   *-MGCRELST               (LENGTH OF PLIST)
         SPACE ,
*                                  *----------------------------------*
*                                  *  MCS CONSOLE MACRO PLIST         *
*                                  *----------------------------------*
DMCONSID DC    F'0'                     MCS CONSOLE ID
DMCSCSA  DC    A(0)                     MCS CSA
DMCSCSAA DC    A(0)                     MCS CSA(ALET)
DMCSECB  DC    F'0'                     MCS CONSOLE ECB
DMCSMDB  DC    2A(0)                    MCS CURRENT MDB POINTER/ALET
DMCSRTCD DC    2F'0'                    MCS RETCD/REASON
CONSNAME DC    CL8'MYCONS01'            MCS CONSOLE NAME
CONSTERM DC    CL8'MYCONS01'            MCS CONSOLE TERMINAL
         DS    0D
DMCSOPP  DC    XL(MCSOPLEN)'00'         MCS OPERPARM FIELD
         SPACE ,
***********************************************************************
         LTORG ,                        USER LITERAL PLACE AT HERE
*---------------------------------------------------------------------*
         DS    0F
CMDREPLY DC    4096X'00'     通知されたメッセージはこの領域に128バイト
         ：                  ずつに区切って格納される。
         ：
         ：
         ：
*---------------------------------------------------------------------*
         PRINT GEN
         IEAVG132 ,                     MDB PREFIX
         IEAVM105 ,                     MDB
         IEAVG131 ,                     MCS CONSOLE STATUS AREA
         IEZVG111 ,                     OPERPARM PARAMETER AREA
         ：

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

----+----1----+----2----+----3----+----4----+----5----+----6----+----7--

MODESET MODE=SUP SET US TO SUPERVISOR MODE

SPACE ,

* *----------------------------------*

* * ACTIVATE MCS CONSOLE *

* *----------------------------------*

OPENCONS DS 0H

LA R1,DMCSOPP BUILD OPERPARM DEFAULTS

USING MCSOPPRM,R1 MAP IT

XC 0(MCSOPLEN,R1),0(R1) CLEAR OPERPARM PARM LIST

MVC MCSOKEY,CONSKEY SET MCS CONSOLE KEY

OI MCSOAUTH,MCSOMSTR INDICATES MASTER AUTHORITY

DROP R1 FORGET OPERPARM FIELD

MCSOPER REQUEST=ACTIVATE, ACTIVATE MCS CONSOLE +

OPERPARM=DMCSOPP, OPER PARAMETER FIELD +

NAME=CONSNAME, CONSOLE NAME +

TERMNAME=CONSTERM, CONSOLE TERMINAL +

CONSID=DMCONSID, CONSOLE ID +

MCSCSA=DMCSCSA, CONSOLE CSA +

MCSCSAA=DMCSCSAA, CONSOLE CSA-ALET +

MSGECB=DMCSECB, CONSOLE ECB +

MSGDLVRY=SEARCH

STM RF,R0,DMCSRTCD SAVE MCS LAST RETCD/REASON

SPACE ,

* *----------------------------------*

* * ISSUE OPERATOR COMMAND *

* *----------------------------------*

ISSUECMD DS 0H

MVI DMCSECB,0 CLEAR MSG RECEIVING ECB

SPKA 0 CHANGE PSWKEY=0

LA RF,XCMDAREA LOAD COMMAND TEXT AREA ADDRESS

MGCRE TEXT=(15), ISSUE JES2 COMMAND +

CONSID=DMCONSID, +

CART=XCMDCART, +

MF=(E,MGCRELST)

ST RF,RCMGCRE SAVE RETCD FOR DIAGNOSIS

SPKA X'80' BACK TO SAFE KEY

SPACE ,

* *----------------------------------*

* * WAIT CONSOLE RESPONSE *

* *----------------------------------*

SLR R1,R1 GR1 --> 0

SAR AR0,R1 CLEAR ALL ACCESS REGISTERS

SAR AR1,R1 I

SAR AR2,R1 I

SAR AR3,R1 I

SAR AR4,R1 I

SAR AR5,R1 I

SAR AR6,R1 I

SAR AR7,R1 I

SAR AR8,R1 I

SAR AR9,R1 I

SAR ARA,R1 I

SAR ARB,R1 I

SAR ARC,R1 I

SAR ARD,R1 I

SAR ARE,R1 I

SAR ARF,R1 V

SYSSTATE ASCENV=AR LET MVS MACROS KNOW

L R2,=A(CMDREPLY) CMD REPLY MSGS STORE AREA

SPACE ,

WAITCONS DS 0H

WAIT ECB=DMCSECB WAIT CONSOLE MESSAGES +

(JES2 COMMAND RESPONSE MSG)+

(EG. $HASP686)

SAC 512 CHANGE US TO AR-MODE

GETNXMDB DS 0H

MCSOPMSG REQUEST=GETMSG, GET MDB FROM OUR MCS CONSOLE +

CONSID=DMCONSID, (GR1 CONTAIN MDB AT RETURN) +

CMDRESP=YES, +

CART=XCMDCART

STM RF,R0,DMCSRTCD SAVE MCS LAST RETCD/REASON

LTR RF,RF MCSOPMSG IS SUCCESSFUL ?

BNZ CLOSCONS NO, IT MAY BE END OF MESSAGES

SPACE ,

ST R1,DMCSMDB SAVE CURRENT MDB POINTER

STAM R1,R1,DMCSMDB+4 SAVE MCS DATA SPACE ALET

LAE R3,0(0,R1) PUT MDB ADDRESS IN R3 AND AR3

USING MDB,R3 ADDRESSABILITY TO THE MDB

SLR R1,R1 CLEAR GR1

SAR AR1,R1 CLEAR AR1

SPACE ,

* *----------------------------------*

* * GET CONSOLE MESSAGES FROM MDB *

* *----------------------------------*

NEXTMDB DS 0H

LA R4,MDB+MDBHLEN LOCATE TO MDBG(GENERAL OBJECT)

CPYA AR4,AR3 SET ALET TO AR4

AH R4,MDBGLEN-MDBG(,R4) SKIP MDBG

CLC MDBCTYPE-MDBSCP(L'MDBCTYPE,R4),=AL2(MDBCOBJ) HERE IS +

CONTROL OBJECT ?

BNE *+4+4 NO, ITS MDBT

AH R4,MDBCLEN-MDBSCP(,R4) LOCATE TO 1ST MDBT(TEXT OBJECT)

USING MDBT,R4 ADDRESS TO MDBT

LH RF,MDBTLEN GET MDBT LENGTH

LTR RF,RF INCLUDED ANY MSG TEXT ?

BZ TSTNXMDB NO, TEST NEXT MDB

GETMTXT DS 0H

LH RF,MDBTLEN GET MDBT LENGTH

SH RF,=Y(MDBTMBOB) GET MSGTEXT LENGTH

BCTR RF,0 FOR EX OPERATION

EX RF,*+4+4 MOVE MSGTEXT TO MSG BUFFER

B *+4+6 (SKIP MODEL INSTRUCTION)

MVC 0(0,R2),MDBTMSGT (MODEL INSTRUCTION)

LA RF,1(,RF) RESTORE ORIGIN LENGTH

LA R2,128(,R2) UPDATE OUR BUFFER POINTER

SPACE ,

AH R4,MDBTLEN LOCATE TO NEXT MDBT

LH RF,MDBLEN LOAD MDB TOTAL LENGTH

LA RF,MDB(RF) LOAD END OF MDB ADDRESS

CLR R4,RF EXIST NEXT MDBT ?

BL GETMTXT YES, GET NEXT CONSOLE MSG

SPACE ,

TSTNXMDB DS 0H

SH R3,=Y(MDBPLNNO) LOCATE TO MDB PREFIX

ICM R3,15,MDBPNEXT-MDBPRFX(R3) GET NEXT MDB BLOCK

BZ GETNXMDB NO, DONE

B NEXTMDB YES, CONTINUE..

DROP R3,R4 FORGET MDBS FOR WORK

SYSSTATE ASCENV=P LET MVS MACROS KNOW

SPACE ,

* *----------------------------------*

* * DEACTIVATE MCS CONSOLE *

* *----------------------------------*

CLOSCONS DS 0H

SAC 0 BACK TO PRIMARY-MODE

MCSOPER REQUEST=DEACTIVATE, DEACTIVATE MCS CONSOLE +

CONSID=DMCONSID CONSOLE ID

STM RF,R0,DMCSRTCD SAVE MCS LAST RETCD/REASON

SPACE ,

* *----------------------------------*

* * HANDLE COMMAND REPLY MESSAGES *

* *----------------------------------*

L R1,=A(CMDREPLY) LOAD OUR MESSAGE BUFFER

：

* *----------------------------------*

* * COMMAND TOKEN AND MODEL *

* *----------------------------------*

CONSKEY DC CL8'MYCONS' MCS CONSOLE KEY

XCMDCART DC CL8'@J2CRSP@' MCS CMD/RESP CART

SPACE ,

* *----------------------------------*

* * MGCRE PLIST *

* *----------------------------------*

RCMGCRE DC F'0' MGCRE RETCD

XCMDAREA DS 0H

DC AL2(LCMDAREA-2) COMMAND TEXT LENGTH

DC CL80'$TOJ72,Q=P,OUTDISP=WRITE' COMMAND TEXT

LCMDAREA EQU *-XCMDAREA (LENGTH OF COMMAND TEXT AREA)

MGCRELST MGCRE MF=L MGCRE PLIST

LGCRELST EQU *-MGCRELST (LENGTH OF PLIST)

SPACE ,

* *----------------------------------*

* * MCS CONSOLE MACRO PLIST *

* *----------------------------------*

DMCONSID DC F'0' MCS CONSOLE ID

DMCSCSA DC A(0) MCS CSA

DMCSCSAA DC A(0) MCS CSA(ALET)

DMCSECB DC F'0' MCS CONSOLE ECB

DMCSMDB DC 2A(0) MCS CURRENT MDB POINTER/ALET

DMCSRTCD DC 2F'0' MCS RETCD/REASON

CONSNAME DC CL8'MYCONS01' MCS CONSOLE NAME

CONSTERM DC CL8'MYCONS01' MCS CONSOLE TERMINAL

DS 0D

DMCSOPP DC XL(MCSOPLEN)'00' MCS OPERPARM FIELD

SPACE ,

***********************************************************************

LTORG , USER LITERAL PLACE AT HERE

*---------------------------------------------------------------------*

DS 0F

CMDREPLY DC 4096X'00' 通知されたメッセージはこの領域に128バイト

：ずつに区切って格納される。

：

*---------------------------------------------------------------------*

PRINT GEN

IEAVG132 , MDB PREFIX

IEAVM105 , MDB

IEAVG131 , MCS CONSOLE STATUS AREA

IEZVG111 , OPERPARM PARAMETER AREA

：

拡張MCSコンソール機能による仮想コンソールをプログラムで作成するには、最初にMCSOPER REQUEST=ACTIVATEによって仮想コンソールをアクティブにします。このコンソールへ出力されるメッセージは、MCSOPMSG REQUEST=GETMSGによって読み込むことができます。必要なコンソール・メッセージを読み取ったら、MCSOPER REQUEST=DEACTIVATEによってコンソールを停止します。
オペレーター・コマンドの発行はMGCREマクロによって行います。このサンプルは、コマンドを発行してその実行結果メッセージを取り込むのが目的なので、発行したコマンドに対する応答メッセージだけを受け取ります。そのため、コマンドと応答を関連付けるための8バイトの応答トークンをコマンド発行時にMGCREマクロのCARTパラメーターで指定します。関連付けられた応答トークンは、MCSOPMSGマクロでも指定されて指定したトークンを持つ応答メッセージがコンソールに出力されると、メッセージ待ち合わせのECBがポストされます。
ECBがポストされたら、MCSOPMSG REQUEST=GETMSGを発行してコマンドに対する応答メッセージを受け取ります。メッセージは、拡張MCS機能によって作成されたデータ空間に展開され、MDB（Message Data Block）によってマッピングされます。1つのMDBには複数のメッセージが格納され、それぞれのメッセージはMDBT（MDB Text Object）によって区分けされています。MDB内の全てのメッセージを処理したら、MDBプレフィックスにポイントされている次のMDBを求めて続きのメッセージ・テキストを読み込みます。チェインの最後のMDBを処理したら、再びMCSOPMSG REQUEST=GETMSGを発行します。これ以上返すMDBがなくなれば、MCSOPMSGはRC=8で復帰します。それによって仮想コンソールの停止タイミングを知ることができます。

このサンプルでは、JES2コマンド「$TOJ72,Q=P,OUTDISP=WRITE」を発行してその応答メッセージを受け取ります。SDSFパネルからOSコマンドを発行すると、その応答メッセージが画面にエコーバックされますが、そのようなことを自分のプログラムで行いたい場合や、発行したコマンドの応答をプログラムで解析してから実行結果を通知したい場合などに利用できます。サンプルのプログラムでは、返された応答メッセージはプログラム内の4KB領域に1行あたり128バイトで格納しています。32行分しか格納できませんが、それを超える数のメッセージが返された場合の考慮はしていません。

コンソールへの出力メッセージを取得して、順次データセットに書き出す

----+----1----+----2----+----3----+----4----+----5----+----6----+----7--
         MODESET MODE=SUP               SET US TO SUPERVISOR MODE
         SPACE ,
*                                  *----------------------------------*
*                                  *  ACTIVATE MCS CONSOLE            *
*                                  *----------------------------------*
OPENCONS DS    0H
         OPEN  (SYSPRINT,OUTPUT)        OPEN SYSPRINT DATASET
         MVI   DMCSECB,0                CLEAR MSG RECEIVING ECB
         MVI   DMCSAECB,0               CLEAR MSG ALERT ECB
         LA    R1,DMCSOPP               BUILD OPERPARM DEFAULTS
         USING MCSOPPRM,R1              MAP IT
         XC    0(MCSOPLEN,R1),0(R1)     CLEAR OPERPARM PARM LIST
         MVC   MCSOSTOR,=Y(32)          LIMIT STORAGE = 32MB
         MVC   MCSOKEY,CONSKEY          SET MCS CONSOLE KEY
         OI    MCSOAUTH,MCSOMSTR        INDICATES MASTER AUTHORITY
         OI    MCSOMFM1,MCSOMFT+MCSOMFS+MCSOMFJ  SYSNAME,TIME,JOBID
         OI    MCSOMLVL,MCSOMLAL        ALL MSG LEVELS
         OI    MCSOMSGT,MCSOMTJT        MONITOR JOB START/END
         OI    MCSOMSGT,MCSOMTST        MONITOR TSO START/END
         OI    MCSORCFL,MCSORCAL        ALL ROUTE CODES
         OI    MCSOLOGC,MCSOLOGS        ALL CMD RESPONSES
         OI    MCSODOM,MCSODOMA         ALL DOM REQUESTES
******** OI    MCSOMSFG,MCSOSALL        RECEIVE FROM ALL SYSTEMS
         OI    MCSOMISC,MCSOUDN         NO RECEIVE UNDELIVERED MESSAGES
         OI    MCSOMISC,MCSOAUTY        RECEIVE ALL AUTOMATED MESSAGES
         OI    MCSOMISC,MCSOHDCY        RECEIVE HARDCOPY MESSEGES
         DROP  R1                       FORGET OPERPARM FIELD
         MCSOPER REQUEST=ACTIVATE,      ACTIVATE MCS CONSOLE           +
               OPERPARM=DMCSOPP,         OPER PARAMETER FIELD          +
               NAME=CONSNAME,            CONSOLE NAME                  +
               TERMNAME=CONSTERM,        CONSOLE TERMINAL              +
               CONSID=DMCONSID,          CONSOLE ID                    +
               MCSCSA=DMCSCSA,           CONSOLE CSA                   +
               MCSCSAA=DMCSCSAA,         CONSOLE CSA-ALET              +
               MSGECB=DMCSECB,           CONSOLE ECB                   +
               ALERTECB=DMCSAECB,        ALERT ECB                     +
               MSGDLVRY=FIFO             MSG RECEIVE TYPE
         STM   RF,R0,DMCSRTCD           SAVE MCS LAST RETCD/REASON
         SPACE ,
         SLR   R1,R1                    GR1 --> 0
         SAR   AR0,R1                   CLEAR ALL ACCESS REGISTERS
         SAR   AR1,R1                    I
         SAR   AR2,R1                    I
         SAR   AR3,R1                    I
         SAR   AR4,R1                    I
         SAR   AR5,R1                    I
         SAR   AR6,R1                    I
         SAR   AR7,R1                    I
         SAR   AR8,R1                    I
         SAR   AR9,R1                    I
         SAR   ARA,R1                    I
         SAR   ARB,R1                    I
         SAR   ARC,R1                    I
         SAR   ARD,R1                    I
         SAR   ARE,R1                    I
         SAR   ARF,R1                    V
         SYSSTATE ASCENV=AR             LET MVS MACROS KNOW
         SPACE ,
*                                  *----------------------------------*
*                                  *  WAIT CONSOLE RESPONSE           *
*                                  *----------------------------------*
WAITCONS DS    0H
         SAC   0                        BACK TO PRIMARY-MODE
         WAIT  ECBLIST=ECBLIST          WAIT NEXT CONSOLE MESSAGES
         TM    DMCSECB,X'40'            POSTED MESSAGE ECB ?
         BO    RECVMSGS                 YES, GET MSGS FROM MDB
         MVI   DMCSAECB,0               CLEAR ALERT ECB
         B     MCSALERT                 DO ALERT PROCESSING
         SPACE ,
RECVMSGS DS    0H
         MVI   DMCSECB,0                DROP POST BIT
         SAC   512                      CHANGE US TO AR-MODE
GETNXMDB DS    0H
         MCSOPMSG REQUEST=GETMSG,       GET MDB FROM OUR MCS CONSOLE   +
               CONSID=DMCONSID          (GR1 CONTAIN MDB AT RETURN)
         STM   RF,R0,DMCSRTCD           SAVE MCS LAST RETCD/REASON
         CH    RF,=H'8'                 MCSOPMSG IS SUCCESSFUL ?
         BL    GOTMDB                   RC < 8 --> SUCCESSFUL...
         BH    MCSOPERR                 RC > 8 --> CONSOLE ERROR
         SPACE ,
         SAC   0                        BACK TO PRIMARY-MODE
         STIMER WAIT,BINTVL==F'100'     SLEEP 1SECOND...
         B     WAITCONS                 WAIT AGAIN
         SPACE ,
*                                  *----------------------------------*
*                                  *  MCS CONSOLE ERROR AND ALERT     *
*                                  *                      PROCESSING  *
*                                  *----------------------------------*
MCSOPERR DS    0H
         SAC   0                        BACK TO PRIMARY-MODE
         CH    RF,=H'12'                SUSPENDED CONSOLE ?
         BE    MCSALERT                 YES, TRY TO RESUME
         CVD   RF,DOUBLE                SET ERROR CODE INTO MSG
         UNPK  WTOOPERR+4+40(4),DOUBLE   I
         OI    WTOOPERR+4+43,C'0'        V
         CVD   R0,DOUBLE                SET REASON CODE INTO MSG
         UNPK  WTOOPERR+4+45(4),DOUBLE   I
         OI    WTOOPERR+4+48,C'0'        V
         WTO   MF=(E,WTOOPERR)          INFORM IT
         B     CLOSCONS                 DEACTIVATE MCS CONSOLE
WTOOPERR WTO   'DEACTIVATE MCS CONSOLE BY PROGRAM ERROR(XXXX-XXXX)...',+
               MF=L
         SPACE ,
MCSALERT DS    0H
         L     RE,DMCSCSA               LOAD MCS STATUS AREA ADDR
         LAM   ARE,ARE,DMCSCSAA         LOAD MCS STATUS AREA ALET
         MVC   DMCSSTAT(MCSCEND-MCSCSA),0(RE)  COPY MCS CONSOLE STATUS +
                                               FROM CONSOLE DATA SPACE
         SLR   RE,RE                    CLEAR GR14
         SAR   ARE,RE                   CLEAR AR14
         WTO   'POSTED MCS ALERT, TRY TO RESUME CONSOLE...'
         USING MCSCSA,DMCSSTAT          ADDRESS TO MCS STATUS AREA
         ：
         ：
         ：
         MCSOPMSG REQUEST=RESUME,       REQUEST TO RESUME MCS CONSOLE  +
               CONSID=DMCONSID
         STM   RF,R0,DMCSRTCD           SAVE MCS LAST RETCD/REASON
         B     WAITCONS                 WAIT AGAIN
         SPACE ,
*                                  *----------------------------------*
*                                  *  GET CONSOLE MESSAGES FROM MDB   *
*                                  *----------------------------------*
GOTMDB   DS    0H
         ST    R1,DMCSMDB               SAVE CURRENT MDB POINTER
         STAM  R1,R1,DMCSMDB+4          SAVE MCS DATA SPACE ALET
         LAE   R3,0(0,R1)               PUT MDB ADDRESS IN R3 AND AR3
         USING MDB,R3                   ADDRESSABILITY TO THE MDB
         SLR   R1,R1                    CLEAR GR1
         SAR   AR1,R1                   CLEAR AR1
         SPACE ,
NEXTMDB  DS    0H
         LA    R4,MDB+MDBHLEN           LOCATE TO MDBG(GENERAL OBJECT)
         CPYA  AR4,AR3                  SET ALET TO AR4
         USING MDBG,R4                  ADDRESS TO MDBT(GENERAL OBJECT)
         MVC   CONSMSG(8),MDBGTIMH      SET MESSAGE TIME
         AH    R4,MDBGLEN               SKIP MDBG
         USING MDBSCP,R4                ADDRESS TO MDBC(CONTROL OBJECT)
         CLC   MDBCTYPE(L'MDBCTYPE),=AL2(MDBCOBJ)  HERE IS             +
                                                       CONTROL OBJECT ?
         BNE   GETMTXT                  NO, ITS MDBT
         TM    MDBCATT1,MDBCMCSC        COMMAND RESPONSE ?
         BO    *+4+4+4                  YES, LOGGING IT
         TM    MDBCATT1,MDBCSPVD        WQE BACKLOG(ENTERED CMD ECHO) ?
         BO    IGNRMDB                  YES, IGNORE IT
         MVC   CONSMSG+9(8),MDBCOJID    SET ORIGINATING JOB ID
         AH    R4,MDBCLEN               LOCATE TO 1ST MDBT(TEXT OBJECT)
GETMTXT  DS    0H
         USING MDBT,R4                  ADDRESS TO MDBT(TEXT OBJECT)
         LH    RF,MDBTLEN               GET MDBT LENGTH
         LTR   RF,RF                    INCLUDED ANY MSG TEXT ?
         BZ    IGNRMDB                  NO, IGNORE IT
         MVI   CONSMSG+18,C' '          CLEAR MSG WORKAREA(MSG TEXT)
         MVC   CONSMSG+19(L'CONSMSG-1-18),CONSMSG+18
         LH    RF,MDBTLEN               GET MDBT LENGTH
         SH    RF,=Y(MDBTMBOB)          GET MSGTEXT LENGTH
         CH    RF,=Y(L'CONSMSG-17)      TOO LONG ?
         BNH   *+4+4                    NO,
         LH    RF,=Y(L'CONSMSG-17)      YES, ADJUST IT
         BCTR  RF,0                     FOR EX OPERATION
         EX    RF,*+4+4                 MOVE MSGTEXT TO MSG BUFFER
         B     *+4+6                    (SKIP MODEL INSTRUCTION)
         MVC   CONSMSG+17(0),MDBTMSGT   (MODEL INSTRUCTION)
         SPACE ,
         SAC   0                        BACK TO PRIMARY-MODE
         PUT   SYSPRINT,CONSMSG         PUT CONSOLE MSG TO SYSPRINT
         CLC   CONSMSG+18(11),=C'STOP MYCONS' ENTERED STOP MYCONS ?
         BE    CLOSCONS                       YES, TERMINATE US
         SPACE ,
*                                  *----------------------------------*
*                                  *  HANDLE CONSOLE MESSAGES         *
*                                  *----------------------------------*
         LA    R1,CONSMSG+18            GR1 --> BEGIN OF MESSAGE TEXT
         ：
         ：
         ：
         ：        必要ならここでMSGを解析して追加の処理を行う。
         ：
         ：
         ：
         SPACE ,
         SAC   512                      CHANGE US TO AR-MODE
         MVI   CONSMSG,C' '             CLEAR MSG WORKAREA(TIME+JOBID)
         MVC   CONSMSG+1(17),CONSMSG
         AH    R4,MDBTLEN               LOCATE TO NEXT MDBT
         LH    RF,MDBLEN                LOAD MDB TOTAL LENGTH
         LA    RF,MDB(RF)               LOAD END OF MDB ADDRESS
         CLR   R4,RF                    EXIST NEXT MDBT ?
         BL    GETMTXT                  YES, GET NEXT CONSOLE MSG
         SPACE ,
IGNRMDB  DS    0H
         SH    R3,=Y(MDBPLNNO)          LOCATE TO MDB PREFIX
         ICM   R3,15,MDBPNEXT-MDBPRFX(R3)  GET NEXT MDB BLOCK
         BNZ   NEXTMDB                     IF CHAINED, HANDLE IT
         B     GETNXMDB                    NO, RE-ISSUE MCSOPMSG
         SPACE ,
         DROP  R3,R4                    FORGET MDBS FOR WORK
         SYSSTATE ASCENV=P              LET MVS MACROS KNOW
         SPACE ,
*                                  *----------------------------------*
*                                  *  DEACTIVATE MCS CONSOLE          *
*                                  *----------------------------------*
CLOSCONS DS    0H
         SAC   0                        BACK TO PRIMARY-MODE
         MCSOPER REQUEST=DEACTIVATE,    DEACTIVATE MCS CONSOLE         +
               CONSID=DMCONSID          CONSOLE ID
         STM   RF,R0,DMCSRTCD           SAVE MCS LAST RETCD/REASON
         CLOSE SYSPRINT                 CLOSE SYSPRINT DCB
         ：
         ：
         ：
         ：
         ：
*                                  *----------------------------------*
*                                  *  WORKAREA FOR PROCESSING         *
*                                  *----------------------------------*
DOUBLE   DC    D'0'                     DOUBLE WORD WORKAREA
ECBLIST  CALL  ,(DMCSECB,DMCSAECB),VL,MF=L  ECBLIST
         SPACE ,
*                                  *----------------------------------*
*                                  *  LOGGING DATASET DCB             *
*                                  *----------------------------------*
SYSPRINT DCB   DDNAME=SYSPRINT,         SYSPRINT DATASET DCB(QSAM)     +
               MACRF=PM,DSORG=PS,RECFM=FB,LRECL=132
CONSMSG  DC    CL132' '                 CONSOLE MSG READ AREA
*---------------------------------------------------------------------*
         SPACE ,
*                                  *----------------------------------*
*                                  *  COMMAND TOKEN AND MODEL         *
*                                  *----------------------------------*
CONSKEY  DC    CL8'MYCONS'              MCS CONSOLE KEY
         SPACE ,
*                                  *----------------------------------*
*                                  *  MCS CONSOLE MACRO PLIST         *
*                                  *----------------------------------*
DMCONSID DC    F'0'                     MCS CONSOLE ID
DMCSCSA  DC    A(0)                     MCS CSA
DMCSCSAA DC    A(0)                     MCS CSA(ALET)
DMCSECB  DC    F'0'                     MCS CONSOLE ECB
DMCSAECB DC    F'0'                     MCS ALERT ECB
DMCSMDB  DC    2A(0)                    MCS CURRENT MDB POINTER/ALET
DMCSRTCD DC    2F'0'                    MCS RETCD/REASON
CONSNAME DC    CL8'MYCONS01'            MCS CONSOLE NAME
CONSTERM DC    CL8'MYCONS01'            MCS CONSOLE TERMINAL
DMCSSTAT DC    (MCSCEND-MCSCSA)X'00'    MCS CONSOLE STATUS COPY AREA
         DS    0D
DMCSOPP  DC    XL(MCSOPLEN)'00'         MCS OPERPARM FIELD
         SPACE ,
***********************************************************************
         LTORG ,                        USER LITERAL PLACE AT HERE
         ：
         ：
         ：
*---------------------------------------------------------------------*
         PRINT GEN
         IEAVG132 ,                     MDB PREFIX
         IEAVM105 ,                     MDB
         IEAVG131 ,                     MCS CONSOLE STATUS AREA
         IEZVG111 ,                     OPERPARM PARAMETER AREA

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

250

251

252

253

254

255

256

257

258

259

260

----+----1----+----2----+----3----+----4----+----5----+----6----+----7--

MODESET MODE=SUP SET US TO SUPERVISOR MODE

SPACE ,

* *----------------------------------*

* * ACTIVATE MCS CONSOLE *

* *----------------------------------*

OPENCONS DS 0H

OPEN (SYSPRINT,OUTPUT) OPEN SYSPRINT DATASET

MVI DMCSECB,0 CLEAR MSG RECEIVING ECB

MVI DMCSAECB,0 CLEAR MSG ALERT ECB

LA R1,DMCSOPP BUILD OPERPARM DEFAULTS

USING MCSOPPRM,R1 MAP IT

XC 0(MCSOPLEN,R1),0(R1) CLEAR OPERPARM PARM LIST

MVC MCSOSTOR,=Y(32) LIMIT STORAGE = 32MB

MVC MCSOKEY,CONSKEY SET MCS CONSOLE KEY

OI MCSOAUTH,MCSOMSTR INDICATES MASTER AUTHORITY

OI MCSOMFM1,MCSOMFT+MCSOMFS+MCSOMFJ SYSNAME,TIME,JOBID

OI MCSOMLVL,MCSOMLAL ALL MSG LEVELS

OI MCSOMSGT,MCSOMTJT MONITOR JOB START/END

OI MCSOMSGT,MCSOMTST MONITOR TSO START/END

OI MCSORCFL,MCSORCAL ALL ROUTE CODES

OI MCSOLOGC,MCSOLOGS ALL CMD RESPONSES

OI MCSODOM,MCSODOMA ALL DOM REQUESTES

******** OI MCSOMSFG,MCSOSALL RECEIVE FROM ALL SYSTEMS

OI MCSOMISC,MCSOUDN NO RECEIVE UNDELIVERED MESSAGES

OI MCSOMISC,MCSOAUTY RECEIVE ALL AUTOMATED MESSAGES

OI MCSOMISC,MCSOHDCY RECEIVE HARDCOPY MESSEGES

DROP R1 FORGET OPERPARM FIELD

MCSOPER REQUEST=ACTIVATE, ACTIVATE MCS CONSOLE +

OPERPARM=DMCSOPP, OPER PARAMETER FIELD +

NAME=CONSNAME, CONSOLE NAME +

TERMNAME=CONSTERM, CONSOLE TERMINAL +

CONSID=DMCONSID, CONSOLE ID +

MCSCSA=DMCSCSA, CONSOLE CSA +

MCSCSAA=DMCSCSAA, CONSOLE CSA-ALET +

MSGECB=DMCSECB, CONSOLE ECB +

ALERTECB=DMCSAECB, ALERT ECB +

MSGDLVRY=FIFO MSG RECEIVE TYPE

STM RF,R0,DMCSRTCD SAVE MCS LAST RETCD/REASON

SPACE ,

SLR R1,R1 GR1 --> 0

SAR AR0,R1 CLEAR ALL ACCESS REGISTERS

SAR AR1,R1 I

SAR AR2,R1 I

SAR AR3,R1 I

SAR AR4,R1 I

SAR AR5,R1 I

SAR AR6,R1 I

SAR AR7,R1 I

SAR AR8,R1 I

SAR AR9,R1 I

SAR ARA,R1 I

SAR ARB,R1 I

SAR ARC,R1 I

SAR ARD,R1 I

SAR ARE,R1 I

SAR ARF,R1 V

SYSSTATE ASCENV=AR LET MVS MACROS KNOW

SPACE ,

* *----------------------------------*

* * WAIT CONSOLE RESPONSE *

* *----------------------------------*

WAITCONS DS 0H

SAC 0 BACK TO PRIMARY-MODE

WAIT ECBLIST=ECBLIST WAIT NEXT CONSOLE MESSAGES

TM DMCSECB,X'40' POSTED MESSAGE ECB ?

BO RECVMSGS YES, GET MSGS FROM MDB

MVI DMCSAECB,0 CLEAR ALERT ECB

B MCSALERT DO ALERT PROCESSING

SPACE ,

RECVMSGS DS 0H

MVI DMCSECB,0 DROP POST BIT

SAC 512 CHANGE US TO AR-MODE

GETNXMDB DS 0H

MCSOPMSG REQUEST=GETMSG, GET MDB FROM OUR MCS CONSOLE +

CONSID=DMCONSID (GR1 CONTAIN MDB AT RETURN)

STM RF,R0,DMCSRTCD SAVE MCS LAST RETCD/REASON

CH RF,=H'8' MCSOPMSG IS SUCCESSFUL ?

BL GOTMDB RC < 8 --> SUCCESSFUL...

BH MCSOPERR RC > 8 --> CONSOLE ERROR

SPACE ,

SAC 0 BACK TO PRIMARY-MODE

STIMER WAIT,BINTVL==F'100' SLEEP 1SECOND...

B WAITCONS WAIT AGAIN

SPACE ,

* *----------------------------------*

* * MCS CONSOLE ERROR AND ALERT *

* * PROCESSING *

* *----------------------------------*

MCSOPERR DS 0H

SAC 0 BACK TO PRIMARY-MODE

CH RF,=H'12' SUSPENDED CONSOLE ?

BE MCSALERT YES, TRY TO RESUME

CVD RF,DOUBLE SET ERROR CODE INTO MSG

UNPK WTOOPERR+4+40(4),DOUBLE I

OI WTOOPERR+4+43,C'0' V

CVD R0,DOUBLE SET REASON CODE INTO MSG

UNPK WTOOPERR+4+45(4),DOUBLE I

OI WTOOPERR+4+48,C'0' V

WTO MF=(E,WTOOPERR) INFORM IT

B CLOSCONS DEACTIVATE MCS CONSOLE

WTOOPERR WTO 'DEACTIVATE MCS CONSOLE BY PROGRAM ERROR(XXXX-XXXX)...',+

MF=L

SPACE ,

MCSALERT DS 0H

L RE,DMCSCSA LOAD MCS STATUS AREA ADDR

LAM ARE,ARE,DMCSCSAA LOAD MCS STATUS AREA ALET

MVC DMCSSTAT(MCSCEND-MCSCSA),0(RE) COPY MCS CONSOLE STATUS +

FROM CONSOLE DATA SPACE

SLR RE,RE CLEAR GR14

SAR ARE,RE CLEAR AR14

WTO 'POSTED MCS ALERT, TRY TO RESUME CONSOLE...'

USING MCSCSA,DMCSSTAT ADDRESS TO MCS STATUS AREA

：

MCSOPMSG REQUEST=RESUME, REQUEST TO RESUME MCS CONSOLE +

CONSID=DMCONSID

STM RF,R0,DMCSRTCD SAVE MCS LAST RETCD/REASON

B WAITCONS WAIT AGAIN

SPACE ,

* *----------------------------------*

* * GET CONSOLE MESSAGES FROM MDB *

* *----------------------------------*

GOTMDB DS 0H

ST R1,DMCSMDB SAVE CURRENT MDB POINTER

STAM R1,R1,DMCSMDB+4 SAVE MCS DATA SPACE ALET

LAE R3,0(0,R1) PUT MDB ADDRESS IN R3 AND AR3

USING MDB,R3 ADDRESSABILITY TO THE MDB

SLR R1,R1 CLEAR GR1

SAR AR1,R1 CLEAR AR1

SPACE ,

NEXTMDB DS 0H

LA R4,MDB+MDBHLEN LOCATE TO MDBG(GENERAL OBJECT)

CPYA AR4,AR3 SET ALET TO AR4

USING MDBG,R4 ADDRESS TO MDBT(GENERAL OBJECT)

MVC CONSMSG(8),MDBGTIMH SET MESSAGE TIME

AH R4,MDBGLEN SKIP MDBG

USING MDBSCP,R4 ADDRESS TO MDBC(CONTROL OBJECT)

CLC MDBCTYPE(L'MDBCTYPE),=AL2(MDBCOBJ) HERE IS +

CONTROL OBJECT ?

BNE GETMTXT NO, ITS MDBT

TM MDBCATT1,MDBCMCSC COMMAND RESPONSE ?

BO *+4+4+4 YES, LOGGING IT

TM MDBCATT1,MDBCSPVD WQE BACKLOG(ENTERED CMD ECHO) ?

BO IGNRMDB YES, IGNORE IT

MVC CONSMSG+9(8),MDBCOJID SET ORIGINATING JOB ID

AH R4,MDBCLEN LOCATE TO 1ST MDBT(TEXT OBJECT)

GETMTXT DS 0H

USING MDBT,R4 ADDRESS TO MDBT(TEXT OBJECT)

LH RF,MDBTLEN GET MDBT LENGTH

LTR RF,RF INCLUDED ANY MSG TEXT ?

BZ IGNRMDB NO, IGNORE IT

MVI CONSMSG+18,C' ' CLEAR MSG WORKAREA(MSG TEXT)

MVC CONSMSG+19(L'CONSMSG-1-18),CONSMSG+18

LH RF,MDBTLEN GET MDBT LENGTH

SH RF,=Y(MDBTMBOB) GET MSGTEXT LENGTH

CH RF,=Y(L'CONSMSG-17) TOO LONG ?

BNH *+4+4 NO,

LH RF,=Y(L'CONSMSG-17) YES, ADJUST IT

BCTR RF,0 FOR EX OPERATION

EX RF,*+4+4 MOVE MSGTEXT TO MSG BUFFER

B *+4+6 (SKIP MODEL INSTRUCTION)

MVC CONSMSG+17(0),MDBTMSGT (MODEL INSTRUCTION)

SPACE ,

SAC 0 BACK TO PRIMARY-MODE

PUT SYSPRINT,CONSMSG PUT CONSOLE MSG TO SYSPRINT

CLC CONSMSG+18(11),=C'STOP MYCONS' ENTERED STOP MYCONS ?

BE CLOSCONS YES, TERMINATE US

SPACE ,

* *----------------------------------*

* * HANDLE CONSOLE MESSAGES *

* *----------------------------------*

LA R1,CONSMSG+18 GR1 --> BEGIN OF MESSAGE TEXT

：

：必要ならここでMSGを解析して追加の処理を行う。

：

SPACE ,

SAC 512 CHANGE US TO AR-MODE

MVI CONSMSG,C' ' CLEAR MSG WORKAREA(TIME+JOBID)

MVC CONSMSG+1(17),CONSMSG

AH R4,MDBTLEN LOCATE TO NEXT MDBT

LH RF,MDBLEN LOAD MDB TOTAL LENGTH

LA RF,MDB(RF) LOAD END OF MDB ADDRESS

CLR R4,RF EXIST NEXT MDBT ?

BL GETMTXT YES, GET NEXT CONSOLE MSG

SPACE ,

IGNRMDB DS 0H

SH R3,=Y(MDBPLNNO) LOCATE TO MDB PREFIX

ICM R3,15,MDBPNEXT-MDBPRFX(R3) GET NEXT MDB BLOCK

BNZ NEXTMDB IF CHAINED, HANDLE IT

B GETNXMDB NO, RE-ISSUE MCSOPMSG

SPACE ,

DROP R3,R4 FORGET MDBS FOR WORK

SYSSTATE ASCENV=P LET MVS MACROS KNOW

SPACE ,

* *----------------------------------*

* * DEACTIVATE MCS CONSOLE *

* *----------------------------------*

CLOSCONS DS 0H

SAC 0 BACK TO PRIMARY-MODE

MCSOPER REQUEST=DEACTIVATE, DEACTIVATE MCS CONSOLE +

CONSID=DMCONSID CONSOLE ID

STM RF,R0,DMCSRTCD SAVE MCS LAST RETCD/REASON

CLOSE SYSPRINT CLOSE SYSPRINT DCB

：

* *----------------------------------*

* * WORKAREA FOR PROCESSING *

* *----------------------------------*

DOUBLE DC D'0' DOUBLE WORD WORKAREA

ECBLIST CALL ,(DMCSECB,DMCSAECB),VL,MF=L ECBLIST

SPACE ,

* *----------------------------------*

* * LOGGING DATASET DCB *

* *----------------------------------*

SYSPRINT DCB DDNAME=SYSPRINT, SYSPRINT DATASET DCB(QSAM) +

MACRF=PM,DSORG=PS,RECFM=FB,LRECL=132

CONSMSG DC CL132' ' CONSOLE MSG READ AREA

*---------------------------------------------------------------------*

SPACE ,

* *----------------------------------*

* * COMMAND TOKEN AND MODEL *

* *----------------------------------*

CONSKEY DC CL8'MYCONS' MCS CONSOLE KEY

SPACE ,

* *----------------------------------*

* * MCS CONSOLE MACRO PLIST *

* *----------------------------------*

DMCONSID DC F'0' MCS CONSOLE ID

DMCSCSA DC A(0) MCS CSA

DMCSCSAA DC A(0) MCS CSA(ALET)

DMCSECB DC F'0' MCS CONSOLE ECB

DMCSAECB DC F'0' MCS ALERT ECB

DMCSMDB DC 2A(0) MCS CURRENT MDB POINTER/ALET

DMCSRTCD DC 2F'0' MCS RETCD/REASON

CONSNAME DC CL8'MYCONS01' MCS CONSOLE NAME

CONSTERM DC CL8'MYCONS01' MCS CONSOLE TERMINAL

DMCSSTAT DC (MCSCEND-MCSCSA)X'00' MCS CONSOLE STATUS COPY AREA

DS 0D

DMCSOPP DC XL(MCSOPLEN)'00' MCS OPERPARM FIELD

SPACE ,

***********************************************************************

LTORG , USER LITERAL PLACE AT HERE

：

*---------------------------------------------------------------------*

PRINT GEN

IEAVG132 , MDB PREFIX

IEAVM105 , MDB

IEAVG131 , MCS CONSOLE STATUS AREA

IEZVG111 , OPERPARM PARAMETER AREA

コマンドに対する応答メッセージではなく、システムやジョブの状況表示など全ての出力メッセージを取り込むこともできます。最初のサンプルと異なり、仮想コンソールをアクティブにする際にMCSOPERのMSGDLVRYでFIFOを指定します。コンソールへのメッセージ出力が行われるとECBにポストされるので、続けてMCSOPMSG REQUEST=GETMSGを発行してメッセージを読み込みます。このサンプルでは、読み込んだメッセージを順次データセットに書き出す処理を行っています。このようなコンソール・モニターを作れば、ジョブの開始や終了、ステップの終了状況（SMF出口等でメッセージ出力していれば）などをリアルタイムに検知して、ユーザー独自の自動運用処理などに応用することもできます。

サンプル・プログラムは、常にコンソール・メッセージの発生を待ち合わせているため終了するタイミングがありません。CANCELコマンドでしか終了できないのは良い作りではありませんので、コンソールに’STOP MYCONS’という文字列が入力されたかをコマンド・メッセージそのものでチェックしています。しかし、このようなシステム常駐型のプログラムではQEDITマクロを使用してMODIFYやSTOPコマンドを受け入れるようするのが本来です。QEDITを使用したオペレーター・コマンドの受け入れを行う方法は、「オペレーター応答とコマンドを受け取る（WTORとQEDIT）」で解説しています。

拡張MCSコンソール機能では、プログラムはアクセス・レジスターモードにしなければなりません。MDBが実際にどのような構造になっていて、どのようにメッセージ・テキストが格納されているのかを調べるために、適当な場所でわざとABENDさせてもMDBは異なる空間に存在するのでSYSUDUMPやSYSABENDダンプでは見ることができません。データ空間の内容を確認するにはいくつかの方法がありますが、比較的簡単なのはSNAPXマクロでDSPSTORパラメーターを指定する方法です。MDBで返されたALETを入力にしたALESERV EXTRACTを発行してMDB領域のSTOKEN値を求め、そのSTOKENを指定したDSPSTORリストを作成してSNAPXマクロを発行します。

         ：
         ：
         ：
*                                  *----------------------------------*
*                                  *  GET CONSOLE MESSAGES FROM MDB   *
*                                  *----------------------------------*
GOTMDB   DS    0H
         ST    R1,DMCSMDB               SAVE CURRENT MDB POINTER
         STAM  R1,R1,DMCSMDB+4          SAVE MCS DATA SPACE ALET
         LAE   R3,0(0,R1)               PUT MDB ADDRESS IN R3 AND AR3
         USING MDB,R3                   ADDRESSABILITY TO THE MDB
         SLR   R1,R1                    CLEAR GR1
         SAR   AR1,R1                   CLEAR AR1
         SPACE ,
         EAR   R2,AR3              <=== ここから追加
         ST    R3,DSPLIST
         LA    R0,4095(,R3)
         ST    R0,DSPLIST+4
         OI    DSPLIST+4,X'80'
         ALESERV EXTRACT,ALET=(2),STOKEN=DSPLIST+8
         SNAPX DCB=SNAPDUMP,PDATA=REGS, DUMP PAGE CONTAIN MDB CHAIN    +
               DSPSTOR=DSPLIST
         B     NEXTMDB
DSPLIST  DS    0D
         DC    A(0)
         DC    A(0)
         DC    AD(0)               <=== ここまでを追加
         SPACE ,
NEXTMDB  DS    0H
         LA    R4,MDB+MDBHLEN           LOCATE TO MDBG(GENERAL OBJECT)
         CPYA  AR4,AR3                  SET ALET TO AR4
         USING MDBG,R4                  ADDRESS TO MDBT(GENERAL OBJECT)
         MVC   CONSMSG(8),MDBGTIMH      SET MESSAGE TIME
         ：
         ：
         ：

：

* *----------------------------------*

* * GET CONSOLE MESSAGES FROM MDB *

* *----------------------------------*

GOTMDB DS 0H

ST R1,DMCSMDB SAVE CURRENT MDB POINTER

STAM R1,R1,DMCSMDB+4 SAVE MCS DATA SPACE ALET

LAE R3,0(0,R1) PUT MDB ADDRESS IN R3 AND AR3

USING MDB,R3 ADDRESSABILITY TO THE MDB

SLR R1,R1 CLEAR GR1

SAR AR1,R1 CLEAR AR1

SPACE ,

EAR R2,AR3 <=== ここから追加

ST R3,DSPLIST

LA R0,4095(,R3)

ST R0,DSPLIST+4

OI DSPLIST+4,X'80'

ALESERV EXTRACT,ALET=(2),STOKEN=DSPLIST+8

SNAPX DCB=SNAPDUMP,PDATA=REGS, DUMP PAGE CONTAIN MDB CHAIN +

DSPSTOR=DSPLIST

B NEXTMDB

DSPLIST DS 0D

DC A(0)

DC AD(0) <=== ここまでを追加

SPACE ,

NEXTMDB DS 0H

LA R4,MDB+MDBHLEN LOCATE TO MDBG(GENERAL OBJECT)

CPYA AR4,AR3 SET ALET TO AR4

USING MDBG,R4 ADDRESS TO MDBT(GENERAL OBJECT)

MVC CONSMSG(8),MDBGTIMH SET MESSAGE TIME

：

SYS1.SAMPLIBにも拡張MCSコンソールのサンプル・プログラムIEAEXMCSが格納されています。また、拡張MCSコンソールの活動状況は、D EMCS[,I|F]コマンドで確認することができます。