TITLE 'XETPUB02-Sample IPCS exit using IXLZSTR with RESTOKEN'
*01* FUNCTION =
* Sample program to illustrate use of IXLZSTR macro
* in an IPCS environment to access coupling facility
* structure data from a dump containing that information. Usage
* of the RESTOKEN keyword is shown for handling requests for
* which all of the information can not be returned in the
* user-provided answer area.
*
*02* OPERATION =
* (1) Obtain a 4K (4096 byte) buffer to be passed to the
* IXLZSTR macro for use as the answer area for a summary
* type request.
*
* (2) Issue the IXLZSTR request to obtain summary structure
* information from the input dump which is expected to
* contain coupling facility structure data for a cache
* structure. The dump also contains multiple entries for
* a given castout class value and the entries have adjunct
* and entry data that was also dumped.
*
* (3) The answer area is searched looking for summary structure
* information for a specific CACHE structure name that is
* expected to have been dumped. If it is found then the
* structure dump id is saved for subsequent use
* in obtaining class entry information for a given castout
* class value.
*
* (4) Free 4K (4096 byte) buffer previously obtained for use as
* a summary data answer area.
*
* (5) Obtain a 8K (8192 byte) buffer to be passed to the
* IXLZSTR macro for use as the answer area for a entry data
* type request.
*
* (6) Issue the IXLZSTR request to obtain all entries with both
* adjunct and entry data returned for a given castout class
* value for the specific Cache structure.
*
* As parts of the answer area are "analyzed", WTOs will
* be issued:
* - Indicating start of analysis of the answer area
* - Identifying the entry name from entry controls
* - Displaying first 16 bytes of adjunct and entry data
* for each entry
* - Indicating going to next table entry in answer area
* - Indicating finished with answer area
*
* (7) Process all of the table entries returned in the answer
* area. Since TYPE(CLASS) data with adjunct and entry data
* is requested and size of entry data is quite large,
* multiple invocations of IXLZSTR are made using the
* RESTOKEN returned to get more data that can not fit in
* the returned answer area for the first and subsequent
* IXLZSTR invocations. (I.e. Step 6 and 7 is repeated as
* many times as necessary to get all of the data.)
*
* (8) Free 8K (8192 byte) buffer previously obtained for use as
* a entry data answer area.
*
* (9) Free dynamic storage previously obtained and return to
* caller.
*********************************************************************
*
*02* RECOVERY-OPERATION = This program functions without recovery.
*
*********************************************************************
EJECT
***********************************************************************
* *
* Standard entry linkage *
* *
***********************************************************************
STM R14,R12,12(R13)
BALR BASEREG1,0 Establish addressability
USING *,BASEREG1
MODID BR=YES
LR R2,R1 Save input parameter
LR R3,R13 Save callers savearea address
STORAGE OBTAIN,ADDR=(DATAREG1),SP=0,LENGTH=DYNASIZE
LA DATAREG2,4095(,DATAREG1) Set Second Data Register
USING DYNA,DATAREG1 First Data Register
USING DYNA+4095,DATAREG2 Second Data Register
ST R3,SAVEAREA+4 Save @ of callers savearea
ST DATAREG1,8(,R3) Chain our savearea to callers
EJECT
***********************************************************************
* *
* Initialize variables *
* *
***********************************************************************
MVC EXITRC,=AL4(GOODRETC) * Initialize return code
ST R2,ABDPLPTR Save input pointer to ABDPL
MVC WTOEXEC(LENWTOS),WTOS * Copy static parmlist to dynamic
MVC WTOTXTD1(L'WTOTXTD1),WTOTXTS1 * Prime WTO text length
EJECT
***********************************************************************
* (1) Obtain a 4K (4096 byte) buffer to be passed to the *
* IXLZSTR macro for use as the answer area for a summary *
* type request. *
***********************************************************************
L R0,SUMMSIZE Size of summary buffer to obtain
STORAGE OBTAIN,ADDR=ANSAREA_PTR,SP=0,LENGTH=(R0)
USING AREAMAP,R2
L R2,ANSAREA_PTR Get addressability to Answer area
EJECT
***********************************************************************
* (2) Issue the IXLZSTR request to obtain summary structure *
* information from the input dump which is expected to contain *
* Coupling Facility structure data for a Cache structure. The *
* dump should also contain multiple entries for a given castout *
* class value and the entries should have adjunct and entry data *
* that was also dumped. *
* *
***********************************************************************
XC MYRESTOKEN(64),MYRESTOKEN Initialize RESTOKEN to
* binary zeros
IXLZSTR ANSAREA=AREAMAP, Output answer area +
ANSLEN=SUMMSIZE, Answer area length +
RESTOKEN=MYRESTOKEN, Input/Output token for IXLZSTR +
ABDPLPTR=ABDPLPTR, IPCS common parameter List addres +
TYPE=STRUCTURE, Get Structure information +
STRLEVEL=SUMMARY, Get summary information +
RETCODE=SAVERET, Return Code +
RSNCODE=SAVERSN, Reason Code +
MF=(E,STREXEC)
***********************************************************************
* Check for the requested data being successfully accessed *
* *
***********************************************************************
L R3,SAVERET Get return code
C R3,=AL4(STRBRETCODESUCC) * All data accessed ?
BNE BADACC Data was not successfully accessed
L R3,SAVERSN Get reason code
C R3,=AL4(STRBRSNCODESUCC) * All data accessed ?
BNE BADACC Data was not successfully accessed
EJECT
***********************************************************************
* Summary data was successfully accessed in the dump *
* *
***********************************************************************
* (3) Search the answer area table entries (which contain summary *
* structure information for the input Cache structure that this *
* sample IPCS exit is interested in. If the structure is found *
* then the corresponding structure dump id is saved for subsequent*
* use in obtaining class entry information for the input castout *
* class value. *
* *
* Note: If the Cache structure of interest was in Structure Rebuild *
* there may be more than one dumped instant of the Cache *
* structure. For purposes of this sample exit, the installation *
* is assumed to be interested in the first dumped instance of the *
* structure. *
* *
***********************************************************************
WTO 'XETPUB02 ANALYZING SUMMARY ANSWER AREA',ROUTCDE=11
USING STRBHEADER,R2 Base Header section of ANSAREA
USING STRBSTRSUMMARY,R4 Base Structure Summary table entry
L R4,STRBFIRSTTABLEENTRY@ * Get addressability to first
* table entry in answer area
NI WRKFLG,NOTFOUND Did not find Cache structure yet
LA R6,STRBSTRSUMMARY_LEN * Size of summary table entry
LA R8,1 Loop increment
LR R9,R8 Processing first table entry
NEXTENT ST R9,I Remember loop count
L R5,STRBNUMTABLEENTRIES * Get number of table entries
CR R9,R5 All table entries searched ?
BH DONESRH Yes, stop searching
***********************************************************************
* Check to see if this table entry is for the input Cache *
* structure *
***********************************************************************
CLI STRBSTRSUMMARYTYPE,STRBSTRTYPECACHE * Cache str type ?
BNE TRYNEXT No, Try next table entry
***********************************************************************
* Check to see if the structure name matches the input Cache *
* structure name *
***********************************************************************
CLC STRBSTRSUMMARYNAME,APPSTRNM * Same str name ?
BNE TRYNEXT No, Try next table entry
***********************************************************************
* Found the table entry for the input Cache structure name. *
* (NOTE: More code needed to handle cases where structure is *
* dumped more than once -- e.g. Structure in rebuild) *
***********************************************************************
OI WRKFLG,FOUNDIT Indicate Cache structure found
LH R3,STRBSTRSUMMARYSTRDUMPID * Save structure dump id
STH R3,DUMPID_STR Remember structure dump id
B DONESRH Stop searching for structure
TRYNEXT EQU * Try next table entry (if any)
ALR R4,R6 Point to next table entry
ST R4,SUMMARY_PTR Remember new table entry address
ALR R9,R8 Processing another table entry
B NEXTENT Go process the next table entry
SPACE 1
***********************************************************************
* Finished searching returned structure summary information *
***********************************************************************
DONESRH EQU * Finished search for structure
TM WRKFLG,FOUNDIT Found the input Cache structure ?
BZ NOCACHE No, tell user structure not found
WTO 'XETPUB02 CACHE STRUCTURE FOUND IN DUMP',ROUTCDE=11
B FREESUM Go free answer area buffer
NOCACHE EQU * Did not find the Cache structure
WTO 'XETPUB02 CACHE STRUCTURE NOT FOUND IN DUMP',ROUTCDE=11
MVC EXITRC,=AL4(BADRETC) Set bad return code
B FREESUM Go free answer area buffer
EJECT
***********************************************************************
* Summary data was not successfully accessed in the dump *
* *
***********************************************************************
BADACC EQU * Data was not accessed successfully
MVC WTOTXTD2(L'WTOTXTD2),WTOBADAC * Set message text
MVC MAPSERV(8),=CL8'IXLZSTR ' * Service that failed
* Convert hex return code to printable hex
MVC PHEXIN(4),SAVERET Hex return code to convert
UNPK PHEXOUT,PHEXIN Unpack the data
MVC MAPRETC(8),PHEXOUT+1 Store unpacked data into target
TR MAPRETC(8),TRTBL-240 Translate to printable hex
* Convert hex reason code to printable hex
MVC PHEXIN(4),SAVERSN Hex reason code to convert
UNPK PHEXOUT,PHEXIN Unpack the data
MVC MAPRSNC(8),PHEXOUT+1 Store unpacked data into target
TR MAPRSNC(8),TRTBL-240 Translate to printable hex
BAL R14,ISSUEWTO Tell user access failed
MVC EXITRC,=AL4(BADRETC) Set bad return code
EJECT
***********************************************************************
* (4) Free 4K (4096 byte) buffer previously obtained for a summary *
* data answer area. *
* *
***********************************************************************
FREESUM L R0,SUMMSIZE Size of summary buffer to be freed
STORAGE RELEASE,ADDR=((R2)),SP=0,LENGTH=(R0)
DROP R2
***********************************************************************
* Only continue processing if input cache structure was dumped *
***********************************************************************
TM WRKFLG,FOUNDIT Found the input Cache structure ?
BZ COMPLETE No, exit is finished
SPACE 2
***********************************************************************
* (5) Obtain a 8K (8192 byte) buffer to be passed to the *
* IXLZSTR macro for use as the answer area for a Entry data *
* type request. *
* *
***********************************************************************
L R0,BIGSIZE Size of big buffer to be obtained
STORAGE OBTAIN,ADDR=ANSAREA_PTR,SP=0,LENGTH=(R0)
USING AREAMAP,R2
L R2,ANSAREA_PTR Get addressability to Answer area
EJECT
***********************************************************************
* (6) Issue the IXLZSTR request to obtain all entries with both *
* adjunct and entry data returned for a given input castout class *
* value for the input Cache structure. *
* *
* This exit is interested in listing the first 16 bytes of the *
* entry data and adjunct data for each entry. For illustration *
* purposes a WTO will be issued to job log for each matching *
* entry found displaying this data. *
* *
* The expected amount of data that will be returned in the answer *
* area is quite large and will not fit in the coded 8K answer *
* area buffer. The following code illustrates how to use *
* IXLZSTR macro with RESTOKEN keyword in a loop to retrieve all *
* of the requested data. *
* *
***********************************************************************
LA R5,ENTBUF Point to start of entry data WTO
* buffer
ST R5,ENTBUF_PTR Remember location in buffer
L R5,MIN_ENTDATA_SIZE Get size of buffer
ST R5,LEN_NEEDED Remember size of buffer still to
* be copied
NI WRKFLG,NOENTWTO Remember that WTO has not been
* issued for current table entry
XC MYRESTOKEN(64),MYRESTOKEN Initialize RESTOKEN to
* binary zeros
***********************************************************************
* Continue to request more of the entry data until all of the *
* data has been returned. (Start of loop) *
* *
***********************************************************************
GETDATA IXLZSTR ANSAREA=AREAMAP, Output answer area +
ANSLEN=BIGSIZE, Answer area length +
RESTOKEN=MYRESTOKEN, Input/Output token for IXLZSTR +
ABDPLPTR=ABDPLPTR, IPCS common parameter List addr +
STRNAME=APPSTRNM, Structure name to get info on +
STRDUMPID=DUMPID_STR, Structure dump id to get info on +
TYPE=CLASS, Get Structure class information +
CLASSTYPE=CASTOUT, Get castout class information +
CLASSLEVEL=ENTRY, Get entry information +
CLASSVAL=GETCLASS, Class value to get info on +
ADJUNCT=YES, Request adjunct data +
ENTRYDATA=YES, Request entry data +
ORDER=TAIL, Return data in tail-to-head order +
RETCODE=SAVERET, Return Code +
RSNCODE=SAVERSN, Reason Code +
MF=(E,STREXEC)
SPACE 1
***********************************************************************
* Check for the requested data being successfully accessed *
***********************************************************************
L R3,SAVERET Get return code
C R3,=AL4(STRBRETCODESUCC) * All data accessed ?
BNE CHKSOME No, Only part of data accessed ?
L R3,SAVERSN Get reason code
C R3,=AL4(STRBRSNCODESUCC) * All data accessed ?
BNE BADACC2 Data was not successfully accessed
B GOODACC Data was successfully accessed
CHKSOME C R3,=AL4(STRBRETCODEMOREDATA) * More data to get ?
BNE BADACC2 Data was not successfully accessed
L R3,SAVERSN Get reason code
C R3,=AL4(STRBRSNCODEANSANOTLGE) * Answer area too small?
BNE BADACC2 Data was not successfully accessed
EJECT
***********************************************************************
* (7) Process all of the table entries returned in the answer area *
* from the IXLZSTR invocation. Since TYPE(CLASS) was requested *
* with adjunct and entry data also returned for a given castout *
* class value and the size of the entry data is quite large, the *
* contents of the answer area just returned may contain different *
* pieces of information. *
* *
* The first thing that appears in the answer area is always the *
* answer area header section mapped by the IXLZSTRB mapping macro *
* (section STRBHEADER). The header section will point to the *
* first table entry returned in the current answer area. *
* *
* The format of each table entry returned for a TYPE(CLASS) *
* CLASSLEVEL(ENTRY) request is also mapping by IXLZSTRB in the *
* mapping section beginning with field STRBENTRY. *
* *
***********************************************************************
GOODACC EQU * Data was successfully accessed
WTO 'XETPUB02 ANALYZING ANSWER AREA',ROUTCDE=11
USING STRBHEADER,R2 Base Header section of ANSAREA
USING STRBENTRY,R4 Base TYPE(CLASS) CLASSLEVEL(ENTRY)
* table entry
L R4,STRBFIRSTTABLEENTRY@ * Get addressability to first
* table entry in answer area
LA R8,1 Loop increment
LR R9,R8 Processing first table entry
NEXTENT2 ST R9,I Remember number of table entries
* processed
***********************************************************************
* The STRBENTRY will indicate if the current table entry has any *
* entry controls present, where it is located and its size. The *
* presence, location, and size of any adjunct data is also in the *
* STRBENTRY. Also, the presence, location, and size of any entry *
* data will be indicated in the STRBENTRY information. *
* *
***********************************************************************
SPACE 1
***********************************************************************
* The first returned answer area associated with a given table *
* entry will point to any entry controls and adjunct data that is *
* going to be returned for the entry. *
***********************************************************************
EJECT
***********************************************************************
* Check for entry control data *
***********************************************************************
L R3,STRBENTRYCNTL@ Get pointer to entry control data
C R3,ZERO Entry control data present ?
BZ SKIPCNTL No, Skip entry control processing
***********************************************************************
* Process the entry controls associated with the current table *
* entry. The entry controls for a cache structure are mapped by *
* DDIC mapping in mapping macro IXLYDDIB. *
* *
* The code below will access the DDIC to get the value specified *
* for the entry when the data was registered in the cache. This *
* information is surfaced by a WTO to the job log. *
***********************************************************************
USING DDIC,R3 Base the cache entry controls
MVC WTOTXTD2(L'WTOTXTD2),WTOCNT * Set message text
MVC MAPCNTNM,DDICNAME Copy the entry's name
BAL R14,ISSUEWTO Issue WTO
SKIPCNTL EQU * Label skips entry control code
SPACE 1
***********************************************************************
* Check for adjunct data *
***********************************************************************
L R3,STRBENTRYADJ@ Get pointer to adjunct data
C R3,ZERO Adjunct data present ?
BZ SKIPADJ No, Skip adjunct data processing
***********************************************************************
* Process the adjunct data associated with the current table *
* entry. Adjunct data is application specific --- the following *
* section of code just issues a WTO to show the first 16 bytes. *
***********************************************************************
USING ADJDATA,R3 Base adjunct data area
MVC WTOTXTD2(L'WTOTXTD2),WTOADJ * Set message text
MVC MAPADJ,ADJ16 First 16 bytes of adjunct data
BAL R14,ISSUEWTO Issue WTO
SKIPADJ EQU * Label skips adjunct data code
EJECT
***********************************************************************
* Process the entry data associated with the current table *
* entry. Entry data is application specific --- the following *
* section of code just issues a WTO to show the first 16 bytes *
* (see constant MIN_ENTDATA_SIZE). *
* *
* NOTE: This code assumes that entry data for the structure is *
* always at least 16 bytes. If a entry is found with less entry *
* data than the expected application minimum size, then a WTO is *
* issued (which would have been proceeded by a WTO that showed *
* the object name associated with the entry from entry controls). *
* *
* There may or may not be room for a table entry's entry data in *
* the first answer area returned for the entry. Entry data may *
* also span one or more answer areas. The code below accumulates *
* entry data in a WTO buffer until MIN_ENTDATA_SIZE bytes of *
* entry data have been returned. Even though there may be more *
* entry data than MIN_ENTDATA_SIZE only MIN_ENTDATA_SIZE bytes *
* are saved for purposes of the WTO showing the first part of the *
* entry data. *
* *
***********************************************************************
* *
* NOTE: Number of IXLZSTR invocations needed to get all of the *
* entry data for a given table entry can be minimized by taking *
* advantage of the STRBENTRYEDATALENLEFT2PROC field to *
* determine how big of an answer area to provide to IXLZSTR. *
***********************************************************************
TM WRKFLG,ENTWTO Processed entry data for this
* table entry yet ?
BNZ SKIPENT Yes, Skip Entry data processing
L R7,STRBENTRYTOTALEDATALEN Get total entry data length
* associated with the table entry
C R7,MIN_ENTDATA_SIZE Total entry data size is large
* enough ?
BNL OKTOTSZ Yes, Process entry data
***********************************************************************
* Issue WTO indicating that the entry data for a table entry was *
* too small. Previous WTO may have already been issued with *
* object name associated with this table entry. *
***********************************************************************
MVC WTOTXTD2(L'WTOTXTD2),WTOBADSZ * Set message text
BAL R14,ISSUEWTO Issue WTO
MVC EXITRC,=AL4(BADRETC) Set bad return code
OI WRKFLG,ENTWTO Indicate WTO issued about this
* table entry's entry data
B SKIPENT Skip Entry data processing
* table entry's entry data
EJECT
OKTOTSZ EQU * Label total entry data size OK
L R3,STRBENTRYEDATA@ Get pointer to entry data
C R3,ZERO Entry data present ?
BZ SKIPENT No, Skip Entry data processing
* associated with the table entry
***********************************************************************
* Some entry data is present in this answer area for the current *
* table entry being processed *
***********************************************************************
L R5,STRBENTRYEDATALEN Get amount of entry data returned
L R6,LEN_NEEDED Get amount of entry data still
* needed before entry data WTO can
* be issued
CLR R5,R6 Was enough entry data returned to
* issue the entry data WTO ?
BL MOVEPART No, move the part of entry data
* in this answer area to WTO buffer
SPACE 1
***********************************************************************
* Enough entry data is present in this answer area to fill up the *
* WTO buffer and issue the entry data WTO. *
***********************************************************************
L R7,ENTBUF_PTR Point to where to move data to
BCTR R6,0 Set length of data to move
EX R6,@MOVEENT Move entry data to WTO buffer
MVC WTOTXTD2(L'WTOTXTD2),WTOENT * Set message text
MVC MAPENT,ENTBUF Move entry data into WTO
BAL R14,ISSUEWTO Issue WTO
OI WRKFLG,ENTWTO Indicate WTO issued about this
* table entry's entry data
B SKIPENT
MOVEPART EQU * Label to move only part of needed
* entry data to WTO buffer
SLR R6,R5 Calculate amount of entry data
* still needed for this table entry
ST R6,LEN_NEEDED Remember how much is still needed
L R7,ENTBUF_PTR Point to where to move data to
BCTR R5,0 Get size of data to be moved
EX R5,@MOVEENT Move entry data to WTO buffer
ALR R7,R5 Point to next byte to move entry
ALR R7,R8 Add one to adjust for prior BCTR
ST R7,ENTBUF_PTR Remember next byte in WTO buffer
* to move entry data to
EJECT
SKIPENT EQU * Skip entry data processing for
* current table entry
***********************************************************************
* Determine if all of the entry data for current table entry has *
* been seen. *
***********************************************************************
L R5,STRBENTRYEDATALENLEFT2PROC * Get amount of entry
* data left to process for last
* table entry in this answer area
C R5,ZERO More entry data for this entry ?
BNE CHKLAST Yes, check that it is last one
***********************************************************************
* All of the entry data for this table entry has been seen. *
* Reset entry data buffer indicators for next table entry. *
***********************************************************************
LA R5,ENTBUF Point to start of entry data WTO
* buffer
ST R5,ENTBUF_PTR Remember location in buffer
L R5,MIN_ENTDATA_SIZE Get size of buffer
ST R5,LEN_NEEDED Remember size of buffer still to
* be copied
NI WRKFLG,NOENTWTO Remember that WTO has not been
* issued for current table entry
CHKLAST EQU * Check for last table entry
***********************************************************************
* Determine if there is another table entry to process in the *
* current answer area *
***********************************************************************
L R9,I Get number of entries processed
ALR R9,R8 Increment number of table entries
L R5,STRBNUMTABLEENTRIES * Get number of table entries
CR R9,R5 All table entries processed ?
BH DONEENT Yes, stop processing table entries
WTO 'XETPUB02 GOING TO NEXT TABLE ENTRY',ROUTCDE=11
EJECT
***********************************************************************
* Point to the next table entry. The following calculation *
* will always give you the length to add to get to the next *
* table entry: *
* *
* size table entry +size adjunct +size entry data +size entry cntls *
* (i.e.) *
* STRBTABLEENTRYLEN+STRBENTRYADJLEN+STRBENTRYEDATLEN+STRBENTRYCNTLLEN *
* *
* NOTE: Some of the sizes above can be different for each *
* table entry and different for the "same table entry" *
* for a table entry for which not all of the entry data *
* can fit in the provided answer area in one IXLZSTR *
* macro invocation. *
* *
***********************************************************************
L R5,STRBTABLEENTRYLEN * Get size of table entry
L R6,STRBENTRYADJLEN Get size of returned adjunct data
ALR R5,R6 Add to table entry size
L R6,STRBENTRYEDATALEN Get size of returned entry data
ALR R5,R6 Add to table entry size
L R6,STRBENTRYCNTLLEN Get size of returned entry cntls
ALR R5,R6 Add to table entry size
ALR R4,R5 Point to next table entry
ST R4,ENTRY_PTR Remember new table entry address
B NEXTENT2 Go process the next table entry
EJECT
***********************************************************************
* Finished processing returned TYPE(CLASS) CLASSLEVEL(ENTRY) data *
* in the current answer area buffer. *
***********************************************************************
DONEENT EQU * Finished processing table entries
WTO 'XETPUB02 FINISHED WITH THIS ANSAREA',ROUTCDE=11
***********************************************************************
* Check to see if there is more data still to get from dump *
***********************************************************************
L R3,SAVERET Is there more data to get ?
C R3,=AL4(STRBRETCODEMOREDATA) * More data to get ?
BE GETDATA Go get more of the data
***********************************************************************
* (End of loop to request more of the entry data in the dump *
* until of the data has been returned) *
* *
***********************************************************************
WTO 'XETPUB02 FINISHED ACCESSING ALL DATA',ROUTCDE=11
B FREEENT Go free answer area buffer
EJECT
***********************************************************************
* Entry data was not successfully accessed in the dump *
* *
***********************************************************************
BADACC2 EQU * Data was not accessed successfully
MVC WTOTXTD2(L'WTOTXTD2),WTOBADAC * Set message text
MVC MAPSERV(8),=CL8'IXLZSTR ' * Service that failed
* Convert hex return code to printable hex
MVC PHEXIN(4),SAVERET Hex return code to convert
UNPK PHEXOUT,PHEXIN Unpack the data
MVC MAPRETC(8),PHEXOUT+1 Store unpacked data into target
TR MAPRETC(8),TRTBL-240 Translate to printable hex
* Convert hex reason code to printable hex
MVC PHEXIN(4),SAVERSN Hex reason code to convert
UNPK PHEXOUT,PHEXIN Unpack the data
MVC MAPRSNC(8),PHEXOUT+1 Store unpacked data into target
TR MAPRSNC(8),TRTBL-240 Translate to printable hex
BAL R14,ISSUEWTO Tell user access failed
MVC EXITRC,=AL4(BADRETC) Set bad return code
EJECT
***********************************************************************
* (8) Free 8K (8192 byte) buffer previously obtained for a entry *
* data answer area. *
* *
***********************************************************************
FREEENT L R0,BIGSIZE Size of entry buffer to be freed
STORAGE RELEASE,ADDR=((R2)),SP=0,LENGTH=(R0)
DROP R2
EJECT
***********************************************************************
* *
* (9) Free up dynamic storage and return to caller *
* *
***********************************************************************
COMPLETE EQU *
L R2,SAVEAREA+4 Save caller's save area address
L R3,EXITRC Save IPCS exit return code
STORAGE RELEASE,ADDR=((DATAREG1)),LENGTH=DYNASIZE
LR R13,R2 Restore caller's save area address
L R14,12(R13) Restore Return address
LR R15,R3 Set IPCS exit return code
LM R0,R12,20(R13) Restore Registers R0-R12
BR R14 Return to caller
SPACE 2
***********************************************************************
* Special EX target instructions *
***********************************************************************
@MOVEENT MVC 0(0,R7),0(R3) Move entry data to WTO buffer
EJECT
***********************************************************************
* *
* Subroutine: ISSUEWTO *
* *
* Function : This routine is called whenever contention is *
* detected on a dataset, and the dataset owner is a *
* job on this system. It will take whatever action it *
* can to attempt to relieve the contention. *
* *
* Input : WTOTXTD1 contains text for WTO message to be issued *
* *
* *
***********************************************************************
ISSUEWTO EQU *
STM R14,R12,SAVE1 Save callers regs
LA R5,WTOTXTD1 Address WTO parmlist
WTO TEXT=(R5),ROUTCDE=(11),MF=(E,WTOEXEC) * Issue WTO
LM R14,R12,SAVE1 Restore callers regs
BR R14 Return to caller
EJECT
***********************************************************************
* *
* Register declares *
* *
***********************************************************************
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
R9 EQU 9
R10 EQU 10 Reserved for future expansion
* of the code or the dynamic area
DATAREG2 EQU 11 Second data register
BASEREG1 EQU 12 Code register
R12 EQU 12
DATAREG1 EQU 13 First data register
R13 EQU 13
R14 EQU 14
R15 EQU 15
EJECT
***********************************************************************
* *
* Static data *
* *
***********************************************************************
DS 0F
TRTBL DC CL16'0123456789ABCDEF' * Translate table
ZERO DC F'0' * Constant zero for comparisons
SPACE 1
***********************************************************************
* *
* Static WTO data *
* *
***********************************************************************
WTOS WTO TEXT=,ROUTCDE=(11),MF=L * Static form of WTO
LENWTOS EQU *-WTOS * Length of WTO parmlist
WTOTXTS1 DC AL2(L'WTOTXTD2) * WTO text length
WTOBADAC DC CL65'XETPUB02 mmmmmmmm RETCODE=rrrrrrrr RSNCODE=ssssssss'
MAPSERV EQU WTOTXTD2+9,8,C'C' * Map service WTO insert
MAPRETC EQU WTOTXTD2+26,8,C'C' * Map service RETCODE insert
MAPRSNC EQU WTOTXTD2+43,8,C'C' * Map service RETCODE insert
WTOADJ DC CL65'XETPUB02 FIRST 16 CHARS ADJUNCT IS: aaaaaaaaaaaaaaaa'
MAPADJ EQU WTOTXTD2+36,16,C'C' * Map adjunct data insert
WTOENT DC CL65'XETPUB02 FIRST 16 CHARS ENTRY DATA: eeeeeeeeeeeeeeee'
MAPENT EQU WTOTXTD2+36,16,C'C' * Map entry data insert
WTOBADSZ DC CL65'XETPUB02 ENTRY DATA SIZE WAS TOO SMALL '
WTOCNT DC CL65'XETPUB02 ENTRY NAME FROM DDICNAME: cccccccccccccccc'
MAPCNTNM EQU WTOTXTD2+36,16,C'C' * Map entry's object name insert
EJECT
***********************************************************************
* *
* Constants used in accessing Coupling Facility structure data. *
* *
***********************************************************************
APPSTRNM DC CL16'CACHE02 ' Application structure name to
* be accessed in the dump
GETCLASS DC F'2' Castout class value for which
* class entry data is to be
* accessed
SUMMSIZE DC F'4096' Size of answer area to be used
* for returning coupling facility
* summary information
BIGSIZE DC F'8192' Size of answer area to be used
* for returning coupling facility
* detail information
MIN_ENTDATA_SIZE DC F'16' Minimum size of entry data
* expected. If this size is
* changed then WTO sizes may have
* to be updated.
* (See ENTBUF, WTOENT, MAPENT, and
* WTOTXTD2 fields)
LTORG
EJECT
***********************************************************************
* *
* Dynamic data *
* *
***********************************************************************
DYNA DSECT
SAVEAREA DS 18F Standard savearea (first field)
ABDPLPTR DS AL4 Pointer to ABDPL
ANSAREA_PTR DS AL4 Answer area storage pointer
LEN_NEEDED DS F Length of entry data still
* needed before WTO is issued
CLASSVAL DS 1F Class value
DETAIL_PTR DS A ANSAREA detail area data pointer
DUMPID_STR DS 1H Structure dump id
DUMP_STRNAME DS CL16 Structure name in dump
ENTBUF DS CL16 Entry data buffer for WTO
DS 0F
ENTBUF_PTR DS A Pointer into entry data buffer
* to copy entry data into
ENTRY_PTR DS A ANSAREA Entry area pointer
I DS 1F Loop index
PHEXIN DS CL5 Work area for printable hex conv
PHEXOUT DS CL10 Work area for printable hex conv
MYRESTOKEN DS CL64 RESTOKEN returned by IXLZSTR
SAVERET DS F Save macro service return code
SAVERSN DS F Save macro service reason code
SAVE1 DS 15F First level subroutine savearea
SAVE2 DS 15F Second level subroutine savearea
SUMMARY_PTR DS A ANSAREA summary data pointer
EXITRC DS F Module Return code
BADRETC EQU 8 Bad return code from IPCS exit
GOODRETC EQU 0 Good return code from IPCS exit
SPACE 1
WRKFLG DS BL.008 Work Flags
FOUNDIT EQU X'80' Indicates Input Cache structure
* summary info found in the dump
ENTWTO EQU X'40' Indicates WTO issued about entry
* data for current entry
NOENTWTO EQU X'BF' Indicates WTO not issued about
* entry data for current entry
NOTFOUND EQU X'7F' Indicates summary info not found
* in the dump
EJECT
***********************************************************************
* *
* List forms of macros (Dynamic storage) *
* *
***********************************************************************
IXLZSTR MF=(L,STREXEC)
EJECT
***********************************************************************
* *
* Dynamic WTO storage *
* *
***********************************************************************
WTOEXEC WTO TEXT=,ROUTCDE=(11),MF=L * List form of WTO parmlist
WTOTXTD1 DC AL2(L'WTOTXTD1) * WTO text length
WTOTXTD2 DC CL65' ' * WTO text
***********************************************************************
* *
* End of dynamic storage *
* *
***********************************************************************
DYNASIZE EQU *-DYNA Total size of dynamic storage
EJECT
***********************************************************************
* *
* Other mappings *
* *
***********************************************************************
AREAMAP EQU 0,,C'C' Map Answer area
SPACE 2
ADJDATA DSECT Map Adjunct data
ADJ16 DS CL16 First 16 bytes adjunct data
ADJREST DS CL48 Rest of adjunct data
EJECT
***********************************************************************
* *
* Mapping macros *
* *
***********************************************************************
BLSABDPL
IXLZSTRB
IXLYDDIB
END
z/OS MVS Programming: Sysplex Services Reference
Copyright IBM Corporation 1990, 2014