//FCMD### JOB CLASS=F,MSGCLASS=1,NOTIFY=FSUPP17,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'v0r0m1' 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. ST R06,CPPL_PTR save CPPL Address USING CPPL,R06 CPPL Base Reg. R06 * USING MCSCOMM,R05 LA R05,MCSENT * SAC 0 Primary Mode SYSSTATE ASCENV=P * 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 * BAL R14,@PPL parse command routine * MVC COM_CONN(8),@CONSN ST R06,COM_CPPL Load CPPL Address XC COM_TLEN,COM_TLEN XC COM_WLEN,COM_WLEN CALL CMDE,((R05)) * @BYE EQU * *- L R13,SA#001+4 *- RETURN (14,12),RC=0 STORAGE RELEASE, Freemain Storage X LENGTH=R2ENTAL, X ADDR=(R04) 08650000 PR Program Return Mother * *-------------------------------------------------------------------- * --- Sub Routine ------------------------------------------------- * --- PPL ( parse service routine ) ------------------------------- @PPL EQU * *- STM R00,R15,SAVEPPL save reg. BAKR R14,0 Branch and Stack ( Stack Only ) SAC 0 Primary Mode SYSSTATE ASCENV=P * GETMAIN RU,LV=L_PPL 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 * L R01,PCLCMD R01 <- Command Result Area LH R02,PCLCMD+4 R02 <- Command Result Length BCTR R02,0 STC R02,*+5 * MVC @CMDRES(0),0(R01) copy dsname MVC COM_CMD(0),0(R01) copy dsname ST R02,@CMDL * L R01,PCLMES R01 <- Command Result Area LH R02,PCLMES+4 R02 <- Command Result Length LTR R02,R02 test IKJPARS BZ @PPL_SP1 if error goto @PPL_ERR BCTR R02,0 STC R02,*+5 MVC @WAITMES(0),0(R01) copy dsname STH R02,@WAITML @PPL_SP1 EQU * * DROP R12 * L R01,PPL_ADR free main PPL comm area FREEMAIN RU,LV=L_PPL,A=(R01) LA R15,0 *- LM R00,R15,SAVEPPL load reg. *- BR R14 return PR Return Main * @PPL_ERR EQU * TPUT MSG#E001,L'MSG#E001 L R01,PPL_ADR free main PPL comm area FREEMAIN RU,LV=L_PPL,A=(R01) LA R15,8 *- LM R00,R15,SAVEPPL load reg. *- BR R14 return PR *-------------------------------------------------------------------- * --- Sub Routine ( error routine ) ------------------------------- * --- Super Locate Getmain Error ---------------------------------- @TERM EQU * L R13,SA#001+4 RETURN (14,12),RC=8 * --- Define Storage ---------------------------------------------- * --- Reg. Save Area ---------------------------------------------- * --- 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 ..') PCLT IKJKEYWD IKJNAME 'T',SUBFLD=PCLTFLD PCLM IKJKEYWD IKJNAME 'M',SUBFLD=PCLMFLD PCLTFLD IKJSUBF PCLTM IKJIDENT 'NUMBER',FIRST=NUMERIC,OTHER=NUMERIC,DEFAULT='30' PCLMFLD IKJSUBF PCLMES IKJIDENT ALPHANUM,FIRST=ANY,OTHER=ANY IKJENDP * PRINT NOGEN * --- DYNAMIC AREA --- R2ENTA DS 0F DS 0F SA#001 DS 18F SAVEPPL DS 18F SAVEIOPL DS 18F @CMDRES DS CL80 @CMDL DS F @WAITMES DS CL80 @WAITML DS H @CONSN DC CL8'CMDCON3' * --- CPPL pointer save area -------------------------------------- CPPL_PTR DS F * --- 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) MCSENT DS (MCSCOMML)X * --- dump work area ---------------------------------------------- B#WK1 DS F dump work area B#WK2 DS F dump work area D#WK1 DS D dump work area D#WK2 DS D dump work area C#WK1 DS CL12 dump work area C#WK2 DS CL12 dump work area P#WK1 DS PL8 dump work area P#WK2 DS PL8 dump work area WK#PRI#C DS CL5 work primary space ( cyl ) WK#PRI#T DS CL5 work primary space ( trk ) WK#ALC#C DS CL5 work allocation space ( cyl ) WK#ALC#T DS CL5 work allocation space ( trk ) WK#ALC#B DS F work allocation space ( bin ) WK#CYLS DS XL2 quantity of cylinder per volume WK#TRKS DS XL2 quantity of tracks per cylinder WK#EXTS DS 16XL10 extent data copy area WK#DEVT DS XL4 device type work area MSG#O001 DC CL79'> DEBUG 1' MSG#O002 DC CL79'> DEBUG 2' MSG#O003 DC CL79'> DEBUG 3' * --- Error Message ----------------------------------------------- MSG#E001 DC CL79'> PPL Error Happend .. Bye !!' * --- messgae ----------------------------------------------------- MSG#HELP DS 0CL79 DC CL79'# > S @VOL,V=serial,opt1 ' 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 * LA R01,MSG#0004 LA R02,L'MSG#0004 BAL R14,@PUTL#S Echo Message * MVC MSG#0003+05(75),COM_CMD Copy Command to Message Area LA R01,MSG#0003 LA R02,L'MSG#0003 BAL R14,@PUTL#S Echo Message XC COM_RC,COM_RC Clear Return Code XC COM_RSN,COM_RSN Clear Reason Code * --- End of Argument Parameter --- * --- MCS Console Activate --- BAL R14,MCS#ACT MCS Console Activate . LTR R15,R15 if Comsole Act Error BNZ QUIT1 goto QUIT * LH R01,=H'100' 1Sec = 0.01Sec * 100 MH R01,COM_WTME LTR R01,R01 BNZ WAITSET1 L R01,=F'6000' 30Sec ( Default ) WAITSET1 EQU * ST R01,WAITMAX 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 * XC WMAXFLG,WMAXFLG STIMERM SET,BINTVL=WAITMAX,ID=WMAXID,WAIT=NO * EVENTS ENTRIES=10 Command Response Events Define ST R01,@EVTBL * --- Command Issue --- BAL R14,CMDISSUE MVS Command Enter * STIMERM CANCEL,ID=WMAXID * * --- Extended MCS Console De-Activate --- BAL R14,MCS#DEA MCS Console DeActivate . * Get Messages * --- 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 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 MVC ERRMSG01+05(8),=CL8'MCSOPER' MVC ERRMSG01+14(8),=CL8'ACTIVATE' BAL R14,ECHOERR LA R15,8 @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 * --- 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+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 TABLE=@EVTBL,ECB=(8),WAIT=NO LTR R01,R01 BNZ MSGGOT @EVLOP2 EQU * STIMERM SET,DINTVL=WAITXX,ID=WAITID,WAIT=YES STIMERM TEST,ID=WMAXID,TU=WAITTU CLC WAITTU,=F'0' BNE @EVLOP1 No Time Over LH R01,COM_TLEN LTR R01,R01 BZ @EVSKP2 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 @EVSKP2 EQU * LA R01,MSG#0016 Timeout Message LA R02,L'MSG#0016 BAL R14,@PUTL#S Echo Message B CMDISU#X De-Activate Console @EVLOP1 EQU * * LA R08,MCSECB EVENTS TABLE=@EVTBL,WAIT=NO LTR R01,R01 BNZ MSGGOT B @EVLOP2 No Time Over *?? WAIT ECB=MCSECB 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 * STIMERM TEST,ID=WMAXID,TU=WAITTU CLC WAITTU,=F'0' BNE WAITSKP1 No Time Over LH R01,COM_TLEN LTR R01,R01 BZ 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 Timeout Message LA R02,L'MSG#0016 BAL R14,@PUTL#S Echo Message B CMDISU#X De-Activate Console WAITSKP1 EQU * * STIMER WAIT,DINTVL=WAITXX Delay 2Sec LA R01,MSG#0018 Timeout Message LA R02,L'MSG#0018 BAL R14,@PUTL#S Echo Message 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) * --- 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 * 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 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 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 * --- 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 * 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+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 * --- 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+17(0),COM_WAIT LA R01,MSG#0005 Get Buffer Text LA R02,L'MSG#0005 BAL R14,@PUTL#S Echo Message 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 * * 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 LR R02,R01 LA R01,WTOID BAL R14,@PUTL#S Echo Message GOTTX DS 0H PR GOTTMVC DS 0H MVC WTOTXT(0),0(R02) DROP R08 PR Program Return *-------------------------------------------------- * --- PUTLINE servise routine ( single line ) --------------------- @PUTL#S EQU * *? STM R00,R01,SAVEIOPL save getmain length and address 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) *? LM R00,R15,SAVEIOPL load reg. *? BR R14 return PR return to caller DROP R06 * --- 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 MCSECB DS F REENTA DS 0F * 0....+....1....+....2....+....3....+....4....+... ERRMSG01 DC CL80'@TC: ######## @@@@@@@@ ERROR RC:@@@@@@@@ RSN:@@@' MSG#0002 DC CL80'@TC: MDBG INFORMATION : @@@@.@@@-@@@@@@@@ ID:@@@@@' * 0....+....1....+....2....+....3....+....4....+... MSG#0003 DC CL80'@TC: @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@* @@@@@@' * 0....+....1....+....2....+....3....+....4....+... MSG#0004 DC CL80'@TC: -- Command Entry From Extended MCS Console --' MSG#A005 DC AL2(L'MSG#0005) MSG#0005 DC CL80'@TC: MESSAGE ID :' * 0....+....1....+....2....+....3....+....4....+....5* ....+....6....+....7....+....8 MSG#0007 DC CL80'@TC: ROUTE CODE : @@@@@@@@ @@@@@@@@ @@@@@@@ @@@@@@ * @ DESC : @@@@' MSG#0014 DC CL80'@TC: MAXIMAM WAIT TIME : @@@@@@@@ (1/100SEC)' MSG#0015 DC CL80'@TC:' DS 100C MSG#0016 DC CL80'@TC: Command Response Timeout ...' MSG#0017 DC CL80'@TC: End of Message Wait Loop ...' MSG#0018 DC CL80'@TC: Command Response Wait Loop Continue ...' MSG#0019 DC CL80'@TC: Wait Start ..' MSG#0020 DC CL80'@TC: Wait End ..' MSG#0021 DC CL80'@TC: Wait Got ..' 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 DC CL08'MCSSTOR' MCS Console Name CONSID DS A MCS Console ID MCART DS CL08 *CSECB 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 CL04'>TC:' 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....+... 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 * --- 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) * * 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 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_CPPL DS F * Result of SOTRMCS 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=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.V1R2M1.LOADLIB(@CMD),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=IKJEFT01,COND=((9,LT,A),(9,LT,L)) //STEPLIB DD DSN=DDMSL.V1R2M1.LOADLIB,DISP=SHR, // UNIT=DASD,VOL=SER=FC9AI3 //SYSTSPRT DD SYSOUT=* //SYSTSIN DD * @CMD 'S FFDUMMY' T(10) M(IEE974I) /* // @CMD 'D SMF' T(10) M(IEE974I) @CMD 'S FFDUMMY' T(10) M(IEE974I)