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
