PED TITLE 'DMKPED VM/370 VERSION 6, LEVEL 0' 00001000
*. 00002000
* MODULE NAME - 00003000
* DMKPED 00004000
* 00005000
* FUNCTION - 00006000
* 00007000
* TO PRODUCE OUTPUT FOR THE PER TRACE FACILITY 00008000
* 00009000
* ATTRIBUTES - 00010000
* 00011000
* RE-ENTRANT, PAGEABLE, CALLED VIA SVC 00012000
* 00013000
* ENTRY POINT - 00014000
* 00015000
* DMKPEDAL 00016000
* 00017000
* ENTRY CONDITIONS - 00018000
* 00019000
* GPR 11 = VMBLOK ADDRESS 00020000
* GPR 12 = ADDRESS OF DMKPEDAL 00021000
* GPR 13 = ADDRESS OF STANDARD SAVEAREA 00022000
* PEXBLOKS TO BE CHECKED HAVE THE SUCCESS BIT ON. 00023000
* 00024000
* EXIT CONDITIONS - 00025000
* 00026000
* SVC 12, GPRS UNCHANGED 00027000
* 00028000
* CALLS TO OTHER ROUTINES - 00029000
* 00030000
* DMKCFMBK - TO ENTER CONSOLE FUNCTION MODE 00031000
* DMKCFMEN - TO EXECUTE A COMMAND BUFFER 00032000
* DMKFREE - TO OBTAIN FREE STORAGE 00033000
* DMKFRET - TO RELEASE FREE STORAGE 00034000
* DMKQCNWT - TO WRITE A LINE TO THE CONSOLE 00035000
* DMKVSPRT - TO PRINT A LINE ON THE VIRTUAL PRINTER 00036000
* 00037000
* TABLES / WORK AREAS 00038000
* 00039000
* PERBLOK, PEXBLOK, SAVEAREA, VMBLOK, PSA 00040000
* 00041000
* OPERATION - 00042000
* 00043000
* 1. DETERMINE WHAT WILL HAVE TO BE DISPLAYED AND HANDLE STEP 00044000
* 2. SET DISPLAY ROUTINE = DMKVSPRT FOR FIRST PASS 00045000
* 3. IF NEEDED, DISPLAY PAGE TRACE INFO. 00046000
* 4. IF DON'T NEED TO DISPLAY ISN, GOTO STEP 7 00047000
* 5. SET UP SEQUENCE INDICATOR 00048000
* 6. DISPLAY INSTRUCTION, CONDITION CODE 00049000
* 7. IF SUCCESSFUL STORE, DISPLAY *STORE* 00050000
* 8. IF WANTED, DISPLAY ALTERED GREGS 00051000
* 9. IF WANTED, DISPLAY TRACEBACK TABLE 00052000
* 10. DISPLAY ANY DATA STOPS 00053000
* 11. SET DISPLAY ROUTINE = DMKQCNWT AND GO TO STEP 3 FOR SECOND PAS 00054000
* 12. TURN OFF ALL SUCCESS BITS 00055000
* 13. UNSTACK AND EXECUTE COMMAND BUFFERS. 00056000
* 14. CALL DMKCFMBK IF NECESSARY 00057000
* 15. EXIT 00058000
* 00059000
* USAGE OF SAVEWORK AREA 00060000
* 00061000
* SAVEWRK1 BYTE 0 FLAGS 00062000
* X'80' DATA TRAPS PRESENT 00063000
* X'40' ATTN HIT DURING OUTPUT 00064000
* X'20' PASS 2 00065000
* X'10' CALL DMKCFMBK 00066000
* BYTE 1 USED TO SAVE VMRSTAT 00067000
* BYTES 2-3 UNUSED 00068000
* 00069000
* SAVEWRK2 BYTE 0 FLAGS (SAVEWRK2 IS DISPLAY INFO FOR PRINTER) 00070000
* X'80' DISPLAY PAGETRACE INFO 00071000
* X'40' DISPLAY TRACEBACK TABLE 00072000
* X'20' DISPLAY INSTRUCTION 00073000
* X'10' DISPLAY *STORE* 00074000
* BYTE 1 UNUSED 00075000
* BYTES 2-3 REGISTER FLAGS, IF CORRESPONDING BIT IS 00076000
* ON DISPLAY THE GIVEN REGISTER. 00077000
* 00078000
* 00079000
* SAVEWRK3 SAME AS SAVEWRK2 BUT FOR TERMINAL OUTPUT 00080000
* 00081000
* SAVEWRK4 SCRATCH 00082000
* 00083000
* SAVEWRK5 POINTER TO STACK OF COMMAND BUFFERS TO EXECUTE 00084000
* 00085000
* SAVEWRK6 ADDRESS OF OUTPUT ROUTINE, DMKVSPRT DURING PASS 1 00086000
* AND DMKQCNWT DURING PASS 2 00087000
* 00088000
* SAVEWRK7-SAVEWRK8 SCRATCH 00089000
* 00090000
* SAVEWRK9 UNUSED 00091000
*. 00092000
EJECT , 00093000
COPY OPTIONS 00094000
COPY LOCAL 00095000
EJECT , 00096000
DMKPED CSECT , 00097000
SPACE 1 00098000
USING SAVEAREA,R13 00099000
USING VMBLOK,R11 00100000
USING PERBLOK,R8 00101000
USING PEXBLOK,R7 00102000
USING PSA,R0 00103000
SPACE 1 00104000
DC CL8'DMKPED' 00105000
SPACE 1 00106000
EXTRN DMKCFMBK,DMKNEMOP,DMKTMRPT,DMKCFMEN 00107000
EJECT , 00108000
*---------------------------------------------------------------------* 00109000
* ENTRY FOR DISPLAY OF INTERUPT * 00110000
*---------------------------------------------------------------------* 00111000
SPACE 1 00112000
DMKPEDAL RELOC , 00113000
L R8,VMPERCTL LOAD PTR TO PERBLOK 00114000
LTR R8,R8 MAKE SURE IT IS THERE 00115000
BZ PED3 NO? WHAT ARE WE DOING HERE? 00116000
CLC PERCHAIN(4),ZEROES ANY PERBLOKS? 00117000
BZ PED4 NO? NEVER SHOULD HAVE GOTTEN HERE 00118000
XC SAVEWRK1(4),SAVEWRK1 CLEAR SAVEWRK1 00119000
XC SAVEWRK2(8),SAVEWRK2 CLEAR DISPLAY FLAGS 00120000
XC SAVEWRK5(4),SAVEWRK5 AND COMMAND STACK 00121000
MVC SAVEWRK1+1(1),VMRSTAT SAVE VMRSTAT FOR EXIT 00122000
OI VMRSTAT,VMCFWAIT PUT INTO CF WAIT 00123000
SPACE 1 00124000
*---------------------------------------------------------------------* 00125000
* DETERMINE WHAT WILL HAVE TO BE DISPLAYED * 00126000
*---------------------------------------------------------------------* 00127000
LA R7,PERCHAIN-(PEXNEXT-PEXBLOK) POINT TO CHAIN 00128000
PEXLOOP L R7,PEXNEXT POINT TO FIST/NEXT BLOCK 00129000
LTR R7,R7 ANY MORE? 00130000
BZ PASS1 NO, GO SET UP FOR PASS 1 00131000
TM PEXFLAGO,PEXSUCC SUCCESSFUL? 00132000
BZ PEXLOOP NO, TRY NEXT ONE 00133000
XC SAVEWRK4+2(2),SAVEWRK4+2 CLEAR GREG FLAGS 00134000
CLI PEXFLAGT,PEXPGT PAGE TRACE? 00135000
BNE NOTPGT NO, SKIP PGT STUFF 00136000
MVI SAVEWRK4,X'80' INDICATE PAGETRACE OUTPUT 00137000
B CHKCMD AND GO CHECK FOR STACKED COMMAND 00138000
NOTPGT MVI SAVEWRK4,X'20' ALL BUT PGT DISPLAY ISN 00139000
CLI PEXFLAGT,PEXBRTB TRRACE BACK? 00140000
BNE NOTTBK NO, SKIP IT THEN 00141000
OI SAVEWRK4,X'40' INDICATE TRACEBACK OUTPUT 00142000
B CHKCMD AND GO CHECK FOR COMMAND 00143000
NOTTBK CLI PEXFLAGT,PEXGPR GREG? 00144000
BNE NOTGREG NO, SKIP IT 00145000
MVC SAVEWRK4+2(2),PEXGSUC MOVE IN DISPLAY FLAGS 00146000
B CHKCMD AND GO CHECK FOR COMMAND 00147000
NOTGREG TM PEXFLAGT,PEXST STORE EVENT? 00148000
BZ NOTST NO, SKIP IT 00149000
OI SAVEWRK4,X'10' SET TO DISPLAY *STORE* 00150000
NOTST CLI PEXDLEN,0 IS IT A DATA STOP? 00151000
BE CHKCMD NO, CHECK FOR COMMAND 00152000
OI SAVEWRK1,X'80' INDICATE DATA TRAPS PRESENT 00153000
CHKCMD L R2,PEXCMND LOAD PTR TO POSSIBLE COMMAND 00154000
LTR R2,R2 ANY? 00155000
BZ CHKOPTS NO, GO CHECK OPTIONS 00156000
LA R0,BUFSIZE LOAD SIZE OF BUFFER 00157000
CALL DMKFREE GET A CON BUF 00158000
XC 0(BUFSIZE*8,R1),0(R1) CLEAR IT OUT 00159000
IC R3,0(,R2) INSERT LENGTH 00160000
BCTR R3,0 MINUS 1 00161000
EX R3,MVCBUF MOVE INTO BUFFER 00162000
MVC BUFCNT+3-BUFFER(1,R1),0(R2) MOVE IN COUNT 00163000
L R2,SAVEWRK5 LOAD POINTER 00164000
LTR R2,R2 ANY STACKED? 00165000
BNZ SRCHND NO, GO FIND END 00166000
ST R1,SAVEWRK5 SAVE PTR 00167000
B CHKOPTS AND GO CHECK OPTIONS 00168000
SRCHND CLC BUFNXT-BUFFER(4,R2),ZEROES END? 00169000
BE SUCCIS YES, STORE PTR 00170000
L R2,BUFNXT-BUFFER(,R2) LOAD FWD PTR 00171000
B SRCHND AND LOOP 00172000
SUCCIS ST R1,BUFNXT-BUFFER(,R2) SET POINTER 00173000
CHKOPTS TM PEXFLAGO,PEXPRINT PRINTER OUTPUT? 00174000
BZ *+10 NO, SKIP OR 00175000
OC SAVEWRK2(4),SAVEWRK4 OR IN FLAGS 00176000
TM PEXFLAGO,PEXTERM TERMINAL OUTPUT? 00177000
BZ *+10 NO, SKIP OR 00178000
OC SAVEWRK3(4),SAVEWRK4 OR IN FLAGS 00179000
TM PEXFLAGO,PEXRUN RUN? 00180000
BO PEXLOOP YES, NO NEED TO CHECK STEP 00181000
L R1,PEXSTEPN LOAD STEP COUNTER 00182000
BCT R1,SAVESTEP CHECK COUNTER 00183000
MVC PEXSTEPN(4),PEXSTEP RESET STEP COUNTER 00184000
OI SAVEWRK1,X'10' SET TO BREAK 00185000
B PEXLOOP AND CHECK NEXT ONE 00186000
SAVESTEP ST R1,PEXSTEPN SAVE STEP 00187000
B PEXLOOP AND CONTINUE LOOP 00188000
SPACE 1 00189000
*---------------------------------------------------------------------* 00190000
* SET UP FOR DISPLAY LOOP * 00191000
*---------------------------------------------------------------------* 00192000
PASS1 MVC SAVEWRK6(4),=V(DMKVSPRT) SET INITIAL ROUTINE 00193000
SPACE 1 00194000
*---------------------------------------------------------------------* 00195000
* OUTPUT PAGE TRACE INFO * 00196000
*---------------------------------------------------------------------* 00197000
PAGEOUT TM SAVEWRK2,X'80' PRODUCE PAGE TRACE OUTPUT? 00198000
BZ ISNOUT NO, SEE IF SHOULD OUTPUT ISN 00199000
MVC PERBUF(6),=C'*PGT* ' MOVE IN MARKER 00200000
CALL DMKTMRPT GO GET CURRENT VIRT TIME 00201000
STM R0,R1,SAVEWRK7 SAVE IT 00202000
UNPK PERBUF+6(7),PERADDR+1(4) UNPACK ADDRESS 00203000
UNPK PERBUF+13(9),SAVEWRK7(5) UNPACK FIRST HALF 00204000
UNPK PERBUF+21(9),SAVEWRK8(5) UNPACK SECOND HALF 00205000
TR PERBUF+6(23),HEXBENT TRANSLATE TO EBCDIC 00206000
MVI PERBUF+12,C' ' MOVE IN BLANK 00207000
LA R0,29 LOAD LENGTH TO OUTPUT 00208000
BAL R4,DISPLAY AND GO DISPLAY IT 00209000
SPACE 1 00210000
*---------------------------------------------------------------------* 00211000
* CHECK SEQUENCE INDICATOR * 00212000
*---------------------------------------------------------------------* 00213000
ISNOUT TM SAVEWRK2,X'20' DISPLAY INSTRUCTION? 00214000
BZ PASS2 NO, NOTHING ELSE EITHER THEN 00215000
LA R9,PERBUF+1 POINT TO FIRST AVAIL SLOT 00216000
MVI PERBUF,C' ' SET FIRST CHAR TO BLANK 00217000
MVC PERBUF+1(79),PERBUF CLEAR REST TO BLANKS 00218000
LA R2,PERSEQP POINT TO SEQUENCE FIELD 00219000
TM SAVEWRK1,X'20' IS IT PASS 1? 00220000
BZ *+8 YES, WE HAVE PROPER SEQ FIELD 00221000
LA R2,PERSEQT POINT TO PROPER SEQUENCE INDICATOR 00222000
CLC PERADDR+1(3),1(R2) DO WE NEED A SEQUENCE INDICATOR? 00223000
BE *+8 NO, SKIP MOVING IT IN 00224000
MVI PERBUF,C'>' MOVE IN SEQUENCE INDICATOR 00225000
LA R1,4 ASSUME RX/RS/S 00226000
CLI PEREX,X'44' WAS IT AN EX? 00227000
BE CALCSEQ YES, HAVE PROPER LENGTH 00228000
TM PERINST,X'C0' CHECK FIRST TWO BITS 00229000
BM CALCSEQ IS OK, GO GET IT 00230000
LA R1,2 ASSUME RR 00231000
BZ CALCSEQ AND IF IS, SKIP LA 00232000
LA R1,6 LOAD LENGTH FOR SS 00233000
CALCSEQ AL R1,PERADDR ADD TO EVENT ADDR 00234000
ST R1,0(,R2) AND STORE BACK 00235000
SPACE 1 00236000
*---------------------------------------------------------------------* 00237000
* DISPLAY INSTRUCTION * 00238000
*---------------------------------------------------------------------* 00239000
UNPK 0(7,R9),PERADDR+1(4) UNPACK EVENT ADDRESS 00240000
TR 0(6,R9),HEXBENT TRANSLATE EVENT ADDRESS 00241000
MVI 6(R9),C' ' MOVE IN BLANK 00242000
LA R9,7(,R9) POINT TO PLACE TO PUT MNEMONIC 00243000
CLI PEREX,X'44' EXECUTE ISN? 00244000
BNE NOTOUTEX NOPE, CONTINUE 00245000
MVC 0(2,R9),=C'EX' MOVE IN MNEMONIC 00246000
UNPK 6(9,R9),PEREX(5) UNPACK INST 00247000
UNPK 15(3,R9),PEREXMOD(2) UNPACK MODIFIER 00248000
UNPK 18(7,R9),PEREXADD(4) UNPACK ADDRESS 00249000
TR 6(18,R9),HEXBENT TRANSLATE TO HEX 00250000
MVI 14(R9),C' ' MOVE IN BLANK 00251000
MVI 17(R9),C' ' MOVE IN BLANK 00252000
MVI 24(R9),C' ' MOVE IN BLANK 00253000
LA R9,25(,R9) POINT TO PLACE TO PUT ISN 00254000
NOTOUTEX LH R0,PERINST LOAD FIRST 2 BYTES OF ISN 00255000
LR R1,R9 PLACE TO PUT MMNEMONIC 00256000
CALL DMKNEMOP GET MNEMONIC 00257000
SLR R1,R1 CLEAR R1 FOR IC 00258000
IC R1,PERINST INSERT OP CODE 00259000
SRL R1,6 KEEP ONLY FIRST 2 BITS 00260000
LA R1,3(,R1) ADD FUDGE FACTOR 00261000
SRL R1,1 AND GET ILC 00262000
LR R5,R1 PREPARE A REG FOR EXECUTE 00263000
SLL R5,5 MOVE FOR L1 OF UNPACK 00264000
ALR R5,R1 AND L2 00265000
ALR R5,R5 AND DOUBLE FOR PROPER POSITION 00266000
EX R5,UNPKINST UNPK 6(*-*,R9),PERINST(*-*) 00267000
SRL R5,4 SHIFT FOR LENGTH OF RESULT 00268000
LA R1,6(R5,R9) LOAD ADDR TO PUT BLANK 00269000
MVI 0(R1),C' ' MOVE IN BLANK 00270000
BCTR R5,0 DECREMENT FOR EX 00271000
EX R5,TRINSTR AND TRANSLATE TO HEX 00272000
LA R9,15(,R9) LOAD ADDR FOR FIRST OP 00273000
TM PERINST,X'C0' 6 BYTE ISN? 00274000
BNO *+8 NO, SKIP LA 00275000
LA R9,4(,R9) ALLOW AN EXTRA 4 BYTES 00276000
TM PEROP1,PEROPNOT IS THERE A FIRST OPERAND? 00277000
BO PUTCC NOPE, GO PUT OUT CC 00278000
UNPK 0(7,R9),PEROP1+1(4) UNPACK OPERAND 1 00279000
TR 0(6,R9),HEXBENT TRANSLATE TO HEX 00280000
MVI 6(R9),C' ' MOVE IN A BLANK 00281000
LA R9,7(,R9) POINT PAST OPERAND 1 00282000
TM PEROP2,PEROPNOT IS THERE A SECOND OPERAND? 00283000
BO PUTCC NOPE, PUT OUT CC 00284000
UNPK 0(7,R9),PEROP2+1(4) UNPACK IT 00285000
TR 0(6,R9),HEXBENT TRANSLATE TO HEX 00286000
MVI 6(R9),C' ' MOVE IN A BLANK 00287000
LA R9,7(,R9) AND POINT TO NEXT AVAIL SLOT 00288000
SPACE 1 00289000
*---------------------------------------------------------------------* 00290000
* PUT OUT CONDITION CODE * 00291000
*---------------------------------------------------------------------* 00292000
PUTCC IC R1,VMPSW+4 ASSUME BC PSW 00293000
TM VMPSW+1,EXTMODE IN EC MODE? 00294000
BZ *+8 NOPE, KEEP THIS CC 00295000
IC R1,VMPSW+2 GET CORRECT CC 00296000
SRL R1,4 SHIFT IT TO POSITION 00297000
N R1,F3 KILL UNWANTED BITS 00298000
MVC 0(3,R9),=C'CC=' MOVE IN CHARS 00299000
STC R1,3(,R9) STORE CC 00300000
OI 3(R9),X'F0' AND OR IN ZONE 00301000
LA R9,5(,R9) POINT TO NEXT AVAIL SLOT 00302000
SPACE 1 00303000
*---------------------------------------------------------------------* 00304000
* CHECK FOR *STORE* * 00305000
*---------------------------------------------------------------------* 00306000
STOUT TM SAVEWRK2,X'10' DISPLAY *STORE*? 00307000
BZ GPROUT NOPE, OUTPUT REGISTERS 00308000
MVC 0(7,R9),=C'*STORE*' MOVE IN MARKER 00309000
LA R9,8(,R9) POINT TO NEXT AVAIL SLOT 00310000
SPACE 1 00311000
*---------------------------------------------------------------------* 00312000
* DISPLAY ALTERED GENERAL REGISTERS * 00313000
*---------------------------------------------------------------------* 00314000
GPROUT LA R10,PERBUF+80-13 POINT TO LAST POSSIBLE POSITION 00315000
SLR R5,R5 CLEAR R5 00316000
ICM R5,B'1100',SAVEWRK2+2 LOAD REGISTER FLAGS 00317000
BZ GDUMP GO DUMP BUFFER 00318000
LA R6,VMGPRS POINT TO REGISTERS 00319000
SLR R7,R7 CLEAR REG N0 00320000
GRLP ALR R5,R5 CHECK FLAG 00321000
BZ GDUMP NO MORE, DUMP BUFFER 00322000
BC B'0100',NXTREG NOT THIS ONE, TRY NEXT 00323000
CR R9,R10 ENOUGH SPACE LEFT? 00324000
BNH NOGOUT YES, DON'T DUMP BUFFER YET 00325000
LR R0,R9 MOVE ADDR TO R9 00326000
LA R1,PERBUF POINT TO BUFFER 00327000
SLR R0,R1 GET LENGTH 00328000
BAL R4,DISPLAY AND DISPLAY THE BUFFER 00329000
MVC PERBUF(4),BLANKS MOVE IN 4 BLANKS 00330000
LA R9,PERBUF+4 POINT TO SLOT 00331000
NOGOUT CVD R7,SAVEWRK8 CONVERT REG NO TO DEC 00332000
UNPK 0(3,R9),SAVEWRK8+6(2) UNPACK REG NUMBER 00333000
OI 2(R9),X'F0' OR IN ZONE 00334000
MVI 0(R9),C'G' MOVE IN G 00335000
MVI 3(R9),C'=' MOVE IN = 00336000
UNPK 4(9,R9),0(5,R6) UNPACK CONTENTS 00337000
TR 4(8,R9),HEXBENT TRANSLATE 00338000
MVI 12(R9),C' ' MOVE IN TRAILING BLANK 00339000
LA R9,13(,R9) POINT TO NEXT AVAIL SLOT 00340000
NXTREG LA R6,4(,R6) POINT TO NEXT REG 00341000
LA R7,1(,R7) ADD TO COUNTER 00342000
B GRLP AND LOOP 00343000
GDUMP LR R0,R9 MOVE ADDR TO R0 00344000
LA R1,PERBUF POINT TO BUFFER 00345000
SLR R0,R1 GET LENGTH 00346000
BAL R4,DISPLAY AND DISPLAY IT 00347000
SPACE 1 00348000
*---------------------------------------------------------------------* 00349000
* CHECK FOR DISPLAY OF TRACEBACK TABLE * 00350000
*---------------------------------------------------------------------* 00351000
TM SAVEWRK2,X'40' DISPLAY TRACEBACK TABLE? 00352000
BZ DATOUT NO, TRY FOR DATA STOP 00353000
LA R0,5 INDICATE NO MORE THAN 5 00354000
BAL R10,DUMPTBAK AND GO DUMP TABLE 00355000
SPACE 1 00356000
*---------------------------------------------------------------------* 00357000
* DISPLAY DATA STOPS * 00358000
*---------------------------------------------------------------------* 00359000
DATOUT TM SAVEWRK1,X'80' DATA TRAPS PRESENT? 00360000
BZ PASS2 NO, GO SET UP FOR PASS 2 00361000
LA R7,PERCHAIN-(PEXNEXT-PEXBLOK) POINT TO START OF CHAIN 00362000
DATLP L R7,PEXNEXT LOAD FORWARD POINTER 00363000
LTR R7,R7 ANY MORE? 00364000
BZ PASS2 NO, SET UP FOR PASS 2 00365000
TM PEXFLAGO,PEXSUCC SUCCESSFUL? 00366000
BZ DATLP NO, TRY NEXT ONE 00367000
CLI PEXDLEN,0 DATA TRAP? 00368000
BZ DATLP NO, TRY NEXT 00369000
CLI PEXFLAGT,PEXGPR GREG? 00370000
BE DATLP YES, DATA ALREADY DISPLAYED 00371000
MVC PERBUF(8),=C'DATA AT ' MOVE IN CHARS 00372000
TM PEXFLAGT,PEXIFET IFETCH? 00373000
UNPK PERBUF+8(7),PEXADDR3+1(4) UNPACK ADDRESS 00374000
TM PEXFLAGT,PEXIFET IFETCH? 00375000
BZ TRADAT NO, GO TRANSLATE IT 00376000
UNPK PERBUF+8(7),PERADDR+1(4) UNPACK ADDRESS 00377000
CLI PEREX,X'44' EXECUTE ISN? 00378000
BNE TRADAT NO, SKIP CHECK 00379000
CLI PEXDATA,X'44' EXECUTE? 00380000
BE TRADAT YES, IS OK THEN 00381000
UNPK PERBUF+8(7),PEREXADD(4) UNPACK PROPER ADDRESS 00382000
TRADAT TR PERBUF+8(6),HEXBENT TRANSLATE TO HEX 00383000
MVI PERBUF+14,C'=' MOVE IN = 00384000
LA R9,PERBUF+15 POINT TO FIRST AVAIL SLOT 00385000
LA R10,PERBUF+80-2 POINT TO LAST POSSIBLE PLACE 00386000
SLR R5,R5 CLEAR R5 FOR IC 00387000
IC R5,PEXDLEN LOAD LENGTH OF DATA 00388000
LA R6,PEXDATA POINT TO DATA 00389000
CLI PEXFLAGT,PEXMASK MASK BLOK? 00390000
BNE OUTDLP NO, GO DO OUTPUT 00391000
ALR R6,R5 POINT TO PROPER DATA 00392000
OUTDLP CR R9,R10 ENOUGH SPACE LEFT? 00393000
BNH OUTDLP1 YES, USE IT 00394000
LR R0,R9 MOVE TO R0 00395000
LA R1,PERBUF POINT TO BUFFER 00396000
SLR R0,R1 AND GET LENGTH 00397000
BAL R4,DISPLAY AND DISPLAY IT 00398000
MVC PERBUF(2),BLANKS MOVE IN TWO BLANKS 00399000
LA R9,PERBUF+2 INDENT TWO 00400000
OUTDLP1 UNPK SAVEWRK8(3),0(2,R6) UNPACK IT 00401000
TR SAVEWRK8(2),HEXBENT TRANSLATE IT 00402000
MVC 0(2,R9),SAVEWRK8 AND MOVE IT 00403000
LA R9,2(,R9) POINT ONWARD 00404000
LA R6,1(,R6) POINT TO NEXT BYTE 00405000
BCT R5,OUTDLP AND TRY NEXT BYTE 00406000
LR R0,R9 MOVE TO R0 00407000
LA R1,PERBUF POINT TO BUFFER 00408000
SLR R0,R1 GET LENGTH 00409000
BAL R4,DISPLAY AND GO DISPLAY IT 00410000
SPACE 1 00411000
*---------------------------------------------------------------------* 00412000
* HANDLE SECOND PASS * 00413000
*---------------------------------------------------------------------* 00414000
PASS2 TM SAVEWRK1,X'20' ALREADY PASS 2? 00415000
BO UNSUCC YES, GO TURN OFF SUCCESS BITS 00416000
MVC SAVEWRK6(4),=V(DMKQCNWT) MOVE IN ROUTINE ADDR 00417000
OI SAVEWRK1,X'20' INDICATE IS PASS 2 00418000
MVC SAVEWRK2(4),SAVEWRK3 MOVE IN FLAGS FOR PASS 2 00419000
B PAGEOUT AND GO DO IT ALL AGAIN 00420000
SPACE 1 00421000
*---------------------------------------------------------------------* 00422000
* TURN OFF ALL SUCCESS BITS * 00423000
*---------------------------------------------------------------------* 00424000
UNSUCC LA R7,PERCHAIN-(PEXNEXT-PEXBLOK) POINT TO CHAIN 00425000
UNSUCCL L R7,PEXNEXT POINT TO NEXT PEXBLOK 00426000
LTR R7,R7 ANY MORE? 00427000
BZ UNSTACK NO, GO UNSTACK COMMAND BUFFERS 00428000
NI PEXFLAGO,255-PEXSUCC TURN OFF BIT 00429000
B UNSUCCL AND LOOP 00430000
SPACE 1 00431000
*---------------------------------------------------------------------* 00432000
* UNSTACK COMMAND BUFFERS * 00433000
*---------------------------------------------------------------------* 00434000
UNSTACK L R1,SAVEWRK5 LOAD POINTER 00435000
LTR R1,R1 ANYTHING? 00436000
BZ CHKBRK NO, GO CHECK FOR BREAK 00437000
TM VMRSTAT,VMLOGOFF IS A LOGOFF PENDING? 00438000
BO STKFRT YES, FRET THE STACK 00439000
MVC SAVEWRK5(4),BUFNXT-BUFFER(R1) SET NEW POINTER 00440000
L R0,BUFCNT-BUFFER(,R1) LOAD COUNT 00441000
ST R1,BUFNXT-BUFFER(,R1) SAVE POINTER 00442000
CALL DMKCFMEN GO EXECUTE IT 00443000
B UNSTACK AND GO UNSTACK NEXT ONE 00444000
STKFRT LR R2,R1 MOVE TO R2 00445000
STKFRTL LTR R1,R2 CHECK IT 00446000
BZ CHKBRK NONE, GO CHECK FOR BREAK 00447000
LA R0,BUFSIZE LOAD SIZE OF BUFFER 00448000
L R2,BUFNXT-BUFFER(,R1) LOAD FWD PTR 00449000
CALL DMKFRET FRET THE BUFFER 00450000
B STKFRTL AND LOOP 00451000
SPACE 1 00452000
*---------------------------------------------------------------------* 00453000
* CHECK TO SEE IF SHOULD CALL DMKCFMBK * 00454000
*---------------------------------------------------------------------* 00455000
CHKBRK TM VMOSTAT,VMSLEEP WAS HE PUT TO SLEEP? 00456000
BO EXIT YES, JUST EXIT 00457000
TM SAVEWRK1,X'40'+X'10' SHOULD WE BREAK? 00458000
BZ EXIT NO, JUST EXIT 00459000
OI SAVEWRK1+1,VMCFWAIT CFMBK TURNS ON CF WAIT 00460000
CALL DMKCFMBK CALL CFM TO PUT IN CONS MODE 00461000
B EXIT AND EXIT 00462000
EJECT , 00463000
*---------------------------------------------------------------------* 00464000
* ENTRY TO DISPLAY TRACEBACK TABLE * 00465000
*---------------------------------------------------------------------* 00466000
SPACE 00467000
DMKPEDTB RELOC , 00468000
MVC SAVEWRK6(4),=V(DMKQCNWT) MOVE IN ADDR 00469000
MVC SAVEWRK1+1(1),VMRSTAT SAVE VMRSTAT ON ENTRY 00470000
OI VMRSTAT,VMCFWAIT PUT INTO CF WAIT 00471000
L R8,VMPERCTL LOAD POINTER 00472000
LTR R8,R8 ANY? 00473000
BZ NOENTBK 00474000
LA R0,6 DISPLAY UP TO 6 ENTRIES 00475000
BAL R10,DUMPTBAK AND GO DUMP IT 00476000
B EXIT AND EXIT 00477000
NOENTBK LA R0,L'EMPTY LOAD LENGTH 00478000
LA R1,EMPTY POINT TO IT 00479000
SLR R2,R2 CLEAR FLAG 00480000
CALL DMKQCNWT AND TYPE MSG 00481000
B EXIT AND EXIT 00482000
EJECT , 00483000
*---------------------------------------------------------------------* 00484000
* COMMON EXIT * 00485000
*---------------------------------------------------------------------* 00486000
EXIT OI SAVEWRK1+1,255-VMCFWAIT RESTORE VMRSTAT 00487000
NC VMRSTAT(1),SAVEWRK1+1 EXCEPT FOR VMCFWAIT 00488000
EXIT , 00489000
EJECT , 00490000
*---------------------------------------------------------------------* 00491000
* ROUTINE TO DUMP THE TRACEBACK TABLE * 00492000
*---------------------------------------------------------------------* 00493000
DUMPTBAK LR R6,R0 MOVE COUNTER 00494000
L R3,PERTBAK LOAD POINTER 00495000
LTR R3,R3 IS THERE A TABLE? 00496000
BZ TEMPTY NO, TELL HIM SO 00497000
TEMPTYL CLC 0(16,R3),ZEROES IS IT EMPTY? 00498000
BNE TBAKMSG NO, GO DISPLAY IT 00499000
LA R3,16(,R3) POINT TO NEXT ENTRY 00500000
BCT R6,TEMPTYL LOOP UNTIL SOMETHING FOUND 00501000
B TEMPTY NONE, DISPLAY MSG 00502000
TBAKMSG MVC PERBUF(L'TMSG),TMSG 00503000
LA R0,L'TMSG 00504000
BAL R4,DISPLAY 00505000
MVI PERBUF,C':' MOVE IN TBAK INDICATOR 00506000
TBAKLOOP MVI PERBUF+1,C' ' MOVE IN A BLANK 00507000
MVC PERBUF+2(24),PERBUF+1 CLEAR TO BLANKS 00508000
UNPK PERBUF+1(7),0(4,R3) UNPACK ADDRESS OF BRANCH 00509000
TR PERBUF+1(6),HEXBENT TRANSLATE TO EBCDIC 00510000
MVI PERBUF+7,C' ' MOVE IN A BLANK 00511000
LA R1,PERBUF+8 POINT TO PLACE FOR DMKNEMOP 00512000
LR R9,R1 PUT IN R9 WHILE WE'RE AT IT 00513000
ICM R0,B'0011',3(R3) INSERT OP CODE 00514000
CALL DMKNEMOP AND GO DECODE IT 00515000
IC R1,3(,R3) INSERT OP CODE 00516000
SRL R1,6 SHIFT ALL BUT FIRST 2 BITS OUT 00517000
N R1,F3 KILL UNWANTED BITS 00518000
LA R1,3(,R1) ADD FUDGE FACTOR 00519000
SRL R1,1 GET ILC 00520000
LR R2,R1 MOVE TO R2 00521000
SLL R2,5 SHIFT TO GET L1 00522000
ALR R2,R1 ADD IN L2 00523000
ALR R2,R2 AND SHIFT TO POSITION 00524000
EX R2,UNPKISN2 EXECUTE AN UNPACK 00525000
SRL R2,4 SHIFT FOR TRANSLATE 00526000
BCTR R2,0 MINUS 1 FOR EX 00527000
EX R2,TRINSTR TRANSLATE IT 00528000
LA R2,7(R2,R9) POINT TO CHAR TO FIX 00529000
MVI 0(R2),C' ' FIX THE BLANK 00530000
LA R9,15(,R9) POINT TO PLACE TO PUT ADDR 00531000
CLR R9,R2 ENOUGH? 00532000
BNL *+8 YES, SKIP LA 00533000
LA R9,4(,R9) GIVE IT 4 MORE BYTES 00534000
UNPK 0(7,R9),9(4,R3) UNPACK ADDRESS 00535000
TR 0(6,R9),HEXBENT TRANSLATE IT 00536000
LA R0,6(,R9) POINT PAST IT 00537000
LA R1,PERBUF POINT TO BUFFER 00538000
SLR R0,R1 GET LENGTH 00539000
L R2,12(,R3) LOAD COUNT 00540000
CL R2,F1 COUNT OF 1? 00541000
BNH TBAKDISP YES, GO DISPLAY 00542000
MVC 6(LMASK+6,R9),MASK MOVE IN EDIT MASK 00543000
CVD R2,SAVEWRK8 CONVERT TO DECIMAL 00544000
ED 6(LMASK,R9),SAVEWRK8+2 EDIT IT 00545000
AH R0,=AL2(LMASK+6) ADD LENGTH 00546000
TBAKDISP BAL R4,DISPLAY DISPLAY IT 00547000
LA R3,16(,R3) POINT TO NEXT ENTRY 00548000
BCT R6,TBAKLOOP LOOP THROUGH TABLE 00549000
BR R10 RETURN TO CALLER 00550000
TEMPTY MVC PERBUF(L'EMPTY),EMPTY MOVE IN MSG 00551000
LA R0,L'EMPTY POINT TO IT 00552000
BAL R4,DISPLAY DISPLAY IT 00553000
BR R10 AND RETURN TO CALLER 00554000
EJECT , 00555000
*---------------------------------------------------------------------* 00556000
* OUTPUT ROUTINE * 00557000
*---------------------------------------------------------------------* 00558000
DISPLAY LA R1,PERBUF POINT TO BUFFER 00559000
SLR R2,R2 CLEAR ATTN INDICATOR 00560000
L R15,SAVEWRK6 LOAD OUTPUT ROUTINE ADDR 00561000
SVC 8 CALL IT 00562000
LTR R2,R2 ATTN HIT? 00563000
BZR R4 NO, RETURN 00564000
OI SAVEWRK1,X'40' INDICATE ATTN HIT 00565000
BR R4 AND RETURN 00566000
EJECT , 00567000
*---------------------------------------------------------------------* 00568000
* ABENDS * 00569000
*---------------------------------------------------------------------* 00570000
SPACE 1 00571000
ABEND 3 00572000
ABEND 4 00573000
EJECT , 00574000
*---------------------------------------------------------------------* 00575000
* EXECUTED INSTRUCTIONS * 00576000
*---------------------------------------------------------------------* 00577000
MVCBUF MVC 0(*-*,R1),1(R2) EXECUTED MOVE 00578000
UNPKINST UNPK 6(*-*,R9),PERINST(*-*) EXECUTED UNPACK 00579000
UNPKISN2 UNPK 6(*-*,R9),3(*-*,R3) EXECUTED UNPACK 00580000
TRINSTR TR 6(*-*,R9),HEXBENT EXEUTED TRANSLATE 00581000
EJECT , 00582000
*---------------------------------------------------------------------* 00583000
* CONSTANTS * 00584000
*---------------------------------------------------------------------* 00585000
EMPTY DC C'TRACEBACK TABLE IS EMPTY' 00586000
TMSG DC C'TRACEBACK TABLE:' 00587000
MASK DC C' ',11X'20',C' TIMES' 00588000
LMASK EQU *-MASK-6 00589000
HEXBENT EQU *-C'0' 00590000
DC C'0123456789ABCDEF' 00591000
EJECT , 00592000
*---------------------------------------------------------------------* 00593000
* LITERALS * 00594000
*---------------------------------------------------------------------* 00595000
LTORG , 00596000
EJECT , 00597000
*---------------------------------------------------------------------* 00598000
* DSECTS AND EQUATES * 00599000
*---------------------------------------------------------------------* 00600000
SPACE 1 00601000
COPY CONBUF 00602000
COPY EQU 00603000
COPY PERBLOKS 00604000
PSA , 00605000
COPY SAVE 00606000
COPY VMBLOK 00607000
END DMKPED 00608000