Thanks for the reminder of what it was called. On 20/04/2021 13:17, Seymour J Metz wrote: > AMDPRDMP, originally IMDPRDMP in OS/360. After IPCS, there was a lot of new > code shared between IPCS and AMDPRDMP. > > > -- > Shmuel (Seymour J.) Metz > http://mason.gmu.edu/~smetz3 > > ________________________________________ > From: IBM Mainframe Discussion List [[email protected]] on behalf of > CM Poncelet [[email protected]] > Sent: Monday, April 19, 2021 11:41 PM > To: [email protected] > Subject: Re: Print a SYSMDUMP > > 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) > > ---------------------------------------------------------------------- > 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
