PEC TITLE 'DMKPEC VM/370 VERSION 6, LEVEL 0' 00001000 COPY OPTIONS 00002000 COPY LOCAL 00003000 EJECT , 00004000 DMKPEC 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 DMKSCNFD,DMKCVTHB,DMKERMSG,DMKCVTBH,DMKCVTBD,DMKPERCH 00012000 EXTRN DMKPERT,DMKPEQRY,DMKPEDTB 00013000 SPACE 00014000 MODID DC CL8'DMKPEC' PAGEABLE MODULE IDENTIFIER 00015000 SPACE 00016000 DMKPECMD RELOC , COMMAND ENTRY FROM DMKCFM 00017000 XC SAVEWRK1(4),SAVEWRK1 CLEAR CHAIN POINTER 00018000 XC SAVEWRK2(4),SAVEWRK2 AND NEXT ONE 00019000 XC SAVEWRK3(4),SAVEWRK3 AND CLEAR FLAG AREA 00020000 MVI SAVEWRK3+1,X'FF' AND "AND" FLAGS 00021000 XC SAVEWRK4(4),SAVEWRK4 CLEAR STEP COUNT 00022000 XC SAVEWRK5(4),SAVEWRK5 CLEAR SKIP COUNT 00023000 L R8,VMPERCTL LOAD ADDR OF TRACE EXT BLOCK 00024000 * NOTE THAT IT IS NOT NECESARY FOR THE PERBLOK TO EXIST AT THIS POINT 00025000 EJECT 00026000 *---------------------------------------------------------------------* 00027000 * SCAN COMMAND LINE FOR KEYWORDS * 00028000 *---------------------------------------------------------------------* 00029000 PRCD001 EQU * 00030000 BAL R10,SCANIT POINT TO FIRST/NEXT KEYWORD 00031000 BNZ SCANDONE ALL DONE, GO CONSOLIDATE BLOCKS 00032000 CLI 0(R1),C'G' COULD IT BE A GPR KEYWORD? 00033000 BE GN YES, GO HANDLE IT 00034000 SCNLST LA R2,KWDLIST POINT TO KEYWORD LIST 00035000 SLR R3,R3 CLEAR A REGISTER FOR IC 00036000 LR R4,R0 MOVE FOR EX 00037000 BCTR R4,0 MINUS 1 FOR EX 00038000 FKWD CLM R4,B'0001',3(R2) LONG ENOUGH? 00039000 BL NXTKWD NO, NEXT KEYWORD 00040000 CLM R4,B'0001',4(R2) IS IT TOO LONG? 00041000 BH NXTKWD YES, LOOK AT NEXT ONE 00042000 EX R4,KWDCMP COMPARE 00043000 BE GOTKWD GOT IT, GO HANDLE 00044000 NXTKWD IC R3,4(,R2) INSERT LENGTH OF NAME -1 00045000 LA R2,6(R2,R3) POINT TO NEXT ENTRY 00046000 CLI 0(R2),X'FF' END OF LIST? 00047000 BNE FKWD NO, GO LOOK AT NEXT ONE 00048000 BAL R10,GETRNG SEE IF IS RANGE 00049000 BZ IMPRNG YES, IMPLICIT RANGE 00050000 B PRMERR1 OTHERWISE BAD KEYWORD 00051000 KWDCMP CLC 5(*-*,R2),0(R1) EXECUTED COMPARE 00052000 GOTKWD LH R4,0(,R2) LOAD OFFSET OF HANDLER 00053000 LTR R4,R4 ANY HANDLER FOR IT? 00054000 BZ PRMERR1 NO, ERROR 00055000 NI SAVEWRK3+3,255-X'20' TURN OF SCAN FLAG 00056000 B 0(R4,R12) AND GO TO IT 00057000 EJECT 00058000 *---------------------------------------------------------------------* 00059000 * IFETCH * 00060000 * - * 00061000 * IFETCH SPECIFIES A STOP FOR ALL INSTRUCTION FETCHES OR FOR A * 00062000 * PARTICULAR TYPE OF INSTRUCTION. IF ANY HEX STRING IS GIVEN A * 00063000 * STOP WILL OCCUR ONLY IF THE INSTRUCTION FETCHED MATCHES THE * 00064000 * GIVEN HEX STRING. * 00065000 *---------------------------------------------------------------------* 00066000 IFETCH EQU * HANDLE IFETCH AND STORE 00067000 SLR R3,R3 CLEAR FOR LATER 00068000 LR R4,R3 AND THIS ALSO 00069000 BAL R10,GETXSTR TRY FOR A HEX STRING 00070000 BNZ IFGET NONE, GO GET BLOK 00071000 ICOMM NI SAVEWRK3+3,255-X'20' OK, THEN RESET SCAN FLAG. 00072000 LR R5,R0 SAVE LENGTH FOR LATER 00073000 LR R4,R1 AND ADDR 00074000 LA R3,7(,R5) ROUND UP 00075000 CLI 2(R2),PEXMASK IS IT A MASK STOP? 00076000 BNE *+6 NO, SKIP ADD 00077000 ALR R3,R5 YES, THEN NEED SPACE FOR OLD VAL 00078000 SRL R3,3 AND GET DWORDS 00079000 IFGET LA R0,PEXSIZE(,R3) LOAD LENGTH NEEDED 00080000 CALL DMKFREE GO GET A BLOCK OF STORAGE 00081000 XC 0(PEXSIZE*8,R1),0(R1) CLEAR BLOK 00082000 STM R6,R7,PEXADDR3-PEXBLOK(R1) SAVE STORE RANGES 00083000 LR R7,R1 MOVE FOR ADDRESSABILITY 00084000 STC R0,PEXLEN SAVE LENGTH OF BLOK 00085000 MVC PEXFLAGT(1),2(R2) MOVE IN TYPE FLAG 00086000 LTR R4,R4 WAS THERE ANY DATA? 00087000 BZ CHAINI NO, GO CHAIN BLOCK ON 00088000 LA R2,PEXDATA POINT TO DATA AREA 00089000 LR R3,R5 MOVE LENGTH 00090000 STC R3,PEXDLEN SAVE LENGTH 00091000 LR R0,R3 MOVE LENGTH 00092000 LR R1,R4 MOVE ADDR 00093000 MVCL R2,R4 MOVE INTO BLOK 00094000 AL R0,F7 ROUND UP 00095000 SRL R0,3 GET DWORDS 00096000 CALL DMKFRET FRET BLOK 00097000 CLI PEXFLAGT,PEXMASK IS IT A MASK STOP? 00098000 BNE CHAINI NO, THEN ARE DONE 00099000 TM VMESTAT,VMEXTCM IS MACHINE IN EC MODE? 00100000 BNO GETDATA NO, GO GET DATA 00101000 TM VMPSW,TRANMODE IS TRANSLATE ON? 00102000 BNO GETDATA NO, GO GET DATA 00103000 MAKEINVA OI PEXFLAGO,PEXDATAI YES, THEN MARK DATA AS INVALID 00104000 B CHAINI AND GO CHAIN ON 00105000 GETDATA L R3,PEXADDR3 LOAD ADDRESS 00106000 SLR R1,R1 CLEAR R1 FOR IC 00107000 IC R1,PEXDLEN INSERT LENGTH 00108000 BCTR R1,0 MINUS 1 00109000 LR R5,R1 SAVE IN R5 00110000 ALR R1,R3 POINT TO LAST BYTE 00111000 N R1,XPAGNUM ROUND DOWN TO 4K BOUNDRY 00112000 CLR R1,R3 IS IT WITHIN 1 4K PAGE? 00113000 BH TWOMOV NO, WILL HAVE TO DO IN TWO PIECES 00114000 LR R1,R3 MOVE ADDRESS TO R1 00115000 BAL R10,GETPAGE GO GET PAGE 00116000 BNZ MAKEINVA NOT AVAIL, GO MAKE INVALID 00117000 LA R4,PEXDATA+1(R5) POINT TO PLACE TO PUT IT 00118000 EX R5,MASKMVC1 MOVE INTO AREA 00119000 B CHAINI AND GO CHAIN ON 00120000 TWOMOV SLR R6,R6 CLEAR FLAG REG 00121000 LR R1,R3 MOVE ADDRRESS 00122000 BAL R10,GETPAGE TRY TO GET REAL ADDRESS 00123000 BNZ TWOMOV1 NOT AVAIL, TRY FOR SECOND PART ANYWAY 00124000 LA R1,0(R3,R5) POINT TO LAST BYTE 00125000 N R1,XPAGNUM TRUNCATE DOWN 00126000 BCTR R1,0 MINUS 1 00127000 SLR R1,R3 GET LENGTH 00128000 LA R4,PEXDATA+1(R5) POINT TO DATA AREA 00129000 EX R1,MASKMVC1 MOVE DATA IN 00130000 BCTR R6,0 SET FLAG REG 00131000 TWOMOV1 LA R1,0(R3,R5) POINT TO LAST BYTE 00132000 N R1,XPAGNUM TRUNCATE DOWN 00133000 SLR R3,R1 GET LENGTH OF FIRST PART 00134000 LPR R3,R3 ... 00135000 BAL R10,GETPAGE TRY TO GET PAGE 00136000 BZ DOMOV1 GO MOVE DATA IN 00137000 LTR R6,R6 DID WE GET ANYTHING? 00138000 BZ MAKEINVA NO, GO TURN ON INVALID BIT 00139000 B CHAINI YES, GO CHAIN ON 00140000 DOMOV1 BCTR R6,0 SET FLAG REG 00141000 LA R4,PEXDATA+1(R5) POINT TO DATA AREA 00142000 LA R4,0(R4,R3) POINT TO SECOND PART 00143000 SLR R5,R3 AND GET LENGTH OF SECOND PART 00144000 EX R5,MASKMVC1 AND MOVE IT IN 00145000 CHAINI MVC PEXNEXT(4),SAVEWRK1 MOVE IN POINTER 00146000 ST R7,SAVEWRK1 AND CHAIN ON 00147000 OI SAVEWRK3+3,X'40' INDICATE CHANGES MADE 00148000 LA R1,1 AND WHILE WE ARE AT IT, INIT 00149000 ST R1,PEXSTEP STEP 00150000 ST R1,PEXSTEPN ... 00151000 ST R1,PEXSKIP AND SKIP 00152000 ST R1,PEXSKIPN ... 00153000 B PRCD001 GO FOR NEXT KEYWORD 00154000 MASKMVC1 MVC 0(*-*,R4),0(R2) EXECUTED MOVE 00155000 EJECT 00156000 *---------------------------------------------------------------------* 00157000 * BRANCH * 00158000 * - * 00159000 * BRANCH SPECIFIES A STOP FOR EITHER SUCCESSFULL BRANCHES OR FOR * 00160000 * A BRANCH INTO AN ADDRESS OR RANGE OF ADDRESSES. IF NO RANGE * 00161000 * IS SPECIFIED, A STOP WILL OCCUR AFTER A SUCCESFULL BRANCH. IF * 00162000 * A RANGE IS SPECIFIED, A STOP WILL OCCUR FOR A BRANCH INTO THAT * 00163000 * RANGE AND A TRACEBACK OF THE LAST 5 SUCCESSFUL BRANCHES WILL BE * 00164000 * DISPLAYED. * 00165000 *---------------------------------------------------------------------* 00166000 BRANCH EQU * HANDLE BRANCH KEYWORD 00167000 LA R6,1 SET FLAG REGISTER 00168000 SLR R4,R4 CLEAR RANGE 00169000 LR R5,R4 ... 00170000 BAL R10,GETRNG TRY TO GET A RANGE 00171000 BNZ GTBRBK NO, GO GET BLOK 00172000 NI SAVEWRK3+3,255-X'20' TURN OFF SCAN FLAG 00173000 LR R6,R4 CLEAR FLAG REG 00174000 LR R4,R0 MOVE FIRST ADDR 00175000 LR R5,R1 AND SECOND 00176000 GTBRBK LA R0,PEXSIZE LOAD SIZE OF BLOK 00177000 CALL DMKFREE GET SPACE FOR IT 00178000 LR R7,R1 POINT TO IT 00179000 XC PEXBLOK(PEXSIZE*8),PEXBLOK CLEAR TO ZEROS 00180000 STC R0,PEXLEN SAVE LENGTH 00181000 MVI PEXFLAGT,PEXBR SET BRANCH FLAG 00182000 LTR R6,R6 WAS THERE A RANGE? 00183000 BNZ CHAINI NO, GO CHAIN ON 00184000 STM R4,R5,PEXADDR3 SAVE RANGE 00185000 MVI PEXFLAGT,PEXBRTB SET TYPE TO TRACEBACK 00186000 B CHAINI AND GO CHAIN ON 00187000 EJECT 00188000 *---------------------------------------------------------------------* 00189000 * STORE
* 00190000 * -- * 00191000 * STORE SPECIFIES A STOP FOR ALL STORAGE ALTERATIONS OR FOR AN * 00192000 * ALTERATION OF A GIVEN ADDRESS TO A GIVEN VALUE. IF NO PARMS * 00193000 * ARE GIVEN A STOP WILL OCCUR FOR ALL STORE EVENTS, BUT IF THE * 00194000 * PARAMETERS ARE GIVEN A STOP WILL OCCUR ONLY IF THE GIVEN * 00195000 * ADDRESS IS ALTERED TO THE GIVEN VALUE OR IF THE PARAMETER WAS * 00196000 * A RANGE, A STOP WILL OCCUR ONLY IF THE STORE IS MADE INTO * 00197000 * THAT RANGE. * 00198000 *---------------------------------------------------------------------* 00199000 STORE EQU * 00200000 SLR R3,R3 CLEAR FOR LATER 00201000 LR R4,R3 AND THIS ALSO 00202000 LR R6,R3 AND DEFAULT LOW RANGE 00203000 L R7,XRIGHT24 AND LOAD HIGH RANGE 00204000 BAL R10,GETRNG TRY FOR A RANGE 00205000 BNZ IFGET GO JOIN COMMON IFETCH CODE 00206000 NI SAVEWRK3+3,255-X'20' MARK PARM AS USED 00207000 LR R6,R0 MOVE LOW 00208000 LR R7,R1 AND HIGH 00209000 CLR R7,R6 SHOULD WE TRY FOR HEX STRING? 00210000 BNE IFGET NO, GO JOIN COMMON 00211000 BAL R10,GETXSTR TRY FOR A HEX STRING 00212000 BNZ IFGET NONE, GO JOIN COMMON 00213000 ALR R7,R0 ADD LENGTH 00214000 BCTR R7,0 MINUS 1 00215000 B ICOMM AND GO JOIN COMMON IFETCH CODE 00216000 EJECT 00217000 *---------------------------------------------------------------------* 00218000 * MASK ADDRESS HEXDATA * 00219000 * - * 00220000 * MASK SPECIFIES A STOP FOR AN ALTERATION OF BITS AT A GIVEN * 00221000 * GIVEN ADDRESS SPECIFIED BY THE GIVEN MASK. * 00222000 *---------------------------------------------------------------------* 00223000 MASK EQU * 00224000 BAL R10,GETRNG TRY FOR A RANGE 00225000 BNZ PRMERR2 NONE, ERROR 00226000 CLR R0,R1 BETTER BE THE SAME 00227000 BNE PRMERR2 GO PUT OUT EMSG 00228000 LR R6,R1 MOVE ADDR 00229000 LR R7,R1 AND HERE ALSO 00230000 NI SAVEWRK3+3,255-X'20' MARK PARM AS USED 00231000 BAL R10,GETXSTR BETTER BE A HEX STRING 00232000 BNZ PRMERR2 NO, ERROR 00233000 ALR R7,R0 ADD LENGTH 00234000 BCTR R7,0 MINUS 1 00235000 B ICOMM AND JOIN COMMON 00236000 EJECT 00237000 *---------------------------------------------------------------------* 00238000 * PAGETRACE * 00239000 * -- * 00240000 * PAGETRACE CAUSES A TIME STAMPED STOP TO OCCUR EACH TIME A NEW * 00241000 * SECTION OF STORAGE IS ENTERED. IF PAGE-SIZE IS SPECIFIED THEN * 00242000 * STORAGE IS DIVIDED UP INTO SECTIONS OF THAT SIZE AND A STOP * 00243000 * OCCURS EACH TIME A NEW SECTION IS ENTERED. IF THE PAGE-SIZE IS * 00244000 * NOT GIVEN, THE SECTIONS OF CORE WILL BE DEFINED BY THE RANGE * 00245000 * MODIFIERS. * 00246000 *---------------------------------------------------------------------* 00247000 PAGETR EQU * HERE TO HANDLE PAGE TRACE ELEMENT 00248000 SLR R4,R4 CLEAR R4 00249000 BAL R10,GETDEC TRY FOR A DECIMAL PARM 00250000 BZ PAGEGOT YES, GOT IT 00251000 CL R0,F1 ONLY ONE CHARACTER UNSCANNED? 00252000 BH NOPAGE NO, CAN'T BE NNNK 00253000 CLI 0(R1),C'K' WAS IT A K? 00254000 BNE NOPAGE NO, NO PAGE SPECIFIED 00255000 LM R0,R1,SAVEWRK6 RELOAD SCAN PARMS 00256000 LR R15,R0 MOVE TO R15 00257000 S R15,F2 DECREMENT BY 2 00258000 BL NOPAGE NO PAGESIZE ONLY K PRESENT 00259000 EX R15,PACKIT PACK IT 00260000 CVB R1,SAVEWRK8 CONVERT TO BINARY 00261000 CH R1,=H'16384' TOO BIG? 00262000 BH NOPAGE YES, NO PAGE 00263000 SLL R1,10 SHIFT 00264000 PAGEGOT LR R4,R1 MOVE PARM TO SAFE REGISTER 00265000 C R4,XRIGHT24 TOO BIG? 00266000 BH NOPAGE YES, NO PAGESIZE 00267000 NI SAVEWRK3+3,255-X'20' TURN OFF SCAN FLAG 00268000 NOPAGE LA R0,PEXSIZE LOAD LENGTH OF BLOK 00269000 CALL DMKFREE AND GET SPACE 00270000 LR R7,R1 MOVE FOR ADDRESSABILITY 00271000 XC PEXBLOK(PEXSIZE*8),PEXBLOK CLEAR TO ZEROS 00272000 STC R0,PEXLEN SAVE BLOCK LENGTH 00273000 MVC PEXADDR4(4),XRIGHT24 MOVE INITIAL ADDR 00274000 MVI PEXFLAGT,PEXPGT FLAG AS PAGE TRACE 00275000 ST R4,PEXINCR SAVE INCREMENT 00276000 B CHAINI 00277000 EJECT 00278000 *---------------------------------------------------------------------* 00279000 * GREGN * 00280000 * - * 00281000 * GREG SPECIFIES A STOP FOR EITHER ALL REGISTERS, OR A PARTICULAR * 00282000 * REGISTER. IF N IS SPECIFIED (EITHER HEX OR DECIMAL). IF ANY HEX * 00283000 * DATA IS SPECIFIED A STOP WILL OCCUR ONLY WHEN THE REGISTER OR * 00284000 * OR REGISTERS ARE CHANGED TO THAT VALUE. A STOP WILL NOT OCCUR * 00285000 * IF THE VALUE AFTER THE CHANGE IS THE SAME AS BEFORE THE CHANGE. * 00286000 *---------------------------------------------------------------------* 00287000 GN EQU * HANDLE GN KEYWORD 00288000 CL R0,F4 LENGTH GREATER THAN 4? 00289000 BH SCNLST YES, GO CHECK FOR KEYWORDS FIRST 00290000 CL R0,F1 LESS THAN 2? 00291000 BE SCNLST YES, THEN CONTINUE SCAN 00292000 LA R1,1(,R1) POINT TO SECOND CHAR 00293000 BCTR R0,0 MINUS 1 00294000 CALL DMKCVTHB GO TRY TO CONVERT 00295000 BZ GOTGR GOT REG, GO CHECK IT 00296000 RETREG LM R0,R1,SAVEWRK6 GET REGS BACK 00297000 B SCNLST GO DO SCAN 00298000 GOTGR CH R1,=H'21' GREATER THAN X'15'? 00299000 BH RETREG YES, NOT GN PARM THEN 00300000 NI SAVEWRK3+3,255-X'20' INDICATE ACCEPT PARM 00301000 CL R1,F15 TOO HIGH? 00302000 BNH *+8 NO, SKIP SL 00303000 SL R1,F6 SUBTRACT 6 00304000 LA R4,1 LOAD A 1 00305000 SLL R4,15 SHIFT IT OVER 00306000 SRL R4,0(R1) SHIFT TO PROPER POSITION 00307000 B TRYGDAT GO SEE IF ANY DATA 00308000 GPRS L R4,FFS LOAD FLAGS FOR ALL REGS 00309000 TRYGDAT SLR R2,R2 CLEAR FLAG REGISTER 00310000 BAL R10,GETHXWD GO TRY FOR A HEX WORD 00311000 BNZ GETGBLK NONE, GO GET BLOCK 00312000 NI SAVEWRK3+3,255-X'20' OK, THEN RESET SCAN FLAG 00313000 LR R3,R1 SAVE DATA 00314000 LA R2,1 LOAD FLAG REG 00315000 GETGBLK LA R0,PEXSIZE(R2) LOAD SIZE OF BLOK 00316000 CALL DMKFREE GET SPACE FOR IT 00317000 LR R7,R1 MOVE SO CAN ADDRESS 00318000 XC PEXBLOK(PEXSIZE*8),PEXBLOK CLEAR 00319000 STC R0,PEXLEN SAVE LENGTH 00320000 MVI PEXFLAGT,PEXGPR FLAG AS GPR TRAP 00321000 STH R4,PEXGREG SAVE REGISTER FLAGS 00322000 LTR R2,R2 IS IT A DATA STOP? 00323000 BZ CHAINI GO CHAIN ON 00324000 ST R3,PEXDATA SAVE DATA 00325000 MVI PEXDLEN,4 SET DATA LENGTH 00326000 B CHAINI GO CHAIN ON 00327000 EJECT 00328000 *---------------------------------------------------------------------* 00329000 * SKIP DEC-NUMBER * 00330000 * -- * 00331000 * IF SKIP IS SPECIFIED IT CAUSES ONLY EVERY NTH STOP TO BE * 00332000 * DISPLAYED, WHERE DEC-NUMBER SPECIFIES THE NUMBER OF STOPS TO * 00333000 * BE IGNORED BETWEEN DISPLAYS. * 00334000 * * 00335000 * STEP DEC-NUMBER * 00336000 * --- * 00337000 * IF STEP IS SPECIFIED CF MODE WILL BE ENTERED ONLY AFTER THE * 00338000 * NUMBER OF DISPLAYS SPECIFIED BY DEC-NUMBER HAVE OCCURED. * 00339000 *---------------------------------------------------------------------* 00340000 SKIPK EQU * HANDLE SKIP AND STEP 00341000 OI SAVEWRK3+3,X'40' INDICATE CHANGES MADE 00342000 SLR R3,R3 CLEAR R3 FOR IC 00343000 IC R3,2(,R2) INSERT OFFSET 00344000 BAL R10,GETDEC TRY TO GET DECIMAL PARM 00345000 BNZ PRMERR2 NONE, TOO BAD 00346000 LTR R1,R1 LESS THAN 1? 00347000 BNH PRMERR2 YES, INVALID 00348000 NI SAVEWRK3+3,255-X'20' TURN OFF SCAN FLAG 00349000 ST R1,SAVEAREA(R3) SAVE COUNT 00350000 B PRCD001 GO FOR NEXT KEYWORD 00351000 EJECT 00352000 *---------------------------------------------------------------------* 00353000 * RUN * 00354000 * -- * 00355000 * IF RUN IS SPECIFIED CF MODE WILL NOT BE ENTERED AFTER EACH * 00356000 * DISPLAY, IT IS EQUIVILENT TO A STEP OF INFINITY. * 00357000 * * 00358000 * PRINT * 00359000 * -- * 00360000 * IF PRINT IS SPECIFIED, OUTPUT WILL BE DIRECTED TO THE PRINTER * 00361000 * * 00362000 * TERMINAL * 00363000 * -- * 00364000 * IF SPECIFIED, OUTPUT WILL BE DIRECTED TO THE TERMINAL. THIS IS * 00365000 * THE NORMAL DEFAULT, BUT MAY BE USED TO ALTER A PREEXISTING * 00366000 * TRACE ELEMENT WHERE THE OUTPUT WAS DIRECTED ELSEWHERE * 00367000 *---------------------------------------------------------------------* 00368000 FLAGON EQU * HANDLE PRINT, TERMINAL, RUN 00369000 OI SAVEWRK3+3,X'40' INDICATE CHANGES MADE 00370000 OC SAVEWRK3(1),2(R2) TURN ON FLAGS 00371000 MVC SAVEWRK3+2(1),2(R2) MOVE ALSO TO WORKAREA 00372000 NC SAVEWRK3+2(1),SAVEWRK3+1 HAD IT BEEN TURNED OFF ALREADY? 00373000 BZ CONFLICT YES, CONFLICTING OPTIONS 00374000 B PRCD001 GO GET NEXT KEYWORD 00375000 EJECT 00376000 *---------------------------------------------------------------------* 00377000 * NORUN * 00378000 * --- * 00379000 * IF RUN HAD BEEN SPECIFIED FOR A TRACE ELEMENT NORUN WILL RESET * 00380000 * IT SO THAT CF MODE WILL BE ENTERED AFTER DISPLAYS. * 00381000 * * 00382000 * NOPRINT * 00383000 * --- * 00384000 * IF PRINT HAD BEEN SPECIFIED FOR A TRACE ELEMENT, NOPRINT WILL * 00385000 * RESET IT AND STOP OUTPUT TO THE PRINTER FOR THAT ELEMENT. * 00386000 * * 00387000 * NOTERMINAL * 00388000 * --- * 00389000 * NOTERMINAL WILL CAUSE TERMINAL OUTPUT FOR A GIVEN TRACE ELEMENT * 00390000 * TO BE SUPPRESSED. * 00391000 * * 00392000 * NOTE: IF BOTH NOTERMINAL AND NOPRINT ARE IN EFFECT FOR A TRACE * 00393000 * ELEMENT, THAT TRACE ELEMENT IS DELETED. * 00394000 *---------------------------------------------------------------------* 00395000 FLAGOFF EQU * HANDLE NOPRINT, NOTERMINAL, NORUN 00396000 OI SAVEWRK3+3,X'40' INDICATE CHANGESS MADE 00397000 NC SAVEWRK3+1(1),2(R2) TURN OFF FLAG 00398000 MVC SAVEWRK3+2(1),2(R2) MOVE TO WORKAREA 00399000 XI SAVEWRK3+2,X'FF' TOGGLE THE BITS 00400000 NC SAVEWRK3+2(1),SAVEWRK3 HAD IT PREVIOUSLY BEEN TURNED O 00401000 BNZ CONFLICT YES, CONFLICTING OPTIONS 00402000 B PRCD001 GO GET NEXT KEYWORD 00403000 EJECT 00404000 *---------------------------------------------------------------------* 00405000 * RANGE ADDRESS-RANGE * 00406000 * - * 00407000 * THE RANGE KEYWORD IS USED TO MODIFY THE EFFECT OF THE OTHERS BY * 00408000 * LIMITING THE RANGE OVER WHICH THEY ARE IN EFFECT. THE RANGE * 00409000 * GIVEN MAY BE WRAP-AROUND. THIS ROUTINE MAY ALSO BE ENTERED AT * 00410000 * IMPRNG IF A KEYWORD WAS UNRECOGNIZED AND COULD BE A RANGE. THIS * 00411000 * HAS THE EFFECT OF ALLOWING AN ABBREVIATION OF ZERO CHARACTERS * 00412000 * FOR THE RANGE KEYWORD. * 00413000 *---------------------------------------------------------------------* 00414000 RANGE EQU * HANDLE RANGE KEYWORD 00415000 BAL R10,GETRNG TRY FOR A RANGE 00416000 BNZ PRMERR2 NONE, BAD NEWS 00417000 IMPRNG NI SAVEWRK3+3,255-X'20' INDICATE PARM ACCEPTED 00418000 OI SAVEWRK3+3,X'40' INDICATE CHANGES MADE 00419000 LR R4,R0 MOVE IT OVER 00420000 LR R5,R1 ... 00421000 LA R0,2 WE WANT 2 DOUBLE WORDS 00422000 CALL DMKFREE AND GO GET IT 00423000 STM R4,R5,4(R1) SAVE RANGE IN BLOK 00424000 CHAINR LA R3,SAVEWRK2 POINT TO CHAIN OF RANGE BLOKS 00425000 CRLP ICM R4,B'1111',0(R3) POINT TO NEXT (IF ANY) 00426000 BZ CHONR END OF CHAIN, GO CHAIN IT ON 00427000 LR R3,R4 PUT INTO R3 00428000 B CRLP AND GO FOR NEXT 00429000 CHONR ST R1,0(,R3) CHAIN ON 00430000 ST R4,0(,R1) AND ZERO FORWARD POINTER 00431000 B PRCD001 GO BACK TOO PROCESS NEXT KEYWORD 00432000 EJECT 00433000 *---------------------------------------------------------------------* 00434000 * CMD COMMANDS * 00435000 * -- * 00436000 * CMD ALLOWS ONE OR MORE CP COMMANDS TO BE ASSOCIATED WITH A PER * 00437000 * TRAP. WHEN THE PER TRAP IS SATISFIED THE COMMANDS WILL BE * 00438000 * EXECUTED. TO ALLOW MORE THAN ONE COMMAND, THE COMMANDS MUST * 00439000 * BE SEPERATED BY ; SINCE ALL THAT FOLLOWS THE CMD KEYWORD WILL * 00440000 * BE TREATED AS A COMMAND TO BE EXECUTED. * 00441000 *---------------------------------------------------------------------* 00442000 CF EQU * 00443000 BAL R10,SCANIT SEE IF ANY MORE ON LINE 00444000 BNZ PRMERR2 NO, ERROR 00445000 OI SAVEWRK3+3,X'40' INDICATE ACTION NEEDED 00446000 LR R5,R1 SAVE ADDR 00447000 CFLP1 CALL DMKSCNFD SCAN FOR MORE 00448000 BZ CFLP1 CONTINUE SCAN 00449000 ALR R1,R0 POINT PAST END 00450000 SLR R1,R5 GET LENGTH 00451000 LR R4,R1 AND MOVE TO R4 00452000 LA R0,8(,R4) ROUND UP 00453000 SRL R0,3 GET DWORDS 00454000 CALL DMKFREE GO FREE LINE 00455000 STC R4,0(,R1) SAVE LENGTH IN BUFFER 00456000 BCTR R4,0 MINUS 1 00457000 EX R4,SAVBUF MOVE TO BUFFER 00458000 ST R1,SAVEWRK6 SAVE POINTER 00459000 LA R4,1(,R4) ADD 1 FOR BCT 00460000 CFEOLLP CLI 1(R1),C';' SEMICOLEN? 00461000 BNE *+8 NO, SKIP MVI 00462000 MVI 1(R1),X'15' THEN MAKE IT NL CHARACTER 00463000 LA R1,1(,R1) POINT TO NEXT 00464000 BCT R4,CFEOLLP AND GO BACK TO CHECK FOR MORE 00465000 OI SAVEWRK3+3,X'10'+X'04' INDICATE EOL AND SAVED CF 00466000 B PRCD001 AND GO BACK TO MAIN LOOP 00467000 SAVBUF MVC 1(*-*,R1),0(R5) MOVE LINE TO BUFFER 00468000 EJECT 00469000 *---------------------------------------------------------------------* 00470000 * DUMP * 00471000 * - * 00472000 * DUMP CAUSES THE CONTENTS OF THE TRACEBACK TABLE (IF ANY) TO BE * 00473000 * DISPLAYED AT THE CONSOLE. * 00474000 *---------------------------------------------------------------------* 00475000 DUMP EQU * 00476000 CALL DMKPEDTB GO DISPLAY TABLE 00477000 B PRCD001 GO FOR MORE 00478000 B PRCD001 GO BACK FOR MORE 00479000 EJECT 00480000 *---------------------------------------------------------------------* 00481000 * SAVE TRACE-NAME * 00482000 * -- * 00483000 * THE SAVE KEYWORD WILL CAUSE THE CURRENT TRACE SET TO BE SAVED * 00484000 * UNDER THE SPECIFIED NAME. IF A TRACE SET OF THAT NAME ALREADY * 00485000 * EXISTS, IT WILL BE FRET'D. * 00486000 *---------------------------------------------------------------------* 00487000 SAVE EQU * 00488000 LTR R8,R8 ANY PERBLOK? 00489000 BNH NOSAVE NO, GIVE EMSG 00490000 ICM R7,B'1111',PERCHAIN LOAD CHAIN POINTER 00491000 BZ NOSAVE NO CHAIN, GO GIVE EMSG 00492000 BAL R10,GETPES SEE IF ONE ALREADY EXISTS 00493000 BNZ MAKEPES NO, THEN WE'LL JUST HAVE TO MAKE ONE 00494000 LA R6,PESCHAIN-PESBLOK(,R1) POINT TO CHAIN TO COPY INTO 00495000 LA R7,PERCHAIN AND TO CHAIN TO COPY FROM 00496000 B SGCOMM AND GO JOIN COMMON CODE 00497000 MAKEPES BAL R10,SCANIT IS THERE A PARAMETER? 00498000 BNZ PRMERR2 NO, ERROR 00499000 CL R0,F1 ONE CHAR? 00500000 BNE NOTAST NO, THEN IS OK 00501000 CLI 0(R1),C'*' IS IT AN ASTERISK? 00502000 BE PRMERR2 YES, INVALID NAME 00503000 NOTAST CL R0,F8 IS IT SHORT ENOUGH 00504000 BH PRMERR2 NO, GIVE EMSG 00505000 LR R2,R0 SAVE LENGTH 00506000 LR R3,R1 AND ADDRESS 00507000 LA R0,PESSIZE LOAD SIZE OF PESBLOK 00508000 CALL DMKFREE AND GO GET ONE 00509000 MVC PESCHAIN-PESBLOK(4,R1),ZEROES CLEAR CHAIN POINTER 00510000 MVC PESNEXT-PESBLOK(4,R1),PERSAVED MOVE IN FORWARD POINT 00511000 ST R1,PERSAVED AND CHAIN IT ON 00512000 MVC PESNAME-PESBLOK(8,R1),BLANKS MOVE IN BLANKS 00513000 BCTR R2,0 MINUS 1 FOR EX 00514000 EX R2,SAVMVC MOVE IN NAME 00515000 LA R7,PERCHAIN POINT TO CHAIN TO COPY 00516000 LA R6,PESCHAIN-PESBLOK(,R1) AND PLACE TO PUT IT 00517000 B SGCOMM1 SKIP TRYING TO FRET CHAIN 00518000 SAVMVC MVC PESNAME-PESBLOK(*-*,R1),0(R3) EXECUTED MOVE 00519000 SGCOMM L R2,0(,R6) LOAD FORWARD POINTER 00520000 SGCL1 LTR R1,R2 MOVE AND TEST 00521000 BZ SGCOMM1 NO MORE, GO DO COPY 00522000 L R2,PEXNEXT-PEXBLOK(,R2) POINT TO NEXT 00523000 BAL R10,FRETPEX GO FRET PEXBLOK 00524000 B SGCL1 AND TRY FOR NEXT 00525000 SGCOMM1 L R7,0(,R7) LOAD POINTER 00526000 NI SAVEWRK3+3,255-X'20' AND INDICATE ACCEPTED PARM 00527000 SGCLP1 LTR R7,R7 ANY MORE? 00528000 BZ PRCD001 NO, ALL DONE 00529000 BAL R10,COPYPEX COPY THE PEXBLOK 00530000 ST R1,PEXNEXT-PEXBLOK(,R6) CHAIN IT ON 00531000 LR R6,R1 AND MOVE POINTER 00532000 L R7,PEXNEXT POINT TO NEXT BLOK 00533000 B SGCLP1 AND GO COPY IT 00534000 EJECT 00535000 *---------------------------------------------------------------------* 00536000 * GET TRACE-NAME * 00537000 * --- * 00538000 * GET WILL CAUSE THE CURRENT TRACE SET TO BE REPLACED BY THE * 00539000 * NAMED TRACE SET SPECIFIED. * 00540000 *---------------------------------------------------------------------* 00541000 GET EQU * 00542000 LTR R8,R8 ANY PERBLOK? 00543000 BNH PRMERR2 NO, GIVE EMSG 00544000 BAL R10,GETPES TRY FOR A TRACE SET NAME 00545000 BNZ PRMERR2 GO GIVE EMSG 00546000 OI SAVEWRK3+3,X'40' INDICATE NEED TO RECOMPUTE CREGS 00547000 LA R7,PESCHAIN-PESBLOK(,R1) POINT TO SOURCE CHAIN 00548000 LA R6,PERCHAIN AND TO SINK CHAIN 00549000 B SGCOMM AND GO JOIN COMMON CODE 00550000 EJECT 00551000 *---------------------------------------------------------------------* 00552000 * CLEAR * 00553000 * - * 00554000 * CLEAR WILL CAUSE EITHER THE CURRENT TRACE SET OR A SAVED TRACE * 00555000 * SET TO BE CLEARED. IF THE PARAMETER FOLLOWING CLEAR IS A VALID * 00556000 * SAVED TRACE SET NAME, THAT TRACE SET WILL BE CLEARED, OTHERWISE * 00557000 * THE CURRENT TRACE SET WILL BE CLEARED. * 00558000 *---------------------------------------------------------------------* 00559000 CLEAR EQU * HERE TO HANDLE CLEAR REQUEST 00560000 LTR R8,R8 ANY PERBLOK? 00561000 BNH PRCD001 NO, JUST CONTINUE 00562000 BAL R10,GETPES SEE IF HAVE TRACE SET NAME 00563000 BNZ CLRCUR NO, GO CLEAR CURRENT SET 00564000 NI SAVEWRK3+3,255-X'20' INDICATE PARM ACCEPTED 00565000 L R7,PESCHAIN-PESBLOK(,R1) LOAD CHAIN POINTER 00566000 L R2,PERSAVED LOAD CHAIN POINTER 00567000 LA R3,PERSAVED AND PLACE FOR BACK CHAIN 00568000 REPESL CLR R1,R2 IS THIS THE ONE? 00569000 BE PESUNC YES, GO UNCHAIN 00570000 LR R3,R2 MOVE FOR BACK CHAIN 00571000 L R2,PESNEXT-PESBLOK(,R2) LOAD FORWARD POINTER 00572000 B REPESL AND KEEP LOOKING 00573000 PESUNC MVC PESNEXT-PESBLOK(4,R3),PESNEXT-PESBLOK(R2) UNCHAIN 00574000 LA R0,PESSIZE LOAD SIZE 00575000 CALL DMKFRET FRET PESBLOK 00576000 B CLLOOP GO CLEAR CHAIN 00577000 CLRCUR L R7,PERCHAIN POINT TO CHAIN OF PEXBLOKS 00578000 OI SAVEWRK3+3,X'40' INDICATE NEED TO RECOMPUTE CREGS 00579000 XC PERCHAIN(4),PERCHAIN AND CLEAR POINTER 00580000 TM VMPSW+1,EXTMODE IN EXTENDED MODE? 00581000 BNO RESETPND NO, PREVENT POSSIBLE PER INT 00582000 TM VMPSW,PERMODE USER PER ON? 00583000 BO CLLOOP YES, DON'T RESET PENDING PER 00584000 RESETPND NI VMPEND,255-VMPERPND RESET POSSIBLE PENDING PER 00585000 CLLOOP LTR R7,R7 ANY MORE? 00586000 BZ PRCD001 GO FOR NEXT KEYWORD IF NOT. 00587000 LR R1,R7 MOVE POINTER 00588000 L R7,PEXNEXT POINT TO NEXT 00589000 BAL R10,FRETPEX AND FRET THE BLOK 00590000 B CLLOOP AND GO HANDLE 00591000 EJECT 00592000 *---------------------------------------------------------------------* 00593000 * OFF * 00594000 * --- * 00595000 * OFF CAUSES THE EFFECTS OF THE OTHER MODIFIERS TO BE REVERSED. * 00596000 *---------------------------------------------------------------------* 00597000 OFF EQU * 00598000 OI SAVEWRK3+3,X'08'+X'40' TURN ON OFF AND ACTION FLAGS 00599000 B PRCD001 GO BACK FOR MORE 00600000 EJECT 00601000 *---------------------------------------------------------------------* 00602000 * END * 00603000 * -- * 00604000 * END CAUSES COMMAND PROCCESING TO TERMINATE, ALL TRACE SET TO BE * 00605000 * FRET'D AND THE CURRENT TRACE TO BE FRET'D AND IMMEDIATE RETURN * 00606000 * TO THE CALLER. * 00607000 *---------------------------------------------------------------------* 00608000 END EQU * 00609000 CALL DMKPERT RESET TRACE 00610000 NI SAVEWRK3+3,255-X'80' DEQUEUE QUERY 00611000 SLR R8,R8 CLEAR R8 00612000 B EXIT GO EXIT 00613000 EJECT 00614000 *---------------------------------------------------------------------* 00615000 * QUERY * 00616000 * - * 00617000 * QUERY REQUESTS A DISPLAY OF THE CURRENT OR A SAVED TRACE SET. * 00618000 * IF THE PARAMETER FOLLOWING THE QUERY KEYWORD IS THE NAME OF A * 00619000 * SAVED TRACE SET, THAT TRACE SET WILL BE DISPLAYED, OTHERWISE * 00620000 * THE CURRENT TRACE SET WILL BE DISPLAYED AFTER THE COMMAND IS * 00621000 * FINISHED BEING PROCESSED. IF THE NAME GIVEN IS AN * THE NAMES * 00622000 * OF THE SAVED TRACE SETS WILL BE DISPLAYED. * 00623000 *---------------------------------------------------------------------* 00624000 QUERY EQU * HERE FOR QUERY COMMAND 00625000 LTR R8,R8 ANY PERBLOK? 00626000 BNH NOSAVE NO, GIVE EMSG 00627000 BAL R10,GETPES TRY TO FIND PESBLOK OF THAT NAME 00628000 BZ CALQUE GOT IT, SET UP FOR QUERY 00629000 BAL R10,SCANIT CHECK PARM 00630000 CL R0,F1 ONE CHAR? 00631000 BH NOTASTR NO, THEN MUST BE CURRENT 00632000 CLI 0(R1),C'*' IS IT AN ASTERISK? 00633000 BNE NOTASTR NO, THEN IS CURRENT 00634000 MVC SAVEWRK8(8),BLANKS MOVE IN BLANKS 00635000 MVI SAVEWRK8,C'*' AND ASTERISK 00636000 LM R0,R1,SAVEWRK8 LOAD ASTERISK 00637000 B CALQUE1 GO CALL QUERY 00638000 NOTASTR OI SAVEWRK3+3,X'80' INDICATE QUERY ENQUED 00639000 B PRCD001 GO FOR MORE 00640000 CALQUE LM R0,R1,PESNAME-PESBLOK(R1) LOAD NAME 00641000 CALQUE1 CALL DMKPEQRY AND PRODUCE OUTPUT 00642000 NI SAVEWRK3+3,255-X'20' TURN OFF SCAN FLAG 00643000 B PRCD001 AND RETURN FOR MORE KEYWORDS 00644000 EJECT 00645000 *---------------------------------------------------------------------* 00646000 * NOW, HAVE INFO, SEE IF OFF SPECIFIED AND SET UP NEW BLOCKS * 00647000 *---------------------------------------------------------------------* 00648000 SPACE 00649000 SCANDONE EQU * HERE AFTER SUCCESSFUL COMMAND SCANNING 00650000 TM SAVEWRK3+3,X'40' ANY ACTION NEEDED? 00651000 BNO EXIT NO, GO EXIT 00652000 ICM R7,B'1111',SAVEWRK1 POINT TO CHAIN 00653000 BZ USECHN NO CHAIN, THEN MODIFY CURRENT CHAIN 00654000 OI SAVEWRK3,PEXTERM SET DEFAULT TERM OPTION 00655000 ICM R1,B'1111',SAVEWRK2 SEE IF ANY RANGES 00656000 BNZ MAKEM YES, CONTINUE 00657000 LA R0,2 LOAD LENGTH 00658000 CALL DMKFREE GET SPACE 00659000 ST R1,SAVEWRK2 SAVE POINTER 00660000 MVC 0(16,R1),ZEROES ZERO IT 00661000 MVC 8(4,R1),XRIGHT24 MOVE IN UPPER LIMIT 00662000 B MAKEM AND GO TO IT 00663000 USECHN LTR R8,R8 ANY PERBLOK? 00664000 BNH EXIT NO, EXIT 00665000 ICM R7,B'1111',PERCHAIN LOAD CHAIN POINTER 00666000 BZ CALPRC NONE, EXIT 00667000 TM SAVEWRK3+3,X'08' WAS OFF SPECIFIED? 00668000 BO HNDOFF1 GO HANDLE OFF 00669000 MAKEM ICM R1,B'1111',SAVEWRK5 LOAD AND TEST SKIP COUNT 00670000 BZ MAKSTP ZERO, CHECK STEP COUNT 00671000 ST R1,PEXSKIP STORE IT 00672000 ST R1,PEXSKIPN SAVE SKIP COUNTER 00673000 MAKSTP ICM R1,B'1111',SAVEWRK4 LOAD AND TEST THE STEP COUNT 00674000 BZ SETOPTS ZERO, GO SET/RESET OPTIONS 00675000 ST R1,PEXSTEP STORE STEP COUNT 00676000 ST R1,PEXSTEPN SAVE STEP COUNT 00677000 SETOPTS OC PEXFLAGO(1),SAVEWRK3 OR IN OPTIONS 00678000 NC PEXFLAGO(1),SAVEWRK3+1 AND TURN OFF OTHERS 00679000 TM SAVEWRK3+3,X'04' SAVED CF? 00680000 BZ TRYRCHN NO, GO SEE ABOUT RANGES 00681000 L R2,SAVEWRK6 LOAD CF POINTER 00682000 ICM R1,B'1111',PEXCMND IS THERE A CF ALREADY THERE? 00683000 BZ GETNCF NO, JUST MAKE COPY OF THIS ONE 00684000 SLR R0,R0 CLEAR FOR IC 00685000 IC R0,0(,R1) INSERT LENGTH 00686000 AL R0,F8 ROUND UP 00687000 SRL R0,3 AND GET DWORDS 00688000 CALL DMKFRET AND FRET IT 00689000 GETNCF SLR R0,R0 CLEAR FOR IC 00690000 IC R0,0(,R2) INSERT LENGTH 00691000 AL R0,F8 ROUND UP 00692000 SRL R0,3 GET DWORDS 00693000 CALL DMKFREE AND GET SPACE 00694000 SLL R0,3 MAKE BYTES 00695000 LR R3,R0 MOVE TO R3 FOR MOVE 00696000 ST R1,PEXCMND SAVE POINTER 00697000 LR R0,R1 MOVE ADDR 00698000 LR R1,R3 AND LENGTH 00699000 MVCL R0,R2 AND DUPLICATE THE CF 00700000 TRYRCHN ICM R4,B'1111',SAVEWRK2 POINT TO CHAIN 00701000 BZ MAKENEXT NONE, GO TO NEXT 00702000 MAKER1 MVC PEXADDR1(8),4(R4) MOVE IN RANGE 00703000 ICM R4,B'1111',0(R4) POINT TO NEXT 00704000 BZ MAKENEXT NONE, GET NEXT ELEMENT 00705000 BAL R10,COPYPEX MAKE A COPY 00706000 ST R1,PEXNEXT CHAIN IT ON 00707000 LR R7,R1 MOVE FOR ADDR 00708000 B MAKER1 GO MOVE RANGE INTO IT 00709000 MAKENEXT ICM R7,B'1111',PEXNEXT POINT TO NEXT PEXBLOK 00710000 BNZ MAKEM IF EXISTS, GO SET UP 00711000 CLC SAVEWRK1(4),ZEROES ANYTHING TO ADD TO CHAIN? 00712000 BE MERGE NO, GO MERGE 00713000 TM SAVEWRK3+3,X'08' OFF SPECIFIED? 00714000 BO HNDLOFF YES, GO HANDLE IT 00715000 LTR R8,R8 DO WE HAVE A PERBLOK? 00716000 BH OKPERBK YES, NO NEED TO ALLOCATE 00717000 LA R0,PERSIZE LOAD SIZE 00718000 CALL DMKFREE GO GET IT 00719000 LR R8,R1 MOVE TO R8 00720000 XC PERBLOK(PERSIZE*8),PERBLOK CLEAR PERBLOK 00721000 ST R8,VMPERCTL SAVE POINTER 00722000 OI VMPERFLG,VMPERUSE TURN ON PER TRACE BIT 00723000 MVC PERBBLIP(2),=H'10000' MOVE IN BLIP COUNTER 00724000 MVC PERIBLIP(6),PERBBLIP AND PROPAGATE INTO REST 00725000 OKPERBK LA R7,PERCHAIN POINT TO LIST 00726000 ADDLP ICM R6,B'1111',PEXNEXT POINT TO NEXT 00727000 BZ GTNDC NONE, GO CHAIN ON 00728000 LR R7,R6 POINT TO IT 00729000 B ADDLP AND GO TRY AGAIN 00730000 GTNDC MVC PEXNEXT(4),SAVEWRK1 CHAIN IT ON 00731000 ST R6,SAVEWRK1 AND KILL POINTER 00732000 B MERGE GO TRY TO MERGE 00733000 EJECT 00734000 *---------------------------------------------------------------------* 00735000 * HANDLE SELECTIVE TURNING OFF OF TRACES * 00736000 *---------------------------------------------------------------------* 00737000 ****** NOTE: OFF IS NOT COMPLETELY IMPLEMENTED AT THIS POINT. 00738000 ****** IF OFF IS SPECIFIED, ALL PEXBLOKS OF THE SAME TYPE AS 00739000 ****** WAS SPECIFIED ON THE COMMAND LINE ARE DELETED. 00740000 ****** NO CHECKING FOR OVERLAPING RANGES OR DATA IS MADE YET. 00741000 HNDOFF1 EQU * HERE WHEN OFF SPECIFIED AND NO ELEMENTS 00742000 B PRMERR2 FOR NOW WILL BE ERROR 00743000 HNDLOFF EQU * HERE TO HANDLE SELECTIVE OFF 00744000 ICM R7,B'1111',SAVEWRK1 LOAD CHAIN POINTER 00745000 BZ CALPRC NONE, EXIT 00746000 LTR R8,R8 ANY TRACES IN EFFECT? 00747000 BZ EXIT THEN WHAT ARE YOU TRYING TO TURN OFF? 00748000 OFFLP ICM R6,B'1111',PERCHAIN LOAD CHAIN POINTER 00749000 BZ CALPRC NO PEXBLOCKS LEFT, EXIT 00750000 LA R5,PERCHAIN POINT TO PREV PTR 00751000 OFFLP1 CLC PEXFLAGT(1),PEXFLAGT-PEXBLOK(R6) SAME TYPE? 00752000 BNE OFFNXT1 NO, TRY NEXT 00753000 MVC PEXNEXT-PEXBLOK(4,R5),PEXNEXT-PEXBLOK(R6) UNCHAIN 00754000 LR R1,R6 MOVE FOR CALL 00755000 L R6,PEXNEXT-PEXBLOK(,R6) POINT TO NEXT 00756000 BAL R10,FRETPEX FRET THE BLOCK 00757000 LTR R6,R6 ANY MORE? 00758000 BZ OFFNXT NO, TRY NEXT ONE 00759000 B OFFLP1 YES, CHECK IT OUT 00760000 OFFNXT1 LR R5,R6 UPDATE LAST PTR 00761000 ICM R6,B'1111',PEXNEXT-PEXBLOK(R6) POINT TO NEXT 00762000 BNZ OFFLP1 AND IF THERE, GO CHECK IT OUT 00763000 OFFNXT ICM R7,B'1111',PEXNEXT POINT TO NEXT BLOK 00764000 BNZ OFFLP AND IF THERE, GO HANDLE 00765000 EJECT 00766000 *---------------------------------------------------------------------* 00767000 * MERGE PEXBLOKS WHERE POSSIBLE * 00768000 *---------------------------------------------------------------------* 00769000 MERGE EQU * 00770000 LTR R8,R8 ANY PERBLOK? 00771000 BNH EXIT NO, EXIT 00772000 ICM R7,B'1111',PERCHAIN LOAD CHAIN POINTER 00773000 BZ CALPRC NONE, GO CALL PERCH 00774000 MERGE0 LR R6,R7 SAVE POINTER FOR BACK CHAINING 00775000 MERGE1 ST R6,SAVEWRK4 SAVE FOR BACK CHAINING 00776000 ICM R6,B'1111',PEXNEXT-PEXBLOK(R6) POINT TO NEXT 00777000 BZ MERGEN2 NO, TRY NEXT ONE 00778000 CLC PEXFLAGT(1),PEXFLAGT-PEXBLOK(R6) SAME TYPE? 00779000 BNE MERGE1 NO, TRY NEXT ONE 00780000 CLC PEXSTEP(16),PEXSTEP-PEXBLOK(R6) MUST BE EQUAL 00781000 BNE MERGE1 NO, GO LOOK AT NEXT 00782000 CLC PEXFLAGO(1),PEXFLAGO-PEXBLOK(R6) SAME OPTIONS? 00783000 BNE MERGE1 NO, TRY NEXT 00784000 CLI PEXFLAGT,PEXPGT IS IT A PAGE TRACE? 00785000 BNE MERGE2 NO, SKIP THIS CHECK 00786000 CLC PEXINCR(4),PEXINCR-PEXBLOK(R6) SAME? 00787000 BNE MERGE1 NO, GO LOOK AT NEXT 00788000 CLC PEXADDR1(8),PEXADDR1-PEXBLOK(R6) SAME RANGE? 00789000 BNE MERGE1 NO, THEN CAN'T MERGE 00790000 B MERGEIT OTHERWISE MERGE 00791000 MERGE2 CLC PEXDLEN(1),PEXDLEN-PEXBLOK(R6) SAME LENGTH? 00792000 BNE MERGE1 NO, CAN'T MERGE 00793000 CLI PEXDLEN,0 DATA STOPS? 00794000 BE MERGE5 NO, SKIP THIS CHECK 00795000 CLI PEXFLAGT,PEXIFET IS IT AN IFETCH 00796000 BE MERGE4 YES, SKIP ADDR CHECK 00797000 CLC PEXADDR3(8),PEXADDR3-PEXBLOK(R6) SAME ADDR? 00798000 BNE MERGE1 NO, TRY NEXT 00799000 MERGE4 CLC PEXDLEN(1),PEXDLEN-PEXBLOK(R6) SAME LENGTH? 00800000 BNE MERGE1 NO, TRY NEXT ONE 00801000 SLR R1,R1 CLEAR FOR IC 00802000 IC R1,PEXDLEN INSERT DATA LENGTH 00803000 BCTR R1,0 MINUS 1 00804000 EX R1,DATACMP DOES THE DATA COMPARE? 00805000 BNE MERGE1 NO, TRY NEXT ONE 00806000 MERGE5 L R2,PEXCMND LOAD FIRST POINTER 00807000 L R4,PEXCMND-PEXBLOK(,R6) AND SECOND 00808000 CLR R2,R4 EQUAL? 00809000 BE MERGE5A YES, THEN NO CF 00810000 SLR R3,R3 CLEAR R3 FOR IC 00811000 LR R5,R3 AND R5 00812000 IC R3,1(,R2) GET FIRST 00813000 IC R5,1(,R4) AND SECOND 00814000 LA R3,1(,R3) GET TOTAL LENGTH 00815000 LA R5,1(,R5) AND HERE 00816000 CLCL R2,R4 DO COMPARE 00817000 BNE MERGE1 NOT EQUAL, TRY NEXT 00818000 MERGE5A LM R0,R1,PEXADDR1 LOAD FIRST RANGE 00819000 LM R2,R3,PEXADDR1-PEXBLOK(R6) LOAD SECOND SET 00820000 BAL R10,RNGMRG TRY TO MERGE RANGES 00821000 BNZ MERGE1 NO GO, TRY NEXT 00822000 CLI PEXFLAGT,PEXBRTB IS IT A TRACE BACK? 00823000 BE MERGE6 YES, NEED TO CHECK SECOND RANGE 00824000 CLI PEXFLAGT,PEXST IS IT A STORE? 00825000 BNE MERGE7 NO, THEN NO SECOND RANGE 00826000 CLI PEXDLEN,0 DATA STOP? 00827000 BNE MERGE7 THEN NO SECOND RANGE 00828000 MERGE6 LR R4,R0 SAVE R0 00829000 LR R5,R1 AND R1 00830000 LM R0,R1,PEXADDR3 LOAD FIRST RANGE 00831000 LM R2,R3,PEXADDR3-PEXBLOK(R6) AND SECOND RANGE 00832000 BAL R10,RNGMRG GO TRY TO MERGE 00833000 BNZ MERGE1 NO, GO TRY NEXT 00834000 STM R0,R1,PEXADDR3 SAVE NEW RANGE 00835000 LR R0,R4 RESTORE R0 00836000 LR R1,R5 AND R1 00837000 MERGE7 STM R0,R1,PEXADDR1 SAVE ADDRESS RANGE 00838000 CLI PEXFLAGT,PEXGPR IS IT A GREG TRAP? 00839000 BNE MERGEIT NO, THEN SKIP OC 00840000 OC PEXGREG(2),PEXGREG-PEXBLOK(R6) OR IN NEW REGS 00841000 MERGEIT L R5,SAVEWRK4 LOAD POINTER TO PREVIOUS BLOK 00842000 MVC PEXNEXT-PEXBLOK(4,R5),PEXNEXT-PEXBLOK(R6) UNCHAIN BLOK 00843000 LR R1,R6 MOVE ADDR TO R1 00844000 BAL R10,FRETPEX GO FRET PEXBLOK 00845000 B MERGE0 AND GO TRY IT AGAIN 00846000 MERGEN2 ICM R7,B'1111',PEXNEXT POINT TO NEXT 00847000 BNZ MERGE0 YES, GO START SCAN THERE 00848000 CALPRC CALL DMKPERCH CALL DMKPER TO SET UP PERBLOK 00849000 B EXIT AND EXIT 00850000 DATACMP CLC PEXDATA(*-*),PEXDATA-PEXBLOK(R6) EXECUTED COMPARE 00851000 EJECT 00852000 *---------------------------------------------------------------------* 00853000 * PRINT OUT ERROR MESSAGES * 00854000 *---------------------------------------------------------------------* 00855000 PRMERR1 LA R2,2 SET ERROR NUMBER 00856000 LM R0,R1,SAVEWRK6 RESTORE POINTERS 00857000 B PUTMSG GO PUT OUT MSG 00858000 PRMERR2 LA R2,26 SET ERROR CODE 00859000 SLR R0,R0 CLEAR COUNT 00860000 LR R1,R0 AND ADDRESS 00861000 B PUTMSG GO PUT OUT MSG 00862000 CONFLICT LA R2,13 LOAD ERROR CODE 00863000 B PUTMSG GO PUT OUT MSG 00864000 NOSAVE LTR R8,R8 ANY TRACE IN EFFECT? 00865000 BNH NOTRACE NO, GIVE MSG 00866000 LA R1,TRSETM POINT TO MSG 00867000 LA R0,LTRSETM LOAD LENGTH 00868000 LA R2,47 LOAD DOES NOT EXIT MSG 00869000 B PUTMSG AND PUT IT OUT 00870000 NOTRACE LA R2,141 "PER" TRACE NOT ACTIVE 00871000 LA R1,NOTRMSG POINT TO MSG 00872000 LA R0,LNOTRMSG LOAD LENGTH 00873000 B PUTMSG GO PUT OUT MSG 00874000 PUTMSG ICM R0,B'1110',MODID+3 INSERT IDENTIFIER 00875000 ST R2,SAVER2 SAVE RET CODE 00876000 ICM R2,B'1000',=X'80' SET FLAG FOR RETURN 00877000 CALL DMKERMSG GO TYPE EMSG 00878000 NI SAVEWRK3+3,255-X'80' QUERY NO LONGER QUEUED 00879000 TM SAVEWRK3+3,X'40' POSSIBLE "CLEAR"? 00880000 BO CALPRC YES, ENSURE CREGS ARE CORRECT 00881000 B EXIT GO EXIT 00882000 SPACE 00883000 EJECT 00884000 *---------------------------------------------------------------------* 00885000 * CLEAN UP AND RETURN TO CALLER * 00886000 *---------------------------------------------------------------------* 00887000 EXIT L R7,SAVEWRK1 POINT TO CHAIN OF TEMP ELEMENT BLOCKS 00888000 ELEREL LTR R7,R7 ANY MORE? 00889000 BZ FRETCF NO, GO CHECK SAVED CF 00890000 LR R1,R7 MOVE FOR FRET 00891000 SLR R0,R0 CLEAR RO FOR IC 00892000 IC R0,PEXLEN LOAD LENGTH 00893000 L R7,PEXNEXT AND POINT TO NEXT 00894000 CALL DMKFRET GO FRET BLOCK 00895000 B ELEREL GO FRET NEXT 00896000 FRETCF TM SAVEWRK3+3,X'04' IS THERE A SAVED CF POINTER? 00897000 BZ CKRNGB NONE, GO CHECK RANGE BLOCKS 00898000 L R1,SAVEWRK6 LOAD POINTER 00899000 SLR R0,R0 CLEAR FOR IC 00900000 IC R0,0(,R1) INSERT LENGTH 00901000 AL R0,F8 ROUND UP 00902000 SRL R0,3 GET DWORDS 00903000 CALL DMKFRET AND FRET IT 00904000 CKRNGB ST R7,SAVEWRK1 ZAP POINTER (JUST IN CASE) 00905000 L R2,SAVEWRK2 LOAD POINTER TO CHAIN OF RANGES 00906000 ST R7,SAVEWRK2 AND ZERO IT WHILE WE'RE AT IT 00907000 RNGREL LTR R2,R2 ANY MORE? 00908000 BZ DOEXIT NO, JUST EXIT 00909000 LR R1,R2 MOVE FOR FRET 00910000 L R2,0(,R2) POINT TO NEXT ONE 00911000 LA R0,2 SET FOR TWO DOUBLE WORDS 00912000 CALL DMKFRET FRET IT 00913000 B RNGREL GO FOR NEXT ONE 00914000 DOEXIT LTR R8,R8 WAS THERE A PERBLOK? 00915000 BNH ISEXIT NO, SKIP CHECK FOR QUERY 00916000 TM SAVEWRK3+3,X'80' WAS A QUERY ENQUEUED? 00917000 BNO TRYDEL NO, JUST EXIT 00918000 L R7,PERCHAIN LOAD CHAIN POINTER 00919000 SLR R0,R0 CLEAR R0 00920000 CALL DMKPEQRY AND GO DO QUERY 00921000 TRYDEL TM PERCR9,X'F0' ARE THERE ANY TRAPS? 00922000 BNZ TRYBR GO SEE IF A BRANCH TRACEBACK TABLE NEEDED 00923000 ICM R1,B'1111',PERSAVED LOAD CHAIN POINTER 00924000 BNZ TRYBR GO SEE IF NEED BRANCH TRACEBACK TABLE 00925000 CALL DMKPERT FRET EVERYTHING 00926000 B ISEXIT GO RETURN TO CALLER 00927000 TRYBR L R1,PERTBAK LOAD POINTER 00928000 LA R0,(PERTBLEN+7)/8 LOAD LENGTH 00929000 TM PERCR9,PEXBR IS A BRANCH TRACE ACTIVE? 00930000 BNO TRYDBR NO, SEE IF NEED TO DELETE TABLE 00931000 LTR R1,R1 IS THERE ONE? 00932000 BNZ TRYGR YES, GO CHECK OUT GREG SAVE AREA 00933000 CALL DMKFREE GO GET IT 00934000 ST R1,PERTBAK AND SAVE POINTER 00935000 XC 0(PERTBLEN,R1),0(R1) CLEAR TO ZEROES 00936000 B TRYGR GO CHECK OUT GREG SAVEAREA 00937000 TRYDBR LTR R1,R1 DOES A TABLE EXIST 00938000 BZ TRYGR NO, CHECK OUT GREG 00939000 CALL DMKFRET AND FRET IT 00940000 MVC PERTBAK(4),ZEROES CLEAR POINTER 00941000 TRYGR LA R0,16*4/8 LOAD LENGTH OF AREA 00942000 L R1,PERGPRP LOAD ADDR 00943000 TM PERCR9,PEXGPR IS GREG STOP ACTIVE? 00944000 BNO TRYDGR GO TRY TO DELETE IT 00945000 LTR R1,R1 IS THERE ONE? 00946000 BNZ ISEXIT YES, THEN ALL DONE 00947000 CALL DMKFREE GO GET BLOCK 00948000 MVC 0(16*4,R1),VMGPRS MOVE IN REGISTERS 00949000 ST R1,PERGPRP SAVE POINTER 00950000 B ISEXIT AND EXIT 00951000 TRYDGR LTR R1,R1 IS THERE ANY? 00952000 BZ ISEXIT NO, EXIT 00953000 CALL DMKFRET FRET IT 00954000 MVC PERGPRP(4),ZEROES CLEAR POINTER 00955000 ISEXIT NI VMESTAT,255-VMPERCM TURN OFF FLAG 00956000 NI VMTRCTL,255-VMTRPER ... 00957000 TM VMPSW+1,EXTMODE IN EXT MODE? 00958000 BNO OUROWN NO, SEE IF WE HAVE PER 00959000 TM VMPSW,PERMODE USER PER ON? 00960000 BNO OUROWN NO GO CHECK PER 00961000 OI VMESTAT,VMPERCM TURN ON FLAG 00962000 B DONEEXIT AND EXIT 00963000 OUROWN TM VMPERFLG,VMPERUSE CP PER IN EFFECT? 00964000 BNO DONEEXIT NO, EXIT 00965000 L R8,VMPERCTL LOAD POINTER 00966000 CLI PERCR9,00 ANY TRAPS? 00967000 BE DONEEXIT NO, SKIP OI 00968000 OI VMTRCTL,VMTRPER TRUN ON PER TRACE 00969000 OI VMPERFLG,VMPERCM TURN ON PER ANY FLAG 00970000 DONEEXIT EXIT , RETURN TO CALLER 00971000 EJECT 00972000 *---------------------------------------------------------------------* 00973000 * SCAN FOR A DECIMAL PARAMETER * 00974000 *---------------------------------------------------------------------* 00975000 GETDEC EQU * 00976000 ST R10,SAVEWRK8 SAVE RETURN ADDR 00977000 BAL R10,SCANIT GO SCAN 00978000 L R10,SAVEWRK8 LOAD RETURN ADDR 00979000 BNZR R10 IF ERROR, RETURN 00980000 CL R0,F8 IS IT SMALL ENOUGH TO USE? 00981000 BNLR R10 NO, RETURN 00982000 DECCLP CLI 0(R1),C'0' BELOW ZERO? 00983000 BLR R10 YES, ERROR, RETURN 00984000 CLI 0(R1),C'9' ABOVE 9? 00985000 BHR R10 YES, RETURN 00986000 LA R1,1(,R1) POINT TO NEXT ONE 00987000 BCT R0,DECCLP AND CHECK IT OUT 00988000 LM R0,R1,SAVEWRK6 RELOAD POINTERS 00989000 LR R15,R0 MOVE FOR EXECUTE 00990000 BCTR R15,0 MINUS 1 00991000 EX R15,PACKIT PACK NUMBER 00992000 CVB R1,SAVEWRK8 AND CONVERT TO BINARY 00993000 CLR R0,R0 SET CONDITION CODE TO ZERO 00994000 BR R10 RETURN 00995000 PACKIT PACK SAVEWRK8(8),0(*-*,R1) EXECUTED PACK 00996000 EJECT 00997000 *---------------------------------------------------------------------* 00998000 * SCAN FOR A RANGE * 00999000 *---------------------------------------------------------------------* 01000000 GETRNG EQU * 01001000 ST R10,SAVEWRK8 SAVE RETURN ADDR 01002000 BAL R10,SCANIT FIND A PARM 01003000 L R10,SAVEWRK8 LOAD ADDR 01004000 BNZR R10 NONE, ERROR RETURN 01005000 LR R15,R1 MOVE ADDR 01006000 LR R14,R0 AND LENGTH 01007000 SLR R0,R0 CLEAR LENGTH 01008000 GTR1 CLI 0(R15),C'9' ABOVE 9? 01009000 BHR R10 YES, ERROR RETURN 01010000 CLI 0(R15),C'A' BELOW A? 01011000 BL GTR3 YES, MIGHT BE OK 01012000 CLI 0(R15),C'0' BELOW ZERO? 01013000 BNL GTR2 NO, THEN IS OK 01014000 CLI 0(R15),C'F' THEN MUST BE BELOW F 01015000 BHR R10 NO, ERROR RETURN 01016000 GTR2 LA R15,1(,R15) POINT TO NEXT 01017000 AL R0,F1 ADD 1 TO COUNT 01018000 BCT R14,GTR1 TRY NEXT ONE 01019000 GTR3 CL R0,F6 TOO LONG? 01020000 BHR R10 YES, ERROR RETURN 01021000 LTR R0,R0 ZERO? 01022000 BNZ *+10 NO, SKIP THIS JUNK 01023000 LR R1,R0 SET R1 TO ZERO ALSO 01024000 B GTR4 AND SKIP OTHER STUFF 01025000 STM R14,R15,SAVEWRK8 SAVE POINTERS 01026000 CALL DMKCVTHB GO CONVERT 01027000 LM R14,R15,SAVEWRK8 RESTORE POINTERS 01028000 GTR4 ST R1,SAVEWRK8 SAVE LOW BOUND 01029000 LR R0,R1 PUT IN R0 FOR A MOMENT 01030000 LTR R14,R14 ANYTHING LEFT? 01031000 BZR R10 NO, THEN WE HAVE IT 01032000 CLI 0(R15),C'-' IS IT A DASH? 01033000 BE GTR5 YES, CONTINUE 01034000 CLI 0(R15),C':' OR A COLEN? 01035000 BE GTR5 YES, CONTINUE 01036000 CLI 0(R15),C'.' PERIOD? 01037000 BNER R10 NO, ERROR RETURN 01038000 GTR5 MVC SAVEWRK9(1),0(R15) SAVE SEPERATOR 01039000 LA R15,1(,R15) POINT TO NEXT CHAR 01040000 BCT R14,GTR6 AND GO PROCESS NEXT PART 01041000 L R0,SAVEWRK8 LOAD LOW END 01042000 L R1,XRIGHT24 LOAD HIGHT 01043000 BR R10 AND RETURN 01044000 GTR6 LR R0,R14 MOVE LENGTH 01045000 LR R1,R15 AND ADDR 01046000 CL R0,F6 IS IT TOO LONG? 01047000 BHR R10 YES, ERROR RETURN 01048000 CALL DMKCVTHB TRY TO CONVERT 01049000 BNZR R10 IF ERROR, RETURN NOW 01050000 L R0,SAVEWRK8 LOAD FIRST ONE 01051000 CLI SAVEWRK9,C'.' WAS SEPERATOR A PERIOD? 01052000 BNE GTRR0 GO RETURN WITH RC=0 01053000 ALR R1,R0 ADD SINCE IS LENGTH 01054000 BCTR R1,0 MINUS 1 01055000 LA R1,0(,R1) CLEAR TOP BYTE 01056000 GTRR0 CLR R0,R0 SET CC=0 01057000 BR R10 AND RETURN 01058000 EJECT 01059000 *---------------------------------------------------------------------* 01060000 * SCAN FOR A HEX WORD * 01061000 *---------------------------------------------------------------------* 01062000 GETHXWD EQU * 01063000 ST R10,SAVEWRK8 SAVE RETURN ADDR 01064000 BAL R10,SCANIT GO SCAN FOR PARM 01065000 L R10,SAVEWRK8 GET RETURN ADDR BACK 01066000 BNZR R10 NONE, RETURN 01067000 CL R0,F8 TOO BIG? 01068000 BHR R10 YES, RETURN 01069000 CALL DMKCVTHB TRY TO CONVERT 01070000 BR R10 RETURN TO CALLER 01071000 EJECT 01072000 *---------------------------------------------------------------------* 01073000 * SCAN FOR A HEX STRING * 01074000 *---------------------------------------------------------------------* 01075000 GETXSTR EQU * 01076000 ST R10,SAVEWRK8 SAVE RETURN ADDRESS 01077000 BAL R10,SCANIT GO SCAN FOR PARM 01078000 L R10,SAVEWRK8 RELOAD RETURN ADDRESS 01079000 BNZR R10 AND IF NO PARM RETURN 01080000 STC R0,SAVEWRK8 SAVE LAST BYTE 01081000 TM SAVEWRK8,X'01' IS IT AN ODD LENGTH? 01082000 BOR R10 YES, THEN IS NOT A STRING 01083000 LR R14,R0 SAVE LENGTH FOR LATER 01084000 SRL R14,1 DIVIDE BY 2 01085000 ST R14,SAVEWRK8 AND SAVE FOR POSSIBLE RETURN 01086000 LR R14,R0 AND SET IT AGAIN 01087000 XVLOOP CLI 0(R1),C'A' LESS THAN A? 01088000 BLR R10 YES, ERROR RETURN 01089000 CLI 0(R1),C'9' HIGHER THAN 9? 01090000 BHR R10 YES, ERROR RETURN 01091000 CLI 0(R1),C'0' LOWER THAN ZERO? 01092000 BNL XVNXT NO, THEN IS OK 01093000 CLI 0(R1),C'F' THEN BETTER NOT BE ABOVE F 01094000 BHR R10 TOO BAD, ERROR RETURN 01095000 XVNXT LA R1,1(,R1) POINT TO NEXT CHAR 01096000 BCT R0,XVLOOP AND CHECK IT OUT 01097000 L R0,SAVEWRK8 LOAD LENGTH 01098000 L R1,SAVEWRK7 LOAD ADDR AGAIN 01099000 LR R15,R1 AND INTO R15 ALSO 01100000 ANDLP NC 0(2,R1),=X'1F1F' KILL FIRST 3 BITS 01101000 LA R1,2(,R1) POINT TO NEXT PAIR 01102000 BCT R0,ANDLP GO FOR MORE 01103000 BCTR R14,0 MINUS 1 FOR EX 01104000 EX R14,ZTRANS DO HEX CONV TRANSLATE 01105000 L R0,SAVEWRK8 LOAD LENGTH OF STRING 01106000 AL R0,F7 ADD 7 TO ROUND UP 01107000 SRL R0,3 GET DWORDS 01108000 CALL DMKFREE GET SOME SPACE 01109000 L R0,SAVEWRK8 LOAD LENGTH 01110000 ST R1,SAVEWRK9 AND SAVE ADDR FOR RETURN 01111000 L R15,SAVEWRK7 GET ADDR AGAIN 01112000 XCVTLP MVO 0(1,R1),0(1,R15) MOVE OVER FIRST NYBBLE 01113000 MVN 0(1,R1),1(R15) AND SECOND NYBBLE 01114000 LA R1,1(,R1) POINT TO NEXT SLOT 01115000 LA R15,2(,R15) POINT TO NEXT PAIR 01116000 BCT R0,XCVTLP AND CONTINUE CONVERSION 01117000 L R15,SAVEWRK7 LOAD POINTER FROM WHERE SCANIT PUT IT 01118000 L R14,SAVEWRK6 AND LENGTH 01119000 BCTR R14,0 MINUS 1 01120000 EX R14,BACKTR AND RESET CHARS IN LINE 01121000 LM R0,R1,SAVEWRK8 LOAD POINTERS 01122000 CLR R15,R15 SET RETCODE 01123000 BR R10 AND RETURN 01124000 ZTRANS TR 0(*-*,R15),TOBINX EXECUTED TRANSLATE 01125000 BACKTR TR 0(*-*,R15),HEXTAB TRANSLATE BACK TO EBCDIC 01126000 EJECT 01127000 *---------------------------------------------------------------------* 01128000 * SCAN FOR A POSSIBLE TRACE SET NAME * 01129000 *---------------------------------------------------------------------* 01130000 GETPES EQU * 01131000 ST R10,SAVEWRK8 SAVE RETURN ADDR 01132000 BAL R10,SCANIT SCAN LINE 01133000 L R10,SAVEWRK8 RESTORE RETURN ADDR 01134000 BNZR R10 NOT ANYTHING THERE, RETURN 01135000 CL R0,F8 IS PARM TOO LONG? 01136000 BHR R10 YES, ERROR RETURN 01137000 LR R14,R0 MOVE LENGTH SO CAN USE 01138000 BCTR R14,0 MINUS 1 FOR EX 01139000 MVC SAVEWRK8(8),BLANKS CLEAR TO BLANKS 01140000 EX R14,MVCPES AND MOVE IN NAME 01141000 L R1,PERSAVED POINT TO SAVED CHAIN 01142000 GETPESL LTR R1,R1 DONE? 01143000 BZ GETPESR YES, SET RET CODE 01144000 CLC SAVEWRK8(8),PESNAME-PESBLOK(R1) IS THIS IT? 01145000 BZR R10 YES, RETURN 01146000 L R1,PESNEXT-PESBLOK(,R1) LOAD FORWARD POINTER 01147000 B GETPESL GO CHECK IT 01148000 MVCPES MVC SAVEWRK8(*-*),0(R1) EXECUTED MOVE 01149000 GETPESR TM F1+3,X'01' SET CC 01150000 BR R10 AND RETURN 01151000 EJECT 01152000 *---------------------------------------------------------------------* 01153000 * COMMON SCAN ROUTINE * 01154000 *---------------------------------------------------------------------* 01155000 SCANIT EQU * 01156000 TM SAVEWRK3+3,X'10' END OF LINE? 01157000 BOR R10 YES, RETURN 01158000 LM R0,R1,SAVEWRK6 LOAD POINTERS 01159000 TM SAVEWRK3+3,X'20' ALREADY HAVE POINTERS? 01160000 BO SCNRZ RETURN TO CALLER WITH RET CODE ZERO 01161000 OI SAVEWRK3+3,X'20' INDICATE HAVE POINTERS 01162000 CALL DMKSCNFD SCAN 01163000 STM R0,R1,SAVEWRK6 SAVE POINTERS 01164000 BZR R10 IS OK, RETURN 01165000 OI SAVEWRK3+3,X'10' INDICATE END OF LINE 01166000 BR R10 RETURN TO CALLER 01167000 SCNRZ TM F2+3,X'01' MAKE CC=0 01168000 BR R10 AND RETURN 01169000 EJECT 01170000 *---------------------------------------------------------------------* 01171000 * MERGE TWO RANGES (IF POSSIBLE) * 01172000 *---------------------------------------------------------------------* 01173000 RNGMRG EQU * FIRST RANGE R0-R1, SECOND R2-R3 01174000 CLR R0,R2 ARE THEY IN ORDER? 01175000 BNH INORD YES, SKIP SWITCHING 01176000 STM R0,R1,SAVEWRK8 SAVE FIRST RANGE 01177000 LR R0,R2 MOVE DOWN SECOND 01178000 LR R1,R3 ... 01179000 LM R2,R3,SAVEWRK8 AND LOAD FIRST 01180000 INORD CLR R1,R2 OVERLAP (A1B>=A2A) 01181000 BNL OVERLAP YES, GO CONSTRUCT MERGED RANGE 01182000 CLR R0,R1 DOES FIRST RANGE WRAP-AROUND? 01183000 BH OVERLAP YES, THEN MUST OVERLAP 01184000 CLR R2,R3 DOES SECOND WRAP-AROUND? 01185000 BNH TRYADJ NO, CAN'T OVERLAP, TRY ADJACENT 01186000 CLR R3,R0 THEN DOES IT OVERLAP? 01187000 BNL SWAPR YES, BUT SWITCH LOW ADDR FIRST 01188000 TRYADJ LA R15,1(,R1) POINT TO BYTE AFTER LAST IN FIRST RANGE 01189000 CLR R15,R2 IS IT THE FIRST IN SECOND? 01190000 BE OVERLAP YES, THEN IS SAME AS OVERLAP 01191000 LA R15,1(,R3) POINT TO BYTE AFTER LAST IN SECOND RANGE 01192000 CLR R15,R0 IS IT THE FIRST IN FIRST? 01193000 BNER R10 NO, RETURN WITH NONZERO CC 01194000 SWAPR LR R0,R2 USE SECOND AS FIRST ADDR 01195000 OVERLAP CR R1,R0 HIGHER? 01196000 BNL *+8 YES, THEN USE AS IS (NON-WRAP-AROUND) 01197000 AL R1,MEG16 FIX WRAP-AROUND ADDR 01198000 CR R3,R0 HIGHER? 01199000 BNL *+8 YES, THEN IS OK 01200000 AL R3,MEG16 THEN FIX WRAP-AROUND ADDR 01201000 CLR R1,R3 WHICH IS HIGHER? 01202000 BNL *+6 R1 SO LEAVE ALONE 01203000 LR R1,R3 MOVE FOR RETURN 01204000 LA R1,0(,R1) CLEAR TOP BYTE (IN CASE WAS WRAP-AROUND) 01205000 CLR R0,R0 SET CC=0 01206000 BR R10 AND RETURN 01207000 EJECT 01208000 *---------------------------------------------------------------------* 01209000 * MAKE A COPY OF CURRENT PEXBLOK * 01210000 *---------------------------------------------------------------------* 01211000 COPYPEX EQU * 01212000 SLR R0,R0 CLEAR FOR IC 01213000 IC R0,PEXLEN LOAD LENGTH OF BLOK 01214000 CALL DMKFREE AND GET SPACE FOR NEW ONE 01215000 ST R1,SAVEWRK8 SAVE POINTER 01216000 SLL R0,3 GET BYTES 01217000 LR R3,R0 MOVE LENGTH 01218000 LR R0,R1 AND ADDR 01219000 LR R1,R3 PUT LENGTH HERE ALSO 01220000 LR R2,R7 AND ADDR OF SOURCE PEXBLOK 01221000 MVCL R0,R2 AND COPY IT 01222000 ICM R2,B'1111',PEXCMND LOAD COMMAND POINTER 01223000 BZ CPYRET NO, RETURN 01224000 SLR R0,R0 CLEAR FOR IC 01225000 IC R0,0(,R2) INSERT LENGTH 01226000 AL R0,F8 ROUND UP 01227000 SRL R0,3 GET DWORDS 01228000 CALL DMKFREE AND GET SPACE FOR IT 01229000 L R3,SAVEWRK8 LOAD POINTER 01230000 ST R1,PEXCMND-PEXBLOK(,R3) SAVE POINTER 01231000 SLL R0,3 GET BYTES 01232000 LR R3,R0 PUT IN R3 01233000 LR R0,R1 MOVE ADDR TO R0 01234000 LR R1,R3 AND LENGTH TO R1 01235000 MVCL R0,R2 AND COPY IT 01236000 CPYRET L R1,SAVEWRK8 RELOAD POINTER 01237000 BR R10 AND RETURN 01238000 EJECT 01239000 *---------------------------------------------------------------------* 01240000 * FRET A PEXBLOK * 01241000 *---------------------------------------------------------------------* 01242000 FRETPEX EQU * R1->PEXBLOK 01243000 CLC PEXCMND-PEXBLOK(4,R1),ZEROES ANY CF BLOK? 01244000 BZ FRETPEX1 NO, SKIP FRET THEN 01245000 ST R1,SAVEWRK8 SAVE POINTER 01246000 L R1,PEXCMND-PEXBLOK(,R1) LOAD POINTER 01247000 SLR R0,R0 CLEAR FOR IC 01248000 IC R0,0(,R1) INSERT LENGTH 01249000 AL R0,F8 ROUND UP 01250000 SRL R0,3 GET DWORDS 01251000 CALL DMKFRET AND FRET IT 01252000 L R1,SAVEWRK8 LOAD POINTER 01253000 FRETPEX1 SLR R0,R0 CLEAR FOR IC 01254000 IC R0,PEXLEN-PEXBLOK(,R1) GET LENGTH 01255000 CALL DMKFRET AND FRET IT 01256000 BR R10 AND RETURN 01257000 EJECT 01258000 *---------------------------------------------------------------------* 01259000 * PRING A PAGE INTO REAL MEMORY * 01260000 *---------------------------------------------------------------------* 01261000 GETPAGE LCTL C1,C1,VMSEG LOAD SEG TABLE POINTER 01262000 LRA R2,0(,R1) TRY TO LOAD REAL ADDRESS 01263000 BZR R10 GOT IT, RETURN 01264000 LA R2,BRING+DEFER SET OPTIONS 01265000 L R15,APTRAN LOAD THE FETCH RTN ADDR 01266000 SVC 8 GO GET THE PAGE 01267000 BR R10 AND RETURN 01268000 EJECT 01269000 *---------------------------------------------------------------------* 01270000 * CONSTANTS * 01271000 *---------------------------------------------------------------------* 01272000 SPACE 01273000 DS 0F 01274000 MEG16 DC X'01000000' 16 MEG 01275000 HEXTAB DC C'0123456789ABCDEF' TO HEX TABLE 01276000 TOBINX DC XL16'000A0B0C0D0E0F000000000000000000' 01277000 DC XL16'00010203040506070809000000000000' 01278000 NOTRMSG DC C'"PER"',X'00',C'TRACE' 01279000 LNOTRMSG EQU *-NOTRMSG 01280000 TRSETM DC C'TRACE',X'00',C'SET' 01281000 LTRSETM EQU *-TRSETM 01282000 SPACE 01283000 EJECT 01284000 *---------------------------------------------------------------------* 01285000 * DUMP LITERALS * 01286000 *---------------------------------------------------------------------* 01287000 LTORG 01288000 EJECT 01289000 *---------------------------------------------------------------------* 01290000 * KEYWORD LIST * 01291000 *---------------------------------------------------------------------* 01292000 SPACE 01293000 KWDLIST EQU * 01294000 SPACE 01295000 DC AL2(IFETCH-DMKPEC) ADDRESS OF HANDLER 01296000 DC AL1(PEXIFET) FLAG TYPE 01297000 DC AL1(0) MINIMUM TRUNCATION -1 01298000 DC AL1(5) TOTAL LENGTH -1 01299000 DC C'IFETCH' KEYWORD NAME 01300000 SPACE 01301000 DC AL2(BRANCH-DMKPEC) ADDRESS OF HANDLER 01302000 DC AL1(*-*) UNUSED FOR THIS ONE 01303000 DC AL1(0) MINIMUM TRUNCATION -1 01304000 DC AL1(5) TOTAL LENGTH -1 01305000 DC C'BRANCH' KEYWORD NAME 01306000 SPACE 01307000 DC AL2(STORE-DMKPEC) ADDRESS OF HANDLER 01308000 DC AL1(PEXST) FLAG TYPE 01309000 DC AL1(1) MINIMUM TRUNCATION -1 01310000 DC AL1(4) TOTAL LENGTH -1 01311000 DC C'STORE' KEYWORD NAME 01312000 SPACE 01313000 DC AL2(PAGETR-DMKPEC) OFFSET OF HANDLER 01314000 DC AL1(PEXPGT) FLAG AS PAGE TRACE 01315000 DC AL1(1) MINIMUM TRUNCATION -1 01316000 DC AL1(8) TOTAL LENGTH -1 01317000 DC C'PAGETRACE' KEYWORD RANGE 01318000 SPACE 01319000 DC AL2(GPRS-DMKPEC) OFFSET OF HANDLER 01320000 DC AL1(*-*) UNUSED BY THIS ONE 01321000 DC AL1(0) MINIMUM TRUNCATION -1 01322000 DC AL1(3) TOTAL LENGTH -1 01323000 DC C'GREG' KEYWORD NAME 01324000 SPACE 01325000 DC AL2(MASK-DMKPEC) OFFSET OF HANDLER 01326000 DC AL1(PEXMASK) FLAG TYPE 01327000 DC AL1(0) MINIMUM TRUNCATION -1 01328000 DC AL1(3) TOTAL LENGTH -1 01329000 DC C'MASK' KEYWORD NAME 01330000 SPACE 01331000 DC AL2(SKIPK-DMKPEC) OFFSET OF HANDLER 01332000 DC AL1(SAVEWRK5-SAVEAREA) PLACE TO PUT COUNT 01333000 DC AL1(1) MINIMUM TRUNCATION -1 01334000 DC AL1(3) TOTAL LENGTH -1 01335000 DC C'SKIP' KEYWORD NAME 01336000 SPACE 01337000 DC AL2(SKIPK-DMKPEC) OFFSET OF HANDLER 01338000 DC AL1(SAVEWRK4-SAVEAREA) PLACE TO PUT COUNT 01339000 DC AL1(2) MINIMUM TRUNCATION -1 01340000 DC AL1(3) TOTAL LENGTH -1 01341000 DC C'STEP' KEYWORD NAME 01342000 SPACE 01343000 DC AL2(FLAGON-DMKPEC) OFFSET OF HANDLER 01344000 DC AL1(PEXRUN) FLAG AS RUN 01345000 DC AL1(1) MINIMUM TRUNCATION -1 01346000 DC AL1(2) TOTAL LENGTH -1 01347000 DC C'RUN' 01348000 SPACE 01349000 DC AL2(FLAGOFF-DMKPEC) OFFSET OF HANDLER 01350000 DC AL1(255-PEXRUN) SET TO TURN OFF RUN 01351000 DC AL1(2) MINIMUM TRUNCATION -1 01352000 DC AL1(4) TOTAL LENGTH -1 01353000 DC C'NORUN' KEYWORD NAME 01354000 SPACE 01355000 DC AL2(FLAGON-DMKPEC) OFFSET OF HANDLER 01356000 DC AL1(PEXPRINT) SET TO TURN ON PRINT 01357000 DC AL1(1) MINIMUM TRUNCATION -1 01358000 DC AL1(4) TOTAL LENGTH -1 01359000 DC C'PRINT' KEYWORD NAME 01360000 SPACE 01361000 DC AL2(FLAGOFF-DMKPEC) OFFSET OF HANDLER 01362000 DC AL1(255-PEXPRINT) TURN OFF PRINT FLAG 01363000 DC AL1(2) MINIMUM TRUNCATION -1 01364000 DC AL1(6) TOTAL LENGTH -1 01365000 DC C'NOPRINT' KEYWORD NAME 01366000 SPACE 01367000 DC AL2(FLAGON-DMKPEC) OFFSET OF HANDLER 01368000 DC AL1(PEXTERM) SET TO TURN ON TERM FLAG 01369000 DC AL1(1) MINIMUM TRUNCATION -1 01370000 DC AL1(7) TOTAL LENGTH -1 01371000 DC C'TERMINAL' KEYWORD NAME 01372000 SPACE 01373000 DC AL2(FLAGOFF-DMKPEC) OFFSET OF HANDLER 01374000 DC AL1(255-PEXTERM) TURN OF TERM FLAG 01375000 DC AL1(2) MINIMUM TRUNCATION 01376000 DC AL1(9) TOTAL LENGTH -1 01377000 DC C'NOTERMINAL' KEYWORD NAME 01378000 SPACE 01379000 DC AL2(RANGE-DMKPEC) OFFSET OF HANDLER 01380000 DC AL1(*-*) UNUSED 01381000 DC AL1(0) MINIMUM TRUNCATION -1 01382000 DC AL1(4) TOTAL LENGTH -1 01383000 DC C'RANGE' KEYWORD NAME 01384000 SPACE 01385000 DC AL2(CF-DMKPEC) OFFSET OF HANDLER 01386000 DC AL1(*-*) NOT USED 01387000 DC AL1(1) MINIMUM TRUNCATION -1 01388000 DC AL1(2) TOTAL LENGTH -1 01389000 DC C'CMD' KEYWORD NAME 01390000 SPACE 01391000 DC AL2(DUMP-DMKPEC) OFFSET OF HANDLER 01392000 DC AL1(*-*) UNUSED 01393000 DC AL1(0) MINIMUM TRUNCATION -1 01394000 DC AL1(3) TOTAL LENGTH -1 01395000 DC C'DUMP' KEYWORD NAME 01396000 SPACE 01397000 DC AL2(SAVE-DMKPEC) OFFSET OF HANDLER 01398000 DC AL1(*-*) UNUSED 01399000 DC AL1(1) MINIMUM TRUNCATION -1 01400000 DC AL1(3) TOTAL LENGTH -1 01401000 DC C'SAVE' KEYWORD NAME 01402000 SPACE 01403000 DC AL2(GET-DMKPEC) OFFSET OF HANDLER 01404000 DC AL1(*-*) UNUSED 01405000 DC AL1(1) MINIMUM TRUNCATION -1 01406000 DC AL1(2) TOTAL LENGTH -1 01407000 DC C'GET' KEYWORD NAME 01408000 SPACE 01409000 DC AL2(CLEAR-DMKPEC) OFFSET OF HANDLER 01410000 DC AL1(*-*) UNUSED 01411000 DC AL1(0) MINIMUM TRUNCATION -1 01412000 DC AL1(4) TOTAL LENGTH -1 01413000 DC C'CLEAR' 01414000 SPACE 01415000 DC AL2(OFF-DMKPEC) OFFSET OF HANDLER 01416000 DC AL1(*-*) UNUSED 01417000 DC AL1(0) MINIMUM TRUNCATION -1 01418000 DC AL1(2) TOTAL LENGTH -1 01419000 DC C'OFF' KEYWORD NAME 01420000 SPACE 01421000 DC AL2(END-DMKPEC) OFFSET OF HANDLER 01422000 DC AL1(*-*) UNUSED 01423000 DC AL1(1) MINIMUM TRUNCATION -1 01424000 DC AL1(2) TOTAL LENGTH -1 01425000 DC C'END' KEYWORD NAME 01426000 SPACE 01427000 DC AL2(QUERY-DMKPEC) OFFSET OF HANDLER 01428000 DC AL1(*-*) UNUSED 01429000 DC AL1(0) MINIMUM TRUNCATION -1 01430000 DC AL1(4) TOTAL LENGTH -1 01431000 DC C'QUERY' KEWORD NAME 01432000 DC X'FF' FLAG END OF TABLE 01433000 EJECT 01434000 *---------------------------------------------------------------------* 01435000 * DSECTS AND EQUATES * 01436000 *---------------------------------------------------------------------* 01437000 SPACE 01438000 COPY EQU 01439000 COPY PERBLOKS 01440000 PSA 01441000 COPY SAVE 01442000 COPY VMBLOK 01443000 END 01444000