FWIW If you expect to have to do something more than twice, write some
code to do it for you.
Here is some 'model' IPCS REXX code which you can modify/use to analyze
any IPCS system dump.
HTH & Merry Christmas.
Cheers, Chris Poncelet (retired sysprog)
/*-REXX--------------------------------------------------------------*/
/* IPCS CLIST TO ANALYSE A CICS REGION SVC DUMP AND DETERMINE THE */
/* ADDRESS OF THE CSA (DFHCSA). */
/* */
/* INPUT: NONE: IS INVOKED AS A COMMAND, FROM WITHIN IPCS, AND */
/* ¯¯¯¯¯¯ IT THEN ANALYSES THE DUMP CURRENTLY ALLOCATED */
/* */
/* OUTPUT: ADDRESS OF CICS TCB. */
/* ¯¯¯¯¯¯¯ " " " GENERAL PURPOSE REGISTERS FROM TCB. */
/* " " " PRB, IF ANY. */
/* " " " GENERAL PURPOSE REGISTERS FROM ANY PRB. */
/* " " " IRB, IF ANY. */
/* " " " GENERAL PURPOSE REGISTERS FROM ANY IRB. */
/* " " " < ... OTHER RB'S, IF ANY ... > */
/* " " " DFHCSA. */
/* */
/* 06/01/95 CORRECTION TO ACTIVE/SUSPENDED TASK CHAINING */
/* 21/03/94 CMP: AMENDED TO OUTPUT ACTIVE + SUSPENDED TCA'S */
/* 16/03/94 CHRIS PONCELET */
/*-------------------------------------------------------------------*/
ADDRESS IPCS
PSA_ADDRESS = '00000000'
"EVALUATE" PSA_ADDRESS||. ,
"POSITION("X2D(224)") LENGTH(4) REXX(STORAGE(OLD_ASCB_ADDRESS))"
"EVALUATE" OLD_ASCB_ADDRESS||. ,
"POSITION("X2D(6C)") LENGTH(4) REXX(STORAGE(OLD_ASXB_ADDRESS))"
"EVALUATE" OLD_ASXB_ADDRESS||. ,
"POSITION("X2D(4)") LENGTH(4) REXX(STORAGE(TCB_CHAIN_START_ADDRESS))"
"EVALUATE" OLD_ASXB_ADDRESS||. ,
"POSITION("X2D(8)") LENGTH(4) REXX(STORAGE(TCB_CHAIN_STOP_ADDRESS))"
SAY ' '
FIND_CICS_TCB:
FOUND = 'NO'
STOP = 'NO'
TCB_CHAIN_NEXT_ADDRESS = TCB_CHAIN_START_ADDRESS
X_E0 = C2X('E0'X)
X_00 = C2X('00'X)
X_40 = C2X('40'X)
X_60 = C2X('60'X)
X_80 = C2X('80'X)
X_C0 = C2X('C0'X)
DFHSIP = C2X('DFHSIP ')
/* FOR EACH TCB, SEARCH FOR ALL RB'S */
DO WHILE (FOUND = 'NO') & (STOP = 'NO')
IF TCB_CHAIN_NEXT_ADDRESS = TCB_CHAIN_STOP_ADDRESS THEN ,
STOP = 'YEAH'
"EVALUATE" TCB_CHAIN_NEXT_ADDRESS||. ,
"POSITION(0) LENGTH(4) REXX(STORAGE(RB_ADDRESS))"
/* FOR EACH RB: FIND PRB, IF ANY, AND CHECK WHETHER ASSOCIATED */
/* PROGRAM IS DFHSIP */
PRB_ADDRESS = 0
IRB_ADDRESS = 0
TIRB_ADDRESS = 0
SIRB_ADDRESS = 0
SVRB_ADDRESS = 0
DO K = 0 TO 999 WHILE (RB_ADDRESS ¬= TCB_CHAIN_NEXT_ADDRESS)
LINK_ADDRESS.K = RB_ADDRESS
"EVALUATE" RB_ADDRESS||. ,
"POSITION("X2D(0A)") LENGTH(1) REXX(STORAGE(RBSTAB1))"
RB_TYPE_VAL = C2X(BITAND(X2C(X_E0),X2C(RBSTAB1)))
SELECT;
WHEN RB_TYPE_VAL = X_00 THEN DO /* PRB */
LINK_RB.K = 'PRB'
"EVALUATE" RB_ADDRESS||. ,
"POSITION("X2D(0C)") LENGTH(4) REXX(STORAGE(CDE_ADDRESS))"
"EVALUATE" CDE_ADDRESS||. ,
"POSITION("X2D(08)") LENGTH(8) REXX(STORAGE(PROGRAM_NAME))"
IF PROGRAM_NAME = DFHSIP THEN FOUND = 'YEAH'
END
WHEN RB_TYPE_VAL = X_40 THEN , /* IRB */
LINK_RB.K = 'IRB'
WHEN RB_TYPE_VAL = X_60 THEN , /* TIRB */
LINK_RB.K = 'TIRB'
WHEN RB_TYPE_VAL = X_80 THEN , /* SIRB */
LINK_RB.K = 'SIRB'
WHEN RB_TYPE_VAL = X_C0 THEN , /* SVRB */
LINK_RB.K = 'SVRB'
OTHERWISE DO
LINK_RB.K = 'EH??'
SAY 'UNKNOWN RB AT ADDRESS =' RB_ADDRESS
SAY 'RBSTAB1 VALUE = 'RBSTAB1
SAY 'PLEASE CHECK THIS!'
SAY ' '
SAY 'EXECUTION OF IPCS CLIST %#CSAEH IS NOW BEING ABANDONED.'
CALL EXIT
END
END /* SELECT */
"EVALUATE" RB_ADDRESS||. ,
"POSITION("X2D(1D)") LENGTH(3) REXX(STORAGE(RB_ADDRESS))"
RB_ADDRESS = '00'||RB_ADDRESS
END /* DO K = 0 TO 999 WHILE RB_ADDRESS [= TCB_CHAIN_NEXT_ADDRESS */
RB_INDEX = K - 1 /* SAVE RB INDEX COUNTER */
IF FOUND ¬= 'NO' THEN DO
"EVALUATE" TCB_CHAIN_NEXT_ADDRESS||. ,
"POSITION("X2D(70)") LENGTH(4) REXX(STORAGE(AFCB_ADDRESS))"
"EVALUATE" AFCB_ADDRESS||. ,
"POSITION("X2D(08)") LENGTH(4) REXX(STORAGE(DFHCSA_ADDRESS))"
"EVALUATE" DFHCSA_ADDRESS||. ,
"POSITION("X2D(01B8)") LENGTH(8) REXX(STORAGE(DFHCSA_WORKAREA))"
CSA_WORKAREA = X2C(DFHCSA_WORKAREA)
/* DFHCSA HAS BEEN FOUND, SO DISPLAY THE RESULTS */
IF CSA_WORKAREA = 'WORKAREA' THEN DO
/* FETCH ADDRESSES OF LOWEST/HIGHEST PRIORITY TASK DCA'S */
/* ON ACTIVE AND SUSPENDED TASK DCA CHAINS */
"EVALUATE" DFHCSA_ADDRESS||. ,
"POSITION("X2D(00B0)") LENGTH(4) REXX(STORAGE(DFHDCA_ACT_LOW))"
"EVALUATE" DFHCSA_ADDRESS||. ,
"POSITION("X2D(00B4)") LENGTH(4) REXX(STORAGE(DFHDCA_ACT_HIGH))"
"EVALUATE" DFHCSA_ADDRESS||. ,
"POSITION("X2D(00A8)") LENGTH(4) REXX(STORAGE(DFHDCA_SUS_LOW))"
"EVALUATE" DFHCSA_ADDRESS||. ,
"POSITION("X2D(00AC)") LENGTH(4) REXX(STORAGE(DFHDCA_SUS_HIGH))"
/* FETCH TCA'S OF TASKS ON THE ACTIVE CHAIN */
DFHDCA = DFHDCA_ACT_LOW
DO I = 0 TO 999 WHILE (DFHDCA ¬= DFHDCA_ACT_HIGH)
"EVALUATE" DFHDCA||. ,
"POSITION("X2D(0014)") LENGTH(4) REXX(STORAGE(DFHTCA))"
DFHTCA_ACT.I = DFHTCA
"EVALUATE" DFHDCA||. ,
"POSITION("X2D(000C)") LENGTH(4) REXX(STORAGE(DFHDCA))"
END I
"EVALUATE" DFHDCA||. ,
"POSITION("X2D(0014)") LENGTH(4) REXX(STORAGE(DFHTCA))"
DFHTCA_ACT.I = DFHTCA
TCA_ACT_COUNT = I
/* FETCH TCA'S OF TASKS ON THE SUSPENDED CHAIN */
DFHDCA = DFHDCA_SUS_LOW
DO I = 0 TO 999 WHILE (DFHDCA ¬= DFHDCA_SUS_HIGH)
"EVALUATE" DFHDCA||. ,
"POSITION("X2D(0014)") LENGTH(4) REXX(STORAGE(DFHTCA))"
DFHTCA_SUS.I = DFHTCA
"EVALUATE" DFHDCA||. ,
"POSITION("X2D(000C)") LENGTH(4) REXX(STORAGE(DFHDCA))"
END I
"EVALUATE" DFHDCA||. ,
"POSITION("X2D(0014)") LENGTH(4) REXX(STORAGE(DFHTCA))"
DFHTCA_SUS.I = DFHTCA
TCA_SUS_COUNT = I
CALL GET_REGS TCB_CHAIN_NEXT_ADDRESS 'TCB' '30'
/* DISPLAY THE RB'S IN THEIR LINK_TO-ORDER */
DO K = 0 TO RB_INDEX
CALL GET_REGS LINK_ADDRESS.K LINK_RB.K
END K
SAY 'CICS CSA (DFHCSA) ADDRESS = ' DFHCSA_ADDRESS
SAY ' '
SAY ' '
SAY 'TCA''S OF ASCENDING PRIORITY TASKS ON THE ACTIVE CHAIN:-'
SAY ' '
DO I = 0 TO TCA_ACT_COUNT
SAY DFHTCA_ACT.I
END I
SAY ' '
SAY ' '
SAY 'TCA''S OF ASCENDING PRIORITY TASKS ON THE SUSPENDED CHAIN:-'
SAY ' '
DO I = 0 TO TCA_SUS_COUNT
SAY DFHTCA_SUS.I
END I
SAY ' '
END /* IF CSA_WORKAREA = 'WORKAREA' */
ELSE DO
SAY 'ERROR IN CICS CSA (DFHCSA) AT ADDRESS = ' DFHCSA_ADDRESS
SAY 'WORKAREA LITERAL SHOWS =',
'"'CSA_WORKAREA'" (HEX = "'DFHCSA_WORKAREA'")'
SAY 'THIS LITERAL IS INVALID IN A CICS CSA: SHOULD BE "WORKAREA"'
SAY 'PLEASE CHECK THIS!'
CALL EXIT
END /* ELSE */
SAY ' '
END /* IF FOUND */
ELSE IF STOP = 'NO' THEN "EVALUATE" TCB_CHAIN_NEXT_ADDRESS||. ,
"POSITION("X2D(74),
") LENGTH(4) REXX(STORAGE(TCB_CHAIN_NEXT_ADDRESS))"
END /* DO WHILE MORE TCB'S AND NOT FOUND */
SAY ' '
IF FOUND = 'NO' THEN ,
SAY 'NO CICS TCB WAS FOUND IN THE DUMP.'
ELSE ,
SAY 'ALL DONE OK.'
CALL EXIT
GET_REGS:
ARG RB_ADDRESS RB OFFSET
IF OFFSET = '' THEN OFFSET = 20 /* '20'X = RB REGISTER OFFSET */
J = 0
SAY 'CICS 'RB' ADDRESS = ' RB_ADDRESS
DO I = 0 TO 15
"EVALUATE" RB_ADDRESS||. ,
"POSITION("X2D(OFFSET)+I*4") LENGTH(4) REXX(STORAGE(REGIST))"
REGISTER.I = REGIST
END
SAY ' '
SAY RB 'REGISTERS 0-15:'
SAY SUBSTR('----------------------------',1,LENGTH(RB)+16)
/* FORMAT REGISTER CONTENTS OUTPUT :- */
J = 0
DO I1 = 1 TO 2
REG = ''
DO I2 = 1 TO 2
DO J = J TO J+3
REG = REG || REGISTER.J || ' '
END J
REG = REG || ' '
END I2
SAY REG
END I1
SAY ' '
SAY ' '
RETURN
EXIT: EXIT 0
On 25/12/2019 16:13, John Lock wrote:
> On Wed, Dec 25, 2019 at 11:10 John Lock <[email protected]> wrote:
>
>> L 001B000.+32 LEN(4)
>>
> Oops! L 001B000.+32? LEN(length)
>
>>
>> On Wed, Dec 25, 2019 at 09:48 [email protected] <[email protected]> wrote:
>>
>>> Hi,.I'm looking at the z/OS MVS IPCS Commands
>>> .
>>> I can use IPCS LIST 001B000. LENGTH(200)
>>> I can set an equate to this structure
>>> EQUATE CBX 01B000
>>> .
>>> If each Structure had a pointer to the next structure
>>> at a fixed offset I could use a RUNCHAIN t get to the
>>> next structure.
>>> ..
>>> I want to list the data, pointed to by the address that resides within
>>> this structure.
>>> .
>>> Assume At Offset x'32' in this structure is a pointer to a work area.
>>> I can manually look at offset x'32' and use the value there in a LIST
>>> Command.
>>> I want to do this via a COMMAND.
>>> AT 001B000 + 32, I want to automatically display the data pointed to by
>>> this address.
>>> Is this function provided by an IPCS command ?.Any examples would be
>>> appreciated..Paul D'Angelo*
>>>
>>> ----------------------------------------------------------------------
>>> For IBM-MAIN subscribe / signoff / archive access instructions,
>>> send email to [email protected] with the message: INFO IBM-MAIN
>>>
> ----------------------------------------------------------------------
> For IBM-MAIN subscribe / signoff / archive access instructions,
> send email to [email protected] with the message: INFO IBM-MAIN
> .
>
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to [email protected] with the message: INFO IBM-MAIN
