FWIW No idea what "runarray" does, but attached is an example [in this
case for a CICS SVC dump] of some native IPCS REXX [as IPCSREXX.txt] -
which can then be modified to read/process any system dump.
BTW Was written to be executed from within IPCS - else add "ARG" and
"ADDRESS IPCS" etc. cards at the start of the REXX code if to be invoked
via TSO batch JCL.
HTH
On 19/04/2022 23:45, Richard Pace wrote:
> Hi Ben: Not sure if you're still looking...Here's my example. I had an array
> of 512 size blocks that I wanted to display 6 bytes from offset +8 in each
> block (a volser). I positioned IPCS at the first block and tried this:
>
> ipcs runarray address(+0) length(512) entries(1:10) exec((list X+8 length(6)))
>
> This did not work. It listed the first control block repeatedly, similar to
> what you experienced I think. On advice from IBM, I changed the command to
> this:
>
> ipcs runarray address(+8) length(512) entries(1:10) exec((list X length(6)))
>
> This worked -- setting the displacement value, +8, in the address field,
> instead of trying to add to X. I didn't really get an explanation from IBM;
> just "working as designed". However, I suspect that inside the EXEC, LIST
> X+n is treated different than LIST X; i.e. X only needs to be evaluated once
> for X+n, whereas X by itself, List knows to use the new position as
> determined by the origin start (the offset value, +8), the entry number, and
> entry length (512).
> Richard
>
> ----------------------------------------------------------------------
> 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
/*-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
TRACE I
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 %<whatever> 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
GET_TCAS:
EXIT: EXIT 0
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to [email protected] with the message: INFO IBM-MAIN
