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