PRM TITLE 'DMMPRM (IPCS) VM/370 - RELEASE 6' 00001000
* 00002000
* MODULE NAME: DMMPRM 00003000
* 00004000
* 00005000
* FUNCTION: FINAL RTN. IN THE DMMEDM COMPLEX. PROMPTS THE USER 00006000
* FOR ANY INFO. HE MAY HAVE CONCERNING THE PROBLEM, 00007000
* INCLUDING SUPPLEMENTARY DATA FILES AND TEXTUAL 00008000
* NOTES ABOUT THE FAILURE. 00009000
* 00010000
* 00011000
* ATTRIBUTES: NON-REENTRANT 00012000
* NON-REUSABLE 00013000
* 00014000
* 00015000
* ENTRY POINTS: DMMPRM 00016000
* 00017000
* 00018000
* ENTRY CONDITIONS: COMMON SHARED CONSTANT AREA CONTAINS 00019000
* INFORMATION GATHERED BY PREVIOUS ROUTINES. 00020000
* 00021000
* 00022000
* EXIT CONDITIONS: TO DMMEDM WITH PROBLEM REPORT CREATED, THE 00023000
* SYMPTOM SUMMARY FILE APPENDED, AND THE SUMMARY 00024000
* RECORD UPDATED. 00025000
* 00026000
* 00027000
* CALLS TO OTHER ROUTINES: NONE 00028000
* 00029000
* 00030000
* EXTERNAL REFERENCES: SHARECON (COMMON CONSTANT AREA) 00031000
* INTDATA (INTERNAL DATA AREA FOR WRITEREC) 00032000
* 00033000
* 00034000
* TABLES/WORKAREAS: 00035000
* 00036000
* 00037000
* REGISTER USAGE: R13 SAVEAREA 00038000
* R12 BASE 00039000
* R10 INTERNAL LINK REGISTER 00040000
* R9 POINTER TO TERMINAL INPUT OR OUTPUT 00041000
* R8 INTSECT (INTERNAL DATA AREA FOR WRITEREC) 00042000
* R7 SHARECON (SHARED CONSTANT AREA) 00043000
* R2-R6 WORK 00044000
* 00045000
* 00046000
* NOTES: A 200 BYTE PATCH AREA EXISTS AT LABEL 'PATCH' 00047000
* 00048000
* 00049000
* OPERATION: 00050000
* 00051000
* I. TELL THE USER THE NUMBER THIS PROBLEM HAS BEEN ASSIGNED 00052000
* II. PROMPT THE USER FOR THE SEVERITY OF THE PROBLEM 00053000
* III. CHECK WHICH KIND OF FAILURE WE ARE HANDLING, GO DO 00054000
* APPROPRIATE PROCESSING. 00055000
* A. WAIT STATE ERROR PROCESSING: 00056000
* TELL USER OF THE APPARENT WAIT STATE CONDITION AND 00057000
* PROMPT HIM FOR ANY INFORMATION HE CAN SUPPLY ABOUT 00058000
* CONDITIONS AT THE TIME OF THE DUMP. 00059000
* B. INCONCLUSIVE DUMP PROCESSING: 00060000
* TELL USER THE DUMP IS INCONCLUSIVE AND ASK HIM TO 00061000
* INDICATE WHY THE DUMP WAS TAKEN (LOOP, 00062000
* PERFORMANCE OR OTHER. 00063000
* C. PROCESSING ERROR IN PREVIOUS ROUTINE: 00064000
* TELL USER OF PROCESSING ERROR AND INDICATE SUCH IN THE 00065000
* PROBLEM REPORT. 00066000
* D. IF NONE OF THE OTHER CONDITIONS CONTINUE WITH IV. 00067000
* IV. PROMPT THE USER FOR THE NAMES AND LOCATION OF ANY 00068000
* SUPPORTING DATA 00069000
* V. PROMPT USER FOR A TEXTUAL DESCRIPTION OF THE PROBLEM. 00070000
* VI. UPDATE THE SUMMARY RECORD WITH A PROBLEM NUMBER. 00071000
* VII. CALL DMMWRT TO CREATE THE PROB. REPORT AND ADD TO THE 00072000
* SYMPTOM SYMMARY FILE. 00073000
* VIII. RETURN TO DMMEDM 00074000
* 00075000
* ERROR MESSAGES: DMMPRM804I ERROR IN DATA EXTRACTION 00076000
* 00077000
* 00078000
*************************************************************** 00079000
EJECT 00080000
DMMPRM CSECT @VA04250 00081000
USING DMMPRM,R15 TEMPORARY ADDRESSABILITY @VA04250 00082000
B START BRANCH AROUND EYECATCHER @VA04250 00083000
DS 0D @VA04250 00084000
MODNAME DC C'DMMPRM ' MODULE NAME @VA04250 00085000
RELLEV DC C'REL4LEV0' RELEASE AND LEVEL @V4075A1 00086000
DROP R15 @VA04250 00087000
START STM R14,R12,12(R13) SAVE CALLER'S REGISTERS @VA04250 00089000
LR R12,R15 LOAD OUR BASE @VA04250 00090000
USING DMMPRM,R12 ESTABLISH ADDRESSABILITY @VA04250 00091000
ST R13,SAVEAREA+8 SAVE CALLER'S SAVEAREA @VA04250 00092000
LA R13,SAVEAREA SET UP OUR SAVEAREA @VA04250 00093000
L R8,INTERNAL POINT TO INTERNAL DATA AREA @VA04250 00094000
USING INTSECT,R8 ADDRESSABILITY FOR INT. DATA @VA04250 00095000
L R7,VSHARE POINT TO SHARED AREA @VA04250 00096000
USING SHARECON,R7 SHARED CONSTANT ADDRESSABILITY @VA04250 00097000
LA R5,TEXT6 GET START OF USER TEXT AREA @VA04250 00098000
ST R5,TEXTCURR SAVE AS CURRENT POINTER @VA04250 00099000
*************************************************************** 00100000
*INFORM OPERATOR OF PROBLEM NUMBER THAT IS BEING PROCESSED. 00101000
*************************************************************** 00102000
TM TYPESW,PROCERR EXTRACTION ERROR BEEN POSTED? @VA04250 00103000
BNO WPNUM NO @VA04250 00104000
LA R9,MSG804I 'ERROR IN DATA EXTRACT' @VA04250 00105000
LA R3,L'MSG804I SUPPLY WRTERM LENGTH OF MESSAGE @VA04250 00106000
BAL R10,WRTERM GO INFORM USER @VA04250 00107000
WPNUM MVC PROB,DUMPNUM GET PROBLEM NUMBER @VA04250 00108000
LA R9,PROBX POINT TO MESSAGE @VA04250 00109000
LA R3,PROBXL SUPPLY LENGTH OF MESSAGE @VA04250 00110000
BAL R10,WRTERM GO TELL USER @VA04250 00111000
*************************************************************** 00112000
* PROMPT THE USER TO SUPPLY THE SEVERITY FOR THIS PROBLEM 00113000
*************************************************************** 00114000
GETSEV LA R9,SEVMSG ' ENTER SEVERITY (1 2 3 OR 4)' @VA04250 00115000
LA R3,L'SEVMSG LENGTH OF MESSAGE TO WRTERM @VA04250 00116000
BAL R10,WRTERM GO PROMPT USER FOR SEVERITY @VA04250 00117000
LA R9,ADDTEXT POINT TO TERMINAL READ INPUT AREA@VA04250 00118000
BAL R10,RDTERM GO READ USER RESPONSE @VA04250 00119000
MVC INTSEV,ADDTEXT MOVE SEVERITY TO INT.DATA AREA @VA04250 00120000
MVC INTX2,CPCON INDICATE CP AS OPERATING ENV. @VA04250 00121000
CLI INTSEV,SEV4 GREATER THAN ALLOWED? (4) @VA04250 00122000
BH GETSEV YES, FORCE USER @VA04250 00123000
CLI INTSEV,BLANK USER WILLING TO DEFAULT? @VA04250 00124000
BE PRMFORCE YES @VA04250 00125000
CLI INTSEV,SEV1 LESS THAN ALLOWED? @VA04250 00126000
BL GETSEV YES, GO FORCE USER TO ENTER @VA04250 00127000
B PRMTYPSW CONTINUE @VA04250 00128000
PRMFORCE MVI INTSEV,SEV4 DEFAULT TO SEVERITY 4 @VA04250 00129000
************************************************ 00130000
* TEST THE TYPE SWITCH PERFORM THE 00131000
* FOLLOWING ACTIONS: 00132000
* WAITSW-INFORM OPERATOR PROCESSING 00133000
* APPARENT WAIT AND REQUEST ADD. 00134000
* INFORMATION. 00135000
* LOOPSW-DUMP INCONCLUSIVE POSSIBLE LOOP 00136000
* OR PERFORMANCE PROBLEM REQUEST 00137000
* OPER TO RESPOND LOOP OR PERF 00138000
************************************************ 00139000
PRMTYPSW TM TYPESW,WAITSW IS WAIT INDICATED @VA04250 00140000
BO PRMWAIT GO TO WAIT ROUTINE @VA04250 00141000
TM TYPESW,LOOPSW LOOP, PERF, OR OTHER? @VA04250 00142000
BO PRMLPPER YES @VA04250 00143000
MVC INTX1,VMFAIL1 MOVE FAILURE TYPE TO OUTPUT @VA04250 00144000
TM TYPESW,PROCERR ERROR IN EXTRACTION? @VA04250 00145000
BO PRMERREX YES @VA04250 00146000
B PRMSUPP GO GET SUPPORTING DATA FILE @VA04250 00147000
*************************************************************** 00148000
* WAIT STATE INDICATED IN DUMP 00149000
*************************************************************** 00150000
PRMWAIT LA R9,WAITMSG1 'DUMP INDICATES WAIT STATE' @VA04250 00151000
LA R3,L'WAITMSG1 SUPPLY WRTERM WITH MESSAGE LENGTH@VA04250 00152000
BAL R10,WRTERM GO TELL USER @VA04250 00153000
LA R9,WAITMSG2 'DESCRIBE CONDITION AT DUMP TIME'@VA04250 00154000
LA R3,L'WAITMSG2 SUPPLY WRTERM WITH LENGTH OF MSG @VA04250 00155000
BAL R10,WRTERM GO PROMPT USER @VA04250 00156000
B PRMSUPP GO GET SUPPORTING DATA FILES @VA04250 00157000
*************************************************************** 00158000
* PROCESSING ERROR IN PREVIOUS ROUTINE 00159000
*************************************************************** 00160000
PRMERREX L R3,TEXTCURR GET CURRENT TEXT POINTER @VA04250 00161000
MVC 0(L'EXMSG,R3),EXMSG PUT PROC. ERR.IN TEXT @VA04250 00162000
LA R3,CARDLEN(R3) BUMP THE TEXT AREA POINTER @VA04250 00163000
ST R3,TEXTCURR SAVE IT FOR NEXT USER @VA04250 00164000
B PRMSUPP GO GET SUPPORTING DATA FILES @VA04250 00165000
*************************************************************** 00166000
*HERE IF DUMP WAS TAKEN BECAUSE OF A LOOP OR PERF. PROBLEM. 00167000
*************************************************************** 00168000
PRMLPPER LA R9,DDIMSG1 'DUMP DATA IS INCONCLUSIVE....' @VA04250 00169000
LA R3,L'DDIMSG1 SUPPLY WRTERM WITH LNG OF MSG @VA04250 00170000
BAL R10,WRTERM GO TELL USER @VA04250 00171000
ENTERIT LA R9,DDIMSG2 'ENTER LOOP PERF OR OTHER' @VA04250 00172000
LA R3,L'DDIMSG2 SUPPLY WRTERM WITH MESSAGE LENGTH@VA04250 00173000
BAL R10,WRTERM GO PROMPT USER @VA04250 00174000
LA R9,ADDTEXT POINT TO TERMINAL READ INPUT AREA@VA04250 00175000
BAL R10,RDTERM GO READ USER RESPONSE @VA04250 00176000
LTR R0,R0 CHECK ENTRY @VA04250 00177000
BZ ENTERIT FORCE ENTRY @VA04250 00178000
CLC =C'LOOP',ADDTEXT USER RESPOND LOOP? @VA04250 00179000
BE LPPF YES @VA04250 00180000
CLC =C'PERF',ADDTEXT USER RESPOND PERF? @VA04250 00181000
BE LPPF YES @VA04250 00182000
CLC =C'OTHER',ADDTEXT USER RESPOND OTHER? @VA04250 00183000
BNE ENTERIT NO, FORCE CORRECT RESPONSE @VA04250 00184000
* 00185000
* 00186000
********************************************* 00187000
* ALTER THE VMFAILURE KEYWORD TO LOOP OR PERF 00188000
********************************************* 00189000
* 00190000
LPPF MVC VMFAIL1,ADDTEXT GET KEYWORD FOR SKELETON @VA04250 00191000
LA R2,VMFAILLP-KEY GET LENGTH OF TOTAL KEY AREA @VA04250 00192000
STH R2,KEY SAVE THIS COUNT @VA04250 00193000
MVI FAILLN+ONE,(VMFAIL1-FAILLN+FOUR) FAIL KEY LN @VA04250 00194000
MVC INTX1(FOUR),VMFAIL1 SAVE FAILURE FOR WRITEREC @VA04250 00195000
CLC LP,ADDTEXT IS KEYWORD LOOP @VA04250 00196000
BE LOOP YES @VA04250 00197000
CLC PF,ADDTEXT IS KEYWORD PERFORMANCE @VA04250 00198000
BE PERF YES @VA04250 00199000
B OTHER GO PROCESS AS AN 'OTHER' PROBLEM @VA04250 00200000
EJECT 00201000
************************************************ 00202000
* ENTERED IF OPERATOR RESPONDED 'LOOP' 00203000
* TO PROMPTING. 00204000
************************************************ 00205000
* 00206000
*********************************** 00207000
* DETERMINE MODULE NAME 00208000
*********************************** 00209000
LOOP LA R9,LPMS3 MESSAGE TEXT @VA04250 00210000
LA R3,L'LPMS3 SUPPLY LENGTH TO WRTERM @VA04250 00211000
LA R2,L'VMMODPRM GET LENGTH OF KEY @VA04250 00212000
SLL R2,16 PUT LENGTH IN FIRST HALF WORD @VA04250 00213000
ST R2,KEYWRK SAVE FOR LATER USE @VA04250 00214000
LA R2,VMMODPRM POINT TO VMMODULE= KEYWORD @VA04250 00215000
MVI KEYSW,KEYHERE INDICATE KEY PRESENT @VA04250 00216000
BAL R10,WRTREAD GO TO WRITE/READ @VA04250 00217000
*********************************** 00218000
* GET LOOP ADDRESSES 00219000
********************************** 00220000
LA R5,TEXT6 ADDRESS OF FIRST PROMPT TEXT @VA04250 00221000
LA R9,LPMS4 MESSAGE TEXT @VA04250 00222000
LA R3,L'LPMS4 SUPPLY WRTERM WITH MESSAGE LENGTH@VA04250 00223000
BAL R10,WRTREAD @VA04250 00224000
LTR R0,R0 DID HE ENTER ANYTHING @VA04250 00225000
BZ BYPASS NO, MOVE ON @VA04250 00226000
MVC 0(L'LPADD,R5),LPADD MOVE IN LOOP ADDRESS HEADER @VA04250 00227000
LA R5,L'LPADD(,R5) BUMP TEXT POINTER @VA04250 00228000
EX R2,MVTEXT MOVE THIS TO TEXT AREA @VA04250 00229000
L R6,TEXTCURR GET AMOUNT OF TEXT SO FAR @VA04250 00230000
AH R6,TEXTLEN BUMP COUNT BY 1 RECORD (80) @VA04250 00231000
ST R6,TEXTCURR SAVE IT FOR NEXT USER @VA04250 00232000
****************************** 00233000
* GET COMMAND IF APPLICABLE 00234000
***************************** 00235000
BYPASS LA R9,LPMS6 'ENTER COMMAND WHICH CAUSED FAIL'@VA04250 00236000
LA R3,L'LPMS6 SUPPLY WRTREAD MESSAGE LENGTH @VA04250 00237000
LA R2,L'VMCMD GET LENGTH OF KEYWORD @VA04250 00238000
SLL R2,16 PUT LENGTH IN FIRST HALF WORD @VA04250 00239000
ST R2,KEYWRK SAVE FOR LATER USER @VA04250 00240000
LA R2,VMCMD POINT TO KEYWORD VMCMD= @VA04250 00241000
MVI KEYSW,KEYHERE INDICATE KEY PRESENT @VA04250 00242000
BAL R10,WRTREAD GO TO WRITE/READ ROUTINE @VA04250 00243000
B PRMSUPP GO GET SUPPORTIVE DATA FILES @VA04250 00244000
EJECT 00245000
************************************************ 00246000
***** ENTERED HERE IF OPERATOR RESPONDED 'PERF'* 00247000
***** TO PROMPTING. * 00248000
************************************************ 00249000
* DETERMINE NATURE OF DEGRADATION 00250000
******************************* 00251000
PERF LA R9,PRMS2 'ENTER NATURE OF DEGRADATION' @VA04250 00252000
LA R3,L'PRMS2 SUPPLY WRTREAD MESSAGE LENGTH @VA04250 00253000
LA R2,L'VMDEG GET LENGTH OF KEY @VA04250 00254000
SLL R2,16 PUT LENGTH INTO FIRST HALF WORD @VA04250 00255000
ST R2,KEYWRK SAVE FOR USE BY KEYMOVE ROUTINE @VA04250 00256000
LA R2,VMDEG POINT TO KEY VMDEGRADE= @VA04250 00257000
MVI KEYSW,KEYHERE INDICATE THIS IS KEYWORDED @VA04250 00258000
BAL R10,WRTREAD GO TO WRITE READ @VA04250 00259000
B PRMSUPP GO GET SUPPLEMENTARY DATA FILES @VA04250 00260000
EJECT 00261000
*************************************************************** 00262000
* NOT LOOP OR PERFORMANCE (OTHER) 00263000
*************************************************************** 00264000
OTHER LA R9,CIRCMSG1 'DESCRIBE CIRCUMSTANCES' @VA04250 00265000
LA R3,L'CIRCMSG1 SUPPLY WRTERM WITH MESSAGE LENGTH@VA04250 00266000
BAL R10,WRTERM GO TELL USER @VA04250 00267000
LA R9,CIRCMSG2 'SUPPLY INFO. WHEN PROMPTED' @VA04250 00268000
LA R3,L'CIRCMSG2 SUPPLY WRTERM LENGTH OF MESSAG @VA04250 00269000
BAL R10,WRTERM GO TELL USER @VA04250 00270000
LA R2,VMFAILOT-KEY GET LN OF KEYAREA IF 'OTHER' @VA04250 00271000
STH R2,KEY UPDATE KEY AREA LENGTH @VA04250 00272000
MVI FAILLN+ONE,(VMFAIL1-FAILLN+FIVE) AND FAIL KEY LN@VA04250 00273000
B PRMSUPP GO GET SUPPORTING DATA FILES @VA04250 00274000
EJECT 00275000
*************************************************************** 00276000
* PROMPT OPERATOR FOR NAME AND LOCATION OF SUPPORTING DOCUM. 00277000
*************************************************************** 00278000
PRMSUPP MVC SUPP1(L'DUMPNUM),DUMPNUM MOVE DUMP NAME TO OUTP.@VA04250 00279000
MVC SUPP1+L'DUMPNUM+ONE(L'SUPPFTFM),SUPPFTFM FN FT @VA04250 00280000
LA R9,SUPPMSG1 'ENTER NAME AND LOC OF SUPP DATA'@VA04250 00281000
LA R3,L'SUPPMSG1 SUPPLY WRTERM WITH LENGTH OF MSG @VA04250 00282000
BAL R10,WRTERM GO PROMPT USER @VA04250 00283000
LA R9,SUPPMSG2 'TRACE TABLE A1 TRACE OUTPUT' @VA04250 00284000
LA R3,L'SUPPMSG2 SUPPLY WRTERM LENGTH OF MESSAG @VA04250 00285000
BAL R10,WRTERM GO PROMPT USER @VA04250 00286000
LA R9,ADDTEXT POINT TO TERMINAL READ INPUT AREA@VA04250 00287000
BAL R10,RDTERM GO READ USER RESPONSE @VA04250 00288000
LTR R0,R0 WAS ENTRY NULL? @VA04250 00289000
BZ PRMTEXTA YES @VA04250 00290000
LA R6,SUPP2 START PUTTING OUTPUT HERE @VA04250 00291000
MVC 0(OUTLEN,R6),ADDTEXT USER RESPONSE TO OUTPUT @VA04250 00292000
LH R5,SUPPLN GET CURRENT AMOUNT OF SUPP DATA @VA04250 00293000
LA R5,OUTLEN(,R5) BUMP SUPPORT DATA LENGTH @VA04250 00294000
STH R5,SUPPLN SAVE IT FOR LATER @VA04250 00295000
PRMDATA LA R9,SUPPMSG3 'ENTER MORE SUPP DATA OR NULL' @VA04250 00296000
LA R3,L'SUPPMSG3 SUPPLY WRTERM WITH LENGTH OF MSG @VA04250 00297000
BAL R10,WRTERM GO PROMPT USER @VA04250 00298000
LA R9,ADDTEXT POINT TO TERMINAL READ INPUT AREA@VA04250 00299000
BAL R10,RDTERM GO READ USER RESPONSE @VA04250 00300000
LTR R0,R0 ANYTHING ENTERED? @VA04250 00301000
BZ PRMTEXTA NO @VA04250 00302000
LA R6,OUTLEN(,R6) POINT TO NEXT OUTPUT RECORD @VA04250 00303000
LH R5,SUPPLN GET CURRENT LENGTH @VA04250 00304000
LA R5,OUTLEN(,R5) ADD IN ONE MORE RECORD WORTH @VA04250 00305000
STH R5,SUPPLN SAVE IT FOR NEXT TIME @VA04250 00306000
CH R5,SUPPMAX GOT ALL WE CAN HANDLE? @VA04250 00307000
MVC 0(OUTLEN,R6),ADDTEXT MOVE USER DATA TO OUTPUT @VA04250 00308000
BNL PRMTEXTA YES @VA04250 00309000
B PRMDATA GO BACK FOR MORE @VA04250 00310000
EJECT 00311000
*************************************************************** 00312000
* PROMPT THE USER FOR FREE FORM TEXT DESCRIPTION 00313000
*************************************************************** 00314000
PRMTEXTA LA R9,MORETEXT 'ENTER ADD. TEXT 80 CHAR LINE @VA04250 00315000
LA R3,L'MORETEXT SUPPLY WRTERM WITH LENGTH OF MSG @VA04250 00316000
BAL R10,WRTERM GO PROMPT USER @VA04250 00317000
LA R9,ENDTX 'ENTER TEXT OR NULL' @VA04250 00318000
LA R3,L'ENDTX SUPPLY WRTERM WITH LENGTH OF MSG @VA04250 00319000
BAL R10,WRTERM GO PROMPT USER @VA04250 00320000
L R6,TEXTCURR GET NEXT AVAILABLE TEXT RECORD @VA04250 00321000
LA R5,TEXTENDO POINT TO END OF TEXT OUTPUT AREA @VA04250 00322000
READ1 LR R9,R6 POINT TO TERMINAL INPUT AREA @VA04250 00323000
BAL R10,RDTERM GO READ USER RESPONSE @VA04250 00324000
CLC ENDTEXT,0(R6) WAS TEXT A NULL LINE? @VA04250 00325000
BE CLEANUP IF YES GO FINISH PROCESSING @VA04250 00326000
LA R6,CARDLEN(,R6) UPDATE OUTPUT POINTER @VA04250 00327000
CR R6,R5 REACHED LIMIT? @VA04250 00328000
BNL CLEANUP YES, GO CLEAN UP AND EXIT @VA04250 00329000
ST R6,TEXTCURR KEEP TRACK OF AMOUNT OF TEXT @VA04250 00330000
LA R9,ENDTX 'ENTER TEXT OR NULL' @VA04250 00331000
LA R3,L'ENDTX SUPPLY WRTERM WITH MESSAGE LENGTH@VA04250 00332000
BAL R10,WRTERM GO PROMPT USER @VA04250 00333000
B READ1 CONTINUE UNTIL USER ENTERS NULL @VA04250 00334000
EJECT 00335000
*************************************************************** 00336000
* FINAL PROCESSING AND EXIT 00337000
*************************************************************** 00338000
CLEANUP EQU * @VA04250 00339000
NORMEXIT ST R8,PRMPARM1 INTSECT ADDRESS TO PARM LIST @VA04250 00340000
LA R5,KEY ADDRESS OF KEY AREA @VA04250 00341000
ST R5,PRMPARM2 KEY ADDRESS TO PARMLIST @VA04250 00342000
L R2,TEXTCURR GET CURRENT TEXT POINTER @VA04250 00343000
LA R3,TEXTA POINT TO START OF AREA @VA04250 00344000
SR R2,R3 GET AMOUNT OF TEXT AREA @VA04250 00345000
STH R2,TEXT SAVE LENGTH FOR WRITEREC @VA04250 00346000
LA R5,TEXT ADDRESS OF TEXT AREA @VA04250 00347000
ST R5,PRMPARM3 TEXT AREA ADDRESS TO PARMLIST @VA04250 00348000
LA R5,SUPPLN ADDRESS OF SUPPORTING DATA AREA @VA04250 00349000
ST R5,PRMPARM4 SUPPORT DATA TO PARM LIST @VA04250 00350000
LA R1,PRMPARM1 PARM LIST ADDRESS TO R1 @VA04250 00351000
MVC INTPNUM,NUM DUMP NUMBER TO INTSECT @VA04250 00352000
CALL DMMWRT @VA04250 00353000
LTR R15,R15 GOOD RETURN FROM DMMWRT? @VA04250 00354000
BNZ EXIT NO, DON'T DO DUPLICATE SEARCH @VA04250 00355000
LA R1,PRMPARM1 RESTORE PARM FOR SEARCH @VA04250 00356000
CALL DMMSEA @VA04250 00357000
EXIT LM R0,R15,EDMSAVE GET DMMEDM RETURN ADDRESS @VA04250 00358000
BR R14 NORMAL RETURN @VA04250 00359000
EJECT 00360000
*************************************************************** 00361000
* USER ENTERED HX (HE WANTS TO HALT EXECUTION) 00362000
*************************************************************** 00363000
HXRTN PACK NEWNUM,NUM(FIVE) PROBLEM NUMBER TO DECIMAL @V4075A1 00364000
SP NEWNUM,WUN SUBTRACT ONE @V4075A1 00364100
UNPK SUMBUF(FIVE),NEWNUM PROBLEM NUMBER IN BUFFER @V4075A1 00364200
OI SUMLOW,NUMERIC STRIP OFF ZONE BITS @V4075A1 00364300
FSWRITE 'SUMMARY RECORD A1',BUFFER=SUMBUF,ERROR=PRBWRTER, X00364400
RECNO=1,BSIZE=80 @V4075A1 00364500
HXRET FSCLOSE 'SUMMARY RECORD A1' @V4075A1 00365000
LM R0,R15,EDMSAVE RESTORE DMMEDM'S REGISTERS @V4075A1 00365100
BR R14 RETURN TO DMMEDM @V4075A1 00365200
PRBWRTER CVD R15,ERRCODE GET RETURN FOR MESSAGE @V4075A1 00365300
UNPK ERRCODEZ,ERRCODE+FOUR(FOUR) UNPACK IT @V4075A1 00365400
OI LOWCODE,NUMERIC MAKE IT READABLE @V4075A1 00365500
MVC ERRMSGCD,CDPLUS1 MOVE RETURN CODE TO MSG @V4075A1 00365600
WRTERM ERRMSG,ERRMSGL WRITE THE MESSAGE @V4075A1 00365700
B HXRET 00365800
EJECT 00366000
************************************************ 00367000
***** COMMON TERMINAL PROMPT ROUTINE 00368000
***** USER RESPONSE IS READ FOLLOWING TERMINAL PROMPT 00369000
************************************************ 00370000
WRTREAD WRTERM (R9),(R3) @VA04250 00371000
ST R10,R10SAVE SAVE LINK REG @VA04250 00372000
LA R9,ADDTEXT POINT TO TERMINAL READ INPUT AREA@VA04250 00373000
BAL R10,RDTERM GO READ USER RESPONSE @VA04250 00374000
L R10,R10SAVE RESTORE CALLER'S LINK REG @VA04250 00375000
LTR R0,R0 USER ENTER ANYTHING? @VA04250 00376000
BZ NEXTWRIT NO @VA04250 00377000
CLI KEYSW,KEYHERE KEY ASSOCIATED WITH RESPONSE? @VA04250 00378000
BE KEYMOVE YES @VA04250 00379000
LR R2,R0 SAVE LENGTH OF RESPONSE @VA04250 00380000
B NEXTWRIT RETURN TO CALLER @VA04250 00381000
EJECT 00382000
************************************************ 00383000
***** ROUTINE TO MOVE KEYWORDS TO KEY AREA * 00384000
************************************************ 00385000
KEYMOVE LA R6,KEY POINT TO START OF KEY AREA @VA04250 00386000
LH R5,KEY GET CURRENT TOTAL LENGTH @VA04250 00387000
AR R6,R5 POINT TO NEXT AVAIL OUTPUT SPOT @VA04250 00388000
AR R5,R0 ADD USER ENTERED DATA LENGTH @VA04250 00389000
AH R5,KEYWRK ADD KEYWORD LENGTH TO LENGTH @VA04250 00390000
LA R5,LENLEN(R5) ADD IN LENGTH FIELD @VA04250 00391000
STH R5,KEY SAVE CUMULATIVE RESULTS IN OUTPUT@VA04250 00392000
LH R5,KEYWRK GET LENGTH OF THIS KEY @VA04250 00393000
LR R3,R5 SAVE THIS LENGTH FOR LATER @VA04250 00394000
AR R5,R0 ADD IN LNGTH OF USER ENTERED INFO@VA04250 00395000
LA R5,LENLEN(R5) ADD IN LENGTH OF LENGTH FIELD @VA04250 00396000
STH R5,KEYWRK STORE IT @VA04250 00397000
MVC 0(L'KEYWRK,R6),KEYWRK MOVE LN FIELD TO OUTPUT @VA04250 00398000
LA R6,LENLEN(R6) POINT WHERE KEY GOES @VA04250 00399000
BCTR R3,0 SET KEY LENGTH FOR EXECUTE @VA04250 00400000
EX R3,MOVEKEY MOVE KEY TO OUTPUT @VA04250 00401000
LA R6,DATA(R6,R3) POINT TO WHERE DATA WILL GO @VA04250 00402000
LR R3,R0 GET LENGTH OF USER DATA @VA04250 00403000
BCTR R3,0 SET FOR EXECUTE @VA04250 00404000
DATMOVE EX R3,MOVEDAT MOVE USERSUPPLIED DATA TO OUTPUT @VA04250 00405000
NEXTWRIT MVI KEYSW,NOKEY RESET KEY SWITCH @VA04250 00406000
BR R10 RETURN TO CALLER @VA04250 00407000
MOVEKEY MVC 0(0,R6),0(R2) MOVE KEY TO OUTPUT (EXECUTED) @VA04250 00408000
MOVEDAT MVC 0(0,R6),ADDTEXT EXECUTED INSTRUCTION @VA04250 00409000
MVTEXT MVC 0(0,R5),ADDTEXT EXECUTED INSTRUCTION @VA04250 00410000
EJECT 00411000
*************************************************************** 00412000
* TERMINAL READ ROUTINE 00413000
*************************************************************** 00414000
RDTERM RDTERM (R9) READ USER RESPONSE @VA04250 00415000
LTR R0,R0 ANYTHING ENTERED? @VA04250 00416000
BZ RDTERME NO @VA04250 00417000
CLC HALT,0(R9) USER WANT TO QUIT? @VA04250 00418000
BE HXRTN YES @VA04250 00419000
CLC HALT2,0(R9) COLON HX? @VA04250 00420000
BE HXRTN YES @VA04250 00421000
LR R15,R9 ADDRESS OF INPUT TO TEMP WORK @VA04250 00422000
LA R14,FORTY CHECK FIRST 40 CHAR FOR NON BLANK@VA04250 00423000
RDTERML CLI 0(R15),BLANK NON BLANK? @VA04250 00424000
BNE RDTERME YES, RETURN TO CALLER @VA04250 00425000
LA R15,ONE(R15) POINT TO NEXT INPUT BYTE @VA04250 00426000
BCT R14,RDTERML CHECK FIRST 40 BYTES @VA04250 00427000
SR R0,R0 SET READ LENGTH TO ZERO @VA04250 00428000
RDTERME BR R10 RETURN TO CALLER @VA04250 00429000
*************************************************************** 00430000
* COMMON SIMPLE TERMINAL WRITE ROUTINE 00431000
*************************************************************** 00432000
WRTERM WRTERM (R9),(R3) WRITE MESSAGE ON TERMINAL @VA04250 00433000
BR R10 RETURN TO CALLER @VA04250 00434000
*************************************************************** 00435000
* CONSTANTS SAVEAREAS AND EQUATES 00436000
*************************************************************** 00437000
SAVEAREA DS 18F OUR SAVEAREA @VA04250 00438000
VSHARE DC V(SHARECON) POINTER TO SHARED CONSTANT AREA @VA04250 00440000
WKDWD DS D DOUBLE WORK WORK AREA @VA04250 00441000
R10SAVE DS F SAVE AREA FOR INTERNAL LINK REG @VA04250 00442000
ERRMSG DC C'DMMPRM200S ERROR''' @V4075A1 00442100
ERRMSGCD DS CL3 ERROR MSG RETURN CODE @V4075A1 00442200
DC C''' ' @V4075A1 00442300
ERRMSGTY DC C' WRITING FILE ''' SUMMARY RECORD A1 ''' @V4075A1 00442400
ERRMSGL EQU *-ERRMSG LENGTH OF ERROR MESSAGE @V4075A1 00442500
SUPPMAX DC H'400' MAX SUPP DATA ALLOWED @VA04250 00443000
SUMBUF DC 80C' ' PROBLEM NUMBER BUFFER @V4075A1 00443100
WUN DC X'001C' CONSTANT TO DECREMENT PRB NUM @V4075A1 00443200
NEWNUM DS CL5 00443300
DS F @V4075A1 00443400
ERRCODE DS CL8 ERROR CODE FOR FILE ERROR MSG @V4075A1 00443500
ERRCODEZ DS CL4 @V4075A1 00443600
LOWCODE EQU ERRCODEZ+3 LOW ORDER OF THE ERROR CODE @V4075A1 00443700
CDPLUS1 EQU ERRCODEZ+1 @V4075A1 00443800
SUMLOW EQU SUMBUF+4 LOW ORDER OF PROBLEM NUM. @V4075A1 00443900
**************************** 00444000
* PARMS FOR WRITEREC 00445000
**************************** 00446000
PRMPARM1 DS F POINTER TO INTERNAL DATA AREA @VA04250 00447000
PRMPARM2 DS F POINTER TO KEYWORDED AREA @VA04250 00448000
PRMPARM3 DS F POINTER TO TEXT DESCRIPTION AREA @VA04250 00449000
PRMPARM4 DS F POINTER TO SUPPORTING DOC AREA @VA04250 00450000
**************************** 00451000
KEYWRK DS F WORK AREA FOR KEY LENGTH @VA04250 00452000
**************************** 00453000
* SWITCH INDICATING WHETHER OR NOT RESPONSE IS TO BE KEYWORDED 00454000
**************************** 00455000
KEYSW DC X'00' SWITCH (SET TO KEY NOT PRESENT) @VA04250 00456000
NOKEY EQU X'00' RESPONSE NOT TO BE KEYWORDED @VA04250 00457000
KEYHERE EQU X'FF' RESPONSE IS TO BE KEYWORDED @VA04250 00458000
**************************** 00459000
SUPPFTFM DC C'DUMP A1' FILETYPE AND FILEMODE OF DUMP @VA04250 00460000
TEXTLEN DC H'80' HALF WORD OF 80 (RECORD SIZE) @VA04250 00461000
HALT DC C'HX' HALT EXECUTION RESPONSE @VA04250 00462000
HALT2 DC C':HX' ALTERNATE METHOD TO REQUEST HX @VA04250 00463000
LP DC C'LOOP' @VA04250 00464000
PF DC C'PERF' @VA04250 00465000
ENDTEXT DC C' ' @VA04250 00466000
TEXTCURR DS F'0' ADDRESS OF NEXT TEXT OUT REC @VA04250 00467000
LPADD DC C'LOOP ADDR: ' @VA04250 00468000
PACKED1 DC P'1' USED TO INCREMENT PROBLEM NUMBER @VA04250 00469000
PNWORK DS CL5 WORK AREA TO UPDATE PROBLEM NUMB.@VA04250 00470000
ADDTEXT DS CL160 TERMINAL INPUT AREA @VA04250 00471000
CPCON DC C'CP ' @VA04250 00472000
VMCMD DC C'VMCMD=' KEYWORD VM COMMAND @VA04250 00473000
VMDEG DC C'VMDEGRADE=' KEYWORD FOR DEGRADATION @VA04250 00474000
INTERNAL DC V(INTDATA) INTERNAL DATA AREA @VA04250 00475000
VMMODPRM DC C'VMMODULE=' KEYWORD FOR LOOPING MODULES @VA04250 00476000
BLANK EQU C' ' BLANK @VA04250 00477000
SEV1 EQU C'1' USED TO CHECK SEVERITY @VA04250 00478000
SEV4 EQU C'4' USED TO CHECK SEVERITY @VA04250 00479000
NUMERIC EQU X'F0' USED TO MAKE UNPACKED READABLE @VA04250 00480000
LENLEN EQU 4 LENGTH OF LENGTH FIELD @VA04250 00481000
ONE EQU 1 FOR MVC DISP AND LENGTH ETC. @VA04250 00482000
THREE EQU 3 FOR MVC DISP AND LENGTH ETC. @VA04250 00483000
FOUR EQU 4 FOR MVC DISP AND LENGTH ETC. @VA04250 00484000
FIVE EQU 5 FOR MVC DISP AND LENGTH ETC. @VA04250 00485000
SIX EQU 6 FOR MVC DISP AND LENGTH ETC. @VA04250 00486000
FORTY EQU 40 FOR MVC DISP AND LENGTH ETC. @VA04250 00487000
CARDLEN EQU 80 LENGTH OF CARD OF DATA @VA04250 00488000
OUTLEN EQU 80 LENGTH OF CARD OF OUTPUT @VA04250 00489000
*************************************************************** 00490000
* TEXT OF MESSAGES ISSUED IN THIS PROGRAM 00491000
*************************************************************** 00492000
MORETEXT DC C'ENTER ADDITIONAL TEXT 80 CHARS PER LINE' @VA04250 00493000
ENDTX DC C'ENTER TEXT OR NULL' @VA04250 00494000
PRMS1 DC C'ENTER NATURE OF DEGRADATION' @VA04250 00495000
LPMS1 DC C'ENTER OPERATING ENVIRONMENT. CP,CMS,RSCS,VIRTMACH' 00496000
LPMS3 DC C'ENTER KNOWN MODULES WITHIN LOOP. MOD1,MOD2,ETC' 00497000
LPMS4 DC C'ENTER UP TO TEN LOOP ADDRESSES. ADDR1,ADDR2,ETC' 00498000
LPMS6 DC C'ENTER COMMAND WHICH CAUSED FAILURE IF APPLICABLE' 00499000
PRMS2 DC C'ENTER NATURE OF DEGRADATION' @VA04250 00500000
EXMSG DC C'DATA EXTRACTION PROCESS ERROR--SEE MSG. DMMPRM804I' 00501000
EXMSGL EQU *-EXMSG LENGTH OF EXMSG @VA04250 00502000
PROBX DC C'ASSIGNED PROBLEM NUMBER ' @VA04250 00503000
PROB DS CL8 @VA04250 00504000
PROBXL EQU *-PROBX LENGTH OF PRBX MESSAGE @VA04250 00505000
SEVMSG DC C'ENTER SEVERITY OF PROBLEM (1 2 3 OR 4)' @VA04250 00506000
SUPPMSG1 DC C'ENTER FN FT FM OF SUPPORTING DATA AND DESCRIPTION' 00507000
SUPPMSG2 DC C'E.G. PRBNNNNN TRACE A1-CONS. OUTPUT OF TRACE' @VA04250 00508000
SUPPMSG3 DC C'ENTER FURTHER FILES OR NULL LINE' @VA04250 00509000
DDIMSG1 DC C'THE DUMP DATA IS INCONCLUSIVE, POSSIBLE LOOP OR PERF' 00510000
DDIMSG2 DC C'ENTER: LOOP, PERF, OR OTHER' @VA04250 00511000
WAITMSG1 DC C'DUMP INDICATES AN APPARENT WAIT STATE. WHEN PROMPTED' 00512000
WAITMSG2 DC C'FOR TEXT DESCRIBE CONDITIONS AT THE TIME OF THE DUMP' 00513000
MSG804I DC C'DMMPRM804I PROCESSING ERROR IN DATA EXTRACTION' 00514000
CIRCMSG1 DC C'DESCRIBE THE CIRCUMSTANCES AT THE TIME THE DUMP' 00515000
CIRCMSG2 DC C'WAS TAKEN. ENTER WHEN PROMPTED FOR TEXT.' @VA04250 00516000
MSG200 DC C'DMMPRM200S ERROR ''' @VA04250 00517000
WRCODE DS CL3 FSWRITE RETURN CODE @VA04250 00518000
DC C''' WRITING ''SUMMARY RECORD A1' @VA04250 00519000
MSG200L EQU *-MSG200 LENGTH OF ERROR MESSAGE @VA04250 00520000
*************************************************************** 00521000
PATCH DC 50F'0' PATCH AREA @VA04250 00522000
LTORG @VA04250 00523000
SPACE 1 00524000
COPY INTSECT @VA04250 00525000
COPY EXCONST @VA04250 00526000
DATA EQU 1 OUTPUT AREA OFFSET @VA04250 00527000
DECODE EQU WKDWD+6 ERR CODE IN DECIMAL FIELD @VA04250 00528000
LASTBYTE EQU WRCODE+3 LOW ORDER OF RET CODE @VA04250 00529000
REGEQU @VA04250 00530000
END 00531000