FWIW
Pre-IPCS, there was a TSO batch program to format SYSMDUMPs. I can't
remember precisely, but perhaps it was called something like AMSPRDMP or
similar.
With IPCS, there are lots of pre-written IPCS REXX execs available
somewhere (if memory serves, they begin with BLS*) and they can be
invoked to do most of the standard SYSMDUMP analyses.
I preferred to write my own REXX execs to do that - and I would
recommend that IPCS users likewise write their own execs.
Here is an example of some IPCS REXX (in this case for a CICS dump). HTH.
/*-REXX--------------------------------------------------------------*/
/* IPCS CLIST TO EXTRACT THE ADDRESSES OF A CICS REGION'S SYSTEM */
/* TCA'S (STCA), FROM AN SVC DUMP, THEN REPEATEDLY FOR EACH STCA, */
/* INVOKE %ONLCZDWE PASSING THE STCA AS ARGUMENT. */
/* */
/* INVOKES %ONLCZDWE */
/* ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ */
/* INPUT: NONE: IS INVOKED AS A COMMAND, FROM WITHIN IPCS, AND */
/* ¯¯¯¯¯¯ IT THEN ANALYSES THE DUMP CURRENTLY ALLOCATED */
/* */
/* OUTPUT: ADDRESS OF ACTIVE + SUSPENDED TASKS' SYSTEM TCA'S */
/* ¯¯¯¯¯¯¯ FOR EACH SYSTEM TCA, OUTPUTS: */
/* - TRANSID */
/* - ASSOCIATED PROGRAM ID */
/* - USERID */
/* - TERMID */
/* - DISPATCH CONTROL INDICATOR STATUS */
/* - TASK NUMBER */
/* - DEFERRED WORK ELEMENT LIST */
/* - QUEUE ELEMENT LIST */
/* */
/* */
/* 06/01/95 CORRECTION TO ACTIVE/SUSPENDED TASK CHAINING */
/* 26/08/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))"
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 %ONLCZTAS 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 = 1 TO 999 WHILE (DFHDCA ¬= DFHDCA_ACT_HIGH)
"EVALUATE" DFHDCA||. ,
"POSITION("X2D(0014)") LENGTH(4) REXX(STORAGE(DFHTCA))"
/* WHEN CICS IS CORRUPTED, CAN HAVE DFHTCA = X'00000000' */
/* - WHICH CAUSES INVALID D2X(-400); BYPASS DFHTCA */
/* PROCESSING IN SUCH CASES: */
IF X2D(DFHTCA) ¬= 0 THEN ,
DFHTCA_ACT.I = D2X(X2D(DFHTCA)-400)
ELSE ,
DO
I = I - 1
SAY DFHDCA ': DCA - INVALID ASSOCIATED TCA, ACTIVE CHAIN'
END
"EVALUATE" DFHDCA||. ,
"POSITION("X2D(000C)") LENGTH(4) REXX(STORAGE(DFHDCA))"
END I
"EVALUATE" DFHDCA||. ,
"POSITION("X2D(0014)") LENGTH(4) REXX(STORAGE(DFHTCA))"
/* WHEN CICS IS CORRUPTED, CAN HAVE DFHTCA = X'00000000' */
/* - WHICH CAUSES INVALID D2X(-400); BYPASS DFHTCA */
/* PROCESSING IN SUCH CASES: */
IF X2D(DFHTCA) ¬= 0 THEN ,
DFHTCA_ACT.I = D2X(X2D(DFHTCA)-400)
ELSE ,
DO
I = I - 1
SAY DFHDCA ': DCA - INVALID ASSOCIATED TCA, ACTIVE CHAIN'
END
TCA_ACT_COUNT = I
/* FETCH TCA'S OF TASKS ON THE SUSPENDED CHAIN */
DFHDCA = DFHDCA_SUS_LOW
DO I = 1 TO 999 WHILE DFHDCA ¬= DFHDCA_SUS_HIGH
"EVALUATE" DFHDCA||. ,
"POSITION("X2D(0014)") LENGTH(4) REXX(STORAGE(DFHTCA))"
IF X2D(DFHTCA) ¬= 0 THEN ,
DFHTCA_SUS.I = D2X(X2D(DFHTCA)-400)
ELSE ,
DO
I = I - 1
SAY DFHDCA ': DCA - INVALID ASSOCIATED TCA, SUSPENDED CHAIN'
END
"EVALUATE" DFHDCA||. ,
"POSITION("X2D(000C)") LENGTH(4) REXX(STORAGE(DFHDCA))"
END I
"EVALUATE" DFHDCA||. ,
"POSITION("X2D(0014)") LENGTH(4) REXX(STORAGE(DFHTCA))"
IF X2D(DFHTCA) ¬= 0 THEN ,
DFHTCA_SUS.I = D2X(X2D(DFHTCA)-400)
ELSE ,
DO
I = I - 1
SAY DFHDCA ': DCA - INVALID ASSOCIATED TCA, SUSPENDED CHAIN'
END
TCA_SUS_COUNT = I
/* INVOKE %ONLCZDWE FOR EACH STCA */
DO I = 1 TO TCA_ACT_COUNT
CALL ONLCZDWE DFHTCA_ACT.I
END I
DO I = 1 TO TCA_SUS_COUNT
CALL ONLCZDWE DFHTCA_SUS.I
END I
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
EXIT: EXIT 0
Cheers, Chris Poncelet (r)
On 19/04/2021 14:20, Barbara Nitz wrote:
>> And if I remember correctly you can look at ACTIVE control blocks/memory
>> using IPCS.
> Yes, you can. No problem for common storage because that is visible to every
> address space. active can also be used to peek into other address spaces and
> their data spaces. I hope everybody has protected that function! Here my
> group is the only one that can use it and I am the only one who knows how :-)
>
> Barbara
>
> ----------------------------------------------------------------------
> 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
