./ ADD NAME=$$$INDEX *---------------------------------------------------------------------* * Directory list of ABBYDALE.MPF.SOURCE * *---------------------------------------------------------------------* | Member | Description | *---------------------------------------------------------------------* | $$$INDEX | This member. | *---------------------------------------------------------------------* | ASLLLA1R | Issue a F LLA,REFRESH when ASLLLA1R is issued. | *---------------------------------------------------------------------* | ASLLLA2R | Issue a F LLA,REFRESH when ASLLLA1R is issued by an | | | authorised jobname (table held in exit) | *---------------------------------------------------------------------* | BPXI078D | Reply "Y" to shutdown of zFS. | *---------------------------------------------------------------------* | DFHS517X | Cut SMF records at CICS start and termination. | *---------------------------------------------------------------------* | HASP190X | Issue a JES2 start for a printer automatically. | *---------------------------------------------------------------------* | IEA793AX | Reply "D" to delete a dump if all dump datasets are full.| *---------------------------------------------------------------------* | IEF176IX | Issue a stop for an external writer. | *---------------------------------------------------------------------* | IKT002IX | Change the text of the message to be more meaningful. | *---------------------------------------------------------------------* | USERCVTS | Sample of using a USERCVT. The code will issue a stop | | | command for a runaway RJE line. This code will need | | | modified to suit site standards and it is really just | | | given as an example of how to use a usercvt. | *---------------------------------------------------------------------* | ©Copyright of Abbydale Systems LLC. | *---------------------------------------------------------------------* ./ ADD NAME=ASLLLA1R ASLLLA1R CSECT ASLLLA1R AMODE 31 ASLLLA1R RMODE ANY * COPY ASLEQUC *********************************************************************** ** A S L L L A 1 R ** *********************************************************************** ** Purpose :- Issue an LLA refresh ** ** ** *********************************************************************** ** Copyright 1998 (C) Abbydale Systems LLC. ** *********************************************************************** *********************************************************************** * REGISTER EQUATES * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * R0 EQU 0 * R1 EQU 1 * R2 EQU 2 * R3 EQU 3 * R4 EQU 4 * R5 EQU 5 * R6 EQU 6 * R7 EQU 7 * R8 EQU 8 A S L E Q U C * R9 EQU 9 * R10 EQU 10 EQUATE PREFIX TO NUMERIC SYMBOLS IN ORDER * R11 EQU 11 TO MAKE THE USE OF REGISTER OPERANDS IN * R12 EQU 12 INSTRUCTIONS SELF EXPLANITORY.THIS ALSO * R13 EQU 13 CREATES ENTRIES IN CROSS REFERENCE. * R14 EQU 14 * R15 EQU 15 * FPR0 EQU 0 * FPR2 EQU 2 * FPR4 EQU 4 * FPR6 EQU 6 * EJECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * MISCELLANEOUS EQUATES * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * EQUHOBON EQU X'80000000' SET HIGH ORDER BIT ON * PACKDIG EQU X'0F' PACK DIGIT * * K.E.F. * * ******************************************************************* * STM R14,R12,12(R13) Save callers registers BALR R12,0 Load base register ... USING *,R12 ... and establish addressability L R5,0(R1) CTXT address into R5 ... USING CTXT,R5 ... and establish addressability *********************************************************************** ** Get Storage for SVC 34 (below the line) ** *********************************************************************** STORAGE OBTAIN,LENGTH=DATAEND,ADDR=(R11),LOC=BELOW USING DATA,R11 Address the area returned ST R13,SAVEAREA+4 Set backwards pointer LA R15,SAVEAREA Get our save area address ... ST R15,8(R13) ... and set forward pointer LR R13,R15 Load R13 with savearea address L R2,CTXTTXPJ Get address of message attributes ... USING CTXTATTR,R2 ... and establish addressability OI CTXTRFB2,CTXTRHCO Set to suppress message XC MGCRPL(MGCRLTH),MGCRPL Clear SVC 34 area MVC MGCRTEXT(L'REPLYT),REPLYT Move our reply in LA R1,(MGCRTEXT-MGCRPL)+L'REPLYT Get length of Reply STC R1,MGCRLGTH Save the length XR R0,R0 Clear register zero MGCR MGCRPL Issue the reply L R13,4(R13) Restore register 13 STORAGE RELEASE,LENGTH=DATAEND,ADDR=(R11) Free the storage LM R14,R12,12(R13) Restore callers registers PR Return to caller REPLYT DS 0CL13 DC CL13'F LLA,REFRESH' Refresh LLA DATA DSECT DS 0F SAVEAREA DS 18F Register save area DATAEND EQU *-DATA MGCR IEZMGCR DSECT=NO IEZVX100 END ./ ADD NAME=ASLLLA2R ASLLLA1R CSECT ASLLLA1R AMODE 31 ASLLLA1R RMODE ANY * COPY ASLEQUC *********************************************************************** ** A S L L L A 1 R ** *********************************************************************** ** Purpose :- Issue an LLA refresh if message is issue by a jobname ** ** defined within the table in the code. ** ** ** *********************************************************************** ** Copyright 1998 (C) Abbydale Systems LLC. ** *********************************************************************** *********************************************************************** * REGISTER EQUATES * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * R0 EQU 0 * R1 EQU 1 * R2 EQU 2 * R3 EQU 3 * R4 EQU 4 * R5 EQU 5 * R6 EQU 6 * R7 EQU 7 * R8 EQU 8 A S L E Q U C * R9 EQU 9 * R10 EQU 10 EQUATE PREFIX TO NUMERIC SYMBOLS IN ORDER * R11 EQU 11 TO MAKE THE USE OF REGISTER OPERANDS IN * R12 EQU 12 INSTRUCTIONS SELF EXPLANITORY.THIS ALSO * R13 EQU 13 CREATES ENTRIES IN CROSS REFERENCE. * R14 EQU 14 * R15 EQU 15 * FPR0 EQU 0 * FPR2 EQU 2 * FPR4 EQU 4 * FPR6 EQU 6 * EJECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * MISCELLANEOUS EQUATES * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * EQUHOBON EQU X'80000000' SET HIGH ORDER BIT ON * PACKDIG EQU X'0F' PACK DIGIT * * K.E.F. * * ******************************************************************* * STM R14,R12,12(R13) Save callers registers BALR R12,0 Load base register ... USING *,R12 ... and establish addressability L R5,0(R1) CTXT address into R5 ... USING CTXT,R5 ... and establish addressability *********************************************************************** ** Get Storage for SVC 34 (below the line) ** *********************************************************************** STORAGE OBTAIN,LENGTH=DATAEND,ADDR=(R11),LOC=BELOW USING DATA,R11 Address the area returned ST R13,SAVEAREA+4 Set backwards pointer LA R15,SAVEAREA Get our save area address ... ST R15,8(R13) ... and set forward pointer LR R13,R15 Load R13 with savearea address L R2,CTXTTXPJ Get address of message attributes ... USING CTXTATTR,R2 ... and establish addressability OI CTXTRFB2,CTXTRHCO Set to suppress message BAS R10,Check_User Go see if we are authorised LTR R7,R7 Can we do it? BNZ Not_Auth No - Get out XC MGCRPL(MGCRLTH),MGCRPL Clear SVC 34 area MVC MGCRTEXT(L'REPLYT),REPLYT Move our reply in LA R1,(MGCRTEXT-MGCRPL)+L'REPLYT Get length of Reply STC R1,MGCRLGTH Save the length XR R0,R0 Clear register zero MGCR MGCRPL Issue the reply Not_Auth DS 0H L R13,4(R13) Restore register 13 STORAGE RELEASE,LENGTH=DATAEND,ADDR=(R11) Free the storage LM R14,R12,12(R13) Restore callers registers PR Return to caller Check_User DS 0H MVC JOBNAME,CTXTJBNM Save jobname TR JOBNAME,TRTABLE LA R7,8 Set default to fail LA R2,Table Start of table LA R3,Table_End End of table Loop_Back DS 0H CLC CTXTJBNM,0(R2) Jobname match? BE Exit_CC0 Yes - Go set Cond code and then exit LA R2,8(R2) Point at next table entry CR R2,R3 End of table? BH Exit_User B Loop_Back Exit_CC0 DS 0H XR R7,R7 Flag OK to issue Exit_User DS 0H BR R10 *********************************************************************** * Start of authorised jobname table * *********************************************************************** Table DS 0H DC CL8'REFRESH ' DC CL8'ASMMPF ' Table_End DS 0H Table_Size EQU Table_End-Table *********************************************************************** * End of autorised jobnames tabel * *********************************************************************** TRTABLE DS 0CL256 DC XL1'40',XL255'00' REPLYT DS 0CL13 DC CL13'F LLA,REFRESH' Refresh LLA DATA DSECT DS 0F JOBNAME DS CL8 SAVEAREA DS 18F Register save area MGCR IEZMGCR DSECT=NO DATAEND EQU *-DATA IEZVX100 END ./ ADD NAME=BPXI078D BPXI078D CSECT BPXI078D AMODE 31 BPXI078D RMODE ANY * COPY ASLEQUC *********************************************************************** ** B P X I 0 7 8 D ** *********************************************************************** ** Purpose :- To reply "Y" to the shutdown message for zFS ** ** ** *********************************************************************** ** Copyright 1998 (C) Abbydale Systems LLC. ** *********************************************************************** *********************************************************************** * REGISTER EQUATES * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * R0 EQU 0 * R1 EQU 1 * R2 EQU 2 * R3 EQU 3 * R4 EQU 4 * R5 EQU 5 * R6 EQU 6 * R7 EQU 7 * R8 EQU 8 A S L E Q U C * R9 EQU 9 * R10 EQU 10 EQUATE PREFIX TO NUMERIC SYMBOLS IN ORDER * R11 EQU 11 TO MAKE THE USE OF REGISTER OPERANDS IN * R12 EQU 12 INSTRUCTIONS SELF EXPLANITORY.THIS ALSO * R13 EQU 13 CREATES ENTRIES IN CROSS REFERENCE. * R14 EQU 14 * R15 EQU 15 * FPR0 EQU 0 * FPR2 EQU 2 * FPR4 EQU 4 * FPR6 EQU 6 * EJECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * MISCELLANEOUS EQUATES * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * EQUHOBON EQU X'80000000' SET HIGH ORDER BIT ON * PACKDIG EQU X'0F' PACK DIGIT * * K.E.F. * * ******************************************************************* * MESSLEN EQU L'MESSAGE STM R14,R12,12(R13) Save callers registers BALR R12,0 Load base register ... USING *,R12 ... and establish addressability L R5,0(R1) CTXT address into R5 ... USING CTXT,R5 ... and establish addressability *********************************************************************** ** Get Storage for SVC 34 (below the line) ** *********************************************************************** STORAGE OBTAIN,LENGTH=DATAEND,ADDR=(R11),LOC=BELOW USING DATA,R11 Address the area returned ST R13,SAVEAREA+4 Set backwards pointer LA R15,SAVEAREA Get our save area address ... ST R15,8(R13) ... and set forward pointer LR R13,R15 Load R13 with savearea address L R2,CTXTTXPJ Get address of message attributes ... USING CTXTATTR,R2 ... and establish addressability LA R4,CTXTTMSG Get adrress of text area ... USING MSGTEXT,R4 ... and address it OI CTXTRFB2,CTXTRHCO Set to suppress message XC MGCRPL(MGCRLTH),MGCRPL Clear SVC 34 area MVC MGCRTEXT(L'REPLYT),REPLYT Move our reply in MVC MGCRTEXT+6(2),CTXTRPID Move in reply number LA R1,(MGCRTEXT-MGCRPL)+L'REPLYT Get length of ReplyH STC R1,MGCRLGTH Save the length XR R0,R0 Clear register zero MGCR MGCRPL Issue the reply L R13,4(R13) Restore register 13 STORAGE RELEASE,LENGTH=DATAEND,ADDR=(R11) Free the storage LM R14,R12,12(R13) Restore callers registers PR Return to caller REPLYT DS 0CL10 DC CL10'REPLY XX,Y' Reply to BPXI078D DATA DSECT DS 0F SAVEAREA DS 18F Register save area COMMAND DS CL6 REPLY DS CL2 REPLYMSG DS CL3 ORG DATAEND EQU *-DATA MSGTEXT DSECT MESSAGE DS 0CL133 MSGID DS CL8 ORG MSGTEXT MGCR IEZMGCR DSECT=NO IEZVX100 END ./ ADD NAME=DFHS517X DFHS517X CSECT DFHS517X AMODE 31 DFHS517X RMODE ANY *********************************************************************** ** D F H S 5 1 7 X ** *********************************************************************** ** Purpose :- To write a SMF record at "CONTROL IS BEING GIVEN TO ** ** CICS" message SMF record type 110 (Hex 6E), Write a ** ** SMF record at "CICS TERMINATION IS COMPLETE". ** *********************************************************************** ** Copyright 1998 (C) Abbydale Systems LLC. ** *********************************************************************** *********************************************************************** * Register Equates * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * R0 EQU 0 * R1 EQU 1 * R2 EQU 2 * R3 EQU 3 * R4 EQU 4 * R5 EQU 5 * R6 EQU 6 * R7 EQU 7 * R8 EQU 8 A S L E Q U C * R9 EQU 9 * R10 EQU 10 EQUATE PREFIX TO NUMERIC SYMBOLS IN ORDER * R11 EQU 11 TO MAKE THE USE OF REGISTER OPERANDS IN * R12 EQU 12 INSTRUCTIONS SELF EXPLANITORY.THIS ALSO * R13 EQU 13 CREATES ENTRIES IN CROSS REFERENCE. * R14 EQU 14 * R15 EQU 15 * FPR0 EQU 0 * FPR2 EQU 2 * FPR4 EQU 4 * FPR6 EQU 6 * EJECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * MISCELLANEOUS EQUATES * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * EQUHOBON EQU X'80000000' SET HIGH ORDER BIT ON * PACKDIG EQU X'0F' PACK DIGIT * * K.E.F. * * ******************************************************************* * * COPY ASLEQUC STM R14,R12,12(R13) Save callers registers BALR R12,0 Load base register ... USING *,R12 ... and establish addressability L R5,0(R1) CTXT address into R5 ... USING CTXT,R5 ... and establish addressability *********************************************************************** ** Get some storage ** *********************************************************************** STORAGE OBTAIN,LENGTH=DATAEND,ADDR=(R11),LOC=ANY USING DATA,R11 Address the area returned ST R13,SAVEAREA+4 Set backwards pointer LA R15,SAVEAREA Get our save area address ... ST R15,8(R13) ... and set forward pointer LR R13,R15 Load R13 with save area address L R2,CTXTTXPJ Get address of message attributes ... USING CTXTATTR,R2 ... and establish addressability LA R4,CTXTTMSG Get address of the text area ... USING MSGTEXT,R4 ... and establish addressability CLC =C'Control is',CONTROL Start up? BE CONT Yes - Cut type 200 SMF record CLC =C'CICS is be',CONTROL Termination message? BNE EXIT Neither one so go and get out MVC SMFREC(SMFSLEN),SMFSKEL Move in skeleton SMF record MVI SMFDRECT,X'C9' Set SMF record number to 201 B Build_it Skip to build SMF Record CONT DS 0H MVC SMFREC(SMFSLEN),SMFSKEL Move in skeleton SMF record Build_it DS 0H MVC SMFJOB,CTXTJBNM Move in our jobname LA R6,SMFSLEN Get length of SMF record STH R6,SMFDLEN Save length into actual record MVC SMFCICS,CICSNAME Move in name of CICS system MVC SMFJID,CICSNAME Move in task name of CICS TIME BIN Get date and time ST R0,SMFDTIME Store time in SMF record ST R1,SMFDDATE Store date in SMF record L R1,16 Address of CVT L R6,196(R1) Address of SMCA L R1,0(0,R1) Address of TCB words L R1,4(0,R1) Point to our TCB L R1,180(R1) Get JSCB Address L R1,316(R1) ... now our SSIB MVC SMFJID,12(R1) Move the identifier to SMF record MVC SMFDSID,16(R6) Move System identifier to SMF record SMFWTM SMFREC Write the SMF record LTR R15,R15 Did it work? BZ EXIT Yes - go and exit *********************************************************************** ** Write of SMF Record failed so issue a fail message ** *********************************************************************** MVC MCSFLAGS,=X'8000' Set WTO Flags MVC MESSAGE(32),=C'MPF exit DFHS517X has failed to ' MVC MESSAGE+32(24),=C'write an SMF record for ' MVC MESSAGE+56(8),CTXTJBNM MVC MESSAGE+64(13),=C' CICS System ' MVC MESSAGE+77(8),CICSNAME MVC LENGTH,=H'89' Store length MVC OTHRFLAG,=X'40004000' Set routing and descriptor codes LA R1,LENGTH Point to WTO Skeleton ... SVC 35 ... and issue the WTO EXIT DS 0H L R13,4(R13) Restore register 13 STORAGE RELEASE,LENGTH=DATAEND,ADDR=(R11) Free the storage LM R14,R12,12(R13) Restore callers registers PR ... and get out LTORG SMFSKEL DS 0H SMF record skeleton SMFLEN DC H'34' .. Record length SMFSEG DC H'0' .. Segment indicator SMFSIND DC X'06' .. System indicator SMFRECTY DC AL1(200) .. Record type (number) SMFTIME DS XL4 .. Time SMFDATE DS XL4 .. Date SMFSID DS CL4 .. System identifier SMFJOBN DS CL8 .. Jobname SMFCICN DS CL8 .. CICS System name SMFID DS CL8 .. Job identifier SMFSLEN EQU *-SMFSKEL .. Length DATA DSECT SAVEAREA DS 18F Register save area CNOP 2,4 SMFREC DS 0H SMF record area SMFDLEN DS H .. Record length SMFDSEG DS H .. Segment indicator SMFDSIND DS XL1 .. System indicator SMFDRECT DS XL1 .. Record type (number) SMFDTIME DS XL4 .. Time SMFDDATE DS XL4 .. Date SMFDSID DS CL4 .. System identifier SMFJOB DS CL8 .. Jobname SMFCICS DS CL8 .. CICS System name SMFJID DS CL8 .. Job identifier LENGTH DS H WTO Length MCSFLAGS DS CL2 MCS Flags MESSAGE DS CL86 Message Area OTHRFLAG DS CL4 Routing and descriptor codes ORG DATAEND EQU *-DATA MGCR IEZMGCR DSECT=NO MSGTEXT DSECT MSGID DS CL8 DS CL2 CICSNAME DS CL8 DS CL1 CONTROL DS CL10 ORG MSGTEXT DSECT IEZVX100 END ./ ADD NAME=HASP190X HASP190X CSECT HASP190X AMODE 31 HASP190X RMODE ANY * COPY ASLEQUC *********************************************************************** ** H A S P 1 9 0 X ** *********************************************************************** ** Purpose :- To issue a start printer command automatically ** *********************************************************************** ** Copyright 1998 (C) Abbydale Systems LLC. ** *********************************************************************** *********************************************************************** * REGISTER EQUATES * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * R0 EQU 0 * R1 EQU 1 * R2 EQU 2 * R3 EQU 3 * R4 EQU 4 * R5 EQU 5 * R6 EQU 6 * R7 EQU 7 * R8 EQU 8 A S L E Q U C * R9 EQU 9 * R10 EQU 10 EQUATE PREFIX TO NUMERIC SYMBOLS IN ORDER * R11 EQU 11 TO MAKE THE USE OF REGISTER OPERANDS IN * R12 EQU 12 INSTRUCTIONS SELF EXPLANITORY.THIS ALSO * R13 EQU 13 CREATES ENTRIES IN CROSS REFERENCE. * R14 EQU 14 * R15 EQU 15 * FPR0 EQU 0 * FPR2 EQU 2 * FPR4 EQU 4 * FPR6 EQU 6 * EJECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * MISCELLANEOUS EQUATES * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * EQUHOBON EQU X'80000000' SET HIGH ORDER BIT ON * PACKDIG EQU X'0F' PACK DIGIT * * K.E.F. * * ******************************************************************* * STM R14,R12,12(R13) Save callers registers BALR R12,0 Load base register ... USING *,R12 ... and establish addressability L R5,0(R1) CTXT address into R5 ... USING CTXT,R5 ... and establish addressability *********************************************************************** ** Get Storage for SVC 34 (below the line) ** *********************************************************************** STORAGE OBTAIN,LENGTH=DATAEND,ADDR=(R11),LOC=BELOW USING DATA,R11 Address the area returned ST R13,SAVEAREA+4 Set backwards pointer LA R15,SAVEAREA Get our save area address ... ST R15,8(R13) ... and set forward pointer LR R13,R15 Load R13 with save area address L R2,CTXTTXPJ Get address of message attributes ... USING CTXTATTR,R2 ... and establish addressability LA R4,CTXTTMSG Get address of the text area ... USING MSGTEXT,R4 ... and establish addressability * CLC =C'PRT1',PRINTER WAS IT PRINTER 1 ? * BE ISSUE YES - GO AND ISSUE IT ISSUE OI CTXTRFB2,CTXTRHCO Set to suppress the message MVC STPRT,PRINTER Move printer id to command XC MGCRPL(MGCRLTH),MGCRPL Clear SVC 34 area MVC MGCRTEXT(L'REPLYT),REPLYT Move our reply in LA R1,(MGCRTEXT-MGCRPL)+L'REPLYT Get length of reply STC R1,MGCRLGTH ... and save in reply area XR R0,R0 Clear register 0 MGCR MGCRPL Issue the start command EXIT DS 0H L R13,4(R13) Restore register 13 STORAGE RELEASE,LENGTH=DATAEND,ADDR=(R11) Free the storage LM R14,R12,12(R13) Restore callers registers PR ... and get out LTORG REPLYT DS 0CL6 Command to be issued DC CL2'$S' Start command ($S) STPRT DS CL4 ... printer id DATA DSECT DS 0F SAVEAREA DS 18F Register save area MGCR IEZMGCR DSECT=NO ORG MGCRTEXT REPLYMSG DS CL3 ORG DATAEND EQU *-DATA MSGTEXT DSECT MSGID DS CL8 DS CL1 JOBNAME DS CL8 DS CL9 PRINTER DS CL4 ORG MSGTEXT IEZVX100 END ./ ADD NAME=IEA793AX IEA793AX CSECT IEA793AX AMODE 31 IEA793AX RMODE ANY * COPY ASLEQUC *********************************************************************** ** I E A 7 9 3 A X ** *********************************************************************** ** Purpose :- To issue a reply of D to delete a dump if no dump ** ** datasets are available. ** ** ** *********************************************************************** ** Copyright 1998 (C) Abbydale Systems LLC. ** *********************************************************************** *********************************************************************** * REGISTER EQUATES * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * R0 EQU 0 * R1 EQU 1 * R2 EQU 2 * R3 EQU 3 * R4 EQU 4 * R5 EQU 5 * R6 EQU 6 * R7 EQU 7 * R8 EQU 8 A S L E Q U C * R9 EQU 9 * R10 EQU 10 EQUATE PREFIX TO NUMERIC SYMBOLS IN ORDER * R11 EQU 11 TO MAKE THE USE OF REGISTER OPERANDS IN * R12 EQU 12 INSTRUCTIONS SELF EXPLANITORY.THIS ALSO * R13 EQU 13 CREATES ENTRIES IN CROSS REFERENCE. * R14 EQU 14 * R15 EQU 15 * FPR0 EQU 0 * FPR2 EQU 2 * FPR4 EQU 4 * FPR6 EQU 6 * EJECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * MISCELLANEOUS EQUATES * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * EQUHOBON EQU X'80000000' SET HIGH ORDER BIT ON * PACKDIG EQU X'0F' PACK DIGIT * * K.E.F. * * ******************************************************************* * STM R14,R12,12(R13) Save callers registers BALR R12,0 Load base register ... USING *,R12 ... and establish addressability L R5,0(R1) CTXT address into R5 ... USING CTXT,R5 ... and establish addressability *********************************************************************** ** Get Storage for SVC 34 (below the line) ** *********************************************************************** STORAGE OBTAIN,LENGTH=DATAEND,ADDR=(R11),LOC=BELOW USING DATA,R11 Address the area returned ST R13,SAVEAREA+4 Set backwards pointer LA R15,SAVEAREA Get our savearea address ... ST R15,8(R13) ... and set forward pointer LR R13,R15 Load r13 with savearea address L R2,CTXTTXPJ Get address of message attributes ... USING CTXTATTR,R2 ... and establish addressability LA R4,CTXTTMSG Get address of the text area ... USING MSGTEXT,R4 ... and establish addressability OI CTXTRFB2,CTXTRHCO Set to suppress the message XC MGCRPL(MGCRLTH),MGCRPL Clear SVC 34 area MVC MGCRTEXT(L'REPLYT),REPLYT Move our repy in MVC MGCRTEXT+6(2),CTXTRPID Move in reply number LA R1,(MGCRTEXT-MGCRPL)+L'REPLYT Get length STC R1,MGCRLGTH ... and save in reply area XR R0,R0 Clear register 0 MGCR MGCRPL Issue the stop command EXIT DS 0H L R13,4(R13) Restore register STORAGE RELEASE,LENGTH=DATAEND,ADDR=(R11) LM R14,R12,12(R13) Restore callers registers PR ... and get out DS 0H REPLYT DC CL10'REPLY XX,D' Reply to be issued DATA DSECT DS 0F SAVEAREA DS 18F Register save area MGCR IEZMGCR DSECT=NO ORG MGCRTEXT COMMAND DS CL6 REPLY DS CL2 REPLYMSG DS CL3 ORG DATAEND EQU *-DATA MSGTEXT DSECT MSGIDNT DS CL8 Message identifier (IEA793A) DS CL4 DS CL19 ORG MSGTEXT IEZVX100 END IEA793AX ./ ADD NAME=IEF176IX IEF176IX CSECT IEF176IX AMODE 31 IEF176IX RMODE ANY * COPY ASLEQUC *********************************************************************** ** I E F 1 6 7 I X ** *********************************************************************** ** Purpose :- To issue a stop for external writers that are reading ** ** R or L (SYSLOG) data from the spool. All others are ** ** left. The 'WAITING FOR WORK' is the trigger message. ** ** ** ** If your external writer is designed to pull output off the spool ** ** as soon as it hits the spool then it is probably better to leave ** ** it running rather than stop it...unless you automatically start ** ** another external writer for it. You may need to review the output ** ** dataset to ensure previous output is not overwritten or discarded ** ** ** ** This process works best if only one outclass is being read from ** ** the spool if more than one is being used then make sure that the ** ** class check is changed accordingly ** *********************************************************************** ** Copyright 1998 (C) Abbydale Systems LLC. ** *********************************************************************** *********************************************************************** * REGISTER EQUATES * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * R0 EQU 0 * R1 EQU 1 * R2 EQU 2 * R3 EQU 3 * R4 EQU 4 * R5 EQU 5 * R6 EQU 6 * R7 EQU 7 * R8 EQU 8 A S L E Q U C * R9 EQU 9 * R10 EQU 10 EQUATE PREFIX TO NUMERIC SYMBOLS IN ORDER * R11 EQU 11 TO MAKE THE USE OF REGISTER OPERANDS IN * R12 EQU 12 INSTRUCTIONS SELF EXPLANITORY.THIS ALSO * R13 EQU 13 CREATES ENTRIES IN CROSS REFERENCE. * R14 EQU 14 * R15 EQU 15 * FPR0 EQU 0 * FPR2 EQU 2 * FPR4 EQU 4 * FPR6 EQU 6 * EJECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * MISCELLANEOUS EQUATES * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * EQUHOBON EQU X'80000000' SET HIGH ORDER BIT ON * PACKDIG EQU X'0F' PACK DIGIT * * K.E.F. * * ******************************************************************* * STM R14,R12,12(R13) Save callers registers BALR R12,0 Load base register ... USING *,R12 ... and establish addressability L R5,0(R1) CTXT address into R5 ... USING CTXT,R5 ... and establish addressability *********************************************************************** ** Get Storage for SVC 34 (below the line) ** *********************************************************************** STORAGE OBTAIN,LENGTH=DATAEND,ADDR=(R11),LOC=BELOW USING DATA,R11 Address the area returned ST R13,SAVEAREA+4 Set backwards pointer LA R15,SAVEAREA Get our savearea address ... ST R15,8(R13) ... and set forward pointer LR R13,R15 Load r13 with savearea address L R2,CTXTTXPJ Get address of message attributes ... USING CTXTATTR,R2 ... and establish addressability LA R4,CTXTTMSG Get address of the text area ... USING MSGTEXT,R4 ... and establish addressability CLC WRITER(7),=C'CLASS=R' Is it writing R class? BE STOPIT Yes - Go and stop it CLC WRITER(7),=C'CLASS=L' Is it writing the SYSLOG? BNE EXIT No - just go and exit STOPIT DS 0H MVC PUNIT,UNIT Move in 'Unit name' to SVC 34 OI CTXTRFB2,CTXTRHCO Set to suppress the message XC MGCRPL(MGCRLTH),MGCRPL Clear SVC 34 area MVC MGCRTEXT(L'REPLYT),REPLYT Move our repy in LA R1,(MGCRTEXT-MGCRPL)+L'REPLYT Get length STC R1,MGCRLGTH ... and save in reply area XR R0,R0 Clear register 0 MGCR MGCRPL Issue the stop command EXIT DS 0H L R13,4(R13) Restore register STORAGE RELEASE,LENGTH=DATAEND,ADDR=(R11) LM R14,R12,12(R13) Restore callers registers PR ... and get out DS 0H REPLYT DC CL10'P XXXXXXX' Command to be issued PUNIT EQU REPLYT+2,8 Unit name area DATA DSECT DS 0F SAVEAREA DS 18F Register save area MGCR IEZMGCR DSECT=NO ORG MGCRTEXT COMMAND DS CL6 REPLY DS CL2 REPLYMSG DS CL3 ORG DATAEND EQU *-DATA MSGTEXT DSECT MSGIDNT DS CL8 Message identifier (IEF176I) DS CL4 UNIT DS CL8 Process name for stop command DS CL19 WRITER DS CL7 Displays the out class being ORG MSGTEXT IEZVX100 END IEF176IX ./ ADD NAME=IKT002IX IKT002IX CSECT IKT002IX AMODE 31 IKT002IX RMODE ANY *********************************************************************** ** This exit will change the text of the IKT002I message so that if ** ** the reason code is 04 it puts in a meaningful description ** *********************************************************************** COPY ASLEQUC MESSLEN EQU L'MESSAGE STM R14,R12,12(R13) Save callers registers BALR R12,0 Load base register ... USING *,R12 ... and establish addressability L R5,0(R1) CTXT address into R5 ... USING CTXT,R5 ... and establish addressability STORAGE OBTAIN,LENGTH=DATAEND,ADDR=(R11) LOC=BELOW USING DATA,R11 Address the area returned ST R13,SAVEAREA+4 Set backwards pointer LA R15,SAVEAREA Get our save area address ... ST R15,8(R13) ... and set forward pointer LR R13,R15 Load R13 with savearea address L R2,CTXTTXPJ Get address of message attributes ... USING CTXTATTR,R2 ... and establish addressability LA R4,CTXTTMSG Get address of the text area ... USING MSGTEXT,R4 ... and establish addressability CLC REASON,=C' 04 ' Is it reason code 48? BNE EXIT No - Do nothing OI CTXTRFB1,CTXTRCMT Set to change message text OI CTXTRFB2,CTXTROMS Override MPF suppression OI CTXTRFB2,CTXTRBCA Send to all active consoles OI CTXTTFB1,CTXTTFWR Set to WTOR MVC NEWTEXT,TEXTCHNG Move in new message text MVI CTXTTLEN+1,MESSLEN Move length of new text EXIT DS 0H L R13,4(R13) Restore R13 STORAGE RELEASE,LENGTH=DATAEND,ADDR=(R11) Free the storage LM R14,R12,12(R13) Restore callers registers PR Return to caller TEXTCHNG DC CL37'TSO ALREADY ACTIVE. REQUEST IGNORED ' DS 0F DATA DSECT DS 0F SAVEAREA DS 18F MGCR IEZMGCR DSECT=NO ORG MGCRTEXT COMMAND DS CL6 REPLY DS CL2 REPLYMSG DS CL3 ORG DATAEND EQU *-DATA MSGTEXT DSECT MESSAGE DS 0CL133 MSGID DS CL8 DS CL34 REASON DS CL4 NEWTEXT EQU MSGID+8,37 ORG MSGTEXT IEZVX100 END ./ ADD NAME=USERCVTS USERCVTS CSECT USERCVTS AMODE 31 USERCVTS RMODE ANY * COPY ASLEQUC *********************************************************************** ** U S E R C V T S ** *********************************************************************** ** Purpose :- Issue a stop for a runaway RJE line if it issues more ** ** than 10 error messages in 10 minutes. ** ** ** *********************************************************************** ** Copyright 1998 (C) Abbydale Systems LLC. ** *********************************************************************** *********************************************************************** * REGISTER EQUATES * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * R0 EQU 0 * R1 EQU 1 * R2 EQU 2 * R3 EQU 3 * R4 EQU 4 * R5 EQU 5 * R6 EQU 6 * R7 EQU 7 * R8 EQU 8 A S L E Q U C * R9 EQU 9 * R10 EQU 10 EQUATE PREFIX TO NUMERIC SYMBOLS IN ORDER * R11 EQU 11 TO MAKE THE USE OF REGISTER OPERANDS IN * R12 EQU 12 INSTRUCTIONS SELF EXPLANITORY.THIS ALSO * R13 EQU 13 CREATES ENTRIES IN CROSS REFERENCE. * R14 EQU 14 * R15 EQU 15 * FPR0 EQU 0 * FPR2 EQU 2 * FPR4 EQU 4 * FPR6 EQU 6 * EJECT * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * MISCELLANEOUS EQUATES * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * EQUHOBON EQU X'80000000' SET HIGH ORDER BIT ON * PACKDIG EQU X'0F' PACK DIGIT * * K.E.F. * * ******************************************************************* * STM R14,R12,12(R13) Save callers registers BALR R12,0 Load base register ... USING *,R12 ... and establish addressability L R5,0(R1) CTXT address into R5 ... USING CTXT,R5 ... and establish addressability *********************************************************************** ** Get Storage for SVC 34 (below the line) ** *********************************************************************** STORAGE OBTAIN,LENGTH=DATAEND,ADDR=(R11),LOC=BELOW USING DATA,R11 Address the area returned ST R13,SAVEAREA+4 Set backwards pointer LA R15,SAVEAREA Get our save area address ... ST R15,8(R13) ... and set forward pointer L R8,CVTPTR Get CVT pointer ... USING CVT,R8 ... and establish addressability L R9,CVTUSER Get address of any USERCVT DROP R8 LTR R9,R9 Do we have a user CVT?? BNZ OK_TO_GO Yes - Skip error message WTO 'ASLUSE1E - NO USER CVT. USERCVTS' B EXIT Now go and exit OK_TO_GO DS 0H USING USERCVT,R9 Address the USERCVT L R10,HASPLINE Get our CVT Address LTR R10,R10 Do we have one yet? BZ GETMAIN No - So go and build one USING CSATABLE,R10 ... Else adddress it CLC =C'USERCVTS',CSAEYECC Is it ours?? BE Success Yes - Skip to SUCCESS WTO 'ASLUSR2E - INCORRECT CVT ENTRY USERCVTS' B EXIT Now go and exit GETMAIN DS 0H STORAGE OBTAIN,LENGTH=198,ADDR=(R10),LOC=ANY, X SP=241,RELATED=GETCSA MVC CSAEYECC,=C'USERCVTS' Move in the eyecatcher XR R2,R2 Clear r2 CS R2,R10,HASPLINE Save it in the CVT area BE Success If it worked - Keep going WTO 'ASLUSR3E - BEATEN TO IT. USERCVTS' B EXIT Now go to exit Success DS 0H L R7,CTXTTXPJ Load major line pointer ... USING CTXTATTR,R7 ... and establish addressability LA R4,CTXTTMSG Address the text area ... USING MSGTEXT,R4 ... and establish addressability LA R10,8(R10) Skip the eyecatcher LA R9,9 MAx table length - 1 COMPARE DS 0H CLC LINE,=C'LINE189' Is it line 189? BE EXIT Yes - just go and exit CLC 0(7,R10),LINE No - Look for a line match BE HIT If we find one go to process it CLC 0(7,R10),=X'00000000000000' Empty entry in table? BE ADDLINE Yes - Add the line in this area LA R10,19(R10) No - skip to next entry ... BCT R9,COMPARE ... then go and check for line again WTO 'TABLE OVERFLOW FOR USERCVTS. CONTACT T.S.S' B EXIT Now go and exit ADDLINE DS 0H MVC 0(7,R10),LINE Move in the line name TIME BIN Get the time RESET DS 0H ST R1,7(R10) Store the date in the table ST R0,11(R10) Store the time in the table LA R1,1 set counter to 1 ... ST R1,15(R10) ... and save it in the table B EXIT Now go and exit ********************************************************************** ** Now check line for 10 errors in the last 10 minutes. If not then ** ** update date and time stamp and reset counter. If it has kill the ** ** line by issuing a $PLNEXX. ** ********************************************************************** HIT DS 0H TIME BIN Get current time ST R1,DATE Save the date ST R0,TIME Save the time CLC DATE,7(R10) Do the dates match? BE CHECK Yes - go to check the time RELOAD DS 0H L R1,DATE Put current date into R1 L R0,TIME Put current time into R0 B RESET Now go and reset the counters CHECK DS 0H L R3,TIME Load current time into R2 S R3,11(R10) Subtract start timeE BNP RELOAD If negative go and reload table C R3,=X'0000EA60' Is the difference less than 10 mins? BH RELOAD No - go and reload the table L R4,15(R10) Load counterR LA R4,1(R4) Add 1 to current counter C R4,=F'10' Tenth time? BH CANCEL Yes - go and stop the line ST R4,15(R10) No - save the counter ... B EXIT ... then go and exit CANCEL DS 0H MVC LINENUM,4(R10) Move line number to command XC MGCRPL(MGCRLTH),MGCRPL Clear parameter list MVC MGCRTEXT(L'PL),PL Move in the message LA R1,(MGCRTEXT-MGCRPL)+L'PL Get the length of the message STC R1,MGCRLGTH Save it in the message area XR R0,R0 Clear R0 for MGCRPL MGCR MGCRPL Issue stop command MVC 15(4,R10),=X'00000000' Clear counter EXIT DS 0H L R13,4(R13) Restore register 13 STORAGE RELEASE,LENGTH=DATAEND,ADDR=(R11) Free the storage LM R14,R12,12(R13) Restore callers registers PR Return to caller PL DC C'$PLNEXXX ' Stop line command LINENUM EQU PL+5,3 .. place the line number goes DATA DSECT DS 0F SAVEAREA DS 18F Register save area DATE DS F Date save area TIME DS F Time save area MGCR IEZMGCR DSECT=NO DATAEND EQU *-DATA MSGTEXT DSECT MSGID DS CL8 DS CL14 LINE DS CL7 MSGTEXT DSECT ORG MSGTEXT COPY USERCVT CSATABLE DSECT CSAEYECC DS D TABLE EYE-CATCHER TABLE DS 10CL19 TABLE OF LINES CVT DSECT=YES DSECT IEZVX100 END ./ ENDUP "REVIEW" PDS MEMBER OFFLOAD AT 20:23 ON 21-08-28