//FSTORMGR JOB CLASS=F,MSGCLASS=1,NOTIFY=FSUPP17,TIME=1440 //*SRO208A JOB CLASS=F,MSGCLASS=W,NOTIFY=USRO208,TIME=1440 //A EXEC PGM=IEV90,PARM=OBJECT,REGION=2000K //SYSIN DD * START DC C'* << ... STORAGE !! >> _ KIMU _ &SYSDATE _ &SYSTIME *' * PRINT NOGEN * --- 31 Bit Addressing Mode --- STORMGR AMODE ANY STORMGR RMODE 24 STORMGR CSECT * --------------------------------------------------------- * * Command File STORMGR STORMCS Mvs Command * Program Program * __________ * <__________> +---------+ * |CF STOR ~ | <-Reserved- | STORMGR | * |D M=STOR | | | +-------+ * |~~~~~~~ | ----Read--->| Call STORMCS-> |STORMCS|-> CF STOR ~ * | | | | +-------+ * | | | | * | | | | +-------+ * | | | Call STORMCS-> |STORMCS|-> D M=STOR * | | | | +-------+ * | | | | * | | | | +-------+ * | | | Call STORMCS-> |STORMCS|-> ~~~~~~~~~ * | | | | +-------+ * | | <-- Deq ----| | * \__________/ +---------+ * * - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - * --- Multi System Image --- * Command File * +------------+ * +------------+ * | | * +-Reserved-> | | <-Reserved-+ * | +------------+ | * | | | * | Reserved | * | | | * +AI03----- +AI07------ +AI08----- * | | | * CF STOR(E=1),ON | | * CF STOR(352M-512M),OFF | | * CF STOR(E=1),ON | * CF STOR(E=1),ON * * Real ( Reserved ) Storage * +--------------------------------------------+ * | | * +--------------------------------------------+ * 0 256M * AI03 |<--------------256M Oline------------------>| * | |<------- 160M Offline ------>| * AI07 | |<-80M Online->| * AI08 | |<-80M Online->| * * * *-Registor Usage * * R03 : Based Registor * R04 : Re-Entrant Dynamic Data Area Base Registor * --------------------------------------------------------- ********************************************************************** SAVE (14,12),T,* BALR R03,0 USING *,R03 BASE REG. R03 ST R13,SA#MGR+4 SAVE A(OLD SAVEAREA) LR R12,R13 LA R13,SA#MGR ST R13,8(R12) SAVE A(NEW SAVEAREA) * WTO TEXT=MSG#A000,MF=(E,WTOINFO) USING MCSCOMM,R04 LA R04,MCSENT * BAL R14,CMD#OPEN * BAL R14,CMD#READ * BAL R14,CMD#CLOS * QUIT EQU * L R13,SA#MGR+4 RETURN (14,12),RC=0 * --- Input File Open and Reserved Volume --- CMD#OPEN DS 0H BAKR R14,0 Branch and Stack ( Stack Only ) MVC ERRMSG02+10(8),=CL8'GETDSAB' MVC CMD_DDNA(8),CMDFILE+X'28' Copy DD-Name GETDSAB DDNAME=CMD_DDNA,DSABPTR=CMD_DSAB LTR R15,R15 if DSAB Error BNZ CMD_ERR1 goto CMD#ERR1 * L R12,CMD_DSAB Load DSAB Adr L R12,16(R12) Load TIOT Adr LA R12,16(R12) L R01,0(R12) R01 <- UCB Address N R01,=X'00FFFFFF' USING UCBOB,R01 MVC MSG#0001+23(6),UCBVOLI MVC CMD_V(6),UCBVOLI DROP R01 * OPEN (CMDFILE) RDJFCB CMDFILE Get JFCB CLOSE (CMDFILE) MVC MSG#0001+34(44),CMD_DSN MVC CMD_D(44),CMD_DSN * MVC MSG#0001+10(8),=CL8'RESERVE' WTO TEXT=MSG#A001,MF=(E,WTOINFO) MVC ERRMSG02+10(8),=CL8'RESERVE' RESERVE (CMD_QNAM,CMD_RNAM,E,0,SYSTEMS),UCB=(R12) LTR R15,R15 if Reserve Error BNZ CMD_ERR1 goto CMD_ERR1 * OPEN (CMDFILE) Open CMDFILE Input XR R15,R15 PR Return CMD_ERR1 EQU * ST R15,WK#F2 CALL @HC,(WK#F2,ERRMSG02+28,4) WTO TEXT=ERRMSA02,MF=(E,WTOERROR) LA R15,8 ConDition Code Set PR * --- End of Input File Open and Reserved Volume --- * --- Input File Close and Deq Volume --- CMD#CLOS EQU * BAKR R14,0 Branch and Stack ( Stack Only ) CLOSE CMDFILE Close CMDFILE Input MVC MSG#0001+10(8),=CL8'DEQ' WTO TEXT=MSG#A001,MF=(E,WTOINFO) DEQ (CMD_QNAM,CMD_RNAM,0,SYSTEMS) e Serial LTR R15,R15 if Error BNZ CMD_ERR2 goto CMD_ERR2 XR R15,R15 Clear Condition Code PR Return CMD_ERR2 EQU * MVC ERRMSG02+10(8),=CL8'DEQ' CALL @OS#6HC,(RC,ERRMSG02+28,4) WTO TEXT=ERRMSA02,MF=(E,WTOERROR) LA R15,8 ConDition Code Set PR * --- End of Input File Close and Deq Volume --- * --- Input File Read --- CMD#READ EQU * BAKR R14,0 Branch and Stack ( Stack Only ) READLOP1 EQU * GET CMDFILE,READBUF LH R01,LINENUM LA R01,1(R01) STH R01,LINENUM CLI READBUF,C'*' if Comment BE READLOP1 Goto Next Line CLC READBUF(8),=CL8'COMMAND' if not Command BNE CMD#SKP2 goto CMD#SKP2 TM READFLG,X'80' if not Command Flag BNO CMD#SKP1 goto CMD#SKP1 BAL R14,CALL#MCS call Enter Commands CMD#SKP1 EQU * OI READFLG,X'80' MVC COM_CMD(71),READBUF+9 B READLOP1 * CMD#SKP2 EQU * CLC READBUF(8),=CL8'WAIT' BE CMD#WAIT CLC READBUF(8),=CL8'DELAY' BE CMD#DELY CLC READBUF(8),=CL8'RESPONSE' BE CMD#RESP CLC READBUF(8),=CL8'TIMEOUT' BE CMD#TOUT CLC READBUF(8),=CL8'WTO' BE CMD#WTO * BNE CMD#SKP3 * OI READFLG,X'40' * MVC COM_WAIT(8),READBUF+1 CMD#SKP3 EQU * B READLOP1 *MD#DELY EQU * *MD#RESP EQU * *MD#TOUT EQU * CMD#WTO EQU * B READLOP1 CMD#WAIT EQU * LA R01,72-10 LA R02,READBUF+9 CMD#W01 EQU * CLI 0(R02),C' ' BNE CMD#W02 LA R02,1(R02) BCT R01,CMD#W01 * WTO 'STOR-MGR: WAIT TIME NOT-FOUND .' B CMD#ERR * CMD#W02 EQU * LR R07,R02 LA R02,1(R02) CL R01,=F'4' BL CMD#W03 LA R01,4 CMD#W03 EQU * CLI 0(R02),C' ' BE CMD#W04 LA R02,1(R02) BCT R01,CMD#W03 * WTO 'STOR-MGR: WAIT TIME OVER FLOW .' B CMD#ERR * CMD#W04 EQU * SR R02,R07 LA R01,4 SR R01,R02 LA R01,WK#WAIT(R01) * MVC WK#WAIT,=CL4'0000' STC R02,*+5 MVC 0(0,R01),0(R07) * * MVC PK_AREA(8),=PL8'0' PACK PK_AREA(8),WK#WAIT CVB R01,PK_AREA STH R01,COM_WTME * MVC MSG#0009+44(4),WK#WAIT WTO TEXT=MSG#A009,MF=(E,WTOINFO) CMD#W_Q EQU * B READLOP1 * CMD#DELY EQU * LA R01,72-10 LA R02,READBUF+9 CMD#D01 EQU * CLI 0(R02),C' ' BNE CMD#D02 LA R02,1(R02) BCT R01,CMD#D01 * WTO 'STOR-MGR: DELAY TIME NOT-FOUND .' B CMD#ERR * CMD#D02 EQU * LR R07,R02 LA R02,1(R02) CL R01,=F'2' BL CMD#D03 LA R01,2 CMD#D03 EQU * CLI 0(R02),C' ' BE CMD#D04 LA R02,1(R02) BCT R01,CMD#D03 * WTO 'STOR-MGR: DELAY TIME OVER FLOW .' B CMD#ERR * CMD#D04 EQU * SR R02,R07 LA R01,2 SR R01,R02 LA R01,WK#DELY(R01) STC R02,*+5 MVC 0(0,R01),0(R07) * CLC WK#DELY,=CL2'60' BL CMD#D05 WTO 'STOR-MGR: DELAY TIME OVER FLOW . MAX 59 MIN' B CMD#ERR * CMD#D05 EQU * MVC MSG#0010+24(2),WK#DELY WTO TEXT=MSG#A010,MF=(E,WTOINFO) STIMER WAIT,DINTVL=C#DELAY Delay WTO TEXT=MSG#A013,MF=(E,WTOINFO) CMD#D_Q EQU * B READLOP1 * CMD#RESP EQU * LA R01,72-10 LA R02,READBUF+9 CMD#R01 EQU * CLI 0(R02),C' ' BNE CMD#R02 LA R02,1(R02) BCT R01,CMD#R01 * WTO 'STOR-MGR: COMMAND RESPONSE MESSAGE NOT FOUND .' B CMD#ERR * CMD#R02 EQU * LR R07,R02 LA R02,READBUF+72 CMD#R03 EQU * CLI 0(R02),C' ' BNE CMD#R04 BCTR R02,0 BCT R01,CMD#R03 * WTO 'STOR-MGR: COMMAND RESPONSE MESSAGE NOT FOUND ??' B CMD#ERR * CMD#R04 EQU * SR R02,R07 STH R02,COM_WLEN STC R02,*+5 MVC COM_WAIT,0(R07) MVI MSG#0011+29,C'*' MVC MSG#0011+30(50),MSG#0011+29 STC R02,*+5 MVC MSG#0011+29(0),0(R07) WTO TEXT=MSG#A011,MF=(E,WTOINFO) * CMD#R_Q EQU * B READLOP1 * * CMD#TOUT EQU * LA R01,72-10 LA R02,READBUF+9 CMD#T01 EQU * CLI 0(R02),C' ' BNE CMD#T02 LA R02,1(R02) BCT R01,CMD#T01 * WTO 'STOR-MGR: COMMAND TIME-OUT MESSAGE NOT FOUND .' B CMD#ERR * CMD#T02 EQU * LR R07,R02 LA R02,READBUF+72 CMD#T03 EQU * CLI 0(R02),C' ' BNE CMD#T04 BCTR R02,0 BCT R01,CMD#T03 * WTO 'STOR-MGR: COMMAND TIME-OUT MESSAGE NOT FOUND ??' B CMD#ERR * CMD#T04 EQU * SR R02,R07 STH R02,COM_TLEN STC R02,*+5 MVC COM_TOUT,0(R07) MVI MSG#0012+29,C'*' MVC MSG#0012+30(50),MSG#0012+29 STC R02,*+5 MVC MSG#0012+29(0),0(R07) WTO TEXT=MSG#A012,MF=(E,WTOINFO) * CMD#T_Q EQU * B READLOP1 * CMD#ERR EQU * LH R01,LINENUM CVD R01,PK_AREA UNPK UPK_AREA(8),PK_AREA(8) OI UPK_AREA+7,X'F0' MVC MSG#0008+10(4),UPK_AREA+4 * CALL @OS#6HC,(LINENUM,MSG#0008+10,2) MVC MSG#0008+17(72-10),READBUF WTO TEXT=MSG#A008,MF=(E,WTOINFO) B READLOP1 READ#X EQU * TM READFLG,X'80' if not Command Flag BNO CMD#SKP4 goto CMD#SKP1 BAL R14,CALL#MCS call Enter Commands CMD#SKP4 EQU * PR CALL#MCS EQU * BAKR R14,0 Branch and Stack ( Stack Only ) MVI MSG#0006+11,C' ' MVC MSG#0006+12(80-13),MSG#0006+11 MVC MSG#0006+10(20),=CL20'COMMAND ENTER > ' MVC MSG#0006+30(50),COM_CMD WTO TEXT=MSG#A006,MF=(E,WTOINFO) * * TM READFLG,X'40' * BNO CMD#SKP5 * MVI MSG#0006+11,C' ' * MVC MSG#0006+12(80-13),MSG#0006+11 * MVC MSG#0006+11(16),=CL16'REPLY : ' * MVC MSG#0006+27(08),COM_WAIT * WTO TEXT=MSG#A006,MF=(E,WTOINFO) *MD#SKP5 EQU * * MVC COM_CONN(8),=CL8'STORMGR' CALL STORMCS,((R04)) XC READFLG,READFLG PR * --- End of Input File Read --- * SA#MGR DS 18F SAVEAREA * Dataset Control Bolck CMDFILE DCB DSORG=PS,MACRF=(GM),DDNAME=CMDFILE, * EODAD=READ#X, * EXLST=CMD_EXL DS 0D CMD_EXL DC X'87',AL3(CMD_JFCB) Command File ExList CMD_JFCB DS 0CL176 Command File * Job File Control Block CMD_DSN DS CL44 Command File Name CMD_DSCB DC CL140' ' Command File CMD_DDNA DS CL8 Command File DD-Name CMD_DSAB DS F Command File * Dataset Allocation Block CMD_RNAM DS 0XL51 Volume Reserved R-Name DC FL1'50' CMD_V DS CL6 Volume Serial CMD_D DS CL44 Dataset Name CMD_RLEN EQU *-CMD_RNAM Length of R-Name CMD_QNAM DC CL8'STOR-MGR' * WK#F2 DS F READFLG DS BL1'00000000' * µ : Command * µ : Response * µ DS 0F WTOINFO WTO TEXT=, WTO parameter list X DESC=(6), descriptor code 6 is Job Status X MF=L WTOERROR WTO TEXT=, WTO parameter list X DESC=(5), descriptor code 6 is Job Status X MF=L MSG#A000 DC AL2(L'MSG#0000) MSG#0000 DC CL80'STOR-MGR: --- START OF STORAGE RE-CONFIG CONTROL PR* OGRAM ---' MSG#A001 DC AL2(L'MSG#0001) MSG#0001 DC CL80'STOR-MGR: ######## SER:@@@@@@ DSN:@@@@' ERRMSA02 DC AL2(L'ERRMSG02) ERRMSG02 DC CL80'STOR-MGR: ######## ERROR RC:@@@@@@@@' MSG#A006 DC AL2(L'MSG#0006) MSG#0006 DC CL80'STOR-MGR: ' MSG#A008 DC AL2(L'MSG#0008) MSG#0008 DC CL80'STOR-MGR: @@@@ >' MSG#A009 DC AL2(L'MSG#0009) MSG#0009 DC CL80'STOR-MGR: SET COMMAND RESPONSE WAIT TIME IS @@@@ MI* N' MSG#A010 DC AL2(L'MSG#0010) MSG#0010 DC CL80'STOR-MGR: PROCESS DELAY @@ MIN ...' MSG#A011 DC AL2(L'MSG#0011) * 0....+....1....+....2....+....3....+....4....+....5* ....+....6....+....7....+....8 MSG#0011 DC CL80'STOR-MGR: COMMAND RESPONSE >' MSG#A012 DC AL2(L'MSG#0012) * 0....+....1....+....2....+....3....+....4....+....5* ....+....6....+....7....+....8 MSG#0012 DC CL80'STOR-MGR: COMMAND TIME-OUT >' MSG#A013 DC AL2(L'MSG#0013) MSG#0013 DC CL80'STOR-MGR: PROCESS DELAY DONE .....' MCSENT DS (MCSCOMML)X READBUF DS CL80 LINENUM DS H WK#WAIT DS CL4 DS 0D * HHMMSSTT C#DELAY DS 0CL8'00020000' Delay 2Sec DC CL2'00' WK#DELY DS CL2 DC CL4'0000' * DS 0D PK_AREA DS PL8 UPK_AREA DS XL16 LTORG ********************************************************************** * --- 31 Bit Addressing Mode --- STORMCS AMODE 31 STORMCS RMODE 24 STORMCS CSECT * --------------------------------------------------------- *-Registor Usage * * R03 : Based Registor * R04 : Re-Entrant Dynamic Data Area Base Registor * --------------------------------------------------------- * --- Start of AR-Mode Program ( Initialize ) --- * PRINT NOGEN BAKR R14,0 Branch and Stack ( Stack Only ) * SAVE (14,12),T,* Save Reg. 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 STORMCS,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 * ST R13,SAVEAREA+4 Store Old-R13 SA+4(Sec Word) * LR R12,R13 * LAE R13,SAVEAREA Load New-R13 * ST R13,8(R12) Store New-R13 SA+8(Thd Word) * --- Start of AR-Mode Program ( End-Initialize ) --- SAC 0 Primary Mode SYSSTATE ASCENV=P LA R01,MSG#A004 Opening Message Show BAL R14,MESSR * --- Main Process --- * --- Start of Argument Parameter --- L R05,0(R05) R05 <- Parameter Area Dsect USING MCSCOMM,R05 MVC MSG#0003+20(60),COM_CMD LA R01,MSG#A003 Display Entry Command BAL R14,MESSR XC COM_RC,COM_RC Clear Return Code XC COM_RSN,COM_RSN Clear Reason Code * LA R01,100 * ST R01,COM_RC * ST R01,COM_RSN * --- End of Argument Parameter --- * * GETMAIN RC,LV=DCBENTL,LOC=BELOW DCB section Area Getmain * LTR R15,R15 if Error * BNZ QUIT1 goto @goto @G_ERR1 * LR R05,R01 Save Global Comm Area * LAE R08,DCBENT Copied Dinamic Stor. * L R09,=A(DCBENTL) * LAE R10,0(0,R05) * LR R11,R09 * MVCL R10,R08 * USING DCBENT,R05 R05 <- Dynamic Stor. * --- Input File Open and Reserved Volume --- * WTO '*** CMD#OPEN ***' * BAL R14,CMD#OPEN * LTR R15,R15 if File Open Error * BNZ QUIT1 goto QUIT * --- MCS Console Activate --- * WTO '*** MCS#ACT ***' BAL R14,MCS#ACT MCS Console Activate . LTR R15,R15 if Comsole Act Error BNZ QUIT1 goto QUIT * * WTO '*** CMDISSUE ***' * * LH R01,=H'6000' 1Min = 0.01Sec * 6000 MH R01,COM_WTME LTR R01,R01 BNZ WAITSET1 L R01,=F'180000' 30Min ( Default ) WAITSET1 EQU * ST R01,WAITMAX * LA R07,WAITMAX-REENTA(R04) LA R07,WAITMAX LA R09,MSG#0014+30-REENTA(R04) CALL @HC,((R07),(R09),4) LA R01,MSG#A014 Opening Message Show BAL R14,MESSR * XC WMAXFLG,WMAXFLG * STIMERM SET,BINTVL=WAITMAX,ID=WMAXID,WAIT=NO,EXIT=WMAXEXT STIMERM SET,BINTVL=WAITMAX,ID=WMAXID,WAIT=NO * BAL R14,CMDISSUE MVS Command Enter * STIMERM CANCEL,ID=WMAXID * * WTO '*** MCS#DEA ***' BAL R14,MCS#DEA MCS Console DeActivate . * Get Messages * --- End-Main Process --- * --- Terminate of Program --- *UIT2 EQU * * BAL R14,CMD#CLOS Close Command File 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 MCS 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 *DEBUG START* MVC ERRMSG01+10(8),=CL8'MCSOPER' BAL R14,ECHOERR LA R15,8 *DEBUG END* @MCSACTQ EQU * 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 * WTO '>> MGCRE ' * --- Primary and SVC Mode --- LA R02,TEXTAREA MGCRE TEXT=(R02), C CONSID=CONSID, C CART=MCART, C CMDFLAG=NOHCPY, C MF=(E,LMGCRE) LTR R15,R15 If Nomal Complete BZ 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+10(8),=CL8'MGCRE' 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 * WTO '>> WAIT ' * --- Wait to Message --- WAIT ECB=MCSECB * MSGLP EQU * * --- Primary Mode Set --- SAC 0 Primary Mode SYSSTATE ASCENV=P * DEBUG * * WTO '>> MCSOPMSG ' * DEBUG * * --- 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 * DEBUG * * WTO '>> MCSOPMSG E' * DEBUG * * --- 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) * BE CMDISU#Q no more messages (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 * STIMERM TEST,ID=WMAXID,TU=WAITTU CLC WAITTU,=F'0' BNE WAITSKP1 * CLC WMAXFLG,=F'0' * BE WAITSKP1 LH R01,COM_TLEN LTR R01,R01 BZ WAITSKP2 STC R01,*+5 MVC MSG#0015+10(0),COM_TOUT LA R01,MSG#A015 Opening Message Show BAL R14,MESSR B CMDISU#X De-Activate Console WAITSKP2 EQU * WTO 'STOR-MGR : COMMAND RESPONSE TIME OUT ..' B CMDISU#X De-Activate Console WAITSKP1 EQU * * STIMER WAIT,DINTVL=WAITXX Delay 2Sec STIMERM SET,DINTVL=WAITXX,ID=WAITID,WAIT=YES B CMDWAIT DS 0D * HHMMSSTT WAITXX DC CL8'00000200' Delay 2Sec WAITID DS XL4 WAITTU DS XL4 GOTERR EQU * some kind of error (rc>8) * DEBUG * * SAC 0 AccessRegister(AR) Mode * SYSSTATE ASCENV=P * WTO '>> GOTERR ' * SAC 512 AccessRegister(AR) Mode * SYSSTATE ASCENV=AR * DEBUG * * --- 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 *DEBUG START* MVC ERRMSG01+10(8),=CL8'MCSOPMSG' BAL R14,ECHOERR *DEBUG END* B CMDISU#X De-Activate Console CMDISU#Q EQU * SAC 0 Primary Mode SYSSTATE ASCENV=P WTO 'STOR-MGR: END OF MESSAGE WAIT LOOP ...' 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 * BAKR R14,0 Branch and Stack ( Stack Only ) * --- Primary Mode Set --- SAC 0 Primary Mode SYSSTATE ASCENV=P * WTO '>> ECHOERR ' LA R07,RC-REENTA(R04) LA R09,ERRMSG01+28-REENTA(R04) CALL @HC,((R07),(R09),4) * CALL @HC,(RC,ERRMSG01+28,4) LA R07,RSN-REENTA(R04) LA R09,ERRMSG01+41-REENTA(R04) CALL @HC,((R07),(R09),4) * CALL @HC,(RSN,ERRMSG01+41,4) LA R01,ERRMSA01 get error message BAL R14,MESSR show it 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 * --- Copy General Information to Message Area --- MVC MSG#0002+29(4),MDBGDSTP Copy Date Stamp MVC MSG#0002+34(3),MDBGDSTP+4 MVC MSG#0002+38(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+50-REENTA(R04) CALL @HC,((R07),(R09),4) * --- Show General Messgae --- LA R01,MSG#A002 Write General Object Information BAL R14,MESSR show it * --- AR Mode Set --- SAC 512 AccessRegister(AR) Mode SYSSTATE ASCENV=AR * 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 SAC 0 Primary Mode SYSSTATE ASCENV=P LA R07,WKCERC-REENTA(R04) LA R09,MSG#0007+23-REENTA(R04) CALL @HC,((R07),(R09),16) LA R07,WKCDESC-REENTA(R04) LA R09,MSG#0007+66-REENTA(R04) CALL @HC,((R07),(R09),2) LA R01,MSG#A007 Opening Message Show BAL R14,MESSR * --- AR Mode Set --- SAC 512 AccessRegister(AR) Mode SYSSTATE ASCENV=AR * --- Binary Data to Chanacter Convert --- 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 * STC R01,*+5 MVC MSG#0005+22(0),COM_WAIT LA R01,MSG#A005 get buf addr BAL R14,MESSR display the text OI MSGWAITF,X'80' B MDBTWAIT don't redisplay my text echo MDBTWAI2 EQU * WTO 'STOR-MGR: NO RESPONSE WAIT ...' OI MSGWAITF,X'80' B MDBTWAIT don't redisplay my text echo MDBTWAIT 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 C R01,=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 GOTT1 DS 0H S R01,=F'1' 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 STH R01,WTOBUF set message length LA R01,WTOBUF get buf addr BAL R14,MESSR display the text GOTTX DS 0H PR GOTTMVC DS 0H MVC WTOTXT(0),0(R02) DROP R08 PR Program Return MESSR DS 0H BAKR R14,0 save caller environment SAC 0 run in primary mode SYSSTATE ASCENV=P tell macros primary mode LR R02,R01 use R02 for text in WTO CLI CMDRSP,1 check for command response BE MESSRC yes, issue as cmd response WTO TEXT=(R02), display message X MF=(E,WTOPL) PR return to caller MESSRC DS 0H WTO TEXT=(R02), display message X CONSID=MYOPER, X CART=MCART, X MF=(E,WTOPLCR) * WTO '>> MESSRC ' PR return to caller * INFOWTO WTO TEXT=, WTO parameter list X DESC=(6), descriptor code 6 is Job Status X MF=L WTOPL WTO TEXT=, WTO parameter list X MF=L * DESC=(7), WTOPLCR WTO TEXT=, WTO parameter list for cmd response X CONSID=, X CART=, X DESC=(5,7), descriptor code 5 is cmd response X MF=L DS 0D LMGCRE MGCRE MF=L * DROP R04 LTORG * WMAXEXT DS 0D SAVE (14,12),T,* LR R03,R15 USING WMAXEXT,R03 WTO '>>> WAIT TIME OUT EXIT ISSUE ...' L R01,WMAXFLG LA R01,1(R01) ST R01,WMAXFLG RETURN (14,12),RC=0 * --- DYNAMIC AREA --- *CBENT DS 0F *MDFILE DCB DSORG=PS,MACRF=(GM),DDNAME=CMDFILE, * EODAD=CMDISU#X, * RECFM=FB,LRECL=80,BLKSIZE=9040 * EODAD=CMDISU#X,EXLST=CMD_EXL, *MDFILEE DCBE RMODE=BUFF *CBENTL EQU *-DCBENT WMAXFLG DS XL4 STIMER ID WAITMAX DS XL4 Time Out Wait Time WMAXID DS XL4 STIMER ID REENTA DS 0F SAVEAREA DS 18F Registor Save Area * --- WTO --- WTOAREA DS 0F DC AL2(WTOLEN) DC B'0000000000000000' MESSAGE DC CL80' ' WTOLEN EQU *-WTOAREA * 0....+....1....+....2....+....3....+....4....+... ERRMSA01 DC AL2(L'ERRMSG01) ERRMSG01 DC CL80'>STOR-MGR ######## ERROR RC:@@@@@@@@ RSN:@@@@@@@@' *RRMSA02 DC AL2(L'ERRMSG02) *RRMSG02 DC CL80'>STOR-MGR ######## ERROR RC:@@@@@@@@' *SG#A001 DC AL2(L'MSG#0001) *SG#0001 DC CL80'STOR-MGR: ######## SER:@@@@@@ DSN:@@@@' MSG#A002 DC AL2(L'MSG#0002) MSG#0002 DC CL80'STOR-MGR: MDBG INFORMATION : @@@@.@@@-@@@@@@@@ ID:@* @@@@@@' MSG#A003 DC AL2(L'MSG#0003) * 0....+....1....+....2....+....3....+....4....+... MSG#0003 DC CL80'STOR-MGR: ENTER CMD>@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@* @@@@@@' MSG#A004 DC AL2(L'MSG#0004) * 0....+....1....+....2....+....3....+....4....+... MSG#0004 DC CL80'STOR-MGR: --- COMMAND ENTRY FROM EXTENDED MCS CONSO* LE ---' MSG#A005 DC AL2(L'MSG#0005) MSG#0005 DC CL80'STOR-MGR: MESSAGE ID :' MSG#A007 DC AL2(L'MSG#0007) * 0....+....1....+....2....+....3....+....4....+....5* ....+....6....+....7....+....8 MSG#0007 DC CL80'STOR-MGR: ROUTE CODE : @@@@@@@@ @@@@@@@@ @@@@@@@ @@* @@@@@@ DESC : @@@@' MSG#A014 DC AL2(L'MSG#0014) MSG#0014 DC CL80'STOR-MGR: MAXIMAM WAIT TIME : @@@@@@@@ (1/100SEC)' MSG#A015 DC AL2(L'MSG#0015) MSG#0015 DC CL80'STOR-MGR:' DS 100C *ABIT DC 0F'0',X'80000000' *MD_EXL DC X'87',AL3(CMD_JFCB) Command File ExList *MD_JFCB DS 0CL176 Command File * Job File Control Block *MD_DSN DS CL44 Command File Name *MD_DSCB DC CL140' ' Command File * Dataset Control Bolck *MD_DDNA DS CL8 Command File DD-Name *MD_DSAB DS F Command File * Dataset Allocation Block *MD_RNAM DS 0XL51 Volume Reserved R-Name * DC XL1'50' *MD_V DS CL6 Volume Serial *MD_D DS CL44 Dataset Name *MD_QNAM DC CL8'STOR-MGR' *MD_RLEN EQU *-CMD_RNAM Length of R-Name * *EADBUF DS CL80 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 * *EXTAREA DC H'30',CL30'CF STOR(352M-512M),OFFLINE' CONSNM DC CL08'MCSSTOR' MCS Console Name CONSID DS A MCS Console ID MCART DS CL08 MCSECB DS F MCSA DS F MCSCSAA DS F WK_F DS F RC DS F RSN 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 CL10'STOR-MGR:' messge id for echoed messages WTOTXT DS CL118 message text MYOPER DS F console id from last modify command DS 0F MSGWAITF DS XL1 DS 0F * 0....+....1....+....2....+....3....+....4....+... *XCMDLST DC H'32' * DC AL2(0) *XCMD DC CL80'S DUMPKUNG,INDSN=''SYS1.MANx''' MSGPARM DS 0F MSGLEN DC AL2(0) MSG DC CL80' ' @MCSOP DS CL60 WKCERC DS XL16 WKCDESC DS XL2 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 --------------------------------------------------------- *VT DSECT CVT DSECT=YES,LIST=YES * --- JESCT ------------------------------------------------------- IEFJESCT * --- DSAB -------------------------------------------------------- IHADSAB * --- UCB --------------------------------------------------------- * PRINT GEN DSECT IEFUCBOB LIST=YES 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) * * LR R11,R01 * * LA R01,SKIPXA * O R01,XABIT * BSM 0,R01 *KIPXA EQU * * --- Address --- * ST R01,WK#ADR * --- from characher --- * LA R02,0(R01) * ST R02,WK#FROM * --- to character --- * LA R02,4(R01) * ST R02,WK#TO * --- convert length --- * LA R02,8(R01) * ST R02,WK#LEN * --- from characher --- L R07,0(R01) * --- to character --- L R08,4(R01) * --- convert length --- L R09,8(R01) * * WTO '*** BINARY TO CHARACTER CONVERTER ***' * LR R01,R09 * SLL R01,1 * STC R01,*+5 * MVC MES#STR2+8(0),0(R08) * MVC @HC#MES,MES#STR2 * LA R01,@HC#WA * SVC 35 * WTO Message * * LA R07,ALLOCER * LA R08,ERRMSG02+30 * LA R09,4 BAL R14,@CO_HEX CALL CONVERT HEX-CHAR * DEBUG ** * * LA R07,WK#ADR * LA R08,MES#ADR+8 * LA R09,4 * BAL R14,@CO_HEX CALL CONVERT HEX-CHAR * MVC @HC#MES,MES#ADR * LA R01,@HC#WA * SVC 35 * WTO Message * * L R07,WK#FROM * L R07,0(R07) * LA R08,MES#STR+8 * L R09,WK#LEN * L R09,0(R09) * CL R09,=F'35' * BNH @DBGSKP1 * LA R09,35 *DBGSKP1 EQU * * BAL R14,@CO_HEX CALL CONVERT HEX-CHAR * MVC @HC#MES,MES#STR * LA R01,@HC#WA * SVC 35 * WTO Message * * L R07,WK#FROM * LA R08,MES#FROM+8 * LA R09,4 * BAL R14,@CO_HEX CALL CONVERT HEX-CHAR * MVC @HC#MES,MES#FROM * LA R01,@HC#WA * SVC 35 * WTO Message * * L R07,WK#TO * LA R08,MES#TO+8 * LA R09,4 * BAL R14,@CO_HEX CALL CONVERT HEX-CHAR * MVC @HC#MES,MES#TO * LA R01,@HC#WA * SVC 35 * WTO Message * * L R07,WK#LEN * LA R08,MES#LEN+8 * LA R09,4 * BAL R14,@CO_HEX CALL CONVERT HEX-CHAR * MVC @HC#MES,MES#LEN * LA R01,@HC#WA * SVC 35 * WTO Message * * DEBUG ** 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 * * LA R01,SKIP370 * BSM 0,R01 *KIP370 EQU * BR R14 * @HC#SA DS 18F WORK SAVEAREA TR DC C'0123456789ABCDEF' CHAR TRUNC TABLE A_TR DC A(TR) * --- WTO --- *HC#WA DS 0F * DC AL2(@HC#WL) * DC B'0000000000000000' *HC#MES DS CL80 *HC#WL EQU *-@HC#WA *ABIT DC 0F'0',X'80000000' *ES#FROM DC CL80'HC FROM:' *ES#TO DC CL80'HC TO :' *ES#LEN DC CL80'HC LEN :' *ES#STR DC CL80'HC AFT :' *ES#STR2 DC CL80'HC BFR :' *ES#ADR DC CL80'HC ADR :' *K#FROM DS F *K#TO DS F *K#LEN DS F *K#ADR DS F LTORG DUMMYCAL AMODE 31 DUMMYCAL RMODE 24 DUMMYCAL CSECT SYSSTATE ASCENV=P SAVE (14,12),T,* BALR R03,0 USING *,R03 BASE REG. R03 ST R13,SA+4 SAVE A(OLD SAVEAREA) LR R12,R13 LA R13,SA ST R13,8(R12) SAVE A(NEW SAVEAREA) * USING MCSCOMM,R04 LA R04,MCSENT2 LA R05,MCSENT2 * * BAL R14,SHOWREGS * WTO '*** CALL TO STORMCS ***' * MVC COM_CONN(8),=CL8'STORMGR' MVC COM_CMD(80),=CL80'D M=STOR' MVC COM_WAIT(8),=CL8'IEE174I' CALL STORMCS,((R04)) * * BAL R14,SHOWREGS * MVC COM_CONN(8),=CL8'STORMGR' MVC COM_CMD(80),=CL80'CF STOR(E=1),ON' MVC COM_WAIT(8),=CL8'IEE712I' CALL STORMCS,((R04)) * MVC COM_CONN(8),=CL8'STORMGR' MVC COM_CMD(80),=CL80'CF STOR(352M-512M),OFF' MVC COM_WAIT(8),=CL8'IEE712I' CALL STORMCS,((R04)) * * BAL R14,SHOWREGS * MVC COM_CONN(8),=CL8'STORMGR' MVC COM_CMD(80),=CL80'D M=STOR' MVC COM_WAIT(8),=CL8'IEE174I' CALL STORMCS,((R04)) * * BAL R14,SHOWREGS * WTO '*** RETURN TO STORMCS ***' L R15,COM_RC LTR R15,R15 BZ @QUIT1 * MVC M,M1 MVC M+21(8),COM_MAC MVC M+37(8),COM_ACT LA R02,COM_RC CALL @HC,((R02),M+49,4) LA R02,COM_RSN CALL @HC,((R02),M+62,4) LA R01,WTOA SVC 35 * WTO Message * @QUIT1 EQU * L R13,SA+4 RETURN RETURN (14,12),RC=0 SHOWREGS EQU * STM R00,R15,SA#REGS MVC M,M2 CALL @HC,(SA#REGS,M+15,16) LA R01,WTOA SVC 35 * WTO Message MVC M,M2 CALL @HC,(SA#REGS+16,M+15,16) LA R01,WTOA SVC 35 * WTO Message MVC M,M2 CALL @HC,(SA#REGS+32,M+15,16) LA R01,WTOA SVC 35 * WTO Message MVC M,M2 CALL @HC,(SA#REGS+48,M+15,16) LA R01,WTOA SVC 35 * WTO Message LM R00,R15,SA#REGS BR R14 * DS 0F SA DS 18F SAVEAREA SA#REGS DS 18F SAVEAREA MCSENT2 DS (MCSCOMML)X * --- WTO --- WTOA DS 0F DC AL2(WTOL) DC B'0000000000000000' * 0....+....1....+....2....+....3....+....4....+... M DS CL80 WTOL EQU *-WTOA M1 DC CL80'STOR-MGR ERROR MACRO:@@@@@@@@ ACTION:@@@@@@@@ RC:@@* @@@@@@ RSN:@@@@@@@@' M2 DC CL80'STOR-MGR REGS :' 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' * Result of SOTRMCS COM_MAC DS CL8 COM_ACT DS CL8 COM_RC DS F COM_RSN DS F MCSCOMML EQU *-MCSCOMM * END DUMMYCAL END STORMGR /* //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=DDMS.V1R2M1.OBJLIB,DISP=SHR //* DD DSN=SYS1.LINKLIB,DISP=SHR //SYSLIN DD DSN=&&LOADSET,DISP=(OLD,DELETE) // DD DDNAME=SYSIN //SYSLMOD DD DSN=DDMSL.V1R2M2.LOADLIB(STOR#ON),DISP=SHR, // UNIT=DASD,VOL=SER=FC9AI3 //*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=DDMS.V1R2M1.OBJLIB //SYSIN DD * //G EXEC PGM=*.L.SYSLMOD,COND=((9,LT,A),(9,LT,L)) //CMDFILE DD DSN=STORAGE.COMMANDS(AI03),DISP=SHR, // UNIT=DASD,VOL=SER=FC9AI3 //