ibm:vm370-lib:cp:dmkpec.assemble_src
Table of Contents
DMKPEC Source
References
- Fixes Applied : 1
- This Source Date : Wednesday, June 25, 1980
- Last Fix ID : [HRC013DK]
Source Listing
- DMKPEC.ASSEMBLE.txt
- 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
ibm/vm370-lib/cp/dmkpec.assemble_src.txt · Last modified: 2023/08/06 13:37 by Site Administrator