PEQ TITLE 'DMKPEQ VM/370 VERSION 6, LEVEL 0' 00001000 COPY OPTIONS 00002000 COPY LOCAL 00003000 EJECT , 00004000 DMKPEQ CSECT 00005000 USING VMBLOK,R11 00006000 USING SAVEAREA,R13 00007000 USING PERBLOK,R8 00008000 USING PEXBLOK,R7 00009000 USING PSA,R0 00010000 SPACE 00011000 EXTRN DMKCVTBH,DMKERMSG,DMKCVTBD 00012000 SPACE 00013000 MODID DC CL8'DMKPEQ' PAGEABLE MODULE IDENTIFIER 00014000 EJECT 00015000 *---------------------------------------------------------------------* 00016000 * INITIALIZE AND DETERMINE TYPE OF QUERY * 00017000 *---------------------------------------------------------------------* 00018000 DMKPEQRY RELOC , ENTRY FROM DMKPEC 00019000 MVC SAVER2(4),ZEROES SET RET CODE 00020000 L R8,VMPERCTL LOAD POINTER TO PER BLOK 00021000 LTR R8,R8 ANY? 00022000 BZ NOTRACE NO, PER TRACE NOT IN EFFECT 00023000 CLC SAVER0(2),=C'* ' WANT NAMES DISPLAYED? 00024000 BE PUTNAMES YES, GO DISPLAY SAVED NAMES 00025000 STM R0,R1,SAVEWRK1 SAVE NAME (IF ANY) 00026000 L R7,PERCHAIN ASSUME WANT CURRENT CHAIN 00027000 LTR R0,R0 WAS NAME ZERO? 00028000 BZ QUERYO YES, GO PRODUCE OUTPUT 00029000 L R6,PERSAVED POINT TO LIST OF SAVED TRACES 00030000 QFNDLP LTR R6,R6 ANY? 00031000 BZ NOTRACE NO, GIVE EMSG 00032000 CLC PESNAME-PESBLOK(8,R6),SAVEWRK1 IS THIS THE BLOK? 00033000 BE GOTBLOK YES, GO LOAD R7 00034000 L R6,PESNEXT-PESBLOK(,R6) LOAD FWD POINTER 00035000 B QFNDLP GO CHECK IT 00036000 GOTBLOK L R7,PESCHAIN-PESBLOK(,R6) 00037000 EJECT 00038000 *---------------------------------------------------------------------* 00039000 * START PRODUCING QUERY OUTPUT * 00040000 *---------------------------------------------------------------------* 00041000 QUERYO EQU * HERE TO PRODUCE QUERY OUTPUT 00042000 LTR R7,R7 ANY? 00043000 BZ NOTRACE NO, GIVE ERROR MSG 00044000 QLOOP MVI PERBUF,C' ' MOVE IN A BLANK 00045000 MVC PERBUF+1(79),PERBUF CLEAR BUFFER 00046000 LA R2,PERBUF POINT TO BUFFER 00047000 LA R3,80 INDICATE 80 BYTES LEFT 00048000 SPACE 00049000 *---------------------------------------------------------------------* 00050000 * MOVE NAME OF TRACE TO OUTPUT LINE * 00051000 *---------------------------------------------------------------------* 00052000 IC R0,PEXFLAGT LOAD TYPE FLAGS 00053000 TM PEXFLAGT,X'0F' ANY THING ON IN SECOND BYTE? 00054000 BZ *+8 NO, SKIP AND 00055000 N R0,F15 KILL OTHER BITS 00056000 LA R1,TYPEBYTE POINT TO PLIST 00057000 BAL R6,BITNAME AND OUTPUT TYPE 00058000 SPACE 00059000 *---------------------------------------------------------------------* 00060000 * IF GREG DISPLAY REGISTER NUMBERS * 00061000 *---------------------------------------------------------------------* 00062000 QTRYADD TM PEXFLAGT,PEXGPR GREG? 00063000 BNO QTRYPGT NO, GO SEE ABOUT PAGE TRACE 00064000 CLC PEXGREG(2),FFS IS IT OK? 00065000 BE QTRYST YES, GO SEE IF RANGE 00066000 MVC PERBUF(8),BLANKS CLEAR FIRST PART OF BUFFER 00067000 LA R2,PERBUF POINT TO BUFFER 00068000 LA R3,80 LOAD LENGTH 00069000 SLR R0,R0 CLEAR R0 00070000 ICM R0,B'1100',PEXGREG LOAD REGISTER FLAGS 00071000 LA R1,16 LOAD COUNTER 00072000 ZAP SAVEWRK8(2),=P'0' ZERO IT 00073000 QGLP1 ALR R0,R0 SHIFT UP 00074000 BC B'1100',QGLP2 IF NO CARRY GO TO END OF LOOP 00075000 MVI 1(R2),C'G' MOVE IN G 00076000 UNPK SAVEWRK9(3),SAVEWRK8(2) UNPACK 00077000 MVC 2(2,R2),SAVEWRK9 MOVE IN REG ID 00078000 LA R15,4 SET SPACE TAKEN 00079000 CLI 2(R2),C'0' LEADING ZERO? 00080000 BNE QGLP3 NO, SKIP FIX 00081000 BCTR R15,0 MINUS 1 00082000 MVC 2(2,R2),3(R2) SQUEAZE OUT LEADING ZERO 00083000 QGLP3 ALR R2,R15 POINT TO NEXT PLACE 00084000 SLR R3,R15 DEC LENGTH 00085000 QGLP2 AP SAVEWRK8(2),=P'10' ADD TO REG NUMBER 00086000 BCT R1,QGLP1 GO BACK TO TOP 00087000 B QTRYDAT GO SEE IF ANY DATA 00088000 SPACE 00089000 *---------------------------------------------------------------------* 00090000 * PUT OUT INCREMENT FOR PAGE TRACE * 00091000 *---------------------------------------------------------------------* 00092000 QTRYPGT TM PEXFLAGT,PEXPGT IS IT A PAGE TRACE? 00093000 BNO QTRYST NO, GO SEE IF NEED TO PUT OUT RANGE 00094000 L R1,PEXINCR LOAD INCREMENT 00095000 LTR R1,R1 ANY? 00096000 BZ QCOMMN NO, GO DISPLAY OPTIONS 00097000 N R1,=X'000003FF' EVEN NUMBER OF K? 00098000 L R1,PEXINCR RELOAD PAGE SIZE 00099000 BZ PUTK YES, PUT OUT IN K 00100000 BAL R6,PUTDEC GO DISPLAY NUMBER 00101000 B QCOMMN GO JOIN COMMON 00102000 PUTK SRL R1,10 SHIFT TO MAKE K 00103000 BAL R6,PUTDEC PUT OUT NUMERIC PART 00104000 MVI 0(R2),C'K' PUT OUT K 00105000 LA R2,1(,R2) POINT PAST IT 00106000 BCTR R3,0 DECREMENT LENGTH 00107000 B QCOMMN JOIN COMMON 00108000 SPACE 00109000 *---------------------------------------------------------------------* 00110000 * PUT OUT RANGE OR ADDRESS FOR STORE AND BRANCH * 00111000 *---------------------------------------------------------------------* 00112000 QTRYST TM PEXFLAGT,PEXST+PEXBR COULD THERE BE A RANGE? 00113000 BZ QTRYDAT NO, GO SEE IF ANY DATA 00114000 CLI PEXFLAGT,PEXBR ONLY BRANCH? 00115000 BE QCOMMN YES, THEN NO RANGE 00116000 LM R0,R1,PEXADDR3 LOAD RANGE FOR DISPLAY 00117000 CLI PEXFLAGT,PEXBRTB IS IT? 00118000 BE QRG3 YES, SKIP OTHER CHECKS 00119000 CLI PEXDLEN,0 ANY DATA? 00120000 BE *+6 NO, SKIP SETTING EQUAL 00121000 LR R1,R0 SET EQUAL THEN 00122000 QRG3 LTR R0,R0 IS THE FIRST ZERO? 00123000 BNZ PUTRST NO, PUT IT OUT 00124000 CL R1,XRIGHT24 IS THE SECOND FFFFFF 00125000 BE QCOMMN YES, THEN NO NEED TO DISPLAY 00126000 PUTRST BAL R6,PUTRNG PUT OUT RANGE 00127000 SPACE 00128000 *---------------------------------------------------------------------* 00129000 * PUT OUT DATA * 00130000 *---------------------------------------------------------------------* 00131000 QTRYDAT CLI PEXDLEN,0 ANY DATA? 00132000 BE QCOMMN NO, GO TO COMMON SECTION 00133000 LA R4,PEXDATA POINT TO DATA 00134000 SLR R5,R5 CLEAR R5 FOR IC 00135000 IC R5,PEXDLEN LOAD DATA LENGTH 00136000 BCTR R3,0 SUBTRACT 1 00137000 LA R2,1(,R2) POINT TO FIRST SLOT 00138000 QODLP SL R3,F2 SUBTRACT 2 00139000 BNL QODLP2 STILL SPACE, CONTINUE 00140000 BAL R6,BUFRESET GO RESET BUFFER 00141000 QODLP2 UNPK SAVEWRK8(3),0(2,R4) UNPACK 2 HEX DIGITS 00142000 TR SAVEWRK8(2),HEXTAB-C'0' TRANSLATE TO EBCDIC 00143000 MVC 0(2,R2),SAVEWRK8 MOVE TO LINE 00144000 LA R2,2(,R2) POINT TO NEXT SLOT 00145000 LA R4,1(,R4) POINT TO NEXT PAIR 00146000 BCT R5,QODLP GO ON 00147000 SPACE 00148000 *---------------------------------------------------------------------* 00149000 * DISPLAY RANGE * 00150000 *---------------------------------------------------------------------* 00151000 QCOMMN LM R0,R1,PEXADDR1 LOAD RANGE 00152000 LTR R0,R0 ZERO? 00153000 BNE QROUT NO, OUTPUT RANGE 00154000 CL R1,XRIGHT24 FFFFFF? 00155000 BE QCOMMN1 NO, GO OUTPUT REST OF STUFF 00156000 QROUT SL R3,F6 MINUS LENGTH 00157000 BNL QNBRT IF OK, DON'T CALL BUFRESET 00158000 BAL R6,BUFRESET GO RESET BUFFER 00159000 SL R3,F6 MINUS LENGTH 00160000 LM R0,R1,PEXADDR1 RELOAD ADDR 00161000 QNBRT MVC 1(5,R2),NRANGE MOVE IN NAME 00162000 LA R2,6(,R2) POINT TO NEXT SPACE 00163000 BAL R6,PUTRNG PUT OUT RANGE 00164000 SPACE 00165000 *---------------------------------------------------------------------* 00166000 * DISPLAY OPTIONS * 00167000 *---------------------------------------------------------------------* 00168000 QCOMMN1 IC R0,PEXFLAGO INSERT OPTION FLAGS 00169000 LA R1,OPTBYTE POINT TO PLIST 00170000 BAL R6,BITNAME AND DISPLAY BIT NAMES 00171000 SPACE 00172000 *---------------------------------------------------------------------* 00173000 * DISPLAY STEP AND SKIP * 00174000 *---------------------------------------------------------------------* 00175000 L R1,PEXSTEP LOAD STEP 00176000 CL R1,F1 ANY? 00177000 BNH QTRYSKIP NO, TRY SKIP 00178000 SL R3,F5 ENOUGH SPACE? 00179000 BNL *+12 YES, SKIP CALL 00180000 BAL R6,BUFRESET GO RESET BUFFER 00181000 SL R3,F5 MINUS LENGTH 00182000 MVC 1(4,R2),NSTEP MOVE IN ID 00183000 LA R2,5(,R2) POINT TO NEXT SPACE 00184000 L R1,PEXSTEP LOAD IT 00185000 BAL R6,PUTDEC GO PUT OUT NUMBER 00186000 QTRYSKIP L R1,PEXSKIP LOAD SKIP COUNT 00187000 CL R1,F1 IS THERE ANY? 00188000 BNH QTRYCMD NO, SEE IF ASSOCIATED COMMAND 00189000 SL R3,F5 ENOUGH SPACE? 00190000 BNL *+12 YES, SKIP CALL 00191000 BAL R6,BUFRESET RESET BUFFER 00192000 SL R3,F5 DEC COUNT 00193000 MVC 1(4,R2),NSKIP MOVE IN NAME 00194000 LA R2,5(,R2) POINT ON 00195000 L R1,PEXSKIP LOAD IT AGAIN 00196000 BAL R6,PUTDEC AND PUT IT OUT 00197000 SPACE 00198000 *---------------------------------------------------------------------* 00199000 * DISPLAY ASSOCIATED COMMAND IF ANY * 00200000 *---------------------------------------------------------------------* 00201000 QTRYCMD L R1,PEXCMND LOAD POINTER 00202000 LTR R1,R1 IS THERE A COMMAND? 00203000 BZ QOUT1 NO, GO DUMP BUFFER 00204000 SLR R4,R4 CLEAR FOR IC 00205000 IC R4,0(,R1) INSERT LENGTH OF COMMAND 00206000 LA R5,1(,R1) AND POINT TO FIRST BYTE 00207000 CL R3,F3 ENOUGH SPACE FOR KEYWORD? 00208000 BNL QCMD1 YES, GO MOVE TO BUFFER 00209000 BAL R6,BUFRESET GO RESET BUFFER 00210000 QCMD1 MVC 1(3,R2),NCMD MOVE IN KEYWORD 00211000 SL R3,F5 INDICATE LENGTH USED 00212000 LA R2,5(,R2) POINT TO PLACE TO PUT CMND 00213000 QCMLP1 SL R3,F1 MINUS 1 00214000 BNL *+12 ENOUGH SPACE, CONTINUE 00215000 BAL R6,BUFRESET RESET BUFFER 00216000 SL R3,F1 MINUS 1 00217000 MVC 0(1,R2),0(R5) MOVE IN CHARACTER 00218000 CLI 0(R2),X'15' EOL? 00219000 BNE *+8 NO, SKIP MVI 00220000 MVI 0(R2),C';' MOVE IN SEMICOLEN 00221000 LA R2,1(,R2) POINT TO NEXT SPACE 00222000 LA R5,1(,R5) AND NEXT SLOT 00223000 BCT R4,QCMLP1 GO BACK FOR NEXT CHAR 00224000 SPACE 00225000 *---------------------------------------------------------------------* 00226000 * DUMP REST OF BUFFER AND FINISH UP LOOP * 00227000 *---------------------------------------------------------------------* 00228000 QOUT1 LR R0,R2 MOVE ADDR TO R0 00229000 LA R1,PERBUF POINT TO BUFFER 00230000 SLR R0,R1 GET LENGTH 00231000 SLR R2,R2 CLEAR REG 00232000 CALL DMKQCNWT GO OUTPUT LINE TO CONSOLE 00233000 LTR R2,R2 ATTN HIT? 00234000 BNZ QRET YES, RETURN TO CALLER 00235000 QLOOPND L R7,PEXNEXT POINT TO NEXT PEXBLOCK 00236000 LTR R7,R7 ANY? 00237000 BNZ QLOOP YES, GO HANDLE IT 00238000 QRET EXIT , RETURN TO CALLER 00239000 EJECT 00240000 *---------------------------------------------------------------------* 00241000 * ROUTINE TO CONVERT TO EBCDIC DECIMAL * 00242000 *---------------------------------------------------------------------* 00243000 PUTDEC CVD R1,SAVEWRK2 CONVERT TO DECIMAL 00244000 UNPK SAVEWRK4(15),SAVEWRK2(8) UNPACK 00245000 OI SAVEWRK4+14,X'F0' FIX ZONE 00246000 LA R1,SAVEWRK4 POINT TO NUMBER 00247000 LA R14,14 LOAD COUNT FOR ZERO SUPPRESSION 00248000 PUTDL1 CLI 0(R1),C'0' ZERO? 00249000 BNE PUTD2 NO, THEN DONE 00250000 LA R1,1(,R1) POINT TO NEXT 00251000 BCT R14,PUTDL1 GO BACK FOR MORE 00252000 PUTD2 LA R15,2(,R14) GET SPACE NEEDED 00253000 CLR R3,R15 ENOUGH? 00254000 BNL PUTDEC1 YES, KEEP GOING 00255000 ST R6,SAVEWRK9 SAVE RET ADDR 00256000 ST R1,SAVEWRK2 SAVE ADDR 00257000 ST R14,SAVEWRK3 AND LENGTH 00258000 BAL R6,BUFRESET RESET BUFFER 00259000 L R6,SAVEWRK9 LOAD RET ADDR 00260000 L R1,SAVEWRK2 LOAD ADDR 00261000 L R14,SAVEWRK3 AND LENGTH 00262000 PUTDEC1 EX R14,MVCDEC MOVE IT IN 00263000 LA R2,2(R2,R14) POINT TO NEXT 00264000 SLR R3,R0 MINUS LENGTH 00265000 SL R3,F2 MINUS 2 MORE 00266000 BR R6 RETURN 00267000 MVCDEC MVC 1(*-*,R2),0(R1) EXECUTED MOVE 00268000 SPACE 00269000 *---------------------------------------------------------------------* 00270000 * ROUTINE TO PUT OUT RANGE * 00271000 *---------------------------------------------------------------------* 00272000 PUTRNG EQU * 00273000 STM R0,R1,SAVEWRK8 SAVE RANGE 00274000 LR R1,R0 MOVE LOW END 00275000 CALL DMKCVTBH GO CONVERT 00276000 STCM R0,B'0011',SAVEWRK2 SAVE IN LINE 00277000 STCM R1,B'1111',SAVEWRK2+2 SAVE REST OF IT 00278000 LA R1,SAVEWRK2 POINT TO NUMBER 00279000 LA R14,5 LOAD MAX COMPRESS 00280000 RNGCLP CLI 0(R1),C'0' ZERO? 00281000 BNE RNGCDN NO, THEN GET OUT OF LOOP 00282000 LA R1,1(,R1) POINT TO NEXT 00283000 BCT R14,RNGCLP GO BACK TO CHECK NEXT 00284000 RNGCDN CLC SAVEWRK8(4),SAVEWRK9 ARE TWO ADDRS THE SAME? 00285000 BE MVRNG YES, GO MOVE RANGE 00286000 MVI SAVEWRK2+6,C':' MOVE IN COLEN 00287000 ST R1,SAVEWRK6 SAVE ADDR 00288000 ST R14,SAVEWRK7 SAVE LENGTH 00289000 L R1,SAVEWRK9 LOAD SECOND 00290000 CALL DMKCVTBH CONVERT 00291000 STCM R0,B'0011',SAVEWRK2+7 SAVE FIRST 2 CHARS 00292000 STCM R1,B'1111',SAVEWRK2+9 AND LAST 4 00293000 LA R14,5 LOAD MAX COUNT FOR COMPRESS 00294000 RNGCLP1 CLI SAVEWRK2+7,C'0' ZERO? 00295000 BNE RNGCDN1 NO, THEN GET OUT OF LOOP 00296000 MVC SAVEWRK2+7(5),SAVEWRK2+8 MOVE DOWN ADDR 00297000 BCT R14,RNGCLP1 GO BACK AND CHECK NEXT 00298000 RNGCDN1 AL R14,SAVEWRK7 ADD LENGTH OF PREVIOUS 00299000 LA R14,2(,R14) GET TOTAL LENGTH -1 00300000 L R1,SAVEWRK6 RELOAD POINTER 00301000 MVRNG LA R15,2(,R14) GET LENGTH NEEDED 00302000 CLR R15,R3 ENOUGH SPACE? 00303000 BNH DOMVRNG YES, GO DO MOVE 00304000 ST R14,SAVEWRK6 SAVE LENGTH 00305000 ST R1,SAVEWRK7 AND ADDR 00306000 ST R6,SAVEWRK8 AND RET ADDR 00307000 BAL R6,BUFRESET RESET BUFFER 00308000 L R6,SAVEWRK8 RELOAD RET ADDR 00309000 L R1,SAVEWRK7 ADDR 00310000 L R14,SAVEWRK6 AND LENGTH 00311000 DOMVRNG EX R14,MVCRNG MOVE RANGE IN 00312000 LA R15,2(,R14) GET SPACE USED 00313000 SLR R3,R15 GET NEW LEFT 00314000 ALR R2,R15 AND NEW ADDR 00315000 BR R6 AND RETURN 00316000 MVCRNG MVC 1(*-*,R2),0(R1) EXECUTED MOVE 00317000 SPACE 00318000 *---------------------------------------------------------------------* 00319000 * ROUTINE TO TYPE BUFFER AND RESET IT * 00320000 *---------------------------------------------------------------------* 00321000 BUFRESET LA R1,PERBUF POINT TO BUFFER 00322000 LR R0,R2 MOVE ADDR TO R0 00323000 SLR R0,R1 CALC LENGTH 00324000 SLR R2,R2 CLEAR FLAGS 00325000 CALL DMKQCNWT AND TYPE THE LINE 00326000 LTR R2,R2 ATTN HIT? 00327000 BNZ QRET YES, STOP DISPLAYING 00328000 LA R2,PERBUF+2 INDENT 2 00329000 LA R3,78 LOAD LENGTH 00330000 MVI PERBUF,C' ' MOVE IN A BLANK 00331000 MVC PERBUF+1(79),PERBUF AND CLEAR TO ZEROS 00332000 BR R6 RETURN 00333000 SPACE 00334000 *---------------------------------------------------------------------* 00335000 * ROUTINE TO DISPLAY NAMES OF FLAGS ON IN A BYTE * 00336000 *---------------------------------------------------------------------* 00337000 BITNAME EQU * 00338000 SLL R0,24 SHIFT BYTE INTO POSITION 00339000 BITNLP ALR R0,R0 SHIFT OVER 1 BIT 00340000 BC B'0011',OUTNMB IF CARRY THEN OUTPUT BIT NAME 00341000 BZR R6 NO MORE BITS, RETURN 00342000 BITCNL LA R1,2(,R1) POINT TO NEXT 00343000 B BITNLP GO FOR NEXT BIT 00344000 OUTNMB SLR R4,R4 CLEAR R4 FOR IC 00345000 ICM R4,B'0011',0(R1) INSERT BIT INFO 00346000 BZ BITCNL NONE, CONTINUE LOOP 00347000 SRDL R4,12 SHIFT OFFSET INTO R5 00348000 CLR R4,R3 ENOUGH? 00349000 BL PUTBIT1 YES, SKIP CALL 00350000 STM R0,R1,SAVEWRK8 SAVE R0-R1 00351000 LR R5,R6 AND RET ADDR 00352000 BAL R6,BUFRESET RESET BUFFER 00353000 LM R0,R1,SAVEWRK8 GET R0-R1 BACK 00354000 LR R6,R5 AND RET CODE 00355000 B OUTNMB GO TRY AGAIN 00356000 PUTBIT1 SRL R5,20 AND SHIFT IT TO POSITION 00357000 ALR R5,R12 GET PROPER ADDR 00358000 BCTR R4,0 MINUS 1 FOR EX 00359000 EX R4,BITMV MOVE NAME TO LINE 00360000 LA R4,2(,R4) ADD TO GET LENGTH USED 00361000 SLR R3,R4 GET NEW WHAT LEFT 00362000 ALR R2,R4 GET NEW AVAIL ADDR 00363000 B BITCNL GO FOR NEXT BIT 00364000 BITMV MVC 1(*-*,R2),0(R5) MOVE NAME TO LINE 00365000 SPACE 00366000 *---------------------------------------------------------------------* 00367000 * PLISTS USED BY BITNAME TO DISPLAY BIT NAMES * 00368000 *---------------------------------------------------------------------* 00369000 SPACE 00370000 * PEXFLAGT BIT NAMES 00371000 TYPEBYTE DC AL2(NBRANCH-DMKPEQ+L'NBRANCH*4096) 00372000 DC AL2(NIFETCH-DMKPEQ+L'NIFETCH*4096) 00373000 DC AL2(NSTORE-DMKPEQ+L'NSTORE*4096) 00374000 DC AL2(NGREG-DMKPEQ+L'NGREG*4096) 00375000 DC AL2(NBRANCH-DMKPEQ+L'NBRANCH*4096) 00376000 DC AL2(NPAGETR-DMKPEQ+L'NPAGETR*4096) 00377000 DC AL2(NMASK-DMKPEQ+L'NMASK*4096) 00378000 * BIT 7 IS UNUSED 00379000 SPACE 00380000 * PEXFLAGO BIT NAMES 00381000 OPTBYTE DC AL2(NRUN-DMKPEQ+L'NRUN*4096) 00382000 DC AL2(NPRINT-DMKPEQ+L'NPRINT*4096) 00383000 DC AL2(NTERM-DMKPEQ+L'NTERM*4096) 00384000 DC 3AL2(*-*) NO NAMES FOR BITS 3, 4, AND 5 00385000 * BITS 6 AND 7 ARE UNUSED 00386000 EJECT 00387000 *---------------------------------------------------------------------* 00388000 * DISPLAY NAMES OF SAVED TRACE SETS * 00389000 *---------------------------------------------------------------------* 00390000 PUTNAMES EQU * HERE TO DISPLAY NAMES OF SAVED SETS 00391000 L R6,PERSAVED LOAD POINTER TO CHAIN 00392000 LTR R6,R6 ANY? 00393000 BZ NOSAVED NO, GO GIVE EMSG 00394000 LP1 MVI PERBUF,C' ' MOVE IN A BLANK 00395000 MVC PERBUF+1(79),PERBUF CLEAR BUFFER 00396000 LA R5,9 MAX OF 9 TO A LINE 00397000 LA R4,PERBUF POINT TO FIRST ONE 00398000 LP2 MVC 0(8,R4),PESNAME-PESBLOK(R6) MOVE IN NAME 00399000 LA R4,9(,R4) POINT TO NEXT BLOK 00400000 L R6,PESNEXT-PESBLOK(,R6) LOAD FORWARD POINTER 00401000 LTR R6,R6 IS THERE ONE? 00402000 BZ PUTIT NO, GO DUMP BUFFER 00403000 BCT R5,LP2 GO BACK FOR MORE 00404000 PUTIT LA R1,PERBUF POINT TO BUFFER 00405000 LR R0,R4 MOVE ADDR 00406000 SLR R0,R1 CALC LENGTH 00407000 SLR R2,R2 SET FLAG REGISTER 00408000 CALL DMKQCNWT AND TYPE MSG 00409000 LTR R2,R2 ANY ATTN HIT? 00410000 BNZ QRET YES, EXIT 00411000 LTR R6,R6 SHOULD WE GO FOR MORE? 00412000 BNZ LP1 YES, GO TO IT 00413000 B QRET OTHERWISE EXIT 00414000 EJECT 00415000 *---------------------------------------------------------------------* 00416000 * PRODUCE ERROR MSG * 00417000 *---------------------------------------------------------------------* 00418000 NOSAVED LA R2,101 LOAD NON-EXISTANT MSG NUMBER 00419000 LA R1,NOSMSG POINT TO MSG 00420000 LA R0,L'NOSMSG LOAD LENGTH 00421000 B PUTMSG AND GO PUT OUT MSG 00422000 NOTRACE LA R1,NOMSG POINT TO MSG 00423000 LA R0,LNOMSG LOAD LENGTH 00424000 LA R2,47 LOAD MSG NUMBER 00425000 PUTMSG ST R2,SAVER2 SET RET CODE 00426000 ICM R0,B'1110',MODID+3 INSERT MOD ID 00427000 ICM R2,B'1000',=X'80' INSERT RETURN FLAG 00428000 CALL DMKERMSG ERROR 00429000 B QRET GO EXIT 00430000 EJECT 00431000 *---------------------------------------------------------------------* 00432000 * CONSTANTS * 00433000 *---------------------------------------------------------------------* 00434000 SPACE 00435000 HEXTAB DC C'0123456789ABCDEF' HEX TRANSLATE TABLE 00436000 NBRANCH DC C'BRANCH' 00437000 NCMD DC C'CMD' 00438000 NGREG DC C'GREG' 00439000 NIFETCH DC C'IFETCH' 00440000 NPAGETR DC C'PAGETRACE' 00441000 NMASK DC C'MASK' 00442000 NPRINT DC C'PRINTER' 00443000 NRANGE DC C'RANGE' 00444000 NRUN DC C'RUN' 00445000 NSKIP DC C'SKIP' 00446000 NSTEP DC C'STEP' 00447000 NTERM DC C'TERMINAL' 00448000 NSTORE DC C'STORE' 00449000 NOMSG DC C'TRACE',X'00',C'SET' 00450000 LNOMSG EQU *-NOMSG 00451000 NOSMSG DC C'TRACE SETS DO NOT EXIST' 00452000 EJECT 00453000 *---------------------------------------------------------------------* 00454000 * LITERALS * 00455000 *---------------------------------------------------------------------* 00456000 LTORG 00457000 EJECT 00458000 *---------------------------------------------------------------------* 00459000 * DSECTS AND EQUATES * 00460000 *---------------------------------------------------------------------* 00461000 SPACE 00462000 COPY EQU 00463000 COPY PERBLOKS 00464000 PSA 00465000 COPY SAVE 00466000 COPY VMBLOK 00467000 END 00468000