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