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