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 <HEX STRING> * 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 <RANGE> * 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 <ADDRESS HEXDATA> * 00190000
* -- <RANGE> * 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 <PAGE-SIZE> * 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 <HEX DATA> * 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 <TRACE SET NAME> * 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 <SAVED TRACE NAME> * 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