//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)