ibm:vm370-lib:dumpscan:dmmpro.assemble_src
Table of Contents
DMMPRO Source
References
- Fixes Applied : 0
- This Source Date : Friday, December 8, 1978
- Last Fix ID : [Unmodified]
Source Listing
- DMMPRO.ASSEMBLE.txt
- PRO TITLE 'DMMPRO (IPCS) VM/370 - RELEASE 6' 00001000
- *************************************************************** 00002000
- * 00003000
- * MODULE NAME: 00004000
- * 00005000
- * PROB 00006000
- * 00007000
- * FUNCTION: 00008000
- * 00009000
- * TO CREATE A PROBLEM REPORT THROUGH USER PROMPTING 00010000
- * 00011000
- * ATTRIBUTES: 00012000
- * 00013000
- * NON-REUSABLE 00014000
- * NON-REENTRANT 00015000
- * 00016000
- * ENTRY POINTS: 00017000
- * 00018000
- * DMMPRO 00019000
- * 00020000
- * ENTRY CONDITIONS: 00021000
- * 00022000
- * FROM CMS WHEN PROB COMMAND ISSUED 00023000
- * 00024000
- * EXIT CONDITIONS: 00025000
- * 00026000
- * RETURN CODE IN R15 0 NORMAL COMPLETION 00027000
- * 4 USER TYPED :HX (HALT EXECUTION) 00028000
- * 8 UNRECOVERABLE ERROR OCCURRED 00029000
- * 00030000
- * CALLS TO OTHER ROUTINES: 00031000
- * 00032000
- * DMMWRT TO WRITE THE PROBLEM REPORT ON DISK 00033000
- * DMMSEA TO LOOK FOR A DUPLICATE OF THIS PROBLEM 00034000
- * 00035000
- * EXTERNAL REFERENCES: 00036000
- * 00037000
- * NONE 00038000
- * 00039000
- * TABLES/WORKAREAS: 00040000
- * 00041000
- * LOGTBL EACH PROMPT HAS STATUS SAVED HERE FOR REPROMPTING 00042000
- * SUPPAREA 5 80 BYTE RCDS FOR SUPPLEMENTARY DATA INFO 00043000
- * INTAREA AREA TO STORE INTERNAL DATA FOR OTHER ROUTINES 00044000
- * TEXTAREA 20 80 BYTE RECORDS FOR TEXTUAL PROBLEM DESCRIPTION 00045000
- * NUCON (CMS LOW CORE DSECT) FOR CURRENT TIME AND DATE 00046000
- * 00047000
- * REGISTER USAGE: 00048000
- * 00049000
- * R13 POINTER TO SAVEAREA 00050000
- * R12 BASE REG 1 00051000
- * R11 BASE REG 2 00052000
- * R10 BASE REG 3 00053000
- * R9 ADDRESS OF EXECUTING PROMPT. SAVED FOR REPROMPTING 00054000
- * R8 INTERNAL LINK REGISTER 00055000
- * R7 POINTER TO PROMPTING MESSAGE 00056000
- * R6 USUALLY BCT REGISTER USED BY PROMPTING CODE 00057000
- * R5 WRTERM RETURN ADDRESS, USUALLY POINTS TO RDTERM 00058000
- * R4,R3,R2 WORK REGISTERS 00059000
- * R1 POINTER TO START OF DATA ENTERED BY USER 00060000
- * R0 LENGTH OF DATA ENTERED BY USER 00061000
- * R14,R15,R1 USED AS SHORT TERM WORK REGS WHEN NEEDED 00062000
- * 00063000
- * NOTES: 00064000
- * 00065000
- * ALL MESSAGES ISSUED ARE CODED USING A SPECIAL MSGP MACRO. 00066000
- * MSGP MACRO PROTOTYPE IS AS FOLLOWS: 00067000
- * &NAME MSGP MSG=,MIN=,MAX=,TYPE=,MORE=NO,KEY= 00068000
- * MSG MESSAGE TEXT TO APPEAR AT TERMINAL 00069000
- * MIN MINIMUM NUMBER OF CHARACTERS ALLOWED ON INPUT 00070000
- * MAX MAXIMUM NUMBER OF CHARACTERS ALLOWED ON INPUT 00071000
- * TYPE TYPE OF ALLOWED INPUT (HEX,CHAR, OR NUMERIC) 00072000
- * MORE WHETHER MORE LINES FOLLOW IN THIS PROMPT BEFORE READ 00073000
- * KEY KEYWORD TO BE ASSOCIATED WITH USER RESPONSE 00074000
- * 00075000
- * 00076000
- * OPERATION: 00077000
- * 00078000
- * I. OLD PROBLEM 00079000
- * II. NEW PROBLEM 00080000
- * III. WRTERM OPERATION (INTERNAL SUBROUTINE) 00081000
- * IV. RDTERM OPERATION (INTERNAL SUBROUTINE) 00082000
- * V. KYINSERT OPERATION (INTERNAL SUBROUTINE) 00083000
- * 00084000
- * THE USER IS FIRST ASKED IF THIS IS AN ADDITIONAL REPORT 00085000
- * CONCERNING AN ALREADY EXISTING PROBLEM. 00086000
- * 00087000
- * I. ADDITIONAL REPORT (OLD PROBLEM) 00088000
- * 00089000
- * 1. THE USER IS PROMPTED FOR THE PROBLEM NUMBER OF THE OLD 00090000
- * PROBLEM. 00091000
- * A. THE NUMBER IS TRANSLATED INTO THE FORM 'PRBNNNNN' WHERE 00092000
- * NNNNN IS THE RIGHT JUSTIFIED PROBLEM NUMBER WITH LEADING 00093000
- * ZEROES. 00094000
- * B. THE EXISTANCE OF THE PROBLEM REPORT CORRESPONDING TO THAT 00095000
- * PROBLEM NUMBER (PRBNNNNN REPORT A1) IS VERIFIED. 00096000
- * C. IF THE REPORT DOES NOT EXIST THE USER IS NOTIFIED AND 00097000
- * PROMPTED AGAIN FOR A PROBLEM NUMBER. 00098000
- * 00099000
- * 2. THE USER IS PROMPTED FOR THE NAMES AND DESCRIPTIONS OF 00100000
- * FILES CONTAINING DATA HE HAS COLLECTED TO AID IN DIAGNOSIS 00101000
- * OF THE PROBLEM. UP TO 5 OF THESE FILES MAY BE SPECIFIED. 00102000
- * 00103000
- * 3. THE USER IS PROMPTED FOR A FREE FORM (TEXT) DESCRIPTION 00104000
- * OF ANY FURTHER INFORMATION HE HAS CONCERNING THE PROBLEM. 00105000
- * 00106000
- * 4. THE INFORMATION COLLECTED IS ADDED TO THE END OF THE 00107000
- * ORIGINAL PROBLEM REPORT (PRBNNNNN REPORT A1) PRECEDED BY A 00108000
- * RECORD OF THE FORM: 00109000
- * *** ADDED *** MM/DD/YY HH:MM 00110000
- * 00111000
- * 5. RETURN TO CALLER 00112000
- * 00113000
- * 00114000
- * 00115000
- * II. NEW PROBLEM REPORT 00116000
- * 00117000
- * 1. THE FILE 'SUMMARY RECORD A1' IS READ TO OBTAIN THE NEXT 00118000
- * SEQUENTIAL PROBLEM NUMBER. THIS NUMBER WILL BE ASSOCIATED 00119000
- * WITH THIS REPORT. 00120000
- * 00121000
- * 2. MAINLINE PROMPTING 00122000
- * A. ALL PROMPTS THROUGH LABEL 'GETFAIL' ARE EXECUTED FOR 00123000
- * EACH REPORT. 00124000
- * B. WHEN THE USER HAS SELECTED THE TYPE OF FAILURE AT LABEL 00125000
- * 'GETFAIL' THAT PARTICULAR SUBROUTINE IS ENTERED. 00126000
- * C. WHEN THE ABOVE SUBROUTINE HAS FINISHED 'TEXTENTR' IS 00127000
- * BRANCHED TO AND THE TEXTUAL DESCRIPTION OF THE PROBLEM 00128000
- * IS REQUESTED. 00129000
- * 00130000
- * 3. THE AMOUNT OF DATA COLLECTED IN THE KEYWORD, SUPPORTING 00131000
- * AND TEXT AREAS IS CALCULATED AND SAVED. 00132000
- * 00133000
- * 4. THE USER IS TOLD THE NUMBER ASSIGNED TO THIS PROBLEM 00134000
- * AND THE NUMBER INCREMENTED AND WRITTEN BACK OUT TO DISK. 00135000
- * 00136000
- * 5. A PARM LIST CONTAINING POINTERS TO ALL DATA COLLECTED IS 00137000
- * LOADED IN R1 AND DMMWRT IS CALLED TO WRITE THE PROBLEM 00138000
- * REPORT ON DISK AND TO ADD THE PROBLEM TO THE SYMPTOM 00139000
- * SUMMARY. 00140000
- * 00141000
- * 6. USING THE SAME PARM LIST AS DMMWRT, DMMSEA IS CALLED TO 00142000
- * FIND ANY PREVIOUSLY REPORTED PROBLEMS WHOSE KEYWORD DATA 00143000
- * MATCHES THAT OF THE NEW PROBLEM. 00144000
- * 00145000
- * 7. RETURN TO CALLER 00146000
- * 00147000
- * 00148000
- * 00149000
- * III. WRTERM (COMMON TERMINAL WRITE ROUTINE) 00150000
- * 1. IF THIS IS A PROMPT MESSAGE REGS 5,6, AND 7 ARE SAVED IN 00151000
- * THE LOG TABLE FOR POSSIBLE REPROMPT USE. 00152000
- * 00153000
- * 2. THE 80 BYTE OUTPUT BUFFER IS CLEARED 00154000
- * 00155000
- * 3. IF 'ENTSW' IS NOT SET THE LINE NUMBER FOR REPROMPT IS 00156000
- * MOVED TO THE FRONT OF THE OUTPUT BUFFER. 00157000
- * SWITCH 'ENTSW' IS SET TO ALLOW ONLY THE FIRST LINE OF A 00158000
- * MULTI-LINE PROMPT TO EXHIBIT A REPROMPT NUMBER. 00159000
- * 00160000
- * 4. THE PROMPT MESSAGE LENGTH IS FOUND AND THE MSG TEXT 00161000
- * IS MOVED TO THE OUTPUT AREA AND WRITTEN TO THE TERMINAL. 00162000
- * 00163000
- * 5. THE 'MSGSTOP' FIELD IN THE PROMPT IS TESTED AND IF THERE 00164000
- * IS ANOTHER LINE OF PROMPTING MESSAGE RETURN TO 2. IF NOT 00165000
- * EXIT ON R9. 00166000
- * 00167000
- * IV. RDTERM (COMMON TERMINAL READ ROUTINE) 00168000
- * 00169000
- * 1. A READ IS ISSUED TO THE TERMINAL 00170000
- * 00171000
- * 2. IF NO INPUT RETURN TO CALLER 00172000
- * 00173000
- * 3. REMOVE LEADING BLANKS AND CHECK FOR ':HX' (HALT EXEC) 00174000
- * ':L' (USER REQUESTING A REPROMPT). IF :HX GO TO HXEXIT. 00175000
- * IF :L-- GO TO 5 BELOW. IF NULL EFFECTIVE INPUT RETURN. 00176000
- * 00177000
- * 4. REMOVE TRAILING BLANKS AND CHECK FOR DATA TYPE AND LNGTH 00178000
- * RESTRICTIONS AS SPECIFIED IN THE MSGP MACRO. 00179000
- * A. IF FIELD MSGMIN IS NON-ZERO CHECK FOR IMBEDDED BLANKS 00180000
- * AND DON'T ACCEPT THE INPUT IF ANY ARE FOUND. IF NO BLANKS 00181000
- * ARE FOUND CHECK THE LENGTH OF ENTERED DATA AGAINST THE 00182000
- * VALUE IN MSGMIN AND DON'T ACCEPT THE INPUT IF LESS THAN 00183000
- * MSGMIN AND FORCE A REPROMPT. IF OK GO TO B. 00184000
- * B. IF FIELD MSGMAX IS NON ZERO CHECK THE LENGTH OF INPUT 00185000
- * AGAINST MSGMAX AND IF THE LENGTH IS GREATER INFORM THE 00186000
- * USER AND REPROMPT HIM. IF OK GO TO C. 00187000
- * C. CHECK FOR DATA TYPE RESTRICTIONS (NUM OR HEX) AND IF SO 00188000
- * CHECK THE DATA FOR VIOLATIONS. IF INVALID DATA INFORM THE 00189000
- * USER AND FORCE A REPROMPT. IF OK RETURN. 00190000
- * 5. USER REQUESTED REPROMPT. CHECK TO SEE IF REPROMPTING IS 00191000
- * ALREADY IN EFFECT, AND IF SO INFORM THE USER IT IS ILLEGAL 00192000
- * AND RETURN TO THE ORIGINAL PROMPT BEFORE THE PREVIOUS 00193000
- * REQUEST FOR REPROMPTING. 00194000
- * A. SAVE THE CURRENT STATUS (REGS 5-9) 00195000
- * B. SEARCH THE LOG TABLE LIFO FOR A MATCHING REPROMPT LINE 00196000
- * NUMBER. 00197000
- * C. IF NOT FOUND INFORM THE USER AND RESTORE THE STATUS AND 00198000
- * DISPLAY THE ORIGINAL PROMPT. 00199000
- * D. IF FOUND SET REGS R5-R7 AND BRANCH TO THE REQUESTED 00200000
- * PROMPT ROUTINE VIA R5. 00201000
- * E. IT IS THE PROMPT ROUTINE'S ROLE TO CAUSE THE PREVIOUS 00202000
- * PROMPT'S STATUS TO BE RESTORED IF THE REPROMPT WAS NOT 00203000
- * OF A DECISION NATURE. IF A DECISION WAS TO BE MADE 00204000
- * ON THE DATA ENTERED THE ROUTINE WILL RESET THE REPROMPT 00205000
- * SWITCH AND CONTINUE FROM THAT POINT IN THE PROMPTING 00206000
- * LOGIC. 00207000
- * 00208000
- * 00209000
- * 00210000
- * V. KYINSERT (INTERNAL SUBROUTINE TO PUT KEYWORDS AND 00211000
- * ASSOCIATED DATA IN AN OUTPUT AREA) 00212000
- ***** THE DATA WILL BE IN VARIABLE BLOCKED FORMAT 00213000
- * 00214000
- * |TT00|LL00|..DATA1..|LL00|..DATA2..|...... 00215000
- * 4 4 LL-4 4 LL-4 00216000
- * 00217000
- * WHERE TT IS THE TOTAL LENGTH OF THE BLOCK 00218000
- * INCLUDING LENGTH FIELDS, AND EACH LL IS 00219000
- * THE LENGTH OF THAT LOGICAL RCD INCLUDING 00220000
- * ITS LENGTH FIELD. 00221000
- * 00222000
- * 00223000
- * 1. THE DATA LENGTH IS TESTED AND IF ZERO RETURN TO CALLER 00224000
- * 00225000
- * 2. THE KEYWORD IS EXTRACTED FROM THE MSGP EXPANSION AND 00226000
- * THE OUTPUT KEY AREA IS CHECKED TO SEE IF THE KEYWORD HAS 00227000
- * ALREADY BEEN STORED THERE (REPROMPTING MAY CAUSE THIS TO 00228000
- * HAPPEN, FOR EXAMPLE). 00229000
- * 00230000
- * 3. IF THE KEYWORD ALREADY EXISTS IN THE OUTPUT THE LEN OF 00231000
- * NEW DATA IS COMPARED TO THE LENGTH OF THE OLD. IF THEY ARE 00232000
- * THE SAME GO TO 4. 00233000
- * A. IF THE NEW DATA LENGTH IS GREATER ROOM MUST BE MADE FOR 00234000
- * IT BY MOVING ANY SUBSEQUENT DATA OUTWARD. GO TO 4. 00235000
- * B. IF THE NEW DATA LENGTH IS LESS ANY SUBSEQUENT DATA MUST 00236000
- * BE MOVED INWARD. 00237000
- * 00238000
- * 4. THE KEYWORD AND DATA (PREFIXED BY THE VARIABLE LNGTH 00239000
- * RECORD DESCRIPTOR) ARE STORED IN THE OUTPUT AREA. 00240000
- * RETURN TO CALLER. 00241000
- * 00242000
- * ERROR MESSAGES: 00243000
- * 00244000
- * DMMPRO100S ERROR 'NNN' READING FILE 'FNAME FTYPE FM' 00245000
- * DMMPRO200S ERROR 'NNN' WRITING FILE 'FNAME FTYPE FM' 00246000
- * 00247000
- *************************************************************** 00248000
- EJECT 00249000
- DMMPRO CSECT @VA04250 00250000
- USING DMMPRO,R15 TEMPORARY ADDRESSABILITY @VA04250 00251000
- B START GO AROUND EYECATCHER @VA04250 00252000
- DS 0D @VA04250 00253000
- MODNAME DC C'DMMPRO ' EYECATCHER @VA04250 00254000
- RELLEV DC C'REL4LEV0' RELEASE AND LEVEL @V4075A1 00255000
- START STM R14,R12,12(R13) SAVE CALLER'S REGS @VA04250 00256000
- LR R12,R15 SET OUR BASE @VA04250 00257000
- DROP R15 @VA04250 00258000
- USING DMMPRO,R12 @VA04250 00259000
- USING INTSECT,R2 AREA FOR DATE,TIME,CPU, ETC. @VA04250 00260000
- USING MSGCNTRL,R7 DSECT DESCRIBING MSGP DATA FORMAT@VA04250 00261000
- USING NUCON,R0 CMS LOW CORE DSECT @VA04250 00262000
- LR R11,R12 SET UP SECOND BASE @VA04250 00263000
- LA R11,TWOK(R11) @VA04250 00264000
- LA R11,TWOK(R11) @VA04250 00265000
- USING DMMPRO+FOURK,R11 SECOND BASE @VA04250 00266000
- LA R10,TWOK(R11) SET UP THIRD BASE @VA04250 00267000
- LA R10,TWOK(R10) @VA04250 00268000
- USING DMMPRO+EIGHTK,R10 THIRD BASE @VA04250 00269000
- ST R13,SAVEBACK SAVE CALLER'S SAVE AREA @VA04250 00270000
- LA R13,SAVEAREA POINT TO OUR OWN SAVE AREA @VA04250 00271000
- *************************************************************** 00272000
- * DETERMINE WHETHER THIS ACTIVITY IS TO REPORT A NEW PROBLEM OR 00273000
- * PERTAINS TO AN ALREADY EXISTING PROBLEM. 00274000
- *************************************************************** 00275000
- EXIST BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00276000
- * -------------------------- 00277000
- LA R7,MSGEXIST 'THIS PERTAIN TO AN EXISTING PROB@VA04250 00278000
- * -------------------------- 00279000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00280000
- MVI ENTSW,ENTON REPROMPT NOT TO BE ALLOWED HERE @VA04250 00281000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00282000
- CLI 0(R1),YES YES? @VA04250 00283000
- BE OLDPROB OLD PROBLEM @VA04250 00284000
- CLI 0(R1),NO NO? @VA04250 00285000
- BNE EXIST NOT A VALID INPUT, GO REPROMPT @VA04250 00286000
- MVI DBYTE,NORMAL RESET REPROMPTING IF IT IS ACTIVE@VA04250 00287000
- *************************************************************** 00288000
- * GET A PROBLEM NUMBER. WE'LL REWRITE IT AT END. 00289000
- *************************************************************** 00290000
- RPNUM LA R7,SUMMFILE POINT TO FN FT FM OF PROB NUMBER @VA04250 00291000
- FSREAD (R7),RECNO=1,ERROR=SUMERRR,BSIZE=80, @VA04250X00292000
- BUFFER=PNUMIN @VA04250 00293000
- FSCLOSE (R7) @VA04250 00294000
- PNRETRY MVC XXXXX(PLENGTH),PNUMIN SAVE REPORT PROBLEM NUMBER@VA04250 00295000
- RPNUM2 L R2,INTPT POINT TO INTERNAL DATA AREA @VA04250 00296000
- MVC INTPNUM(PLENGTH),XXXXX SAVE PROBLEM NUMBER @VA04250 00297000
- LA R7,PRBXXXXX POINT FN FT FM OF REPORT @VA04250 00298000
- FSSTATE (R7) DOES THE REPORT ALREADY EXIST? @VA04250 00299000
- LTR R15,R15 CHECK RETURN CODE @VA04250 00300000
- BNZ MAINLINE CONTINUE IF REPORT DOES NOT EXIST@VA04250 00301000
- MVI PNSWITCH,PNSWON INDICATE LOOKING FOR OPEN NUMBER@VA04250 00302000
- B PNUPDATE GO UPDATE PROBLEM NUMBER @VA04250 00303000
- *************************************************************** 00304000
- * MAINLINE PROMPTING ROUTINE 00305000
- *************************************************************** 00306000
- MAINLINE CLI OLDSW,OLDON PROCESSING AN OLD PROBLEM? @VA04250 00307000
- BE GETSDATA YES, GO GET SUPPORTING DATA FIRST@VA04250 00308000
- NEWPROB BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00309000
- * -------------------------- 00310000
- LA R7,MSGPCPU 'PROBLEM OCCUR ON THIS CPU?' @VA04250 00311000
- * -------------------------- 00312000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00313000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00314000
- MVI DBYTE,NORMAL THIS IS A DECISION, DON'T REPRMPT@VA04250 00315000
- CLI 0(R1),NO NOT THIS CPU @VA04250 00316000
- BE GETCPU GO PROMPT FOR IT @VA04250 00317000
- CLI 0(R1),YES YES? @VA04250 00318000
- BNE NEWPROB NO, GO FORCE VALID INPUT @VA04250 00319000
- *************************************************************** 00320000
- * USING STIDP INSTRUCTION GET CPU TYPE AND SERIAL 00321000
- *************************************************************** 00322000
- STIDP WKDWD GET THIS CPU TYPE AND SERIAL. @VA04250 00323000
- L R2,INTPT POINT TO INTERNAL DATA AREA @VA04250 00324000
- L R3,WKDWD2 GET TYPE OF CPU. @VA04250 00325000
- SRL R3,12 POSITION IT @VA04250 00326000
- ST R3,WKDWD2 SET UP FOR UNPACK @VA04250 00327000
- OI WKDWDEND,PACKMASK ALL SET NOW @VA04250 00328000
- UNPK INTCPUT(THREE),WKDWD+SIX(TWO) GET READABLE TYPE @VA04250 00329000
- MVI WKDWD2,PACKMASK PREPARE SERIAL FOR UNPACK @VA04250 00330000
- UNPK WKDWD(SEVEN),WKDWD+DISP1(DISP4) GET SERIAL @VA04250 00331000
- MVI WKDWD,CHARZERO SIX DIGITS OF SERIAL SO PREFIX @VA04250 00332000
- MVC INTSER,WKDWD MOVE SER OUT @VA04250 00333000
- B GETSDATA CONTINUE INTERNAL DATA @VA04250 00334000
- *************************************************************** 00335000
- * PROMPT FOR CPU TYPE AND SERIAL 00336000
- *************************************************************** 00337000
- GETCPU BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00338000
- * -------------------------- 00339000
- LA R7,MSGCPU 'ENTER CPU TYPE' @VA04250 00340000
- * -------------------------- 00341000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00342000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00343000
- LTR R0,R0 ANYTHING ENTERED @VA04250 00344000
- BZ GETCPU NO, FORCE HIM TO ENTER @VA04250 00345000
- L R2,INTPT ADDRESSABILITY FOR INTMNT AREA @VA04250 00346000
- MVC INTCPUT,0(R1) MOVE CPU TYPE TO OUTPUT @VA04250 00347000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00348000
- BE RESTORE YES, GO RESTORE @VA04250 00349000
- GETSER BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00350000
- * -------------------------------- 00351000
- LA R7,MSGSER 'ENTER CPU SERIAL' @VA04250 00352000
- * -------------------------------- 00353000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00354000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00355000
- LTR R0,R0 ANYTHING ENTERED? @VA04250 00356000
- BZ GETSER FORCE ENTRY @VA04250 00357000
- L R2,INTPT ADDRESSABILITY FOR INTSECT @VA04250 00358000
- MVC INTSER,0(R1) MOVE IT TO OUTPUT (INTSECT) @VA04250 00359000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00360000
- BE RESTORE YES, GO RESTORE @VA04250 00361000
- *************************************************************** 00362000
- * GET SUPPLEMENTARY FILES AND DESCRIPTIONS 00363000
- *************************************************************** 00364000
- GETSDATA BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00365000
- SR R2,R2 ZERO WORK @VA04250 00366000
- L R3,SUPPLNTH POINT TO CUMMULATIVE OUT LENGTH @VA04250 00367000
- STH R2,0(R3) CLEAR IT IN CASE OF REPROMPT @VA04250 00368000
- L R2,SUPPPT POINT TO SUPPORTING DATA AREA @VA04250 00369000
- LA R3,FIVECARD CLEAR 5 'CARDS' @VA04250 00370000
- MVI 0(R2),BLANK BLANK TO FIRST BYTE @VA04250 00371000
- GETSCLR MVC DISP1(CARDLEN,R2),0(R2) CLEAR ALL OF 'CARD' @VA04250 00372000
- LA R2,CARDLEN(R2) POINT TO NEXT AREA TO BE CLEARED @VA04250 00373000
- BCT R3,GETSCLR CLEAR ALL 5 @VA04250 00374000
- MVC SUPPCURR,SUPPPT RESET CURR PTR IF REPROMPT @VA04250 00375000
- MVC SUPPBACK,SUPPPT RESET TEMP PTR IF REPROMPT @VA04250 00376000
- * ---------------------------- 00377000
- LA R7,MSGSDATA 'ENTER LOCATION OF SUPPORT DATA' @VA04250 00378000
- * ---------------------------- 00379000
- LA R9,GETS1 DON'T DO READ YET @VA04250 00380000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00381000
- GETS1 BALR R5,0 RETURN ADDRESS FOR REPROMPT @VA04250 00382000
- * ---------------------------- 00383000
- LA R7,MSGSDAT2 'ENTER FN FT FM + DESCRIP OR NULL@VA04250 00384000
- * ---------------------------- 00385000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00386000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00387000
- CLI DBYTE,REPROMPT IN REPROMPTING? @VA04250 00388000
- BNE SUPPD2 NO @VA04250 00389000
- MVC SUPPCURR,SUPPBACK RESET CURRENT PTR TO PREVIOUS @VA04250 00390000
- L R2,SUPPCURR POINT TO RECORD @VA04250 00391000
- MVI 0(R2),BLANK PREP TO CLEAR LAST ENTERED DATA @VA04250 00392000
- MVC DISP1(CARDLEN-DISP1,R2),0(R2) CLEAR IT @VA04250 00393000
- SUPPD2 LTR R0,R0 ANYTHING ENTERED? @VA04250 00394000
- BNZ SUPPD3 YES @VA04250 00395000
- SUPPD4 L R2,SUPPLNTH POINT TO HALFWD LENGTH FIELD @VA04250 00396000
- L R3,SUPPPT POINT TO SUPPORTING DATA AREA @VA04250 00397000
- L R4,SUPPCURR POINT TO CURRENT POSITION @VA04250 00398000
- SR R4,R3 GET LENGTH @VA04250 00399000
- STH R4,0(R2) STORE IT FOR LATER @VA04250 00400000
- B DBYTECHK GO CHECK IF IN REPROMPT @VA04250 00401000
- SUPPD3 LR R2,R0 SAVE LENGTH @VA04250 00402000
- L R3,SUPPCURR GET CURRENT SUPP POINTER @VA04250 00403000
- BCTR R2,0 FOR EXECUTE @VA04250 00404000
- EX R2,SUPPMVC MOVE USER ENTERED DATA TO OUTPUT @VA04250 00405000
- MVC SUPPBACK,SUPPCURR SAVE PTR TO THIS FOR REPROMPT @VA04250 00406000
- LA R3,CARDLEN(R3) POINT TO NEXT 'CARD' OF OUTPUT @VA04250 00407000
- ST R3,SUPPCURR SAVE NEXT AVAIL SLOT FOR OUTPUT @VA04250 00408000
- CLI DBYTE,REPROMPT IN REPROMPTING? @VA04250 00409000
- BE SUPPD4 YES, GO RESTORE TO PREV PROMPT @VA04250 00410000
- L R2,SUPPEND POINT TO END OF SUPP DATA AREA @VA04250 00411000
- CR R3,R2 AT END YET? @VA04250 00412000
- BL GETS1 NO, ALLOW 5 CARDS OF SUPP DATA @VA04250 00413000
- B SUPPD4 GO CLEAN UP @VA04250 00414000
- SUPPMVC MVC 0(0,R3),0(R1) SUBJECT OF EXECUTE @VA04250 00415000
- DBYTECHK CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00416000
- BE RESTORE YES, GO RESTORE @VA04250 00417000
- CLI OLDSW,OLDON PROCESSING AN OLD PROBLEM? @VA04250 00418000
- BE TEXTENTR YES, GO GET TEXT NEXT @VA04250 00419000
- *************************************************************** 00420000
- * GET SEVERITY TO BE ASSIGNED TO THIS PROBLEM 00421000
- *************************************************************** 00422000
- GETSEV BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00423000
- * ---------------------------- 00424000
- LA R7,MSGSEV 'ENTER SEVERITY CODE (1 TO 4)' @VA04250 00425000
- * ---------------------------- 00426000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00427000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00428000
- L R2,INTPT ADDRESSABILITY FOR INTSECT @VA04250 00429000
- LTR R0,R0 ANYTHING ENTERED? @VA04250 00430000
- BZ SVDFLT NO, GO USE DEFAULT @VA04250 00431000
- CLI 0(R1),FOUR CHECK GT 4 SEVERITY @VA04250 00432000
- BH GETSEV THAT'S NO GOOD @VA04250 00433000
- CLI 0(R1),ONE CHECK EBCDIC LESS THAN 1 @VA04250 00434000
- BL GETSEV THAT'S NO GOOD EITHER @VA04250 00435000
- MVC INTSEV,0(R1) STORE IT IN INTERNAL AREA @VA04250 00436000
- B SVDB GO CHECK IF REPROMPTING @VA04250 00437000
- SVDFLT MVI INTSEV,SEVDFLT DEFAULT SEVERITY OF BLANK @VA04250 00438000
- SVDB CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00439000
- BE RESTORE YES, GO RESTORE @VA04250 00440000
- *************************************************************** 00441000
- * ASK WHETHER A BYPASS IS REQUIRED FOR THIS PROBLEM 00442000
- *************************************************************** 00443000
- GETBYPAS BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00444000
- * ---------------------------- 00445000
- LA R7,MSGBYPAS 'IS BYPASS REQUESTED? @VA04250 00446000
- * ---------------------------- 00447000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00448000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00449000
- L R2,INTPT ADDRESSABILITY FOR INTSECT @VA04250 00450000
- LTR R0,R0 ANYTHING ENTERED? @VA04250 00451000
- BZ BYDFLT NO, USE DEFAULT @VA04250 00452000
- CLI 0(R1),NO N? (NO?) @VA04250 00453000
- BE BYMVC OR @VA04250 00454000
- CLI 0(R1),YES Y? (YES?) @VA04250 00455000
- BNE GETBYPAS ONLY ARE VALID. @VA04250 00456000
- BYMVC MVC INTBYPS,0(R1) MOVE WHAT WAS ENTERED TO INTSECT @VA04250 00457000
- B BYDB GO CHECK IF REPROMPTING @VA04250 00458000
- BYDFLT MVI INTBYPS,NO DEFAULT OF NO @VA04250 00459000
- BYDB CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00460000
- BE RESTORE YES, GO RESTORE @VA04250 00461000
- *************************************************************** 00462000
- * GET COMPONENT ID (EG 5749DMS00) 00463000
- *************************************************************** 00464000
- GETCID BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00465000
- * ---------------------------- 00466000
- LA R7,MSGCID 'ENTER COMPONENT ID' @VA04250 00467000
- * ---------------------------- 00468000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00469000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00470000
- BAL R8,KYINSERT PUT CID IN KEYWORDED AREA @VA04250 00471000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00472000
- BE RESTORE YES, GO RESTORE @VA04250 00473000
- *************************************************************** 00474000
- * GET PLC LEVEL OF SYSTEM 00475000
- *************************************************************** 00476000
- GETPLC BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00477000
- * ---------------------------- 00478000
- LA R7,MSGPLC 'ENTER PLC LEVEL' @VA04250 00479000
- * ---------------------------- 00480000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00481000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00482000
- LTR R0,R0 ANYTHING ENTERED? @VA04250 00483000
- BZ PLCDBYT NO @VA04250 00484000
- LA R2,PLCCNT THREE CHAR PLC LEVEL @VA04250 00485000
- CR R2,R0 THREE CHARS ENTERED? @VA04250 00486000
- BE PLC3 YES @VA04250 00487000
- BCTR R1,0 CHECK FOR TWO THEN @VA04250 00488000
- MVI 0(R1),CHARZERO PUT IN LEADING ZERO @VA04250 00489000
- BCTR R2,0 SUBTRACT 1 FROM R2 @VA04250 00490000
- CR R2,R0 IS IT INDEED 2? @VA04250 00491000
- BE PLC1 THAT'S NICE @VA04250 00492000
- BCTR R1,0 ONE MORE BYTE IN FRONT OF DATA @VA04250 00493000
- MVI 0(R1),CHARZERO INSERT ANOTHER LEADING ZERO @VA04250 00494000
- PLC1 LA R0,PLCCNT THE RESULT IS THREE CHARS ALWAYS @VA04250 00495000
- PLC3 BAL R8,KYINSERT PUT PLC IN KEYWORDED AREA @VA04250 00496000
- L R2,INTPT POINT TO INTERNAL DATA AREA @VA04250 00497000
- MVC INTPLC,0(R1) SAVE PLC LEVEL OF SYSTEM @VA04250 00498000
- PLCDBYT CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00499000
- BE RESTORE YES, GO RESTORE @VA04250 00500000
- *************************************************************** 00501000
- * GET SCP LEVEL (RELEASE LEVEL) OF SYSTEM 00502000
- *************************************************************** 00503000
- GETSCPLV BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00504000
- * ---------------------------- 00505000
- LA R7,MSGSCP 'ENTER SCP LEVEL' @VA04250 00506000
- * ---------------------------- 00507000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00508000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00509000
- LTR R0,R0 ANYTHING ENTERED? @VA04250 00510000
- BZ SCPDBYT NO @VA04250 00511000
- LA R2,SCPCNT THREE CHARS OF SCP LEVEL DESIRED @VA04250 00512000
- CR R0,R2 DID HE ENTER 3 CHARACTERS? @VA04250 00513000
- BE SCP3 SURE NUFF @VA04250 00514000
- MVI TWO(R1),CHARZERO TRAILING ZERO @VA04250 00515000
- BCTR R2,0 SUBTRACT ONE FROM R2 @VA04250 00516000
- CR R0,R2 DID HE ENTER 2 CHARACTERS? @VA04250 00517000
- BE SCP1 YES @VA04250 00518000
- MVI DISP1(R1),CHARZERO ANOTHER TRAILING ZERO @VA04250 00519000
- SCP1 LA R0,SCPCNT THE RESULT IS ALWAYS THREE CHARS @VA04250 00520000
- SCP3 BAL R8,KYINSERT GO PUT RESULT IN KEYWORDED AREA @VA04250 00521000
- SCPDBYT CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00522000
- BE RESTORE YES, GO RESTORE @VA04250 00523000
- *************************************************************** 00524000
- * GET DATE FAILURE OCCURRED 00525000
- *************************************************************** 00526000
- GETDATE BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00527000
- * ---------------------------- 00528000
- LA R7,MSGDATE 'ENTER DATE OF FAILURE' @VA04250 00529000
- * ---------------------------- 00530000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00531000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00532000
- LTR R0,R0 ANYTHING ENTERED? @VA04250 00533000
- BZ DATDBYT NO @VA04250 00534000
- CLI TWO(R1),SLASH FORCE USER TO ENTER MM/DD/YY @VA04250 00535000
- BE GETDATE1 HE DID GOOD SO FAR @VA04250 00536000
- B GETDERR TELL HIM THE ERROR OF HIS WAYS @VA04250 00537000
- GETDATE1 CLI FIVE(R1),SLASH FORMAT SHOULD BE MM/DD/YY @VA04250 00538000
- BE GETDATE2 AND A MERRY OLD SOUL WAS HE @VA04250 00539000
- GETDERR MVI ENTSW,ENTON INHIBIT REPROMPT NUMBER @VA04250 00540000
- * ---------------------------- 00541000
- LA R7,MSGERR7 'ENTER EXACTLY AS SHOWN' @VA04250 00542000
- * ---------------------------- 00543000
- BAL R9,WRTERM GO TELL USER @VA04250 00544000
- B GETDATE GO BACK AND ASK AGAIN @VA04250 00545000
- GETDATE2 L R2,INTPT ADDRESSABILITY FOR INTSECT @VA04250 00546000
- MVC INTED,0(R1) MOVE DATA TO OUTPUT (INTSECT) @VA04250 00547000
- DATDBYT CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00548000
- BE RESTORE YES, GO RESTORE @VA04250 00549000
- *************************************************************** 00550000
- * GET MAJOR DESCRIPTION OF FAILURE 00551000
- *************************************************************** 00552000
- GETFAIL BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00553000
- * ---------------------------- 00554000
- LA R7,MSGFAIL 'SELECT KEYWORD... MSG ABEND ETC'@VA04250 00555000
- * ---------------------------- 00556000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00557000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00558000
- LTR R0,R0 ANYTHING ENTERED? @VA04250 00559000
- BZ GETFAIL USER MUST SELECT SOMETHING @VA04250 00560000
- CLI DBYTE,REPROMPT IN REPROMPT? @VA04250 00561000
- BNE GETFAIL1 NO @VA04250 00562000
- L R2,KYCURRPT GET CURRENT POINTER IN KEY OUTPUT@VA04250 00563000
- L R3,KYREST GET VALUE FROM BEFORE @VA04250 00564000
- CR R2,R3 SAME? @VA04250 00565000
- BE GETFAIL1 YES, NO OUTPUT YET @VA04250 00566000
- SR R2,R3 GET DIFFERENCE @VA04250 00567000
- BCTR R2,0 SET FOR EXECUTE @VA04250 00568000
- EX R2,KYRESET RESET OUTPUT DATA @VA04250 00569000
- ST R3,KYCURRPT RESTORE OLD POINTER @VA04250 00570000
- GETFAIL1 MVC KYREST,KYCURRPT SAVE LOCATION IN KEY OUT AREA @VA04250 00571000
- MVI DBYTE,NORMAL CONTINUE FROM HERE IF REPROMPT @VA04250 00572000
- CLC 0(CKLN2,R1),ABEND ABE? (ABEND) @VA04250 00573000
- BE ABERTN YES @VA04250 00574000
- CLC 0(CKLN2,R1),LOOP LOO? (LOOP) @VA04250 00575000
- BE LOORTN YES @VA04250 00576000
- CLC 0(CKLN1,R1),MSG MSG? (MESSAGE) @VA04250 00577000
- BE MSGRTN YES @VA04250 00578000
- CLC 0(CKLN2,R1),INCORR INC? (INCORROUT) @VA04250 00579000
- BE INCRTN YES @VA04250 00580000
- CLC 0(CKLN2,R1),WAIT WAI? (WAIT) @VA04250 00581000
- BE WAIRTN YES @VA04250 00582000
- CLC 0(CKLN2,R1),INFORM INF? (INFORMATION) @VA04250 00583000
- BE INFRTN YES @VA04250 00584000
- CLC 0(CKLN2,R1),DOCUM DOC? (DOCUMENTATION) @VA04250 00585000
- BE DOCRTN YES @VA04250 00586000
- CLC 0(CKLN2,R1),PERFORM PER? (PERFORMANCE) @VA04250 00587000
- BE PERRTN YES @VA04250 00588000
- B GETFAIL INVALID INPUT, GO ASK AGAIN @VA04250 00589000
- INTMVC MVC 0(0,R4),0(R1) @VA04250 00590000
- KYRESET XC 0(0,R3),0(R3) EXECUTED TO CLEAR INVAL KEYS @VA04250 00591000
- ************************************************************* 00592000
- EJECT 00593000
- ************************************************************* 00594000
- * ABEND TYPE REPORT 00595000
- ************************************************************* 00596000
- ABERTN BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00597000
- LA R0,L'ABEND LENGTH OF 'ABEND' @VA04250 00598000
- LA R1,ABEND POINTER TO CONSTANT OF 'ABEND' @VA04250 00599000
- BAL R8,KYINSERT GO PUT 'ABEND' IN VMFAILURE KYWD @VA04250 00600000
- * ---------------------------- 00601000
- LA R7,MSGENV 'ENTER OPERATING ENVIRONMENT' @VA04250 00602000
- * ---------------------------- 00603000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00604000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00605000
- BAL R8,KYINSERT PUT ENTERED DATA IN KEY AREA @VA04250 00606000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00607000
- BE RESTORE YES, GO RESTORE @VA04250 00608000
- ABEABCOD BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00609000
- * ---------------------------- 00610000
- LA R7,MSGABCOD 'ENTER ABEND CODE. EG 0CX' @VA04250 00611000
- * ---------------------------- 00612000
- ABEPRMT LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00613000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00614000
- LTR R0,R0 DID USER ENTER ANYTHING? @VA04250 00615000
- BZ ABEPRMT NO, FORCE ENTRY OF SOMETHING @VA04250 00616000
- S R1,=F'5' WE'LL PREFIX THIS WITH 'ABEND' @VA04250 00617000
- MVC 0(L'ABEND,R1),ABEND MOVE IN DATA OF 'ABEND' @VA04250 00618000
- A R0,=F'5' INCREASE DATA COUNT BY L'ABEND @VA04250 00619000
- BAL R8,KYINSERT GO PUT IN KEY AREA @VA04250 00620000
- ABEDB1 CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00621000
- BE RESTORE YES, GO RESTORE @VA04250 00622000
- ABEFMOD BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00623000
- * ---------------------------- 00624000
- LA R7,MSGFMOD 'ENTER FAILING MODULE IF KNOWN' @VA04250 00625000
- * ---------------------------- 00626000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00627000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00628000
- BAL R8,KYINSERT GO PUT DATA IN KEY AREA @VA04250 00629000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00630000
- BE RESTORE YES, GO RESTORE @VA04250 00631000
- ABEDISP BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00632000
- * ---------------------------- 00633000
- LA R7,MSGDSP 'ENTER DISPLAC WITHIN FAIL MOD' @VA04250 00634000
- * ---------------------------- 00635000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00636000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00637000
- BAL R8,KYINSERT GO PUT DATA IN KEY AREA @VA04250 00638000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00639000
- BE RESTORE YES, GO RESTORE @VA04250 00640000
- ABECALL BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00641000
- * ---------------------------- 00642000
- LA R7,MSGCALL 'ENTER CALLING MODULE IF KNOWN' @VA04250 00643000
- * ---------------------------- 00644000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00645000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00646000
- BAL R8,KYINSERT GO PUT DATA IN KEY AREA @VA04250 00647000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00648000
- BE RESTORE YES, GO RESTORE @VA04250 00649000
- ABECMS BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00650000
- * ---------------------------- 00651000
- LA R7,MSGCMD 'ENTER COMMAND WHICH CAUSED FAIL'@VA04250 00652000
- * ---------------------------- 00653000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00654000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00655000
- BAL R8,DASHIN INSERT DASHES @VA04250 00656000
- BAL R8,KYINSERT GO PUT DATA IN KEY AREA @VA04250 00657000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00658000
- BE RESTORE YES, GO RESTORE @VA04250 00659000
- B TEXTENTR GO GET TEXT OF PROBLEM @VA04250 00660000
- ************************************************************* 00661000
- EJECT 00662000
- ************************************************************* 00663000
- * MSG KEYWORD PROCESSING 00664000
- ************************************************************* 00665000
- MSGRTN BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00666000
- LA R0,L'MSG LENGTH OF DATA @VA04250 00667000
- LA R1,MSG POINT TO DATA @VA04250 00668000
- BAL R8,KYINSERT PUT VMFAILURE IN OUTPUT @VA04250 00669000
- * ---------------------------- 00670000
- LA R7,MSGMSG 'ENTER MESSAGE NUMBER' @VA04250 00671000
- * ---------------------------- 00672000
- MESPRMT LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00673000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00674000
- LTR R0,R0 ANYTHING ENTERED? @VA04250 00675000
- BZ MESPRMT NO, FORCE ENTRY OF MESSAGE @VA04250 00676000
- S R1,=F'2' WE'LL PREFIX THIS WITH 'MS' (MSG)@VA04250 00677000
- MVC 0(L'MSG,R1),MSG MOVE IN DATA OF 'MS' @VA04250 00678000
- A R0,=F'2' INCREASE DATA COUNT BY L'MSG @VA04250 00679000
- BAL R8,KYINSERT GO PUT IN KEY AREA @VA04250 00680000
- MESDB1 CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00681000
- BE RESTORE YES, GO RESTORE @VA04250 00682000
- MESENV BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00683000
- * ---------------------------- 00684000
- LA R7,MSGENV 'ENTER OPERATING ENVIRONMENT' @VA04250 00685000
- * ---------------------------- 00686000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00687000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00688000
- BAL R8,KYINSERT GO PUT IN KEY AREA @VA04250 00689000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00690000
- BE RESTORE YES, GO RESTORE @VA04250 00691000
- MESRCODE BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00692000
- * ---------------------------- 00693000
- LA R7,MSGRCODE 'ENTER RETURN CODE IF APPLICABLE'@VA04250 00694000
- * ---------------------------- 00695000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00696000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00697000
- BAL R8,KYINSERT GO PUT IN KEY AREA @VA04250 00698000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00699000
- BE RESTORE YES, GO RESTORE @VA04250 00700000
- MESPREV BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00701000
- * ---------------------------- 00702000
- LA R7,MSGPREV 'ENTER PREVIOUS MESSAGE NUMBER' @VA04250 00703000
- * ---------------------------- 00704000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00705000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00706000
- BAL R8,KYINSERT GO PUT DATA IN KEY AREA @VA04250 00707000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00708000
- BE RESTORE YES, GO RESTORE @VA04250 00709000
- MESCMD BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00710000
- * ---------------------------- 00711000
- LA R7,MSGCMD 'ENTER CMD WHICH CAUSED FAILURE' @VA04250 00712000
- * ---------------------------- 00713000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00714000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00715000
- BAL R8,DASHIN INSERT DASHES @VA04250 00716000
- BAL R8,KYINSERT GO PUT DATA IN KEY AREA @VA04250 00717000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00718000
- BE RESTORE YES, GO RESTORE @VA04250 00719000
- B TEXTENTR GO ASK USER FOR TEXTUAL INFO @VA04250 00720000
- ************************************************************* 00721000
- EJECT 00722000
- ************************************************************* 00723000
- * DOCUMENTATION TYPE REPORT 00724000
- ************************************************************* 00725000
- DOCRTN BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00726000
- LA R0,L'DOCUM LENGTH OF DATA @VA04250 00727000
- LA R1,DOCUM POINTER TO DATA @VA04250 00728000
- BAL R8,KYINSERT PUT VMFAILURE=DOCUMENTATION @VA04250 00729000
- * ---------------------------- 00730000
- LA R7,MSGDOC 'ENTER PUB PLC OR PTF FICHE' @VA04250 00731000
- * ---------------------------- 00732000
- DOCPRMT LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00733000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00734000
- LTR R0,R0 ANYTHING ENTERED? @VA04250 00735000
- BZ DOCPRMT NO, FORCE A CHOICE @VA04250 00736000
- BAL R8,KYINSERT PUT IN KEY AREA @VA04250 00737000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00738000
- BE RESTORE YES, GO RESTORE @VA04250 00739000
- DOCPUB BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00740000
- * ---------------------------- 00741000
- LA R7,MSGPUB 'ENTER PUBLICATION NUMBER' @VA04250 00742000
- * ---------------------------- 00743000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00744000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00745000
- BAL R8,KYINSERT GO PUT DATA IN KEY AREA @VA04250 00746000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00747000
- BE RESTORE YES, GO RESTORE @VA04250 00748000
- DOCPAGE BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00749000
- * ---------------------------- 00750000
- LA R7,MSGPAGE 'ENTER PAGE NUMBER' @VA04250 00751000
- * ---------------------------- 00752000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00753000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00754000
- BAL R8,KYINSERT GO PUT KEY AND DATA IN KEY AREA @VA04250 00755000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00756000
- BE RESTORE YES, GO RESTORE @VA04250 00757000
- B TEXTENTR GO ASK USER FOR TEXTUAL INFO @VA04250 00758000
- ************************************************************* 00759000
- EJECT 00760000
- ************************************************************* 00761000
- * INCORRECT OUTPUT TYPE REPORT 00762000
- ************************************************************* 00763000
- INCRTN BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00764000
- LA R0,L'INCORR LENGTH OF DATA @VA04250 00765000
- LA R1,INCORR POINTER TO DATA @VA04250 00766000
- BAL R8,KYINSERT VMFAILURE=INCORROUT IN KEY AREA @VA04250 00767000
- * ---------------------------- 00768000
- LA R7,MSGENV 'ENTER OPERATING ENVIRONMENT' @VA04250 00769000
- * ---------------------------- 00770000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00771000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00772000
- BAL R8,KYINSERT KEY AND DATA TO KEY AREA @VA04250 00773000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00774000
- BE RESTORE YES, GO RESTORE @VA04250 00775000
- INCINC BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00776000
- * ---------------------------- 00777000
- LA R7,MSGINC 'SELECT DUP,MISSING,FUNCT,ETC.' @VA04250 00778000
- * ---------------------------- 00779000
- INCPRMT LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00780000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00781000
- LTR R0,R0 ANYTHING ENTERED? @VA04250 00782000
- BZ INCINC NO, FORCE A CHOICE @VA04250 00783000
- LA R2,INCSPELL POINT TO ALLOWED INPUT VALUES @VA04250 00784000
- INCLOOP CLC 0(INCLEN,R2),0(R1) VALID INPUT FOUND? @VA04250 00785000
- BE INCKYIN YES @VA04250 00786000
- LA R2,INCLEN(R2) POINT TO NEXT ALLOWED INPUT VALUE@VA04250 00787000
- CLI 0(R2),INCEND ANY MORE VALID ENTRIES? @VA04250 00788000
- BE INCINC NO, GO PROMPT AGAIN @VA04250 00789000
- B INCLOOP CONTINUE CHECKING @VA04250 00790000
- INCKYIN BAL R8,KYINSERT KEY AND DATA TO KEY AREA @VA04250 00791000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00792000
- BE RESTORE YES, GO RESTORE @VA04250 00793000
- INCCMD BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00794000
- * ---------------------------- 00795000
- LA R7,MSGCMD 'ENTER COMMAND WHICH CAUSED FAIL'@VA04250 00796000
- * ---------------------------- 00797000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00798000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00799000
- BAL R8,DASHIN INSERT DASHES @VA04250 00800000
- BAL R8,KYINSERT KEY AND DATA TO KEY AREA @VA04250 00801000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00802000
- BE RESTORE YES, GO RESTORE @VA04250 00803000
- INCDEV BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00804000
- * ---------------------------- 00805000
- LA R7,MSGDEV 'ENTER DEVICE TYPE IF APPLIC' @VA04250 00806000
- * ---------------------------- 00807000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00808000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00809000
- BAL R8,KYINSERT KEY AND DATA TO KEY AREA @VA04250 00810000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00811000
- BE RESTORE YES, GO RESTORE @VA04250 00812000
- B TEXTENTR GO ASK USER FOR TEXTUAL INFO @VA04250 00813000
- ************************************************************* 00814000
- EJECT 00815000
- ************************************************************* 00816000
- * INFORMATION TYPE REPORT 00817000
- ************************************************************* 00818000
- INFRTN BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00819000
- LA R0,L'INFORM LENGTH OF DATA @VA04250 00820000
- LA R1,INFORM POINTER TO DATA @VA04250 00821000
- BAL R8,KYINSERT VMFAILURE=INFORMATION TO KEY AREA@VA04250 00822000
- B TEXTENTR GO ASK USER FOR TEXTUAL INFO @VA04250 00823000
- ************************************************************* 00824000
- EJECT 00825000
- ************************************************************* 00826000
- * LOOP TYPE REPORT 00827000
- ************************************************************* 00828000
- LOORTN BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00829000
- LA R0,L'LOOP LENGTH OF DATA @VA04250 00830000
- LA R1,LOOP POINTER TO DATA @VA04250 00831000
- BAL R8,KYINSERT VMFAILURE=LOOP TO KEY AREA @VA04250 00832000
- * ---------------------------- 00833000
- LA R7,MSGENV 'ENTER OPERATING ENVIRONMENT' @VA04250 00834000
- * ---------------------------- 00835000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00836000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00837000
- BAL R8,KYINSERT KEY AND DATA TO KEY AREA @VA04250 00838000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00839000
- BE RESTORE YES, GO RESTORE @VA04250 00840000
- LOOSTATE BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00841000
- * ---------------------------- 00842000
- LA R7,MSGSTATE 'ENTER DISABLED OR ENABLED' @VA04250 00843000
- * ---------------------------- 00844000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00845000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00846000
- CLC STATE1,0(R1) ENABLED? @VA04250 00847000
- BE LOOKY YES, O.K. @VA04250 00848000
- CLC STATE2,0(R1) DISABLED? @VA04250 00849000
- BNE LOOSTATE NO, GO FORCE VALID RESPONSE @VA04250 00850000
- LOOKY BAL R8,KYINSERT KEY AND DATA TO KEY AREA @VA04250 00851000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00852000
- BE RESTORE YES, GO RESTORE @VA04250 00853000
- LOOMODS BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00854000
- * ---------------------------- 00855000
- LA R7,MSGLMOD 'ENTER KNOWN MODULES WITHIN LOOP'@VA04250 00856000
- * ---------------------------- 00857000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00858000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00859000
- BAL R8,DASHIN INSERT DASHES BETWEEN ENTRIES @VA04250 00860000
- BAL R8,KYINSERT KEY AND DATA TO KEY AREA @VA04250 00861000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00862000
- BE RESTORE YES, GO RESTORE @VA04250 00863000
- L R6,TEXTCURR ADDR OF WHERE LOOP ADDRS WILL GO @VA04250 00864000
- LOOADDRS BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00865000
- * ---------------------------- 00866000
- LA R7,MSGLADDR 'ENTER LOOP ADDRESSES' @VA04250 00867000
- * ---------------------------- 00868000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00869000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00870000
- BAL R8,DASHIN INSERT DASHES BETWEEN ENTRIES @VA04250 00871000
- LTR R0,R0 ANYTHING ENTERED? @VA04250 00872000
- BZ LOOBYT NO @VA04250 00873000
- LR R2,R6 POINTER TO WHERE OUTPUT IS TO GO @VA04250 00874000
- MVC 0(FIFTEEN,R2),=C'LOOP ADDRESSES=' @VA04250 00875000
- LR R3,R0 GET LENGTH OF DATA @VA04250 00876000
- BCTR R3,0 SET FOR EXECUTE @VA04250 00877000
- EX R3,LOOMVC DO DATA MOVE @VA04250 00878000
- LA R2,CARDLEN(R2) 80 BYTE RECORDS IN TEXT AREA @VA04250 00879000
- ST R2,TEXTCURR SAVE NEW CURRENT POINTER @VA04250 00880000
- B LOOBYT CONTINUE @VA04250 00881000
- LOOMVC MVC FIFTEEN(0,R2),0(R1) SUBJECT OF EXECUTE @VA04250 00882000
- LOOBYT CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00883000
- BE RESTORE YES, GO RESTORE @VA04250 00884000
- L R6,TEXTCURR POINT TO NEXT OUTPUT RECORD @VA04250 00885000
- LOOCPSW BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00886000
- * ---------------------------- 00887000
- LA R7,MSGCPSW 'ENTER CURRENT PSW' @VA04250 00888000
- * ---------------------------- 00889000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00890000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00891000
- LR R2,R6 POINT TO TEXT AREA @VA04250 00892000
- LTR R0,R0 ANYTHING ENTERED? @VA04250 00893000
- BZ LOODBYT NO @VA04250 00894000
- MVC 0(CPSWLN,R2),=C'CURRENT PSW=' @VA04250 00895000
- MVC CPSWLN(PSWL,R2),0(R1) MOVE PSW TO TEXT AREA @VA04250 00896000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00897000
- BE RESTORE YES, GO RESTORE @VA04250 00898000
- LA R2,CARDLEN(R2) INCREMENT CURRENT TEXT POINTER @VA04250 00899000
- ST R2,TEXTCURR SAVE FOR NEXT USER @VA04250 00900000
- LOODBYT CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00901000
- BE RESTORE YES, GO RESTORE @VA04250 00902000
- LOOCMD BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00903000
- * ---------------------------- 00904000
- LA R7,MSGCMD 'ENTER COMMAND WHICH CAUSED FAIL'@VA04250 00905000
- * ---------------------------- 00906000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00907000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00908000
- BAL R8,DASHIN INSERT DASHES @VA04250 00909000
- BAL R8,KYINSERT KEY AND DATA TO KEY AREA @VA04250 00910000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00911000
- BE RESTORE YES, GO RESTORE @VA04250 00912000
- B TEXTENTR @VA04250 00913000
- ************************************************************* 00914000
- EJECT 00915000
- ************************************************************* 00916000
- * PERFORMANCE TYPE REPORT 00917000
- ************************************************************* 00918000
- PERRTN BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00919000
- LA R0,L'PERFORM LENGTH OF DATA @VA04250 00920000
- LA R1,PERFORM POINTER TO DATA @VA04250 00921000
- BAL R8,KYINSERT GO PUT KYWD VMFAILURE IN OUTPUT @VA04250 00922000
- * ---------------------------- 00923000
- LA R7,MSGENV 'ENTER OPERATING ENVIRONMENT' @VA04250 00924000
- * ---------------------------- 00925000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00926000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00927000
- BAL R8,KYINSERT KEY AND DATA TO KEY AREA @VA04250 00928000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00929000
- BE RESTORE YES, GO RESTORE @VA04250 00930000
- PERPERF BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00931000
- * ---------------------------- 00932000
- LA R7,MSGPERF 'ENTER NATURE OF DEGRADATION' @VA04250 00933000
- * ---------------------------- 00934000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00935000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00936000
- BAL R8,KYINSERT KEY AND DATA TO KEY AREA @VA04250 00937000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00938000
- BE RESTORE YES, GO RESTORE @VA04250 00939000
- B TEXTENTR GO PROMPT FOR TEXT DESCRIPTION @VA04250 00940000
- ************************************************************* 00941000
- EJECT 00942000
- ************************************************************* 00943000
- * WAIT TYPE REPORT 00944000
- ************************************************************* 00945000
- WAIRTN BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00946000
- LA R0,L'WAIT LENGTH OF DATA @VA04250 00947000
- LA R1,WAIT POINTER TO DATA @VA04250 00948000
- BAL R8,KYINSERT VMFAILURE=WAIT TO KEY AREA @VA04250 00949000
- * ---------------------------- 00950000
- LA R7,MSGENV 'ENTER OPERATING ENVIRONMENT' @VA04250 00951000
- * ---------------------------- 00952000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00953000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00954000
- BAL R8,KYINSERT KEY AND DATA TO KEY AREA @VA04250 00955000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00956000
- BE RESTORE YES, GO RESTORE @VA04250 00957000
- L R6,TEXTCURR POINTER TO NEXT OUTPUT RECORD @VA04250 00958000
- WAICPSW BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00959000
- * ---------------------------- 00960000
- LA R7,MSGCPSW 'ENTER CURRENT PSW' @VA04250 00961000
- * ---------------------------- 00962000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00963000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00964000
- LTR R0,R0 ANYTHING ENTERED? @VA04250 00965000
- BZ WAIDBYT NO @VA04250 00966000
- LR R2,R6 TEST AREA POINTER FOR THIS @VA04250 00967000
- MVC 0(CPSWLN,R2),=C'CURRENT PSW=' @VA04250 00968000
- MVC CPSWLN(SIXTEEN,R2),0(R1) MOVE DATA TO TEXT AREA @VA04250 00969000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00970000
- BE RESTORE YES, GO RESTORE @VA04250 00971000
- LA R2,CARDLEN(R2) INCREMENT CURRENT TEXT POINTER @VA04250 00972000
- ST R2,TEXTCURR SAVE FOR NEXT USER @VA04250 00973000
- WAIDBYT CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00974000
- BE RESTORE YES, GO RESTORE @VA04250 00975000
- WAICMD BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00976000
- * ---------------------------- 00977000
- LA R7,MSGCMD 'ENTER COMMAND WHICH CAUSED FAIL'@VA04250 00978000
- * ---------------------------- 00979000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 00980000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 00981000
- BAL R8,DASHIN INSERT DASHES @VA04250 00982000
- BAL R8,KYINSERT KEY AND DATA TO KEY AREA @VA04250 00983000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 00984000
- BE RESTORE YES, GO RESTORE @VA04250 00985000
- B TEXTENTR GO ASK USER FOR TEXTUAL INFO @VA04250 00986000
- ************************************************************* 00987000
- EJECT 00988000
- *************************************************************** 00989000
- * READ TEXT PORTION OF REPORT 00990000
- *************************************************************** 00991000
- TEXTENTR LA R6,MAXLINES ALLOW 20 LINES OF INPUT @VA04250 00992000
- MVI TEXTSW,TEXTSWON INDICATE USER ENTERING TEXT @VA04839 00992100
- CLC TEXTPT,TEXTCURR ANYBODY BEEN HERE ALREADY @VA04250 00993000
- BE TEXTNOD NO @VA04250 00994000
- BCTR R6,0 SOMEBODY USED ONE ALREADY @VA04250 00995000
- MVC TEXTLAST,TEXTCURR RESET IN CASE OF REPROMPT @VA04250 00996000
- MVC TEXTBACK,TEXTCURR RESET IN CASE OF REPROMPT @VA04250 00997000
- TEXTNOD BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 00998000
- MVI TEXTSW,TEXTSWON TURN ON TEXT SWITCH IF REPROMP @VA04839 00998100
- MVC TEXTLAST,TEXTBACK RESTORE IN CASE OF REPROMPT @VA04250 00999000
- MVC TEXTCURR,TEXTBACK RESTORE IN CASE OF REPROMPT @VA04250 01000000
- MVI DBYTE,NORMAL RESET REPROMPT IF ACTIVE @VA04250 01001000
- * ---------------------------- 01002000
- LA R7,MSGTEXT 'ENTER TEXT OR NULL' @VA04250 01003000
- * ---------------------------- 01004000
- BAL R9,WRTERM GO ISSUE MESSAGE TO USER @VA04250 01005000
- TEXTWR BALR R5,0 SAVE THIS ADDRESS FOR REPROMPT @VA04250 01006000
- MVI TEXTSW,TEXTSWON TURN ON TEXT SWITCH IF REPROMP @VA04839 01006100
- * ---------------------------- 01007000
- LA R7,MSGTEXT1 'ENTER' @VA04250 01008000
- * ---------------------------- 01009000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 01010000
- BAL R8,WRTERM GO WRITE MESSAGE AND READ REPLY @VA04250 01011000
- CLI DBYTE,REPROMPT REPROMPTING? @VA04250 01012000
- BNE TEXTDO NOT IN REPROMPT @VA04250 01013000
- L R2,TEXTLAST WE'LL GET THE LAST RECORD AGAIN @VA04250 01014000
- MVI 0(R2),BLANK CLEAR LAST TEXT ENTRY @VA04250 01015000
- MVC DISP1(CARDLEN-DISP1,R2),0(R2) ALL 80 BYTES OF IT@VA04250 01016000
- ST R2,TEXTCURR CLEAR LAST ENTERED LINE @VA04250 01017000
- MVI DBYTE,NORMAL CLEAR REPROMPT INDICATOR @VA04250 01018000
- TEXTDO LTR R0,R0 USER ENTER NULL? @VA04250 01019000
- BZ TEXTDONE YES @VA04250 01020000
- LR R2,R0 GET LENGTH OF DATA @VA04250 01021000
- BCTR R2,0 FOR EXECUTE @VA04250 01022000
- L R3,TEXTCURR OUTPUT AREA @VA04250 01023000
- ST R3,TEXTLAST PRESERVE THIS POINT @VA04250 01024000
- MVI 0(R3),BLANK CLEAR @VA04250 01025000
- MVC DISP1(CARDLEN-DISP1,R3),0(R3) OUTPUT RECORD @VA04250 01026000
- EX R2,TXTMVC DO MOVE @VA04250 01027000
- LA R3,CARDLEN(R3) OUTPUT POINTER UPDATE @VA04250 01028000
- ST R3,TEXTCURR SAVE IT @VA04250 01029000
- BCT R6,TEXTWR ALLOW 20 LINES TOTAL OF INPUT HER@VA04250 01030000
- TEXTDONE CLI OLDSW,OLDON PROCESSING AN OLD PROBLEM? @VA04250 01031000
- BE OLDADD YES, GO ADD TO EXISTING REPORT @VA04250 01032000
- L R2,KYAREAPT START OF KEY OUTPUT AREA @VA04250 01033000
- L R3,KYCURRPT GET NEXT AVAILABLE AREA @VA04250 01034000
- SR R3,R2 GET TOTAL KEY AREA OUTPUT @VA04250 01035000
- L R4,KYOUTLN GET POINTER TO HALFWORD LENGTH @VA04250 01036000
- LA R3,DISP4(R3) INCLUDE RECORD DESCRIPTOR LENGTH @VA04250 01037000
- STH R3,0(R4) SAVE IT @VA04250 01038000
- L R2,TEXTPT POINTER TO TEXT OUTPUT AREA @VA04250 01039000
- L R3,TEXTCURR POINT TO NEXT AVAILABLE LINE @VA04250 01040000
- SR R3,R2 GET TEXT OUTPUT LENGTH @VA04250 01041000
- L R4,TXTOUTLN POINT TO LENGTH FIELD @VA04250 01042000
- STH R3,0(R4) SAVE IT @VA04250 01043000
- CLI OLDSW,OLDON PROCESSING AN OLD PROBLEM? @VA04250 01044000
- BE OLDADD YES @VA04250 01045000
- B RPTOK CONTINUE @VA04250 01046000
- TXTMVC MVC 0(0,R3),0(R1) SUBJECT OF EXECUTE @VA04250 01047000
- *************************************************************** 01048000
- * TELL USER THE PROBLEM NUMBER, UPDATE IT, AND REWRITE IT. 01049000
- *************************************************************** 01050000
- RPTOK MVC MSGPRB,XXXXX MOVE PROBLEM NUMBER TO PARM LIST @VA04250 01051000
- * ---------------------------- 01052000
- LA R7,MSGTELL 'THIS REPORT ASSIGNED NUMBER NN @VA04250 01053000
- * ---------------------------- 01054000
- LA R6,LMSGTELL LENGTH OF MESSAGE @VA04250 01055000
- WRTERM (R7),(R6) TELL USER @VA04250 01056000
- PNUPDATE PACK ADDSUM(THREE),XXXXX(PLENGTH) PACK CURRENT NUMBER@VA04250 01057000
- AP ADDSUM(THREE),AONE ADD ONE @VA04250 01058000
- UNPK XXXXX(PLENGTH),ADDSUM(THREE) UNPACK BACK @VA04250 01059000
- OI PRBXXXXX+SEVEN,UNPKMASK PRETTY IT UP @VA04250 01060000
- MVI PNUMIN,BLANK CLEAR THE INPUT OF ANY TRASH @VA04250 01061000
- MVC PNUMIN+1(CARDLEN-1),PNUMIN @VA04250 01062000
- * ALL THE REMAINDER OF RECORD IS CLEARED 01063000
- MVC PNUMIN(PLENGTH),XXXXX MOVE NEW NUMBER TO OUTPUT @VA04250 01064000
- CLI PNSWITCH,PNSWON LOOKING FOR OPEN NUMBER? @VA04250 01065000
- BNE REWRTPN NO @VA04250 01066000
- MVI PNSWITCH,PNSWOFF RESET SWITCH @VA04250 01067000
- B PNRETRY GO SEE IF THIS IS ALRIGHT @VA04250 01068000
- REWRTPN LA R7,SUMMFILE POINT TO FILENAME FT FM @VA04250 01069000
- FSWRITE (R7),RECNO=1,ERROR=SUMERRW,BUFFER=PNUMIN, @VA04250X01070000
- BSIZE=80 @VA04250 01071000
- FSCLOSE (R7) @VA04250 01072000
- *************************************************************** 01073000
- * CALL WRITEREC TO WRITE THE PROBLEM REPORT ON DISK AND ADD TO 01074000
- * THE SYMPTOM SUMMARY FILE. 01075000
- *************************************************************** 01076000
- LA R1,WRTPARM PARMS PASSED TO WRITEREC @VA04250 01077000
- L R15,VWRTREC GET ADDRESS OF WRITEREC @VA04250 01078000
- BALR R14,R15 GO WRITE THE RECORD @VA04250 01079000
- B WRETTBL(R15) RETURN CODES OF 0,4, OR 8 LEGAL @VA04250 01080000
- WRETTBL B WRTRECOK GOOD RETURN @VA04250 01081000
- B WRTRECOK NOT VALID FOR WRITEREC @VA04250 01082000
- B RETCOD8 BAD RETURN @VA04250 01083000
- WRTRECOK LA R1,WRTPARM PARM LIST POINTER SAME AS DMMWRT @VA04250 01084000
- ************************************************************** 01085000
- * CALL SEARCH TO FIND POSSIBLE DUPS 01086000
- ************************************************************** 01087000
- SRCHRTN L R15,VSRCH POINT TO SEARCH ROUTINE @VA04250 01088000
- BALR R14,R15 GO TO SEARCH ROUTINE @VA04250 01089000
- B SRCHRTRN(R15) RETURN CODE IN R15 OF 0,4, OR 8 @VA04250 01090000
- SRCHRTRN B NORMEXIT NODUPS FOUND @VA04250 01091000
- B NORMEXIT FOUND SOME DUPS @VA04250 01092000
- B RETCOD8 BAD ERROR @VA04250 01093000
- EJECT 01094000
- *************************************************************** 01095000
- * REPLACE IMBEDDED BLANKS WITH DASHES 01096000
- *************************************************************** 01097000
- DASHIN LR R14,R0 GET LENGTH OF DATA @VA04250 01098000
- LR R15,R1 GET POINTER TO DATA @VA04250 01099000
- LTR R14,R14 ZERO LENGTH? @VA04250 01100000
- BZ DASHEXIT YES, GET OUT @VA04250 01101000
- AR R15,R14 POINT TO END OF ENTERED DATA @VA04250 01102000
- BCTR R15,0 POINT TO LAST BYTE OF DATA @VA04250 01103000
- DASHLP CLI 0(R15),BLANK IS THIS BLANK? @VA04250 01104000
- BNE DASHCONT NO @VA04250 01105000
- MVI 0(R15),DASH REPLACE BLANK WITH DASH @VA04250 01106000
- DASHCONT BCTR R15,0 NEXT BYTE BACK @VA04250 01107000
- BCT R14,DASHLP DO THIS TILL END @VA04250 01108000
- DASHEXIT BR R8 RETURN TO CALLER @VA04250 01109000
- *************************************************************** 01110000
- * RESTORE CONDITIONS AS THEY WERE BEFORE REPROMPTING 01111000
- *************************************************************** 01112000
- RESTORE MVI DBYTE,NORMAL RESET REPROMPT INDICATOR @VA04250 01113000
- LM R5,R9,RD59 RESTORE PRE-REPROMPT STATUS @VA04250 01114000
- BR R5 GO REISSUE ORIGINAL PROMPT @VA04250 01115000
- EJECT 01116000
- *************************************************************** 01117000
- * THIS ACTIVITY IS ASSOCIATED WITH AN ALREADY REPORTED PROBLEM 01118000
- *************************************************************** 01119000
- OLDPROB MVI DBYTE,NORMAL CLEAR REPROMPT INDICATOR @VA04250 01120000
- OLDPROBC EQU * @VA04250 01121000
- BALR R5,0 SAVE ADDRESS FOR REPROMPT @VA04250 01122000
- * ---------------------------- 01123000
- LA R7,MSGPNUM 'ENTER PROBLEM NUMBER' @VA04250 01124000
- * ---------------------------- 01125000
- LA R9,RDTERM FORCE WRTERM TO GO TO RDTERM @VA04250 01126000
- BAL R8,WRTERM GO ISSUE MESSAGE TO USER @VA04250 01127000
- LTR R0,R0 ANYTHING ENTERED? @VA04250 01128000
- BZ OLDPROBC NO, FORCE ENTRY OF SOMETHING @VA04250 01129000
- LR R2,R0 GET COUNT OF DATA ENTERED @VA04250 01130000
- LR R3,R1 DATA POINTER @VA04250 01131000
- LA R3,5 5 INTO R3 @VA04250 01132000
- SR R3,R2 GET DIFERENCE FROM USER DATA COUN@VA04250 01133000
- BCTR R2,0 SET USER ENTERED COUNT FOR EX @VA04250 01134000
- LA R3,XXXXX(R3) POINT TO WHERE DATA SHOULD GO @VA04250 01135000
- EX R2,PNMVC MOVE DIGITS TO FILE NAME @VA04250 01136000
- LA R3,PRBXXXXX POINT TO FNAME FTYPE FM @VA04250 01137000
- FSSTATE (R3) IS THERE A REPORT OUT THERE? @VA04250 01138000
- MVI DBYTE,NORMAL CLEAR POSSIBLE REPROMPT @VA04250 01139000
- LTR R15,R15 FILE EXIST? @VA04250 01140000
- BNZ STATERR ERROR GO CHECK WHY @VA04250 01141000
- *************************************************************** 01142000
- * A PROBLEM REPORT IS KNOWN TO EXIST AT THIS POINT 01143000
- *************************************************************** 01144000
- MVI OLDSW,OLDON INDICATE PROCESSING AN OLD PROB @VA04250 01145000
- B MAINLINE GO TO MAINLINE PROMPTS @VA04250 01146000
- * PROCESSING IS DONE FOR OLD PROBLEM NOW, LET'S OUTPUT THE DATA 01147000
- OLDADD L R2,SUPPCURR GET POINTER TO CURRENT SUPP DATA @VA04250 01148000
- L R4,SUPPPT POINT TO START OF SUPP DATA AREA @VA04250 01149000
- SR R2,R4 GET DIFFERANCE @VA04250 01150000
- MVI OUTPUT,BLANK CLEAR OUTPUT @VA04250 01151000
- MVC OUTPUT+DISP1(L'OUTPUT-DISP1),OUTPUT @VA04250 01152000
- LA R7,PRBXXXXX POINT TO FILE NAME FT FM @VA04250 01153000
- MVC ADDREC(THIRTEEN),=C'*** ADDED ***' @VA04250 01154000
- MVC ADDDATE(FIVE),CURRDATE TODAY'S DATE @VA04250 01155000
- MVC ADDTIME(L'CURRTIME),CURRTIME AND TIME @VA04250 01156000
- LA R6,CARDLEN BUFFER SIZE FOR FSWRITE @VA04250 01157000
- LA R3,OUTPUT POINT TO OUTPUT RECORD @VA04250 01158000
- LA R4,DISP1 WRITE ONE RECORD ONLY @VA04250 01159000
- BAL R8,FSWRITE GO TO COMMON WRITE @VA04250 01160000
- LR R6,R2 SAVE LENGTH FOR FSWRITE @VA04250 01161000
- LTR R3,R2 SET UP FOR DIVIDE @VA04250 01162000
- BZ TXTCHK NO SUPP DATA, GO HANDLE TEXT @VA04250 01163000
- SR R2,R2 CLEAR EVEN REG FOR DIVIDE @VA04250 01164000
- D R2,=F'80' FIND OUT NUMBER OF RECORDS @VA04250 01165000
- LR R4,R3 NUMBER OF RECORDS TO WRITE @VA04250 01166000
- L R3,SUPPPT POINT TO OUTPUT FOR FSWRITE @VA04250 01167000
- BAL R8,FSWRITE GO TO COMMON FSWRITE ROUTINE @VA04250 01168000
- TXTCHK L R2,TEXTCURR CURRENT POINTER IN TEXT AREA @VA04250 01169000
- L R4,TEXTPT START OF TEXT AREA @VA04250 01170000
- SR R2,R4 GET AMOUNT OF DATA @VA04250 01171000
- BZ SUMMUP NO TEXT INFO ENTERED BY USER @VA04250 01172000
- LR R3,R2 SET FOR DIVIDE @VA04250 01173000
- LR R6,R3 SAVE LENGTH OF DATA FOR FSWRITE @VA04250 01174000
- SR R2,R2 CLEAR EVEN REG FOR DIVIDE @VA04250 01175000
- D R2,=F'80' GET NUMBER OF RECORDS @VA04250 01176000
- LR R4,R3 SAVE IT FOR FSWRITE @VA04250 01177000
- L R3,TEXTPT POINT OT OUTPUT AREA @VA04250 01178000
- BAL R8,FSWRITE GO DO FSWRITE @VA04250 01179000
- *************************************************************** 01180000
- * TELL USER WE HAVE APPENDED THE NEW INFO ON PROBLEM REPORT 01181000
- *************************************************************** 01182000
- SUMMUP FSCLOSE (R7) CLOSE THE OUTPUT REPORT FILE @VA04250 01183000
- * ---------------------------- 01184000
- LA R7,MSGDONE 'PROBLEM REPORT APPENDED' @VA04250 01185000
- * ---------------------------- 01186000
- MVC MSGKYWD+DISP1(L'PRBXXXXX),PRBXXXXX PROB NUMBER @VA04250 01187000
- MVI ENTSW,ENTON DON'T ALLOW PROMPT NUM TO PRINT @VA04250 01188000
- BAL R9,WRTERM ISSUE 'ALL DONE' MESSAGE @VA04250 01189000
- B NORMEXIT WE ARE INDEED DONE @VA04250 01190000
- EJECT 01191000
- *************************************************************** 01192000
- * WE HAD AN ERROR FINDING THE PROBLEM REPORT 01193000
- *************************************************************** 01194000
- STATERR ST R15,WKWD STORE RETURN CODE @VA04250 01195000
- CLI WKWD+THREE,FNOTFND SIMPLE FILE NOT FOUND? @VA04250 01196000
- BNE STERR2 NO, GO PUT OUT ERROR MESSAGE @VA04250 01197000
- * ---------------------------- 01198000
- LA R7,MSGNOPRB REQSTD PROB REPORT DOESN'T EXIST @VA04250 01199000
- * ---------------------------- 01200000
- SR R2,R2 CLEAR WORK FOR INSERT CHAR INSTR @VA04250 01201000
- IC R2,MSGLKYWD GET LENGTH OF KEYWORD AREA @VA04250 01202000
- LA R3,MSGLKYWD+TWO(R2) POINT TO MESSAGE DATA @VA04250 01203000
- MVC 0(L'PRBXXXXX,R3),PRBXXXXX MOVE PROB NUM TO MSG @VA04250 01204000
- MVI ENTSW,ENTON DON'T PRINT REPROMPT LINE NUMBER @VA04250 01205000
- BAL R9,WRTERM GO ISSUE THE MESSAGE TO USER @VA04250 01206000
- MVC XXXXX(PLENGTH),FOFO RESET PROB NUMB TO 00000 @VA04250 01207000
- B EXIST GIVE USER ANOTHER CHANCE @VA04250 01208000
- STERR2 CVD R15,WKDWD CONVERT RETURN CODE TO DECIMAL @VA04250 01209000
- UNPK STMSG1,WKDWD+SIX(TWO) UNPK INTO MSG OUTPUT AREA @VA04250 01210000
- OI STMSG1+TWO,UNPKMASK MAKE IT PRINTABLE @VA04250 01211000
- MVC STMSG3(EIGHT),PRBXXXXX MOVE PROB NUMBER TO MSG @VA04250 01212000
- LA R2,STMSGL LENGTH OF MESSAGE @VA04250 01213000
- WRTERM STMSG,(R2) GO TELL USER @VA04250 01214000
- B RETCOD8 TAKE RETURN CODE 8 EXIT @VA04250 01215000
- STMSG DC C'DMMPRO300S ERROR ''' @VA04250 01216000
- STMSG1 DC C' ' @VA04250 01217000
- STMSG2 DC C''' ON FSSTATE ''' @VA04250 01218000
- STMSG3 DC C' REPORT A1''' @VA04250 01219000
- STMSGL EQU *-STMSG @VA04250 01220000
- PNMVC MVC 0(0,R3),0(R1) @VA04250 01221000
- EJECT 01222000
- *************************************************************** 01223000
- * ROUTINE TO DO FSWRITE AND CHECK RETURN CODE 01224000
- * R8 RETURN REGISTER 01225000
- * R7 FILENAME 01226000
- * R6 BSIZE 01227000
- * R3 BUFFER POINTER 01228000
- * R4 NUMBER OF RECORDS TO BE WRITTEN 01229000
- * R1-R3 WORK REGISTERS 01230000
- * 01231000
- * ISSUES APPROPRIATE ERROR MESSAGE DMM200PROS 01232000
- *************************************************************** 01233000
- FSWRITE FSWRITE (R7),BSIZE=(R6),BUFFER=(R3),NOREC=(R4) @VA04250 01234000
- LTR R15,R15 ERROR? @VA04250 01235000
- BZ 0(R8) NO,RETURN @VA04250 01236000
- SUMERRW CVD R15,WKDWD CONVERT RETURN CODE TO DECIMAL @VA04250 01237000
- UNPK ERRMSG1,WKDWD+SIX(TWO) UNPACK INOT ERROR MSG @VA04250 01238000
- OI ERRMSG1+TWO,UNPKMASK MAKE IT PRINTABLE @VA04250 01239000
- MVC ERRMSG2,0(R7) MOVE IN FILE NAME @VA04250 01240000
- MVC ERRMSG3,EIGHT(R7) MOVE IN FILE TYPE @VA04250 01241000
- MVC ERRMSG4,SIXTEEN(R7) MOVE IN FILE MODE @VA04250 01242000
- LA R2,ERRMSG DMM200PROS @VA04250 01243000
- LA R3,ERRMSGL GET LENGTH @VA04250 01244000
- WRTERM (R2),(R3) @VA04250 01245000
- B RETCOD8 TAKE ERROR EXIT @VA04250 01246000
- ERRMSG DC C'DMMPRO200S ERROR ''' @VA04250 01247000
- ERRMSG1 DC C' ' NNN RETURN CODE ON FSWRITE @VA04250 01248000
- DC C''' WRITING FILE ''' @VA04250 01249000
- ERRMSG2 DS CL8 FILE NAME @VA04250 01250000
- DC C' ' @VA04250 01251000
- ERRMSG3 DS CL8 FILE TYPE @VA04250 01252000
- DC C' ' @VA04250 01253000
- ERRMSG4 DS CL2 FILE MODE @VA04250 01254000
- DC C'''' @VA04250 01255000
- ERRMSGL EQU *-ERRMSG @VA04250 01256000
- EJECT 01257000
- *************************************************************** 01258000
- * ROUTINE TO PLACE KEYWORDS AND VALUES IN OUTPUT BUFFER 01259000
- * ENTRY: R7 POINTS TO MESSAGE 01260000
- * R1 POINTS TO DATA TO BE JOINED WITH KEYWORD 01261000
- * R0 CONTAINS LENGTH OF DATA 01262000
- * 01263000
- * CHECK KYWD FOR VMFAILURE OR VMENVIR AND IF SO STORE THE DATA 01264000
- * IN THE INTERNAL DATA AREA (ADDRESSED VIA INTSECT) 01265000
- * 01266000
- * CHECK TO SEE IF THE KEYWD HAS ALREADY BEEN BUT IN THE OUTPUT. 01267000
- * THIS CAN OCCUR IN THE CASE OF A REPROMPT OR IN THE CASE OF 01268000
- * A VMFAILURE WHICH CAUSES THE INITIAL BASE FAILURE TO BE 01269000
- * PUT HERE FIRST. 01270000
- * 01271000
- * IF THE KEYWD DOES NOT EXIST YET ADD IT TO THE OUTPUT KEYAREA 01272000
- * 01273000
- * IF THE KYWD ALREADY EXISTS WE ALLOW FOR THE NEW DATA BEING 01274000
- * A DIFFERENT LENGTH FROM THE OLD. THE KEYDATA FOLLOWING THE 01275000
- * KEYWORD IN QUESTION IS ADJUSTED INWARD OR OUTWARD AS REQUIRED 01276000
- * PRIOR TO THE NEW DATA BEING STORED IN THE OUTPUT. 01277000
- *************************************************************** 01278000
- KYINSERT CLI MSGLKYWD,NOKYWD ANY KEYWORD PRESENT? @VA04250 01279000
- BE KYRETURN NO @VA04250 01280000
- SR R3,R3 PREPARE FOR IC INSTRUCTION @VA04250 01281000
- IC R3,MSGLKYWD GET LENGTH OF KEYWORD + '=' @VA04250 01282000
- BCTR R3,0 FOR EXECUTE @VA04250 01283000
- LA R4,MSGKYWD POINT TO KEYWORD @VA04250 01284000
- LTR R0,R0 ANYTHING ENTERED? @VA04429 01284300
- BZ KYNOTCID NO, DON'T PUT IN INTSECT @VA04429 01284600
- L R2,INTPT ADDRESSABILITY FOR INTSECT @VA04250 01285000
- CLC =C'VMFAILURE',0(R4) MAJOR VMFAILURE KEYWORD? @VA04250 01286000
- BNE KYMX2 CERTAIN VALUES WE TRY TO SAVE FOR@VA04250 01287000
- MVC INTX1,0(R1) LATER TO BE PUT IN THE @VA04250 01288000
- KYMX2 CLC =C'VMENVIR',0(R4) SYMPTOM SUMMARY CNTRL RECORD. @VA04250 01289000
- BNE KYNOTCID NOT ONE WE WANT TO SAVE @VA04250 01290000
- MVC INTX2,0(R1) SAVE IT IN INTERNAL DATA AREA @VA04250 01291000
- KYNOTCID L R2,KYAREAPT BEGINNING OF OUTPUT AREA @VA04250 01292000
- KYNXT LH R6,0(R2) GET LENGTH OF ENTRY @VA04250 01293000
- LTR R6,R6 ZERO? @VA04250 01294000
- BZ KYNOTFND YES, KEY NOT PRESENT IN OUTPUT @VA04250 01295000
- LA R14,DISP4(R2) POINT TO KEY @VA04250 01296000
- EX R3,KYCMPR KEY MATCH WHAT'S ALREADY THERE? @VA04250 01297000
- BE KYFOUND YES @VA04250 01298000
- LA R2,0(R2,R6) POINT TO NEXT ENTRY. @VA04250 01299000
- B KYNXT AND WHERE WE STOP NOBODY KNOWS. @VA04250 01300000
- KYNOTFND LTR R0,R0 NULL INPUT? @VA04250 01301000
- BZ KYRETURN YES @VA04250 01302000
- IC R3,MSGLKYWD GET LENGTH OF KEYWORD + '=' @VA04250 01303000
- AR R3,R0 TOTAL KEY PLUS DATA @VA04250 01304000
- LA R3,DISP4(R3) ADD ON COUNT WORD LENGTH @VA04250 01305000
- STH R3,0(R2) DO IT TO OUTPUT @VA04250 01306000
- LA R6,0(R2,R3) NEXT AVAIL SPOT @VA04250 01307000
- ST R6,KYCURRPT SAVE IT @VA04250 01308000
- KYLEQ LA R2,DISP4(R2) PAST LENGTH FIELDS @VA04250 01309000
- SR R3,R3 DON'T TAKE ANY CHANCES @VA04250 01310000
- IC R3,MSGLKYWD GET LENGTH OF KEYWORD @VA04250 01311000
- BCTR R3,0 WE'RE USING AN EXECUTE SO--- @VA04250 01312000
- EX R3,KYMVC MOVE KEYWORD TO OUTPUT AREA @VA04250 01313000
- LA R2,DISP1(R2,R3) WHERE ACTUAL DATA GOES @VA04250 01314000
- LR R3,R0 DATA LENGTH @VA04250 01315000
- BCTR R3,0 EXECUTE NEEDS THIS @VA04250 01316000
- EX R3,KYDATMVC MOVE DATA AFTER KEYWORD @VA04250 01317000
- B KYRETURN WE'RE DONE HERE FOR NOW @VA04250 01318000
- KYCMPR CLC 0(0,R4),0(R14) NEW KEYWORD MATCH THE OLD? @VA04250 01319000
- KYMVC MVC 0(0,R2),MSGKYWD MOVE KEYWORD TO OUTPUT AREA @VA04250 01320000
- KYDATMVC MVC 0(0,R2),0(R1) MOVE DATA AFTER KEY @VA04250 01321000
- KYFOUND IC R3,MSGLKYWD GET LENGTH OF THE NEW KEYWORD @VA04250 01322000
- S R6,=F'4' SUBTRACT LENGTH OF LENGTH FIELD @VA04250 01323000
- AR R3,R0 TOTAL LENGTH OF ENTRY @VA04250 01324000
- CR R3,R6 NEW TOTAL AGAINST OLD TOTAL @VA04250 01325000
- BE KYLEQ DON'T HAVE TO MONKEY AROUND @VA04250 01326000
- BH KYMVEOUT MUST ADJUST OUTWARD @VA04250 01327000
- KYMVEIN SR R6,R3 DIFFERENCE BETWEEN OLD AND NEW @VA04250 01328000
- L R14,KYCURRPT POINT TO NEXT AVAILABLE AREA @VA04250 01329000
- SR R14,R6 NEW END POINTER @VA04250 01330000
- LTR R0,R0 NULL RESPONSE ENTERED BY USER? @VA04838 01330150
- BNZ KYMVEI2 NO, JUST CHANGE DATA LENGTH @VA04838 01330300
- LA R6,4(R3,R6) GET LENGTH OF DATA+KEY+LEN FIELD @VA04838 01330450
- SR R14,R3 BACK UP TO DELETE THIS ENTRY @VA04838 01330600
- S R14,=F'4' INCLUDE LENGTH FIELD LENGTH @VA04838 01330750
- KYMVEI2 EQU * CALCULATE MOVE BOUNDRIES @VA04838 01330900
- ST R14,KYCURRPT SAVE NEW CALCULATED POINTER @VA04250 01331000
- AR R14,R6 OLD END POINTER AGAIN @VA04250 01332000
- LA R15,DISP4(R3) ADD IN COUNT FIELD LENGTH @VA04250 01333000
- STH R15,0(R2) NEW LENGTH TO OUTPUT @VA04250 01334000
- LA R3,DISP4(R2,R3) END OF NEW ENTRY @VA04250 01335000
- LTR R0,R0 USER DELETING A RESPONSE? @VA04838 01335200
- BNZ KYMVII2 NO, CONTINUE NORMALLY @VA04838 01335400
- LR R3,R2 POINT TO START OF KEY FOR ENTRY @VA04838 01335600
- KYMVII2 EQU * USER CHANGING LENGTH OF INPUT @VA04838 01335800
- LA R4,0(R3,R6) END OF OLD ENTRY @VA04250 01336000
- SR R14,R4 TOTAL TO BE MOVED @VA04250 01337000
- LTR R14,R14 LAST ENTRY AFTER ALL? @VA04250 01338000
- BZ KYCLREND YES @VA04250 01339000
- KYMVIN MVC 0(DISP1,R3),0(R4) ONE BYTE AT A TIME @VA04250 01340000
- LA R3,DISP1(R3) INCREMENT NEW POINTER @VA04250 01341000
- LA R4,DISP1(R4) INCREMENT OLD POINTER @VA04250 01342000
- BCT R14,KYMVIN DO THIS FOR A WHILE @VA04250 01343000
- KYCLREND L R14,KYCURRPT POINT TO NEXT AVAILABLE AREA @VA04250 01344000
- KYCLEAR MVI 0(R14),HEXZERO CLEAR LEFT OVER TRASH @VA04250 01345000
- LA R14,DISP1(R14) NEXT BYTE @VA04250 01346000
- BCT R6,KYCLEAR CLEAR TRASH LEFT OVER AT END @VA04250 01347000
- LTR R0,R0 USER CANCELLING ENTRY? @VA04838 01347330
- BZ KYRETURN YES, RETURN TO PROMPTING @VA04838 01347660
- B KYLEQ BACK TO MOVE IN KEY AND DATA @VA04250 01348000
- KYMVEOUT LA R15,LFLDLEN(R3) ADD LENGTH FIELD LENGTH TO PTR @VA04250 01349000
- STH R15,0(R2) NEW LENGTH IN FRONT OF DATA @VA04250 01350000
- SR R3,R6 DIFFERENCE IN LENGTH OF OLD @VA04250 01351000
- L R14,KYCURRPT POINT TO NEXT AVAILABLE AREA @VA04250 01352000
- AR R14,R3 NEW END POINTER @VA04250 01353000
- ST R14,KYCURRPT SAVE IT FOR NEXT USER @VA04250 01354000
- LA R4,DISP4(R6,R2) OLD END FOR THIS ENTRY @VA04250 01355000
- LR R6,R14 SAVE TOTAL END @VA04250 01356000
- SR R14,R3 OLD END @VA04250 01357000
- LR R3,R14 OLD END @VA04250 01358000
- SR R3,R4 TOTAL TO BE MOVED @VA04250 01359000
- LTR R3,R3 NULL RESULT? @VA04250 01360000
- BZ KYLEQ LAST ENTRY AFTER ALL THIS @VA04250 01361000
- BCTR R6,0 ONE BYTE PAST WHERE WE WANT @VA04250 01362000
- BCTR R14,0 DITTO @VA04250 01363000
- KYMVOUT MVC 0(DISP1,R6),0(R14) ONE BYTE AT A TIME @VA04250 01364000
- BCTR R6,0 DECREMENT OLD POINTER @VA04250 01365000
- BCTR R14,0 DECREMENT NEW POINTER @VA04250 01366000
- BCT R3,KYMVOUT MOVE IT ALL @VA04250 01367000
- B KYLEQ NOW GO PUT IN NEW DATA @VA04250 01368000
- KYRETURN BR R8 BACK TO CALLER @VA04250 01369000
- EJECT 01370000
- *************************************************************** 01371000
- * ROUTINE TO WRITE MESSAGES TO THE TERMINAL 01372000
- * WORK R2,R3,R4,R14 01373000
- * RETURN R9 01374000
- * CALLER R5 01375000
- * MSG R7 01376000
- * MSGOUT R6 WHERE USER INPUT WILL BE PUT 01377000
- *************************************************************** 01378000
- WRTERM SR R14,R14 CLEAR WORK REG @VA04250 01379000
- LR R3,R14 CLEAR ANOTHER @VA04250 01380000
- L R2,LOGPTR ACTIVITY TRACE POINTER @VA04250 01381000
- CLI 0(R2),FENCE NO MORE ENTRIES? @VA04250 01382000
- BE WRNOLOG GUESS NOT, DON'T RECORD THIS @VA04250 01383000
- CLI ENTSW,ENTON INFORMATION MESSAGE ONLY? @VA04250 01384000
- BE WRNOLOG YES @VA04250 01385000
- ST R5,0(R2) ADDRESS TO REEXECUTE THE CALLER @VA04250 01386000
- ST R7,DISP4(R2) MESSAGE POINTER WE'RE RECORDING @VA04250 01387000
- ST R6,EIGHT(R2) SPECIAL CALLER USAGE @VA04250 01388000
- LA R2,TRSIZE(R2) NEXT ENTRY IN TRACE TABLE @VA04250 01389000
- ST R2,LOGPTR SAVE IT @VA04250 01390000
- WRNOLOG LA R2,OUTPUT POINT TO OUTPUT AREA @VA04250 01391000
- MVI OUTPUT,BLANK @VA04250 01392000
- MVC OUTPUT+DISP1(L'OUTPUT-DISP1),OUTPUT CLEAR OUTPUT@VA04250 01393000
- SR R3,R3 CLEAR WORK @VA04250 01394000
- MVC OUTPUT(L'MSGPRMPT),=C'******' IF NO REPROMPT NUM@VA04250 01395000
- CLI ENTSW,ENTON PUT OUT LINE NUMBER 1SR TIME ONLY@VA04250 01396000
- BE WRMSGOUT WE'VE ALREADY PUT OUT LINE NUMBER@VA04250 01397000
- MVC OUTPUT(MSGRLEN),MSGPRMPT PUT REPROMPT IN OUTPUT @VA04250 01398000
- MVI ENTSW,ENTON ONLY ONCE @VA04250 01399000
- WRMSGOUT LA R2,OUTPUT+SEVEN THIS IS WHERE MESSAGE GOES @VA04250 01400000
- LA R4,MSGLKYWD POINT TO KEYWORD LENGTH @VA04250 01401000
- IC R3,0(R4) GET THIS LENGTH @VA04250 01402000
- LA R4,DISP1(R3,R4) POINT TO MSG LENGTH @VA04250 01403000
- IC R3,0(R4) GET LENGTH OF MESSAGE @VA04250 01404000
- LA R14,SEVEN(R3) LENGTH OF TOTAL MESSAGE @VA04250 01405000
- LA R4,DISP1(R4) POINT TO MESSAGE PROPER @VA04250 01406000
- LTR R3,R3 COULD BE ZERO I SUPPOSE @VA04250 01407000
- BZ WRITE IT IS ZERO @VA04250 01408000
- BCTR R3,0 FOR EXECUTE @VA04250 01409000
- EX R3,WRMVCOUT MOVE MESSAGE TO OUTPUT @VA04250 01410000
- LR R3,R14 GET TOTAL LENGTH IN SAFE REGISTER@VA04250 01411000
- WRITE WRTERM OUTPUT,(R3) WRITE ON TERMINAL @VA04250 01412000
- CLI MSGSTOP,MSGLAST LAST MSG IN PROMPT? @VA04250 01413000
- BE WREXIT YES, BRANCH @VA04250 01414000
- IC R3,MSGENT GET LENGTH OF TOTAL MESSAGE @VA04250 01415000
- AR R7,R3 POINT TO NEXT MESSAGE @VA04250 01416000
- B WRNOLOG GO UNTIL LAST MESSAGE IS FOUND @VA04250 01417000
- WREXIT MVI ENTSW,ENTOFF RESET SWITCH @VA04250 01418000
- BR R9 RETURN ON 9 @VA04250 01419000
- WRMVCOUT MVC 0(0,R2),0(R4) MOVE TO OUTPUT AREA @VA04250 01420000
- EJECT 01421000
- *************************************************************** 01422000
- * ROUTINE TO READ FROM TERMINAL AND DO INITIAL LOOKING AT INPUT 01423000
- * REPROMPTING IS ALSO CONTROLLED FROM HERE 01424000
- * R9 USED TO LINK TO WRTERM (SAVED FIRST IF USED) 01425000
- * R5 USED BY REPROMPT TO GET TO ROUTINE TO DO REPROMPT 01426000
- * R8 RETURN ADDRESS OF CALLING ROUTINE 01427000
- * R7 MESSAGE POINTER 01428000
- * R6 POINTER TO WHERE CALLER IS GOING TO PUT USER INPUT 01429000
- * R2,R3,R4,R14 WORK REGS 01430000
- * R1 RDTERM RETURNS ADDRESS OF INPUT TO CALLER HERE 01431000
- * R0 LENGTH OF INPUT RETURNED TO CALLER IN THIS REG 01432000
- *************************************************************** 01433000
- RDTERM RDTERM INPUT READ FROM TERMINAL @VA04250 01434000
- LTR R0,R0 ANYTHING ENTERED? @VA04250 01435000
- BZ RDNULLIN NO RETURN TO CALLER @VA04250 01436000
- LR R2,R0 GET LENGTH OF INPUT @VA04250 01437000
- LA R1,INPUT POINT TO INPUT AREA @VA04250 01438000
- CLI TEXTSW,TEXTSWON IS USER ENTERING TEXT @VA04839 01438100
- BE RDGOTNB YES, SKIP BLANK SUPPRESSION @VA04839 01438200
- RDCKBLNK CLI 0(R1),BLANK BLANK? @VA04250 01439000
- BNE RDGOTNB NO, GOT SOMETHING @VA04250 01440000
- LA R1,DISP1(R1) POINT TO NEXT INPUT BYTE @VA04250 01441000
- BCT R2,RDCKBLNK CHECK NEXT BYTE FOR NON BLANK @VA04250 01442000
- B RDNULLIN NOTHING BUT BLANKS ENTERED @VA04250 01443000
- RDGOTNB LR R0,R2 NEW COUNT @VA04250 01444000
- CLC =C':HX',0(R1) USER WANT TO GIVE UP? @VA04250 01445000
- BE HXEXIT YES @VA04250 01446000
- CLC =C'HX',0(R1) ANOTHER WAY THE USER MAY SAY STOP@VA04250 01447000
- BE HXEXIT YES, THE USER WANTS TO QUIT @VA04250 01448000
- CLC =C':L',0(R1) REPROMPT REQUEST? @VA04250 01449000
- BNE RDNORMAL NO, GO DO SYNTAX CHECKING @VA04250 01450000
- CLI DBYTE,REPROMPT ALREADY REPROMPTING? @VA04250 01451000
- BNE RDREPRMP NO, GO DO REPROMPT @VA04250 01452000
- * ---------------------------- 01453000
- LA R7,MSGERR1 REPROMPT WITHIN REPROMT NOT ALLOW@VA04250 01454000
- * ---------------------------- 01455000
- MVI ENTSW,ENTON DON'T LET WRTERM PUT OUT PROMPT #@VA04250 01456000
- BAL R9,WRTERM GO TELL THE USER @VA04250 01457000
- MVI DBYTE,NORMAL CLEAR REPROMPT INDICATOR @VA04250 01458000
- LM R5,R9,RD59 RESTORE STATUS BEFORE REPROMPT @VA04250 01459000
- B WRTERM TRY ORIGINAL MESSAGE AGAIN @VA04250 01460000
- RDREPRMP STM R5,R9,RD59 SAVE CURRENT STATUS @VA04250 01461000
- XC TEXTSW,TEXTSW TURN OF TEXT ENTRY SWITCH @VA04839 01461100
- LA R2,LOGTBL POINT TO OUR ACTIVITY TRACE @VA04250 01462000
- L R3,LOGPTR POINT TO END OF OUR ACTIVITY @VA04250 01463000
- SH R3,=H'12' BACK UP TO LAST VALID ENTRY @VA04250 01464000
- RDPLOOK L R7,DISP4(R3) POINT TO MESSAGE @VA04250 01465000
- CLC 0(MSGRLEN,R1),MSGPRMPT LINE NUMBERS COMPARE? @VA04250 01466000
- BE RDFOUND YES, LETS REPROMPT @VA04250 01467000
- SH R3,=H'12' NEXT LOG ENTRY @VA04250 01468000
- CR R2,R3 END OF ACTIVITY @VA04250 01469000
- BH RDNOTFND COULDN'T FIND IT @VA04250 01470000
- B RDPLOOK LOOK AT THIS ONE @VA04250 01471000
- * ---------------------------- 01472000
- RDNOTFND LA R7,MSGERR2 REPROMPT REQUEST NOT FOUND @VA04250 01473000
- * ---------------------------- 01474000
- MVI ENTSW,ENTON DON'T LET WRTERM PUT OUT PROMPT #@VA04250 01475000
- BAL R9,WRTERM TELL USER @VA04250 01476000
- LM R5,R9,RD59 RESTORE PREVIOUS STATUS @VA04250 01477000
- BR R5 GO BACK TO CALLER TO REISSUE MSG @VA04250 01478000
- RDFOUND MVI DBYTE,REPROMPT INDICATE REPROMPT IN PROGRESS @VA04250 01479000
- L R6,EIGHT(R3) POINTER WHERE USER PUT OUTPUT @VA04250 01480000
- L R5,0(R3) WHERE THE PROMPT CAME FROM @VA04250 01481000
- BR R5 GO LET HIM DO IT FOR US @VA04250 01482000
- RDNORMAL LA R2,CARDLEN MOST WE WILL ALLOW IS 80 BYTES IN@VA04250 01483000
- CR R0,R2 MORE THAN 80 ENTERED? @VA04250 01484000
- BNH RDNORM2 NO @VA04250 01485000
- LR R0,R2 SET LENGTH READ TO 80 @VA04250 01486000
- RDNORM2 LR R2,R1 GET INPUT POINTER @VA04250 01487000
- AR R2,R0 POINT TO END @VA04250 01488000
- RDLOOP5 BCTR R2,0 POINT TO LAST BYTE @VA04250 01489000
- CLI 0(R2),BLANK BLANK? @VA04250 01490000
- BNE RDNORMZZ NO, CONTINUE WITH OTHER CHECKS @VA04250 01491000
- BCTR R0,0 GO UNTIL WE FIND SOMETHING @VA04250 01492000
- LTR R0,R0 OR UNTIL WE RUN OUT OF AMMO @VA04250 01493000
- BZ RDNULLIN USER PLAYING WITH SPACE BAR @VA04250 01494000
- B RDLOOP5 CONTINUE LOOKING @VA04250 01495000
- RDNORMZZ SR R3,R3 CLEAR WORK @VA04250 01496000
- CLI MSGMIN,MSGNOMIN MINIMUM RESTRICTION? @VA04250 01497000
- BE RDMXCMPR NO, GO SEE IF MAX RESTRICTION @VA04250 01498000
- * INSURE NO IMBEDDED BLANKS WHEN MINIMUM RESTRICTION IN EFFECT 01499000
- RDTOKEN LR R2,R1 GET INPUT POINTER @VA04250 01500000
- RDTLOOP LA R3,1(R3) KEEP TRACK OF HOW MUCH WE HAVE @VA04250 01501000
- CLI DISP1(R2),BLANK AT END? @VA04250 01502000
- BE RDGOTTOK YES WE HAVE ONE 'TOKEN' @VA04250 01503000
- LA R2,DISP1(R2) LOOK AT NEXT BYTE OF INPUT @VA04250 01504000
- B RDTLOOP CONTINUE LOOKING @VA04250 01505000
- RDGOTTOK CR R0,R3 DID USER IMBED A BLANK? @VA04250 01506000
- BE RDGOTTK2 NO @VA04250 01507000
- * ---------------------------- 01508000
- LA R7,MSGERRI 'IMBEDDED BLANKS NOT ALLOWED' @VA04250 01509000
- * ---------------------------- 01510000
- MVI ENTSW,ENTON DON'T LET WRTERM PRINT PROMPT NUM@VA04250 01511000
- BAL R9,WRTERM PRINT ERROR MESSAGE @VA04250 01512000
- BR R5 REPROMPT USER @VA04250 01513000
- RDGOTTK2 SR R3,R3 IC INSTRUCTION COMING UP @VA04250 01514000
- B RDMIN GO DO MINIMUM CHECKING @VA04250 01515000
- RDMXCMPR CLI MSGMAX,MSGNOMAX MAXIMUM CHECKING TO DO? @VA04250 01516000
- BNE RDMAX YES, GO CHECK @VA04250 01517000
- RDTYCMPR CLI MSGTYPE,MSGFREE FREE FORM INPUT ALLOWED? @VA04250 01518000
- BNE RDTYPE NO, GO DO ANALYSIS @VA04250 01519000
- RDRETURN BR R8 CALLER LINK REG @VA04250 01520000
- RDMIN IC R3,MSGMIN GET MINIMUM ALLOWED @VA04250 01521000
- CR R0,R3 CHECK AGAINST AMOUNT ENTERED @VA04250 01522000
- BL RDMINBAD INPUT LESS THAN ALLOWED @VA04250 01523000
- B RDMXCMPR BACK TO FURTHER CHECKING @VA04250 01524000
- RDMAX IC R3,MSGMAX GET MAX ALLOWED @VA04250 01525000
- CR R0,R3 CHECK AGAINST AMOUNT ENTERED @VA04250 01526000
- BH RDMAXBAD TOO MUCH ENTERED @VA04250 01527000
- B RDTYCMPR BACK FOR FURTHER CHECKING @VA04250 01528000
- RDTYPE CLI MSGTYPE,MSGNUM NUMERIC DATA EXPECTED? @VA04250 01529000
- BE RDNUM YES @VA04250 01530000
- CLI MSGTYPE,MSGHEX HEX INPUT EXPECTED? @VA04250 01531000
- BE RDHEX YES @VA04250 01532000
- B RDRETURN WE'VE DONE ALL WE CAN HERE @VA04250 01533000
- RDNUM LR R2,R1 POINT TO INPUT DATA @VA04250 01534000
- LR R3,R0 GET LENGTH OF INPUT @VA04250 01535000
- RDNUM1 TM 0(R2),NUMERIC NUMERIC? @VA04250 01536000
- BO RDUP YES @VA04250 01537000
- CLI 0(R2),BLANK BLANK? @VA04250 01538000
- BE RDUP YES, ACCEPT IT @VA04250 01539000
- * ---------------------------- 01540000
- LA R7,MSGERR5 'NUMERIC INPUT EXPECTED, NON-NUM'@VA04250 01541000
- * ---------------------------- 01542000
- MVI ENTSW,ENTON DON'T ALLOW REPROMPT @VA04250 01543000
- BAL R9,WRTERM GO TELL USER OF INVALID DATA @VA04250 01544000
- BR R5 ISSUE ORIGINAL PROMPT AGAIN @VA04250 01545000
- RDUP LA R2,DISP1(R2) NEXT INPUT BYTE @VA04250 01546000
- BCT R3,RDNUM1 CHECK ALL INPUT @VA04250 01547000
- B RDRETURN GO TO EXIT @VA04250 01548000
- RDHEX LR R2,R1 INPUT POINT @VA04250 01549000
- LR R3,R0 LENGTH @VA04250 01550000
- RDHEX1 TM 0(R2),NUMERIC 0 THROUGH 9? @VA04250 01551000
- BO RDHUP YES @VA04250 01552000
- CLI 0(R2),ALPHAA CHECK A - F NOW. @VA04250 01553000
- BL RDBCHK NOT A - F @VA04250 01554000
- CLI 0(R2),ALPHAF GT F? @VA04250 01555000
- BH RDERR6 YES, NOT A - F @VA04250 01556000
- B RDHUP CONTINUE CHECKING @VA04250 01557000
- RDBCHK CLI 0(R2),BLANK BLANKS ARE CONCEIVABLE @VA04250 01558000
- BNE RDERR6 BUT NOTHING ELSE @VA04250 01559000
- RDHUP LA R2,DISP1(R2) NEXT INPUT BYTE @VA04250 01560000
- BCT R3,RDHEX1 CHECK ALL INPUT @VA04250 01561000
- B RDRETURN WE'RE DONE HERE @VA04250 01562000
- * ---------------------------- 01563000
- RDERR6 LA R7,MSGERR6 'HEX INPUT EXPECTED. NON-HEX FND'@VA04250 01564000
- * ---------------------------- 01565000
- MVI ENTSW,ENTON INHIBIT REPROMT LINE NUMBER @VA04250 01566000
- BAL R9,WRTERM GO TELL USER @VA04250 01567000
- BR R5 GO BACK AND ISSUE PROMPT AGAIN @VA04250 01568000
- * ---------------------------- 01569000
- RDMINBAD LA R7,MSGERR3 NOT ENOUGH INPUT --REENTER-- @VA04250 01570000
- * ---------------------------- 01571000
- MVI ENTSW,ENTON DON'T LET WRTERM PUT OUT PROMPT #@VA04250 01572000
- BAL R9,WRTERM TELL USER @VA04250 01573000
- BR R5 LET CALLER HANDLE REISSUING MESSA@VA04250 01574000
- * ---------------------------- 01575000
- RDMAXBAD LA R7,MSGERR4 'TOO MUCH INPUT --REENTER--' @VA04250 01576000
- * ---------------------------- 01577000
- MVI ENTSW,ENTON DON'T LET WRTERM PUT OUT PROMPT #@VA04250 01578000
- BAL R9,WRTERM GO TELL USER @VA04250 01579000
- BR R5 LET CALLER REISSUE ORIGINAL PROMP@VA04250 01580000
- RDNULLIN SR R0,R0 INSURE ZERO INPUT PASSED TO CALLE@VA04250 01581000
- BR R8 RETURN TO CALLER @VA04250 01582000
- EJECT 01583000
- *************************************************************** 01584000
- * EXIT ROUTINES 01585000
- *************************************************************** 01586000
- NORMEXIT L R13,SAVEBACK RESTORE CALLER'S SAVERAREA PTR @VA04250 01587000
- LM R14,R12,12(R13) RESTORE CALLER'S REGISTERS @VA04250 01588000
- SR R15,R15 RETURN CODE OF 0 @VA04250 01589000
- BR R14 RETURN TO CALLER @VA04250 01590000
- RETCOD8 L R13,SAVEBACK RESTORE CALLER'S SAVEAREA PTR @VA04250 01591000
- LM R14,R12,12(R13) RESTORE CALLER'S REGISTERS @VA04250 01592000
- LA R15,8 RETURN CODE OF 8 @VA04250 01593000
- BR R14 RETURN TO CALLER @VA04250 01594000
- HXEXIT L R13,SAVEBACK RESTORE CALLER'S SAVEAREA PTR @VA04250 01595000
- LM R14,R12,12(R13) RESTORE CALLER'S REGISTERS @VA04250 01596000
- LA R15,4 RETURN CODE OF 4 @VA04250 01597000
- BR R14 BACK TO CALLER @VA04250 01598000
- SUMERRR C R15,=F'1' FILE NOT FOUND? @VA04250 01599000
- BNE SUMERRR2 NO @VA04250 01600000
- MVC XXXXX(PLENGTH),=C'00001' SET PROB NUMBER TO 1 @VA04250 01601000
- B RPNUM2 CONTINUE @VA04250 01602000
- SUMERRR2 CVD R15,WKDWD CONVERT RETURN CODE TO DECIMAL @VA04250 01603000
- UNPK MSGSUME2,WKDWD+FIVE(THREE) @VA04250 01604000
- OI MSGSUME2+TWO,UNPKMASK MAKE THE RCODE PRINTABLE @VA04250 01605000
- LA R3,MSGSUMEL LENGTH OF MESSAGE @VA04250 01606000
- WRTERM MSGSUMER,(R3) TELL USER OF READ ERROR @VA04250 01607000
- B RETCOD8 GO TO RETURN CODE 8 EXIT @VA04250 01608000
- MSGSUMER DC C'DMMPRO100S ERROR ''' @VA04250 01609000
- MSGSUME2 DC C' ' RETURN CODE @VA04250 01610000
- MSGSUME3 DC C''' READING FILE ''SUMMARY RECORD A1''' @VA04250 01611000
- MSGSUMEL EQU *-MSGSUMER LENGTH OF ERROR MESSAGE @VA04250 01612000
- EJECT 01613000
- ************************************************************** 01614000
- * CONSTANTS SAVEAREAS AND EQUATES 01615000
- ************************************************************** 01616000
- DS 0F @VA04250 01617000
- SAVEAREA EQU * THIS PROGRAM'S SAVE AREA @VA04250 01618000
- SAVEUSR DS F USER WORD @VA04250 01619000
- SAVEFWD DS F FORWARD POINTER @VA04250 01620000
- SAVEBACK DS F BACKWARD POINTER @VA04250 01621000
- SAVER14 DS F SAVE AREA FOR CALLER'S R14 @VA04250 01622000
- SAVER15 DS F SAVE AREA FOR CALLER'S R15 @VA04250 01623000
- SAVER0 DS F SAVE AREA FOR CALLER'S R0 @VA04250 01624000
- SAVER1 DS F SAVE AREA FOR CALLER'S R1 @VA04250 01625000
- SAVER2 DS F SAVE AREA FOR CALLER'S R2 @VA04250 01626000
- SAVER3 DS F SAVE AREA FOR CALLER'S R3 @VA04250 01627000
- SAVER4 DS F SAVE AREA FOR CALLER'S R4 @VA04250 01628000
- SAVER5 DS F SAVE AREA FOR CALLER'S R5 @VA04250 01629000
- SAVER6 DS F SAVE AREA FOR CALLER'S R6 @VA04250 01630000
- SAVER7 DS F SAVE AREA FOR CALLER'S R7 @VA04250 01631000
- SAVER8 DS F SAVE AREA FOR CALLER'S R8 @VA04250 01632000
- SAVER9 DS F SAVE AREA FOR CALLER'S R9 @VA04250 01633000
- SAVER10 DS F SAVE AREA FOR CALLER'S R10 @VA04250 01634000
- SAVER11 DS F SAVE AREA FOR CALLER'S R11 @VA04250 01635000
- SAVER12 DS F SAVE AREA FOR CALLER'S R12 @VA04250 01636000
- R1SAVE DS F SAVE AREA FOR R1 @VA04250 01637000
- RD59 DS 5F SAVE AREA FOR R5 THROUGH R9 @VA04250 01638000
- R23 DS 2F SAVE AREA FOR R2 AND R3 @VA04250 01639000
- WKWD DS F ONE WORD OF WORK AREA @VA04250 01640000
- WKDWD DS D DOUBLE WORD OF WORK AREA @VA04250 01641000
- PNUMIN EQU * READ AREA FOR NEW PROBLEM NUMBER @VA04250 01642000
- OUTPUT DS CL80 OUTPUT AREA FOR MESSAGES @VA04250 01643000
- ADDREC EQU OUTPUT OUTPUT AREA FOR ADDED DATA @VA04250 01644000
- ADDDATE EQU OUTPUT+34 OUTPUT AREA FOR ADDED DATE @VA04250 01645000
- ADDTIME EQU OUTPUT+25 OUTPUT AREA FOR ADDED TIME @VA04250 01646000
- INPUT DS CL160 INPUT AREA FOR USER RESPONSES @VA04250 01647000
- TEXTSW DC C' ' 01647100
- TEXTSWON EQU X'FF' 01647200
- SPACE 1 01648000
- ************** SWITCH INDICATING WHETHER OR NOT 01649000
- OLDSW DC X'00' WE ARE PROCESSING AN OLD PROBLEM @VA04250 01650000
- OLDON EQU X'01' PROCESSING DATA FOR AN OLD PROB @VA04250 01651000
- OLDOFF EQU X'00' NEW PROBLEM @VA04250 01652000
- SPACE 1 01653000
- ************** SWITCH INDICATING WHETHER OR NOT 01654000
- DBYTE DC X'00' REPROMPTING IS IN PROGRESS @VA04250 01655000
- REPROMPT EQU X'01' REPROMPTING IS IN PROGRESS @VA04250 01656000
- NORMAL EQU X'00' REPROMPTING NOT IN PROGRESS @VA04250 01657000
- ************** 01658000
- PNSWITCH DC X'00' LOOKING FOR PROBLEM NUMBER SW @VA04250 01659000
- PNSWON EQU X'01' WE ARE LOOKING @VA04250 01660000
- PNSWOFF EQU X'00' NOT LOOKING @VA04250 01661000
- ************** 01662000
- FOFO DC C'00000' X'F0F0F0F0F0' MASK @VA04250 01663000
- ADDSUM DS FL3'0' AREA USED FOR ARITHMATIC @VA04250 01664000
- SPACE 1 01665000
- ************** FIRST TIME SWITCH FOR WRTERM. 01666000
- ENTSW DC X'00' NUMBER WILL BE DISPLAYED. @VA04250 01667000
- ENTON EQU X'01' PROMPT NUMBER ALREADY DISPLAYED @VA04250 01668000
- ENTOFF EQU X'00' PROMPT NUMBER NOT YET DISPLAYED @VA04250 01669000
- ************** 01670000
- AONE DC X'1C' PACKED 1 TO ADD TO PROBLEM NUMBER@VA04250 01671000
- ************** 01672000
- PRBXXXXX DC C'PRB00000' FILE NAME OF PROBLEM REPORT @VA04250 01673000
- XXXXX EQU PRBXXXXX+3 NUMERIC PORTION OF FILENAME @VA04250 01674000
- PLENGTH EQU 5 LENGTH OF NUMERIC PORTION @VA04250 01675000
- ************** 01676000
- PRBFTFN DC C'REPORT A1' PROBLEM RERORT FILETYPE AND MODE @VA04250 01677000
- SUMMFILE DC C'SUMMARY RECORD A1' NEXT PROB NUMBER FILE @VA04250 01678000
- VSRCH DC V(DMMSEA) POINTER TO SEARCH ROUTINE @VA04250 01679000
- VWRTREC DC V(DMMWRT) POINTER TO WRITEREC ROUTINE @VA04250 01680000
- KYREST DC A(KYAREA) SAVE FOR CURRENT KEY POINTER @VA04250 01681000
- LOGPTR DC A(LOGTBL) POINTER TO REPROMPT LOG TABLE @VA04250 01682000
- LOGCURR DC A(LOGTBL) CURRENT LOCATION IN LOG TABLE @VA04250 01683000
- *************************************************************** 01684000
- * FOLLOWING VALUES INSURE CORRECT SPELLING OF MAJOR SYMPTOMS 01685000
- *************************************************************** 01686000
- ABEND DC C'ABEND' @VA04250 01687000
- DC 16C' ' INSURE NO TRASH IF EXTRA DATA @VA04250 01688000
- MSG DC C'MS' @VA04250 01689000
- DC 16C' ' INSURE NO TRASH IF EXTRA @VA04250 01690000
- WAIT DC C'WAIT' @VA04250 01691000
- DC 9C' ' @VA04250 01692000
- LOOP DC C'LOOP' @VA04250 01693000
- DC 9C' ' @VA04250 01694000
- INCORR DC C'INCORROUT' @VA04250 01695000
- DC 3C' ' @VA04250 01696000
- PERFORM DC C'PERFM' @VA04250 01697000
- DC 7C' ' @VA04250 01698000
- INFORM DC C'INFORMATION' @VA04250 01699000
- DC 1C' ' @VA04250 01700000
- DOCUM DC C'DOC' @VA04250 01701000
- DC 10C' ' @VA04250 01702000
- INCSPELL DC CL10'DUPLICATE' @VA04250 01703000
- DC CL10'MISSING' @VA04250 01704000
- DC CL10'OVERLAID' @VA04250 01705000
- DC CL10'GARBLED' @VA04250 01706000
- DC CL10'FORMAT' @VA04250 01707000
- DC CL10'FUNCTION' @VA04250 01708000
- DC CL10'SEQUENCE' @VA04250 01709000
- DC X'FF' MARKS END OF INCORROUT CHECKING @VA04250 01710000
- INCEND EQU X'FF' END OF INCORROUT COMPARE DATA @VA04250 01711000
- INCLEN EQU 10 LENGTH OF EACH ENTRY ABOVE @VA04250 01712000
- STATE1 DC C'ENA' ENABLED STATE VALIDITY CHECK @VA04250 01713000
- STATE2 DC C'DIS' DISABLED STATE VALIDITY CHECK @VA04250 01714000
- *************************************************************** 01715000
- * MESSAGE TO TELL USER PROBLEM NUMBER 01716000
- *************************************************************** 01717000
- MSGTELL DC C'THIS PROBLEM HAS BEEN ASSIGNED NUMBER ' @VA04250 01718000
- MSGPRB DS CL5 PROBLEM NUMBER WILL GO HERE @VA04250 01719000
- LMSGTELL EQU *-MSGTELL LENGTH OF MSGTELL MESSAGE @VA04250 01720000
- EJECT 01721000
- *************************************************************** 01722000
- * ALL MESSAGES ISSUED ARE CODED USING A SPECIAL MSGP MACRO. 01723000
- * MSGP MACRO PROTOTYPE IS AS FOLLOWS: 01724000
- * &NAME MSGP MSG=,MIN=,MAX=,TYPE=,MORE=NO,KEY= 01725000
- * MSG MESSAGE TEXT TO APPEAR AT TERMINAL 01726000
- * MIN MINIMUM NUMBER OF CHARACTERS ALLOWED ON INPUT 01727000
- * MAX MAXIMUM NUMBER OF CHARACTERS ALLOWED ON INPUT 01728000
- * TYPE TYPE OF ALLOWED INPUT (HEX,CHAR, OR NUMERIC) 01729000
- * MORE WHETHER MORE LINES FOLLOW IN THIS PROMPT BEFORE READ 01730000
- * KEY KEYWORD TO BE ASSOCIATED WITH USER RESPONSE 01731000
- *************************************************************** 01732000
- MSGAREA EQU * @VA04250 01733000
- MSGEXIST MSGP MSG='DOES THIS PERTAIN TO AN EXISTING PROBLEM REPORT? (YX01734000
- OR N)',MIN=1,MAX=3 @VA04250 01735000
- MSGPCPU MSGP MSG='DOES PROBLEM PERTAIN TO THIS CPU? (Y OR N)', C01736000
- KEY=VMCPU,MAX=3,MIN=1 @VA04250 01737000
- MSGCPU MSGP MAX=3,TYPE=NUM,MSG='ENTER CPU TYPE. (NNN)', @VA04250X01738000
- MIN=3 @VA04250 01739000
- MSGSER MSGP TYPE=NUM,MSG='ENTER CPU SERIAL. (NNNNN)',MIN=5,MAX=5 01740000
- MSGSDATA MSGP MSG='ENTER LOCATION OF SUPPORTING DATA.' @VA04250 01741000
- MSGSDAT2 MSGP MSG='ENTER FN FT FM PLUS DESCRIPTION OR NULL WHEN DONE' 01742000
- MSGSEV MSGP TYPE=NUM,MAX=1,MSG='ENTER SEVERITY. 1-4 (N)' @VA04250 01743000
- MSGBYPAS MSGP MSG='IS BYPASS FOR PROBLEM REQUESTED? (Y OR N)', X01744100
- MAX=3,MIN=1 @VA05440 01744200
- MSGCID MSGP KEY=VMCOMPID,MAX=10,MSG='ENTER COMPONENT ID IF KNOWN, EGX01745000
- 5749DMK00 (MAX 10 CHAR)',MIN=1 @VA04250 01746000
- MSGPLC MSGP MAX=3,TYPE=NUM,KEY=VMPLC,MSG='ENTER PLC LEVEL. (1-3 CHARC01747000
- -OMIT LEADING ZEROS)',MIN=1 @VA05440 01748100
- MSGSCP MSGP MAX=3,TYPE=NUM,KEY=VMSCPLV,MSG='ENTER SCP LEVEL. (1-3 CHA01749000
- AR-OMIT LEADING ZEROS)',MIN=1 @VA05440 01750100
- MSGDATE MSGP MSG='ENTER DATE OF FAILURE. (MM/DD/YY)',MIN=8, @V4M0224X01751100
- MAX=8 @VA04250 01752000
- MSGFAIL MSGP MORE=YES,MSG='SELECT ONE OF THE FOLLOWING KEYWORDS' 01753000
- MSGFAIL2 MSGP MORE=YES,MSG='MSG ABEND' @VA04250 01754000
- MSGFAIL3 MSGP MORE=YES,MSG='DOC PERFORMANCE (PER)' @VA04250 01755000
- MSGFAIL4 MSGP MORE=YES,MSG='LOOP INCORROUT (INC)' @VA04250 01756000
- MSGFAIL5 MSGP MSG='WAIT INFORMATION (INF)',KEY=VMFAILURE, @VA04250X01757000
- MIN=3 @VA04250 01758000
- MSGENV MSGP MSG='ENTER OPERATING ENVIRONMENT. CP,CMS,RSCS,VS1,VS2,DOX01759000
- S,ETC. (20 CHAR MAX)',KEY=VMENVIR,MAX=20,MIN=1 @VA04250 01760000
- MSGABCOD MSGP MSG='ENTER ABEND CODE. EG 0CX',KEY=VMFAILURE,MAX=10,MIN=X01761000
- 1 @VA04250 01762000
- MSGFMOD MSGP MSG='ENTER FAILING MODULE IF KNOWN. EG DMKPAG (8 CHAR MAC01763000
- X)',MAX=8,KEY=VMMODULE,MIN=1 @VA04250 01764000
- MSGDSP MSGP MSG='ENTER DISPLACEMENT WITHIN FAILING MODULE. (4 CHAR EX01765000
- XACTLY)',KEY=VMDISP,TYPE=HEX,MAX=4,MIN=4 @VA04250 01766000
- MSGCALL MSGP MSG='ENTER CALLING MODULE IF KNOWN (8 CHAR MAX)',MAX=8,KX01767000
- EY=VMCALLER,MIN=1 @VA04250 01768000
- MSGCMD MSGP MSG='ENTER COMMAND WHICH CAUSED FAILURE IF APPLICABLE',KX01769000
- EY=VMCMD,MAX=79 @VA04250 01770000
- MSGDOC MSGP MSG='SELECT ONE OF THE FOLLOWING:',MORE=YES @VA04250 01771000
- MSGDOC2 MSGP MSG='PUB PLC OR PTF FICHE',KEY=VMDOC, @VA04250X01772000
- MAX=5,MIN=3 @VA04250 01773000
- MSGPUB MSGP MSG='ENTER PUBLICATION NUMBER. EG GC20/1820',KEY=VMDOCNOX01774000
- ,MAX=20,MIN=5 @VA04250 01775000
- MSGPAGE MSGP MSG='ENTER PAGE NUMBER IN ERROR',MAX=6,MIN=1, @VA04250X01776000
- KEY=VMPAGE @VA04250 01777000
- MSGDEV MSGP MSG='ENTER DEVICE TYPE IF APPLICABLE',KEY=VMDEVTYPE 01778000
- MSGINC MSGP MSG='SELECT BEST DESCRIPTION FROM FOLLOWING',MORE=YES 01779000
- MSGINC2 MSGP MSG='DUPLICATE,MISSING,OVERLAID,GARBLED,FORMAT,FUNCTION,X01780000
- SEQUENCE',KEY=VMDATA,MAX=10,MIN=6 @VA04250 01781000
- MSGSTATE MSGP MSG='ENTER WHETHER DISABLED OR ENABLED. (DIS OR ENA)',MIN01782000
- N=3,KEY=VMSTATE @VA04250 01783000
- MSGLMOD MSGP MSG='ENTER KNOWN MODULES WITHIN LOOP. EG MOD1,MOD2,MOD3'X01784000
- ,KEY=VMMODULE,MAX=79 @VA04250 01785000
- MSGLADDR MSGP MSG='ENTER UP TO 10 LOOP ADDRESSES. ADDR1,ADDR2,ADDR3..'X01786000
- ,KEY=VMADDR,MAX=79 @VA04250 01787000
- MSGCPSW MSGP MSG='ENTER CURRENT PSW. (XXXXXXXXXXXXXXXX) (16 CHAR EXACX01788000
- TLY)',TYPE=HEX,MAX=16,MIN=16 @VA04250 01789000
- MSGMSG MSGP MSG='ENTER COMPLETE MESSAGE NUMBER. EG DMKAAANNNA',KEY=VX01790000
- MFAILURE,MAX=20,MIN=1 @VA04250 01791000
- MSGRCODE MSGP MSG='ENTER RETURN CODE IF APPLICABLE',KEY=VMRC,MAX=8,MINX01792000
- =1 @VA04250 01793000
- MSGPREV MSGP MSG='ENTER PREVIOUS MESSAGE IF APPLICABLE',KEY=VMPREVMSGX01794000
- ,MAX=20,MIN=1 @VA04250 01795000
- MSGPERF MSGP MSG='ENTER NATURE OF DEGRADATION. EG TOTAL,TP,I/O,VIRTMAC01796000
- CH',KEY=VMDEGRADE,MAX=20 @VA04250 01797000
- MSGPNUM MSGP MSG='ENTER PROBLEM NUMBER. (1-5 DIGITS)',TYPE=NUM,MIN=1,X01798000
- MAX=5 @VA04250 01799000
- MSGNOPRB MSGP MSG='PRBXXXXX REPORT A1 DOES NOT EXIST.' @VA04250 01800000
- MSGTEXT MSGP MSG='ENTER TEXT DESCRIPTION OF PROBLEM OR NULL LINE' 01801000
- MSGTEXT1 MSGP MSG='ENTER TEXT (MAX 80 CHAR/LINE)' @VA04250 01802000
- MSGDONE MSGP MSG='PRBNNNNN REPORT A1 APPENDED' @VA04250 01803000
- MSGERR1 MSGP MSG='REPROMPT WITHIN REPROMPT NOT ALLOWED' @VA04250 01804000
- MSGERR2 MSGP MSG='REQUESTED REPROMPT LINE NOT FOUND' @VA04250 01805000
- MSGERR3 MSGP MSG='MINIMUM INPUT NOT ENTERED --REENTER--' @VA04250 01806000
- MSGERR4 MSGP MSG='MAXIMUM ALLOWED INPUT EXCEEDED --REENTER--' 01807000
- MSGERR5 MSGP MSG='NUMERIC INPUT EXPECTED. NON-NUMERIC FOUND. --REENTEC01808000
- R--' @VA04250 01809000
- MSGERR6 MSGP MSG='HEX INPUT EXPECTED. NON-HEX FOUND. --REENTER--' 01810000
- MSGERR7 MSGP MSG='PLEASE REENTER IN THE EXACT FORMAT SHOWN BETWEEN THX01811000
- E PARENTHESES' @VA04250 01812000
- MSGERRI MSGP MSG='IMBEDDED BLANKS NOT ALLOWED IN THIS REPLY' @VA04250 01813000
- EJECT 01814000
- *************************************************************** 01815000
- * ADCONS POINTING TO DATA AREAS CUT DOWN ON BASE REGISTERS 01816000
- *************************************************************** 01817000
- DS 0F @VA04250 01818000
- WRTPARM EQU * PARMS PASSED TO WRITEREC @VA04250 01819000
- INTPT DC A(INTAREA) POINTER TO INTSECT AREA @VA04250 01820000
- KYOUTLN DC A(KYAREALN) POINTER TO LENGTH OF KY DATA @VA04250 01821000
- TXTOUTLN DC A(TEXTLN2) POINTER TO TEXT LENGTH @VA04250 01822000
- SUPPLNTH DC A(SUPPLN2) PTR TO SUPPLEMENTARY DATA LENGTH @VA04250 01823000
- * END OF PARMS USED BY WRITEREC 01824000
- SUPPCURR DC A(SUPPDATA) CURRENT PTR TO SUPPLEMENTARY DATA@VA04250 01825000
- SUPPPT DC A(SUPPDATA) START OF SUPPLEMENTARY DATA @VA04250 01826000
- SUPPBACK DC A(SUPPDATA) POINTER USED IN REPROMPT @VA04250 01827000
- SUPPEND DC A(SUPPEND1) POINTER TO END OF SUPP DATA AREA @VA04250 01828000
- TEXTPT DC A(TEXTAREA) POINTER TO TEXT I/O AREA @VA04250 01829000
- TEXTCURR DC A(TEXTAREA) CURRENT PTR WITHIN TEXT I/O AREA @VA04250 01830000
- TEXTEND DC A(TEXTEND1) POINTER TO END OF TEXT AREA @VA04250 01831000
- TEXTLAST DC A(TEXTAREA) TO CONTROL REPROMPTS FOR TEXT @VA04250 01832000
- TEXTBACK DC A(TEXTAREA) TO CONTROL REPROMPTS FOR TEXT @VA04250 01833000
- TEXTLNTH DC A(TEXTLN2) POINTER TO LENGTH OF ENTERED TEXT@VA04250 01834000
- KYAREAPT DC A(KYAREA) POINTER TO KEY AREA @VA04250 01835000
- KYCURRPT DC A(KYAREA) CURRENT POINTER INTO KEYAREA @VA04250 01836000
- PATCH DC 80F'0' PATCH AREA @VA04250 01837000
- LTORG @VA04250 01838000
- EJECT 01839000
- *************************************************************** 01840000
- * DATA AREAS. ALL ARE ADDRESSED VIA ADCONS ABOVE 01841000
- *************************************************************** 01842000
- * TRACE TABLE 01843000
- LOGTBL DC 300F'0' TABLE USED TO LOG PROMPTS @VA04250 01844000
- ENDMARK DC X'FF' END OF LOGTABLE INDICATOR @VA04250 01845000
- DS 0F @VA04250 01846000
- INTAREA DC 160C' ' AREA TO CONTAIN INTERNAL DATA @VA04830 01847500
- KYAREALN DC X'00000000' LENGTH OF DATA IN KEYAREA @VA04250 01848000
- KYAREA DC 400X'00' AREA TO CONTAIN KYWDS AND VALUES @VA04250 01849000
- SUPPLN2 DC X'0000' LENGTH OF SUPPLEMENTARY DATA @VA04250 01850000
- SUPPDATA DC 400C' ' AREA TO CONTAIN SUPLEMENTARY DATA@VA04250 01851000
- SUPPEND1 EQU * END OF SUPLEMENTARY DATA @VA04250 01852000
- DC C' ' FOR EASE OF CLEARING SUPPDATA @VA04250 01853000
- TEXTLN2 DC X'0000' LENGTH OF ENTERED TEXT INFO @VA04250 01854000
- TEXTAREA DC 1600C' ' TEXT DESCRIPTION OF PROBLEM @VA04250 01855000
- TEXTEND1 EQU * END OF TEXT AREA @VA04250 01856000
- *************************************************************** 01857000
- * GENERAL EQUATES 01858000
- *************************************************************** 01859000
- PACKMASK EQU X'0F' USED TO MAKE A PACKED VALUE PLUS @VA04250 01860000
- UNPKMASK EQU X'F0' USED TO MAKE UNPKD VALUES PRINT @VA04250 01861000
- BLANK EQU C' ' BLANK @VA04250 01862000
- FNOTFND EQU X'1C' FILE NOT FOUND @VA04250 01863000
- NOKYWD EQU X'00' NO KEYWORD IN MESSAGE @VA04250 01864000
- HEXZERO EQU X'00' VALUE OF HEX 0 @VA04250 01865000
- FENCE EQU X'FF' END OF FIELD INDICATOR @VA04250 01866000
- NUMERIC EQU X'F0' NUMERIC MASK @VA04250 01867000
- ALPHAA EQU C'A' CHARACTER A @VA04250 01868000
- ALPHAF EQU C'F' CHARACTER F @VA04250 01869000
- YES EQU C'Y' USED TO TEST FOR YES @VA04250 01870000
- NO EQU C'N' USED TO TEST FOR NO @VA04250 01871000
- CHARZERO EQU C'0' CHARACTER ZERO @VA04250 01872000
- FOUR EQU C'4' 4 FOR SEVERITY LIMIT CHECKING @VA04250 01873000
- SEVDFLT EQU C' ' SEVERITY DEFAULT OF BLANK @VA04250 01874000
- ONE EQU C'1' 1 FOR SEVERITY LIMIT CHECKING @VA04250 01875000
- SLASH EQU C'/' SLASH FOR DATE FORMAT CHECKING @VA04250 01876000
- DASH EQU C'-' DASH FOR INSERTING IN OUTPUT @VA04250 01877000
- DISP1 EQU 1 INCR OR DECR 1 @VA04250 01878000
- TWO EQU 2 FOR MVC LENGTHS ETC. @VA04250 01879000
- CKLN1 EQU 2 COMPARE LENGTH FOR ABEND TYPE @VA04250 01880000
- THREE EQU 3 FOR MVC LENGTHS ETC. @VA04250 01881000
- CKLN2 EQU 3 COMPARE LENGTH FOR ABEND TYPE @VA04250 01882000
- PLCCNT EQU 3 SIZE OF PLC INFO @VA04250 01883000
- SCPCNT EQU 3 SIZE OF SCP INFO @VA04250 01884000
- DISP4 EQU 4 4 FOR MVC LENGTHS ETC. @VA04250 01885000
- WKDWD2 EQU WKDWD+4 SECOND WORD OF WORD DOUBLE WD @VA04250 01886000
- FIVE EQU 5 FOR MVC LENGTHS ETC. @VA04250 01887000
- FIVECARD EQU 5 NUMBER OF CARDS OF SUPP DATA @VA04250 01888000
- SIX EQU 6 FOR MVC LENGTHS ETC. @VA04250 01889000
- SEVEN EQU 7 FOR MVC LENGTHS ETC. @VA04250 01890000
- WKDWDEND EQU WKDWD+7 LAST BYTE OF WORK DOUBLE WORD @VA04250 01891000
- EIGHT EQU 8 FOR MVC LENGTHS ETC. @VA04250 01892000
- CPSWLN EQU 12 LENGTH OF 'CURRENT PSW =' @VA04250 01893000
- TRSIZE EQU 12 TRACE TABLE ENTRY SIZE @VA04250 01894000
- THIRTEEN EQU 13 LENGTH OF ***ADDED*** LITERAL @VA04250 01895000
- FIFTEEN EQU 15 TO PUT LOOP ADDRESSED IN OUTPUT @VA04250 01896000
- SIXTEEN EQU 16 FOR MVC LENGTH ETC. @VA04250 01897000
- MAXLINES EQU 20 MAX TEXT INPUT ALLOWED @VA04250 01898000
- CARDLEN EQU 80 SIZE OF CARD OF DATA @VA04250 01899000
- TWOK EQU 2048 FOR SETTING UP BASE REGS @VA04250 01900000
- FOURK EQU 4096 FOR SETTING UP BASE REGS @VA04250 01901000
- EIGHTK EQU 8192 FOR SETTING UP BASE REGS @VA04250 01902000
- PSWL EQU 16 LENGTH OF A PSW @VA04250 01903000
- LFLDLEN EQU 4 LENGTH OF LENGTH FIELD (VAR RCD) @VA04250 01904000
- *************************************************************** 01905000
- * EXTERNAL DSECTS AND REGISTER EQUATES 01906000
- *************************************************************** 01907000
- COPY MSGCNTRL @VA04250 01908000
- COPY INTSECT @VA04250 01909000
- COPY SYMSECT @VA04250 01910000
- REGEQU @VA04250 01911000
- NUCON @VA04250 01912000
- END 01913000
ibm/vm370-lib/dumpscan/dmmpro.assemble_src.txt · Last modified: 2023/08/06 13:37 by Site Administrator