ibm:vm370-lib:cp:dmkpeq.assemble_src
Table of Contents
DMKPEQ Source
References
- Fixes Applied : 1
- This Source Date : Friday, August 17, 1979
- Last Fix ID : [HRC013DK]
Source Listing
- DMKPEQ.ASSEMBLE.txt
- 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
ibm/vm370-lib/cp/dmkpeq.assemble_src.txt · Last modified: 2023/08/06 13:37 by Site Administrator