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