ibm:vm370-lib:cms:dmsdbg.assemble_src
Table of Contents
DMSDBG Source
References
- Fixes Applied : 0
- This Source Date : Tuesday, December 12, 1978
- Last Fix ID : [Unmodified]
Source Listing
- DMSDBG.ASSEMBLE.txt
- DBG TITLE 'DMSDBG (CMS) VM/370 - RELEASE 6' 00001000
- SPACE 2 00002000
- *. 00006000
- * 00007000
- * MODULE NAME - 00008000
- * 00009000
- * DMSDBG (DEBUG) 00010000
- * 00011000
- * FUNCTION - 00012000
- * 00013000
- * TO ENABLE THE USER TO DEBUG HIS PROGRAM FROM THE 00014000
- * TERMINAL. 00015000
- * 00016000
- * ATTRIBUTES - 00017000
- * 00018000
- * REENTRANT, NUCLEUS RESIDENT 00019000
- * 00020000
- * ENTRY POINT - 00021000
- * 00022000
- * 1. DMSDBGP, PRGINT - PROGRAM INTERRUPTS 00023000
- * 2. DMSDBG - ALL OTHER INTERRUPTS CAUSING ENTRY TO DEBUG 00024000
- * 00025000
- * ENTRY CONDITIONS - 00026000
- * 00027000
- * R1 = A(PLIST) 00028000
- * PLIST = CL8'DEBUG' 00029000
- * 00030000
- *|EXIT CONDITIONS - 00031000
- *| 00032000
- *| NORMAL - 00033000
- * USER TYPES IN RETURN, GO, HX, IPL 00034000
- *| 00035000
- *| ERROR - 00036000
- *| NONE 00037000
- *| 00038000
- *|CALLS TO OTHER ROUTINES - 00039000
- *| WAITRD 00040000
- *| DMSDBD - DUMP THE DESIRED LOCATIONS OF USERS VIRTUAL MACHINE 00041000
- *| KILLEX - RE-IPL CMS 00042000
- * DMSABNRT - ABEND RECOVERY 00043000
- *| 00044000
- *|EXTERNAL REFERENCES - 00045000
- *| 00046000
- *| NUCON - NUCLEUS AREA CONSTANTS AND VARIABLES 00047000
- *| DBGSECT - DEBUG STORAGE AREA 00048000
- * DMSABW - WORK AREA FOR ABEND RECOVERY 00049000
- * OPSECT - I/O OPERATION LISTS 00050000
- * DEVTAB - CONSOLE DEVICE ADDRESS 00051000
- *| 00052000
- *|TABLES /WORKAREAS - 00053000
- *| 00054000
- *| SEE DBGSECT 00055000
- *| VARIOUS CONSTANTS AND ERROR MESSAGES 00056000
- *| 00057000
- *|REGISTER USAGE - 00058000
- *| 00059000
- *| GPR2, GPR3 = USED AS EVEN ODD REGISTER PAIR 00060000
- *| GPR4 = COUNT REGISTER 00061000
- *| GPR5, GPR8 = WORK REGISTERS 00062000
- *| GPR6 = A(ARGUMENT IN PLIST BEING PROCESSED) 00063000
- *| GPR7 = DEBUG'S OWN I/O 00064000
- *| GPR10 = A(DBGSECT) 00065000
- *| GPR11, GPR14 = LINK REGISTER 00066000
- *| 00067000
- *|NOTES - 00068000
- *| 00069000
- *| NONE 00070000
- * 00071000
- * OPERATION - 00072000
- * 00073000
- * THE DISCUSSION OF THE DEBUG COMMAND PROGRAM WILL BE 00074000
- * DIVIDED INTO TWO PARTS; PROCESSING ON ENTRY, AND 00075000
- * REQUEST ENVIRONMENT PROCESSING. 00076000
- * 00077000
- * PROCESSING ON ENTRY - 00078000
- * 00079000
- * THE PROCESSING PERFORMED BY THE DEBUG COMMAND PROGRAM 00080000
- * WHEN IT RECEIVES CONTROL DEPENDS ON WHETHER IT WAS 00081000
- * GIVEN CONTROL BECAUSE OF EITHER A DEBUG COMMAND 00082000
- * ENTERED FROM THE TERMINAL, AN EXTERNAL INTERRUPTION, 00083000
- * OR A PROGRAM INTERRUPTION. 00084000
- * 00085000
- * DEBUG COMMAND - 00086000
- * 00087000
- * DEBUG SAVES THE CONTENTS OF THE GENERAL PURPOSE 00088000
- * REGISTERS AND SAVES THE CSW AND CAW. IT THEN TYPES 00089000
- * THE MESSAGE 'DEBUG ENTERED' AT THE TERMINAL AND 00090000
- * ENTERS THE REQUEST ENVIRONMENT. 00091000
- * 00092000
- * EXTERNAL INTERRUPTION - 00093000
- * 00094000
- *| SAVES THE CONTENTS 00095000
- * OF THE GENERAL PURPOSE REGISTERS, AND SAVES THE CSW 00096000
- * AND CAW. IT THEN TYPES THE MESSAGE 'DEBUG ENTERED' 00097000
- * AT THE TERMINAL. NEXT, IT TYPES THE MESSAGE 00098000
- * 'EXTERNAL INT.' AT THE TERMINAL AND ENTERS THE 00099000
- * REQUEST ENVIRONMENT. 00100000
- * 00101000
- * PROGRAM INTERRUPTION - 00102000
- * 00103000
- *| SAVES THE CONTENTS 00104000
- * OF THE GENERAL PURPOSE REGISTERS, AND SAVES THE CSW 00105000
- * AND CAW. IT THEN DETERMINES IF THE PROGRAM 00106000
- * INTERRUPTION OCCURRED AT A BREAKPOINT. (IF THE 00107000
- * ADDRESS OF THE INSTRUCTION THAT CAUSED THE 00108000
- * INTERRUPTION MATCHES THE ADDRESS IN AN ENTRY IN THE 00109000
- * BREAKPOINT TABLE (REFER TO "BREAK REQUEST", LATER IN 00110000
- * THIS SECTION, THE INTERRUPTION OCCURRED AT A 00111000
- * BREAKPOINT). IF THE PROGRAM INTERRUPTION OCCURRED AT 00112000
- * A BREAKPOINT, DEBUG MOVES THE ABSOLUTE ADDRESS OF THE 00114000
- * BREAKPOINT TO THE LAST THREE BYTES OF THE SAVED PSW 00115000
- * AND RESTORES THE OPERATION OF THE INSTRUCTION LOCATED 00116000
- * AT THE BREAKPOINT. IT THEN TYPES THE MESSAGE 00117000
- * 'BREAKPOINT XX AT YYYYYY' (WHERE XX IS THE BREAKPOINT 00118000
- * NUMBER AND YYYYYY THE CORE-ADDRESS OF THE BREAKPOINT 00119000
- * REACHED) AND ENTERS THE REQUEST ENVIRONMENT. 00120000
- * IF THE PROGRAM CHECK IS NOT A BREAKPOINT, 00121000
- * CONTROL IS PASSED TO DMSITP. 00122000
- * 00123000
- * ON ANY ENTRY, DEBUG WILL SAVE LOWCORE LOCATIONS 00124000
- * 0-160; THAT IS A DUMP OF LOW CORE WILL REFLECT ITS 00125000
- * VALUE AT THE TIME OF ENTERING DEBUG. 00126000
- * 00127000
- * REQUEST ENVIRONMENT PROCESSING - 00128000
- * 00129000
- * WHEN THIS ENVIRONMENT IS ENTERED, THE USER IS GIVEN 00130000
- * THE OPPORTUNITY TO MAKE DEBUG REQUESTS FROM THE 00131000
- * TERMINAL. FOR EACH SUCH REQUEST, DEBUG DETERMINES 00132000
- * ITS NATURE THROUGH A TABLE-LOOKUP PROCEDURE AND 00133000
- * PASSES CONTROL TO A CORRESPONDING PROGRAM TO 00134000
- * IMPLEMENT THE REQUEST. WHEN THE EXECUTION OF THAT 00135000
- * PROGRAM IS COMPLETE, IT RETURNS CONTROL TO THE 00136000
- * CONTROL ELEMENT, WHICH OBTAINS THE NEXT REQUEST. 00137000
- * THIS REQUEST IS PROCESSED SIMILARLY. 00138000
- * 00139000
- * ADDRESSING - 00140000
- * 00141000
- * AN ADDRESS MAY BE SPECIFIED TWO WAYS: (1) AS A 00142000
- * SYMBOLIC ADDRESS IF PREVIOUSLY DEFINED, (2) AS A 00143000
- * HEXADECIMAL CONSTANT. THE CURRENT VALUE OF THE 00144000
- * ORIGIN WILL BE ADDED TO THE ADDRESS IF IT WAS 00145000
- * HEXADECIMAL. 00146000
- * 00147000
- * ORIGIN REQUEST - 00148000
- * 00149000
- * DEBUG CONVERTS THE ORIGIN VALUE SUPPLIED ON THE 00150000
- * REQUEST TO BINARY, SAVES IT FOR FUTURE USE, AND 00151000
- * RETURNS FOR THE NEXT REQUEST. THE ORIGIN VALUE MAY 00152000
- * BE A SYMBOLIC ADDRESS OR A HEXADECIMAL ADDRESS. THE 00153000
- * PREVIOUS ORIGIN VALUE IS NOT ADDED INTO THE 00154000
- * HEXADECIMAL ADDRESS. 00155000
- * 00156000
- * DEFINE REQUEST - 00157000
- * 00158000
- * DEBUG CONVERTS THE HEXADECIMAL ADDRESS TO BINARY, 00159000
- * MAKES THE ADDRESS ABSOLUTE BY ADDING THE CURRENT 00160000
- * ORIGIN VALUE TO IT, AND STORES THE RESULTANT ABSOLUTE 00161000
- * ADDRESS IN THE TEMPORARY SYMBOL TABLE (TSYM). IT THEN 00162000
- * RETRIEVES THE SYMBOL BEING DEFINED AND PLACES IT INTO 00163000
- * THE TEMPORARY SYMBOL TABLE. NEXT, DEBUG RETRIEVES 00164000
- * THE LENGTH VALUE FOR THE SYMBOL (IF ANY) SUPPLIED ON 00165000
- * THE REQUEST AND PLACES IT INTO THE TEMPORARY SYMBOL 00166000
- * TABLE. (IF A LENGTH VALUE IS NOT PROVIDED, A DEFAULT 00167000
- * VALUE OF FOUR IS ASSUMED.) FINALLY, DEBUG MOVES THE 00168000
- * CONTENTS OF THE TEMPORARY SYMBOL TABLE INTO THE NEXT 00169000
- * AVAILABLE ENTRY IN THE DEFINED SYMBOL TABLE (SYMTBG) 00170000
- * AND RETURNS FOR THE NEXT REQUEST. 00171000
- * 00172000
- * EXAMINE (X) REQUEST - DEBUG USES THE ADDRESS 00173000
- * SPECIFIED TO DETERMINE THE LOCATIONS TO BE EXAMINED 00174000
- * (SEE THE FOREGOING DESCRIPTION UNDER "ADDRESSING"). 00175000
- * IF THE LENGTH IS SPECIFIED, THAT IS USED; OTHERWISE, 00176000
- * THE LENGTH IS OBTAINED FROM THE SYMBOL TABLE IF THE 00177000
- * ADDRESS WAS SYMBOLIC OR IS ASSUMED TO BE THE DEFAULT 00178000
- * VALUE OF FOUR IF THE ADDRESS WAS HEXADECIMAL. 00179000
- * FINALLY, DEBUG MOVES THE NUMBER OF BYTES SPECIFIED BY 00180000
- * THE LENGTH STARTING FROM THE LOCATION OF THE FIRST 00181000
- * BYTE TO AN OUTPUT BUFFER, TYPES THEM AT THE TERMINAL, 00182000
- * AND RETURNS FOR THE NEXT REQUEST. 00183000
- * 00184000
- * BREAK REQUEST - 00185000
- * 00186000
- * DEBUG USES THE ADDRESS SPECIFIED TO DETERMINE THE 00187000
- * BREAKPOINT LOCATION (SEE "ADDRESSING"). THIS ADDRESS 00188000
- * IS STORED IN THE BREAKPOINT TABLE ENTRY CORRESPONDING 00189000
- * TO THE BREAKPOINT NUMBER SUPPLIED WITH THE REQUEST. 00190000
- * DEBUG SAVES THE OPERATION CODE (THE FIRST BYTE) 00191000
- * LOCATED AT THE BREAKPOINT, REPLACES THE OPERATION 00192000
- * CODE LOCATED AT THE BREAKPOINT WITH AN INVALID 00193000
- * OPERATION CODE, AND RETURNS FOR THE NEXT REQUEST. 00194000
- * (WHEN THE INVALID OPERATION CODE IS ENCOUNTERED 00195000
- * DURING EXECUTION OF THE PROGRAM CONTAINING THE 00196000
- * BREAKPOINT, A PROGRAM INTERRUPTION OCCURS AND CONTROL 00197000
- * IS PASSED TO DEBUG, WHICH TYPES A MESSAGE AT THE 00198000
- * TERMINAL INDICATING THAT THE BREAKPOINT HAS BEEN 00199000
- * REACHED. AN INVALID OPERATION CODE IS X'EX', WHERE X 00200000
- * IS THE BREAKPOINT ID (0-15) IN HEXADECIMAL NOTATION.) 00201000
- * 00202000
- * STORE REQUEST - 00203000
- * 00204000
- * DEBUG USES THE ADDRESS SPECIFIED TO DETERMINE THE 00205000
- * ABSOLUTE LOCATION WHERE THE DATA IS TO BE STORED (SEE 00206000
- * "ADDRESSING"). IT THEN CONVERTS THE DATA TO BE 00207000
- * STORED TO BINARY, MOVES IT OT THE ABSOLUTE CORE 00208000
- * LOCATIONS, AND RETURNS FOR THE NEXT REQUEST. 00209000
- * 00210000
- * DUMP REQUEST - 00211000
- * 00212000
- * DEBUG DETERMINES FROM THE COMMAND LINE THE ABSOLUTE 00213000
- * LIMITS OF THE MAIN STORAGE TO BE DUMPED AND PLACES 00214000
- * THE APPROPRIATE VALUES INTO THE DUMPLIST PLIST. NOTE 00215000
- *| THAT THE DUMPLIST PLIST IS LOCATED IN NUCON. 00216000
- *| ALSO PLACED INTO THE PLIST ARE THE ADDRESSES 00217000
- * OF THE GENERAL REGISTER SAVE AREA, THE FLOATING-POINT 00218000
- * REGISTER SAVE AREA, AND THE ADDRESS OF A LOW CORE 00219000
- *| (0-160) SAVE AREA. DESCRIPTION OF THE PLIST AND ITS 00220000
- * USE CAN BE FOUND IN THE ROUTINE DEBDUMP, WHICH IS THE 00221000
- * DUMP EXECUTIONER. DEBUG THEN BALR'S TO THE DEBDUMP 00222000
- * ROUTINE, THE DUMP IS EXECUTED AND THE NEXT COMMAND 00223000
- * MAY BE ISSUED. 00224000
- * 00225000
- * SET REQUEST - 00226000
- * 00227000
- * IF THE PSW IS TO BE SET, DEBUG CONVERTS THE DATA TO 00228000
- * BINARY, OVERLAYS THE PSW IT SAVED ON ENTRY WITH THE 00229000
- * CONVERTED DATA, AND RETURNS FOR THE NEXT REQUEST. 00230000
- * DEBUG SETS THE CSW, CAW, AND CONTENTS OF THE 00231000
- * SPECIFIED REGISTER IN A SIMILAR MANNER. 00232000
- * 00233000
- * PSW REQUEST - 00234000
- * 00235000
- * DEBUG MOVES THE PSW IT SAVED ON ENTRY TO AN OUTPUT 00236000
- * BUFFER, TYPES IT AT THE TERMINAL, AND RETURNS FOR THE 00237000
- * NEXT REQUEST. (THE PSW SAVED BY DEBUG ON ENTRY MAY 00238000
- * HAVE BEEN MODIFIED BY A SET COMMAND.) 00239000
- * 00240000
- * CSW REQUEST - 00241000
- * 00242000
- * DEBUG MOVES THE CSW IT SAVED ON ENTRY TO AN OUTPUT 00243000
- * BUFFER, TYPES IT AT THE TERMINAL, AND RETURNS FOR THE 00244000
- * NEXT REQUEST. (THE CSW SAVED BY DEBUG ON ENTRY MAY 00245000
- * HAVE BEEN MODIFIED BY A SET REQUEST.) 00246000
- * 00247000
- * CAW REQUEST - 00248000
- * 00249000
- * DEBUG MOVES THE CAW IT SAVED ON ENTRY TO AN OUTPUT 00250000
- * BUFFER, TYPES IT AT THE TERMINAL, AND RETURNS FOR THE 00251000
- * NEXT REQUEST. (THE CAW SAVED BY DEBUG ON ENTRY MAY 00252000
- * HAVE BEEN MODIFIED BY A SET REQUEST.) 00253000
- * 00254000
- * GPR REQUEST - 00255000
- * 00256000
- * DEBUG DETERMINES THE FIRST REGISTER SPECIFIED. IT 00257000
- * THEN MOVES THE CONTENTS OF THAT REGISTER (SAVED UPON 00258000
- * ENTRY) TO AN OUTPUT BUFFER AND TYPES IT AT THE 00259000
- * TERMINAL. DEBUG REPEATS THIS PROCESS FOR EACH 00260000
- * REGISTER TO BE CONSIDERED. IT THEN RETURNS FOR THE 00261000
- * NEXT REQUEST. (THE CONTENTS OF THE REGISTERS SAVED 00262000
- * BY DEBUG ON ENTRY MAY HAVE BEEN MODIFIED BY A SET 00263000
- * REQUEST.) 00264000
- * 00265000
- * GO REQUEST - 00266000
- * 00267000
- * IF AN ADDRESS WAS SPECIFIED (SEE "ADDRESSING"), ITS 00268000
- * ABSOLUTE VALUE IS STORED INTO THE SAVED PSW. DEBUG 00269000
- * RESTORES THE CSW AND CAW IT SAVED ON ENTRY TO THEIR 00270000
- * CORRESPONDING LOCATIONS IN LOWER MAIN STORAGE, 00271000
- * RESTORES THE REGISTERS WITH THE CONTENTS IT SAVED ON 00272000
- * ENTRY, AND LOADS THE PSW IT SAVED ON ENTRY. (THE 00273000
- * CONTENTS OF THE REGISTERS AND THE CSW AND CAW SAVED 00274000
- * BY DEBUG ON ENTRY MAY HAVE BEEN MODIFIED BY A SET 00275000
- * REQUEST.) IF THE GO ADDRESS WAS NOT SPECIFIED, 00276000
- * LOADING OF THE PSW CAUSES CONTROL TO BE RETURNED TO 00277000
- * THE INTERRUPTED PROGRAM AT THE POINT OF INTERRUPTION, 00278000
- * OR PASSED TO THE LOCATION SPECIFIED IF THE USER 00279000
- * MODIFIED THE ADDRESS PORTION OF THE PSW WITH A SET 00280000
- * REQUEST. 00281000
- * 00282000
- * RETURN REQUEST - 00291000
- * 00292000
- * IF DEBUG HAD NOT BEEN ENTERED AFTER AN ABEND, THEN 00293000
- * DEBUG RESTORES THE REGISTERS WITH THE CONTENTS IT 00294000
- * SAVED ON ENTRY, CLEARS REGISTER 15, AND BRANCHES 00295000
- * UNCONDITIONALLY THROUGH REGISTER 14. (THE CONTENTS OF 00296000
- * THE REGISTERS SAVED BY DEBUG ON ENTRY MAY HAVE BEEN 00297000
- * MODIFIED BY A SET REQUEST.) RETURN IS VALID ONLY IF 00298000
- * DEBUG WAS ENTERED VIA THE DEBUG COMMAND. 00299000
- * IF DEBUG HAD BEEN ENTERED AFTER AN ABEND, THEN 00300000
- * CONTROL IS PASSED BACK TO DMSABN. 00301000
- * 00302000
- * HX REQUEST - 00316000
- * 00317000
- * IF HX IS REQUESTED, THE HALT EXECUTION LOGIC IS INVOKED 00318000
- * AS IF HX HAD BEEN ENTERED VIA THE CMS COMMAND ENVIRON- 00319000
- * MENT. THE HALT EXECUTION LOGIC CLOSES ALL OPEN FILES, 00320000
- * AND UPDATES THE USER FILE DIRECTORY. 00321000
- * 00322000
- *. 00323000
- EJECT 00324000
- MACRO 00325000
- DEFINE &LIST 00326000
- LCLA &I 00327000
- LCLC &T 00328000
- .LUP ANOP 00329000
- &I SETA &I+1 00330000
- &T SETC '&SYSLIST(&I)'(1,7) 00331000
- L&T EQU LOWSAVE+&SYSLIST(&I)-NUCON 00332000
- AIF (&I LT N'&SYSLIST).LUP 00333000
- MEND 00334000
- SPACE 00335000
- DMSDBGP CSECT 00336000
- REGEQU 00337000
- DMSDBGP CSECT , PROGRAM INTERRUPT ENTRY POINT 00338000
- ENTRY PRGINT ********** REMOVE ******** 00339000
- PRGINT EQU * ********** REMOVE ******** 00340000
- USING NUCON,R0 00341000
- TM DBGFLAGS,DBGRECUR RECURSION? 00342000
- BCR 1,TEMP (PIDDLING USAGE, I KNOW.) 00343000
- OI DBGFLAGS,DBGPGMCK TURN ON PROGRAM CHECK FLAG 00344000
- SPACE 00345000
- ENTRY DMSDBG 00346000
- DMSDBG EQU * ENTRY FOR ALL OTHER TYPES 00347000
- USING NUCON,R0 ACCESS NUCLEUS AREA CONSTANTS 00348000
- STM 0,15,GPRLOG SAVE ALL REGISTERS 00349000
- * 00350000
- * NOTE -- R14 = RETURN-ADDRESS. 00351000
- * 00352000
- CNOP 2,4 LOCATION COUNTER ON FULLWORD BOUNDARY 00353000
- BALR BASE,0 ADDRESSABILITY 00354000
- USING *,BASE ... 00355000
- L R10,=V(DBGSECT) A(DBGSECT) 00356000
- USING DBGSECT,R10 ACCESS DEBUG STORAGE AND CONSTANTS 00357000
- OI DBGFLAGS,DBGEXEC INDICATE ENTRANCE TO EXEC 00358000
- MVI OUTPT1,X'01' SET OUTPUT BUFF LEN @VA04318 00358100
- MVI DBGOUT,X'17' CARR RET (IDLE CHAR) @VA04318 00358200
- MVC LOWSAVE,0 SAVE LOWCORE 00359000
- STDM F0,F6,FPRLOG STORE FLOATING POINT REGS 00360000
- * 00361000
- * NOTE: CP/CMS SHARED SEGMENT PROTECTION (SSP) FEATURE NOW 00362100
- * PERMITS MODIFICATION BY A USER OF A SHARED SEGMENT. 00363100
- * 00364100
- NI DBGFLAGS,255-DBGRECUR CLEAR "RECURSION" FLAG @V304732 00365100
- TM DBGFLAGS,DBGABN ENTRY FROM DMSABN? 00386000
- BO ABNENT YES 00387000
- TM DBGFLAGS,DBGPGMCK ENTRANCE FROM A PROGRAM CHECK ? 00388000
- BO BRKENT YES 00389000
- TM DBGFLAGS,DBGEXINT ENTRANCE FROM EXTERNAL INTERRUPT 00390000
- BO INTENT YES 00391000
- * 00392000
- * "REGULAR" (ON-PURPOSE) ENTRY ... 00393000
- * 00394000
- L R1,CURRSAVE POINT TO 'DEBUG' SAVE AREA 00395000
- USING SSAVE,R1 00396000
- OI TYPFLAG,TPFUSR MAKE US A 'USER' PROGRAM 00397000
- XC OUTPT1,OUTPT1 INITIALIZE BYTE COUNT @VA01159 00398100
- MVC XPSW(8),PSW1 SET UP A PSW (SO WE HAVE SOMETHING) 00403000
- TM PROTFLAG,PRFPOFF NUCLEUS PROTECTION TURNED OFF? 00404000
- BO *+8 SKIP IF SO 00405000
- OI XPSW+1,USERKEY PUT USER KEY INTO XPSW 00406000
- USERKEY EQU X'E0' 00407000
- B CHEKTYPE TYPE DEBUG ENTERED @VA01159 00408100
- * ENTRY FROM DMSABN. WE MUST COPY PSW AND REGISTERS FROM DMSABN 00409000
- * WORK AREA. 00410000
- ABNENT EQU * 00411000
- L R1,CURRSAVE POINT TO CURRENT SAVE AREA 00412000
- USING SSAVE,R1 00413000
- OI TYPFLAG,TPFUSR MAKE US A 'USER' PROGRAM 00414000
- L R1,=V(DMSABW) POINT TO DMSABN WORK AREA 00415000
- USING ABWSECT,R1 00416000
- MVC XPSW,ABNPSW COPY PSW 00417000
- MVC GPRLOG(4*16),ABNREGS COPY REGISTERS 00418000
- EJECT 00419100
- CHEKTYPE EQU * 00423000
- DMSERR TEXT='DEBUG ENTERED',NUM=728,LET=I, *00424000
- MF=(E,'SYS'),TYPCALL=BALR @VA04738 00425000
- L R1,AOPSECT GET OPSECT ADDRESSABILITY 00426000
- USING OPSECT,R1 00427000
- LA R1,WAITLIST POINT TO CONWAIT PLIST 00428000
- L R15,=V(DMSCWT) GET CONWAIT ADDRESS @VA01039 00429100
- LA IOLINK,JPRINT GET RETURN ADDRESS FROM BALRCALL @VA01039 00429200
- BALRCALL STM R0,R14,DBGSAV1 SAVE ALL REGS @VA01039 00429300
- LA R13,DBGSAV2 GET SAVE AREA FOR BALR @VA01039 00429400
- BALR R14,R15 GO TO CONWAIT OR CONREAD @VA01039 00429500
- USING *,R14 GET ADDRESSABILITY @VA01039 00429600
- L R10,=V(DBGSECT) A(DBGSECT) @VA01039 00429700
- LM R0,R14,DBGSAV1 RESTORE ALL REGS @VA01039 00429800
- BR IOLINK RETURN TO CALLER @VA01039 00429900
- DROP R14 DROP TEMP BASE @VA01039 00430000
- DROP R1 00431000
- EJECT 00439000
- ********************************************************************** 00440000
- * * 00441000
- * 'NEWLIN' * 00442000
- * GET NEXT COMMAND LINE * 00443000
- * * 00444000
- ********************************************************************** 00445000
- * 00446000
- * NOTE -- COMES TO 'JPRINT' IF TYPEOUT TO BE FOLLOWED BY READ... 00447000
- JPRINT BAL IOLINK,IOPRT GIVE TYPEOUT (ALREADY SET UP) 00448000
- * 00449000
- NEWLIN MVI OUTPT1,X'01' SET OUTPUT BUFF LEN @VA01159 00450100
- MVI DBGOUT,X'17' CARR RETURN (VIA IDLE CHAR) @VA01159 00450200
- BAL IOLINK,IOPRT GO TYPE LINE @VA01159 00450300
- XC INPUT(132),INPUT ZERO OUT INPUT BUFFER @VA01159 00450400
- MVC ARGS(MVCNT2),INPUT CLEAR ARGS, JFLAGS, ARGSCT 00451000
- BAL IOLINK,IORD GET READ A LINE @VA01159 00452100
- CH R15,WTRDCNT ANYTHING READ ? @VA01159 00452200
- BNE NOTCAR BNE IF NOT, SOMETHING THERE. 00460000
- MVI OUTPT1,5 IF 'PLAIN' CARRIAGE RETURN, 00462000
- MVC DBGOUT(5),=C'DEBUG' SET UP TO TYPE 'DEBUG' AND 00463000
- B JPRINT GO GET A NEW LINE. (15 JAN 67) 00464000
- * 00465000
- * CLEAN UP INPUT LINE AND FORCE UPPER CASE 00466000
- * 00467000
- * R1 CONSTANT = 1 00468000
- * R2 PROCESSED CHARACTER COUNT 00469000
- * R4 ADDRESS OF INPUT BUFFER - 1 00470000
- * R5 BCT COUNTER FOR INPUT BUFFER 00471000
- * R9 POINTS TO INPUT BUFFER 00472000
- * R3 POINTS TO END OF PROCESSED CHARACTER STRING 00473000
- * R12 ADDRESSABILITY 00474000
- * 00475000
- NOTCAR EQU * 00489000
- LA R4,INPUT-1 LOAD THE INITIAL BUFFER ADDRESS 00490000
- LA R1,1 INITIALIZE THE CONSTANT 1 00491000
- LH R5,WTRDCNT GET NUMBER BYTES READ @VA01159 00492100
- LR R9,R4 LOAD THE INPUT BUFFER POINTER 00493000
- SR22 SR R2,R2 CLEAR THE PROCESSED CHARACTER COUNT 00494000
- LR R3,R4 LOAD THE PROCESSED CHARACTER POINTER 00495000
- FB EQU * 00496000
- CLI 1(R9),C' ' TEST FOR INITIAL BLANK 00497000
- BNE IC 00498000
- AR R9,R1 INCREMENT THE INPUT POINTER 00499000
- BCT R5,FB TEST FOR END OF LINE 00500000
- B NEWLIN 00501000
- * 00502000
- * CHARACTER PROCESSING LOOP 00503000
- * 00504000
- IC EQU * 00505000
- AR R9,R1 INCREMENT THE INPUT POINTER 00506000
- CLI 0(R9),0 TEST FOR END OF LINE 00507000
- BE EOL 00508000
- AR R3,R1 INCREMENT THE PROCESSED CHARACTER POINTER 00513000
- AR R2,R1 INCREMENT THE PROCESSED CHAR. COUNT 00514000
- MVC 0(1,R3),0(R9) MOVE INPUT CHAR. INTO PROCESSED STRING 00515000
- STC1 EQU * 00516000
- BCT R5,IC TEST FOR END OF INPUT BUFFER 00517000
- * 00518000
- * END OF LINE PROCESSING - BLANK FILL REMAINDER OF LINE 00519000
- * 00520000
- EOL EQU * 00521000
- LTR R2,R2 TEST FOR EMPTY INPUT LINE 00522000
- BNH NEWLIN 00523000
- LA R5,130 LOAD LENGTH OF PROCESSED STRING - 2 00524000
- SR R5,R2 COMPUTE NUMBER OF BLANKS NEEDED 00525000
- MVI 1(R3),C' ' STORE BLANK AFTER END OF PROCESSED LINE 00526000
- EX R5,EOLMVC BLANK FILL REMAINDER OF THE LINE 00527000
- STH R2,INPUTSIZ STORE LENGTH OF INPUT LINE FOR LATER USE 00528000
- EJECT 00529000
- ********************************************************************** 00530000
- * * 00531000
- * 'CONTRL' * 00532000
- * ROUTINE TO TEAR APART COMMAND INPUT LINE * 00533000
- * * 00534000
- ********************************************************************** 00535000
- CONTRL LA COUNT,INPUT SET POINTER 00536000
- LA R9,JFLAGS SET R9 FOR JFLAGS (NEW -- JAS) 00537000
- LA TEMP,ARGS SET THE OTHER POINTER 00538000
- LA R7,SAVE1 POINT TO SAVE1 00539000
- CONTL1 SR EVEN,EVEN INITIALE REGISTERS = 0 00540000
- SR ODD,ODD ... 00541000
- LA R13,8 SET FOR 8 CHARACTERS MAXIMUM 00542000
- CONTL2 SLDL EVEN,8 SHIFT TO ALLOW ROOM FOR NEXT CHARACTER 00543000
- IC ODD,0(,COUNT) INSERT CHARACTER 00544000
- CLI 0(COUNT),C'0' IS IT = 0 OR MORE? 00545000
- BNL LACNT BNL IF 0 OR MORE (NUMERIC) 00546000
- CLI 0(COUNT),C'F' IF < 0, IS IT = F OR LESS? 00547000
- BH JWASALF BH IF > F, DEFINITELY 'ALPHABETIC' 00548000
- OI 0(R9),X'F0' OR IN A 'MIXED' FLAG FOR PROBABLY HEX 00549000
- CLI 0(COUNT),C'A' MAKE SURE BETWEEN A AND F INCLUSIVE 00550000
- BNL LACNT BNL IF 'A' OR MORE (LOOKS LIKE HEX) 00551000
- JWASALF OI 0(R9),X'FF' SET FLAG ALL ONES IF NOT A-F OR 0-9. 00552000
- LACNT LA COUNT,1(,COUNT) INCREMENT INPUT-INDEXER, 00553000
- CLI 0(COUNT),C' ' LOOK AT 'NEXT' CHARACTER 00554000
- BE JWASBLNK BE IF A BLANK 00555000
- BCT R13,CONTL2 IF NOT, CONTINUE UP TO 8 TIMES 00556000
- TRUNC LA COUNT,1(,COUNT) IF 8 ALREADY, AND NEXT NOT BLANK, 00557000
- CLI 0(COUNT),C' ' TRUNCATE THE FIELD AFTER 8 CHARS., 00558000
- BNE TRUNC AND KEEP SCANNING FOR A BLANK. 00559000
- JWASBLNK LA AC,ARGMAX IF BLANK FOUND, TEST IF ROOM IN AR. LIST 00560000
- BCTR R13,R0 DECREMENT BY 1 00561000
- SH R13,=H'8' DETERMINE LENGTH OF OPERAND 00562000
- LPR R13,R13 COMPLEMENT IT 00563000
- STC R13,0(,R7) SAVE THE LENGTH OF THE ARG. 00564000
- LA R7,1(,R7) POINT TO THE NEXT SAVE LOCATION 00565000
- CR TEMP,AC ... 00566000
- BNL ERR06 BNL IF NOT ENOUGH ROOM, ERROR 6 00567000
- STM EVEN,ODD,0(TEMP) STORE PARAMETER ARGUMENT 00568000
- LA TEMP,8(0,TEMP) INCREMENT ARGUMENT LIST POINTER 00569000
- LA R9,1(,R9) INCREMENTER POINTER TO 'JFLAGS' FOR NEXT 00570000
- LA AC,INPUT+2 SET UP TEST FOR END-OF-LINE (PLUS 2 BYTES) 00571000
- AH AC,INPUTSIZ EXTRA BYTES GIVE TERMINATING BLANKS 00572000
- CONTL3 LA COUNT,1(0,COUNT) INCREMENT COUNTER 00573000
- CLI 0(COUNT),C' ' HAVE WE REACHED ANOTHER PARAMETER 00574000
- BC 7,CONTL1 YES, PROCESS IT 00575000
- CR COUNT,AC HAVE WE REACHED END OF LINE 00576000
- BL CONTL3 NO, KEEP LOOKING FOR ANOTHER PARAMETER 00577000
- LA TEMP,JFLAGS YES, CALCULATE NO. OF ARGUMENTS 00578000
- SR R9,TEMP ... 00579000
- STC R9,ARGSCT AND STORE. 00580000
- EJECT 00581000
- ********************************************************************** 00582000
- * * 00583000
- * 'ANALYS' * 00584000
- * COMMAND WORD ANALYSIS ROUTINE * 00585000
- * * 00586000
- ********************************************************************** 00587000
- ANALYS EQU * 00588000
- LA AC,3 LOAD LENGTH OF STRING COUNT FOR SEARCH 00589000
- ANALYS1 EQU * 00590000
- CLI ARGS,0 TEST FOR LEADING ZERO IN COMMAND 00591000
- BNE ANALYS2 BRANCH IF NO LEADING ZERO 00592000
- MVC ARGS(7),ARGS+1 SHIFT COMMAND LEFT 1 BYTE 00593000
- MVI ARGS+7,C' ' INSERT TRAILING BLANK INTO COMMAND 00594000
- B ANALYS1 00595000
- SPACE 00596000
- ANALYS2 EQU * 00597000
- SR R8,R8 ZERO OUT REGISTER 8 00598000
- IC R8,SAVE1 GET LENGTH OF ENTERED COMMAND 00599000
- BCTR R8,R0 REDUCE BY 1 FOR EXECUTE INSTR. 00600000
- LA R5,ENTRY1 POINT R5 TO FIRST ENTRY IN COMMAND TABLE 00601000
- LA R6,14 R6 = LENGTH OF ENTRY IN COMMAND TABLE 00602000
- LA R7,ENDTAB R7 = A(LAST ENTRY IN COMMAND TABLE) 00603000
- DEBUG10 EQU * SEE WHICH COMMAND WAS SPECIFIED 00604000
- CLC SAVE1(1),8(R5) GT. OR EQ. MINIMUM LENGTH OF CMMND 00605000
- BL DEBUG20 NO, SEE IF NEXT COMMAND NAME MATCHES 00606000
- EX R8,COMPNAME YES, SEE IF NAME MATCHES 00607000
- BE FOUND YES, THE NAMES MATCH, CHECK ARGS. 00608000
- DEBUG20 EQU * NAMES DO NOT MATCH 00609000
- BXLE R5,R6,DEBUG10 SEE IF NEXT COMMAND NAME MATCHES 00610000
- ERR02 EQU * COULD NOT FIND COMMAND IN TABLE 00611000
- LA AC,MESS02 POINT TO ERROR MESSAGE 00612000
- B ERRPRT TYPE IT OUT 00613000
- FOUND EQU * CHECK MIN. AND MAX. NUM. OF ARGS. 00614000
- L R8,10(,R5) POINT TO CODE HANDLING COMMAND 00615000
- CLC ARGSCT,9(R5) MIN. NO. ARGS. SPECIFIED 00616000
- BNL CHKMAX YS, SEE IF NO MORE THAN MAX. ARGS. SPEC. 00617000
- MISSOP EQU * MISSING OPERAND MESSAGE 00618000
- LA AC,MESS06 NO, POINT TO ERROR MESSAGE 00619000
- B ERRPRT TYPE IT OUT 00620000
- CHKMAX EQU * SEE IF NO MORE THAN MAX. ARGS. SPEC. 00621000
- CLC ARGSCT,10(R5) COMPARE NUM. ARGS. SPEC. 00622000
- BCR 13,R8 NO MORE THAN MAX. SPEC., EX. COMMAND 00623000
- B ERR06 TOO MANY ARGS., TYPE ERROR MESSAGE 00624000
- SPACE 00625000
- * 00626000
- * INSTRUCTION TO COMPARE COMMAND NAME ENTERED FROM TERMINAL 00627000
- * TO COMMAND NAME IN COMMAND NAME TABLE 00628000
- * 00629000
- COMPNAME CLC 0(*-*,R5),ARGS 00630000
- EJECT 00631000
- * 00632000
- * DEBUG COMMAND NAME TABLE 00633000
- * FORMAT OF TABLE : 00634000
- * CL8 - NAME OF COMMAND 00635000
- * AL1 - MINIMUM TRUNCATION OF COMMAND NAME 00636000
- * AL1 - MINIMUM NUMBER OF ARGUMENTS REQUIRED FOR EXECUTION 00637000
- * AL1 - MAXIMUM NUMBER OF ARGUMENTS ALLOWED 00638000
- * AL3 - ADDRESS OF CODE IN DMSDBG HANDLING EXECUTION OF 00639000
- * COMMAND 00640000
- * 00641000
- SPACE 2 00642000
- ENTRY1 DS 0F 00643000
- * 00644000
- DC CL8'BREAK',AL1(2),AL1(3),AL1(3),AL3(BREAK) 00645000
- * 00646000
- ACAW DC CL8'CAW',AL1(3),AL1(1),AL1(1),AL3(DEBCAW) 00647000
- * 00648000
- ACSW DC CL8'CSW',AL1(3),AL1(1),AL1(1),AL3(DEBCSW) 00649000
- * 00650000
- DC CL8'DEFINE',AL1(3),AL1(3),AL1(4),AL3(DEFINE) 00651000
- * 00652000
- DC CL8'DUMP',AL1(2),AL1(1),AL1(4),AL3(DUMP) 00653000
- * 00654000
- DC CL8'GO',AL1(2),AL1(1),AL1(2),AL3(GO) 00655000
- * 00656000
- AGPR DC CL8'GPR',AL1(3),AL1(2),AL1(3),AL3(GPR) 00657000
- * 00658000
- DC CL8'HX',AL1(2),AL1(1),AL1(1),AL3(KX) 00659000
- * 00660000
- DC CL8'ORIGIN',AL1(2),AL1(2),AL1(2),AL3(ORIGIN) 00661000
- * 00662000
- APSW DC CL8'PSW',AL1(3),AL1(1),AL1(1),AL3(PSWCMND) 00663000
- * 00664000
- DC CL8'RETURN',AL1(3),AL1(1),AL1(1),AL3(RTURN) 00665000
- * 00666000
- DC CL8'SET',AL1(3),AL1(3),AL1(5),AL3(SET) 00667000
- * 00668000
- DC CL8'STORE',AL1(2),AL1(3),AL1(6),AL3(STORE) 00669000
- * 00670000
- DC CL8'X',AL1(1),AL1(2),AL1(3),AL3(EXAM) 00673000
- * 00674000
- ENDTAB EQU *-14 END OF COMMAND NAME TABLE 00675000
- EJECT 00676000
- ********************************************************************** 00677000
- * * 00678000
- * 'SYMSTO' AND 'SYMGET' * 00679000
- * SYMBOL TABLE STORER AND RETRIVER ROUTINES * 00680000
- * * 00681000
- ********************************************************************** 00682000
- SYMSTO ST RETURN,SAVE1 SAVE RETURN AND ARGUMENT 00683000
- ST ARG,SAVE2 00684000
- BAL RETURN,SYMGET TEST IF SYMBOL DEFINED ALREADY 00685000
- L RETURN,SAVE1 RESTORE RETURN AND ARGUMENT 00686000
- LR TEMP,ARG 00687000
- L ARG,SAVE2 00688000
- LTR TEMP,TEMP TEMP=-1 MEANS UNDEFINED 00689000
- BC 10,DOIT DEFINED ALREADY, USE PRESENT ENTRY 00690000
- L TEMP,SYMTBG GET NUMBER OF ENTRIES IN TABLE 00691000
- LA AC,SYMMAX GET SIZE OF TABLE IN BYTES 00692000
- CR TEMP,AC TEST FOR TABLE OVERFLOW 00693000
- BNL ERR03 TOO MANY ENTRIES 00694000
- LA AC,SYMTABLE GET TABLE LOCATION 00696000
- L TEMP,SYMTBG GET TABLE COUNT 00699000
- LA TEMP,1(,TEMP) INCREASE BY 1 00700000
- ST TEMP,SYMTBG 00701000
- BCTR TEMP,0 -1 FROM COUNT @VA03403 00701100
- SLL TEMP,4 DISPLACEMENT OF ENTRY IN TABLE @VA03403 00701200
- AR TEMP,AC ADD DISPLACEMENT @VA03403 00701300
- DOIT MVC 0(16,TEMP),0(ARG) MOVE SYMBOL INTO SYMBOL TABLE @VA03403 00701400
- BR RETURN RETURN 00702000
- SYMGET L COUNT,SYMTBG GET TABLE LENGTH 00703000
- LTR COUNT,COUNT 00704000
- BC 8,SYMNO TABLE EMPTY 00705000
- LA TEMP,SYMTABLE GET LOCATION OF SYMBOL TABLE 00706000
- SYMGTL EQU * 00707000
- CLC 0(8,ARG),0(TEMP) COMPARE SYMBOLS 00708000
- BC 8,SYMFND ARE THEY EQUAL 00709000
- LA TEMP,16(,TEMP) ADVANCE TO NEXT ENTRY 00710000
- BCT COUNT,SYMGTL TEST FOR END OF TABLE 00711000
- SYMNO SR ARG,ARG SYMBOL NOT FOUND IN TABLE 00712000
- BCTR ARG,RETURN RETURN WITH ARG SET TO -1 00713000
- SYMFND LR ARG,TEMP RETURN VALUE ADDRESS 00714000
- BR RETURN 00715000
- EJECT 00716000
- ********************************************************************** 00717000
- * * 00718000
- * 'HEXIN' AND 'HEXOUT' * 00719000
- * ROUTINES TO CONVERT TO AND FROM HEXADECIMAL GRAPHICS * 00720000
- * * 00721000
- * FOR 'HEXIN', 'ARG' POINTS TO 8-BYTE INPUT NUMBER 00722000
- * ANSWER IS IN 'HEX' (1 FULL-WORD) 00723000
- * 00724000
- * FOR 'HEXOUT', 'ARG' POINTS TO 4-BYTE INPUT NUMBER, 00725000
- * ANSWER IS IN 'HEXHEX' (2 FULL-WORDS) 00726000
- * 00727000
- ********************************************************************** 00728000
- * 00729000
- * 00730000
- * NOTE -- AT ENTRY, R13 POINTS TO 'JFLAG' CORRESPONDING TO ARG. 00731000
- * 00732000
- HEXIN TM 0(R13),X'FF' CHECK FLAG, MUST BE 0 OR MIXED 00733000
- BO ERR04 ERROR IF NOT NUMERIC OR A-F. 00734000
- MVC HEXHEX(8),0(ARG) IF OK, GET ARGUMENT 00735000
- OC HEXHEX(8),BITS CONVERT 00 TO C0 00736000
- TRT HEXHEX(8),INVTBL CHARS. MUST BE VALID HEX 00737000
- BNZ ERR04 ERROR 00738000
- TR HEXHEX(8),CONHXT TRANSLATE LETTER A-E TO FA-FE 00739000
- PACK HEX(5),HEXHEX(9) PACK TO FORM BINARY NUMBER 00740000
- BR RETURN RETURN 00741000
- HEXOUT MVC HEX(4),0(ARG) GET ARGUMENT 00742000
- JHEXOUT EQU * (CAN ENTER HERE IF INPUT NO. IN 'HEX') 00743000
- UNPK HEXHEX(9),HEX(5) EXPAND 00744000
- TR HEXHEX(8),CONHXT TRANSLATE TO PRINTER GRAPHICS 00745000
- BR RETURN RETURN 00746000
- EJECT 00747000
- ********************************************************************** 00748000
- * * 00749000
- * 'DECIN' AND 'DECOUT' * 00750000
- * ROUTINES TO CONVERT TO AND FROM DECIMAL * 00751000
- * * 00752000
- ********************************************************************** 00753000
- * 00754000
- DECIN2 LA R13,JFLAGS+2 CONVENIENT ENTRY FOR 'ARGS+16' 00755000
- * 00756000
- * NOTE -- AT ENTRY, R13 POINTS TO 'JFLAG' CORRESPONDING TO ARG. 00757000
- * 00758000
- DECIN TM 0(R13),X'FF' CHECK FLAG, MUST BE 0 FOR NUMERIC 00759000
- BNZ ERR04 ERROR IF NOT NUMERIC. 00760000
- MVC DECDEC(8),0(ARG) IF OK, GET ARGUMENT 00761000
- PACK DEC(8),DECDEC(8) PACK 00762000
- CVB TEMP,DEC CONVERT TO BINARY 00763000
- ST TEMP,DEC STORE IN DEC 00764000
- BR RETURN 00765000
- DECOUT L TEMP,0(,ARG) GET ARGUMENT 00766000
- CVD TEMP,DEC CONVERT 00767000
- JDECOUT EQU * ENTER HERE IF NO. IS ALREADY IN 'DEC'... 00768000
- UNPK DECDEC(8),DEC(8) UNPACK 00769000
- OI DECDEC+7,X'F0' MAKE SIGN CORRECT 00770000
- BR RETURN 00771000
- EJECT 00772000
- ********************************************************************** 00773000
- * * 00774000
- * 'VALUE' * 00775000
- * ROUTINE TO DETERMINE VALUE OF PARAMETER * 00776000
- * * 00777000
- ********************************************************************** 00778000
- * 00779000
- * NOW CHECKS TO MAKE SURE OBTAINED-VALUE IS WITHIN CORE LIMITS. 00780000
- * ERR05 (INVALID CORE-ADDRESS) IF IT ISN'T 00781000
- * 00782000
- * 00783000
- VALUE2 LA R13,JFLAGS+2 CONVENIENT ENTRY CORRESPONDING TO ARGS+16 00784000
- * 00785000
- * AT ENTRY, R13 POINTS TO 'JFLAGS' CORRESPOND TO 'ARGS' 00786000
- * 00787000
- VALUE L R15,ORG 'ORIGIN' INTO R15 FOR 'VALUE' ENTRY 00788000
- VALJOIN EQU * ... 00789000
- ST RETURN,RETSAV SAVE RETURN 00790000
- ST ARG,ARGSAV SAVE ARGUMENT LOCATION 00791000
- TM 0(R13),X'FF' CHECK NATURE OF SYMBOL, 00792000
- BZ HEXQ FORGET 'SYMGET' IF ALL NUMERIC 00793000
- BAL RETURN,SYMGET CHECK IF PARAMETER IS A SYMBOL 00794000
- LTR ARG,ARG (IF NOT, ARG=-1) 00795000
- BC 4,HEXQ NOPE, ASSUME HEX 00796000
- L ARG,8(,ARG) GET VALUE 00797000
- BACK L RETURN,RETSAV RESTORE RETURN 00798000
- LTR ARG,ARG BE SURE STORAGE ADDR. GT. 0 00799000
- BM ERR05 IT'S NOT, TYPE ERROR MESSAGE 00800000
- ST TEMP,ARGSAV SAVE 'TEMP' REG. (TO BE SAFE) @V304732 00801100
- LA TEMP,ERR05PGM SET 'TEMP' REG. FOR PROG. INT. @V304732 00801200
- OI DBGFLAGS,DBGRECUR SIGNAL WE MIGHT GET PROG INT @V304732 00801300
- ICM TEMP,BIN1000,0(ARG) REFERENCE THE STORAGE ADDR @V305066 00801400
- NI DBGFLAGS,255-DBGRECUR OK - RESET FLAGBIT @V304732 00801500
- L TEMP,ARGSAV AND RECOVER 'TEMP' REGISTER. @V304732 00801600
- ST ARG,ARGSAV STORE IN 'ARGSAV' FOR CONVENIENCE LATER 00803000
- * NOTE -- ANSWER IS BOTH IN REGISTER 'ARG' AND STORAGE 'ARGSAV' 00804000
- BR RETURN RETURN 00805000
- HEXQ L ARG,ARGSAV RESTORE ARGUMENT LOCATION 00806000
- * NOTE -- R13 IS STILL SET UP FROM CALL TO 'VALUE' 00807000
- BAL RETURN,HEXIN CONVERT FROM HEX 00808000
- L ARG,HEX GET VALUE 00809000
- AR ARG,R15 ADD R15 = 0 FOR 'AVALUE', 'ORG' FOR 'VALUE' 00810000
- B BACK BRANCH TO RETURN ROUTINE 00811000
- * 00812000
- * ENTRY FOR 'ABSOLUTE' VALUE (DON'T ADD IN 'ORG') ... 00813000
- AVALUE SR R15,R15 CLEAR R15 FOR 'AVALUE' ENTRY 00814000
- B VALJOIN ... 00815000
- EJECT 00816000
- ********************************************************************** 00839000
- * * 00840000
- * 'IORD' AND 'IOPRT' * 00841000
- * TYPEWRITER INPUT AND DBGOUT ROUTINES * 00842000
- * * 00843000
- ********************************************************************** 00844000
- IORD EQU * @VA01159 00845100
- LR IOTEMP,IOLINK SAVE RETURN REG @VA01159 00845200
- LA R1,WAITRD GET CONREAD PLIST @VA01159 00845300
- L R15,ADMSCRD GET CONREAD ADDR @VA01159 00845400
- BAL IOLINK,BALRCALL CALL CONREAD VIA BALR @VA01159 00845500
- LR IOLINK,IOTEMP RESTORE RETURN REG @VA01159 00845600
- BR IOLINK RETURN TO CALLER @VA01159 00845700
- SPACE 00845800
- IOPRT EQU * @VA01159 00845900
- CLI OUTPT1,X'00' ANYTHING TO TYPE ? @VA01159 00846000
- BER IOLINK NO, JUST RETURN @VA01159 00846100
- LR IOTEMP,IOLINK SAVE RETURN REG @VA01159 00846200
- MVC CONWRL(1),OUTPT1 SET LENGTH IN PLIST @VA01159 00846300
- LA R1,CONWR GET TYPLIN PLIST @VA01159 00846400
- L R15,=V(DMSCWR) GET TYPLIN ADDR @VA01159 00846500
- BAL IOLINK,BALRCALL CALL TYPLIN VIA BALR @VA01159 00846600
- LR IOLINK,IOTEMP RESTORE RETURN REG @VA01159 00846700
- BR IOLINK RETURN TO CALLER @VA01159 00846800
- EJECT 00865000
- *********************************************************************** 00866000
- * 00867000
- * 'BRKADDR' AND 'BRKLKP' 00868000
- * 00869000
- *********************************************************************** 00870000
- SPACE 00871000
- BRKADDR CLI 0(TEMP),X'B2' DOES THIS LOOK AT ALL LIKE A BRKPNT? 00872000
- BCR 7,RETURN IF NOT, EXIT. 00873000
- TM 1(TEMP),X'E0' LOOK EVEN MORE LIKE ONE? 00874000
- BCR 14,RETURN IF NOT, EXIT. 00875000
- ST RETURN,RETSAV SAVE RETURN. 00876000
- IC AC,1(,TEMP) GET BREAKPOINT NUMBER. 00877000
- BAL RETURN,BRKLKP GET ITS TABLE ENTRY. 00878000
- L RETURN,RETSAV RETURN RETURN. 00879000
- TM 4(AC),X'FF' ENTRY ACTIVE? 00880000
- BCR 1,RETURN NOPE. EXIT. 00881000
- C TEMP,4(,AC) TALKING ABOUT THE SAME PLACE? 00882000
- BCR 7,RETURN NO. EXIT. 00883000
- MVC 0(2,TEMP),0(AC) RESTORE THE OLD OP-CODE. 00884000
- MVI 4(AC),X'FF' DEACTIVATE THE ENTRY. 00885000
- BR RETURN EXIT. 00886000
- SPACE 00887000
- BRKLKP N AC,MASK SAVE THE GOOD PART. 00888000
- SLL AC,3 MULTIPLY BY 8. 00889000
- LA AC,BRKPNTBL(AC) GET ADDR OF CORRECT ENTRY. 00890000
- BR RETURN EXIT. 00891000
- EJECT 00892000
- ********************************************************************** 00893000
- * * 00894000
- * 'ORIGIN' * 00895000
- * * 00896000
- ********************************************************************** 00897000
- ORIGIN LA ARG,ARGS+8 GET PARAMETER 00898000
- LA R13,JFLAGS+1 SET R13 CORRESPONDING TO 'ARGS+8' 00899000
- BAL RETURN,AVALUE CONVERT PARAMETER TO ABSOLUTE BINARY 00900000
- ST ARG,ORG STORE ORIGIN LOCATION 00901000
- B NEWLIN GET NEXT COMMAND LINE 00902000
- SPACE 2 00903000
- ********************************************************************** 00904000
- * * 00905000
- * 'DEFINE' * 00906000
- * * 00907000
- ********************************************************************** 00908000
- DEFINE LA ARG,ARGS+16 GET PARAMETER 00909000
- LA R13,JFLAGS+2 SET R13 CORRESPONDING TO 'ARGS+16' 00910000
- BAL RETURN,HEXIN CONVERT FROM HEX 00911000
- LR RETURN,TEMP SAVE 'TEMP' REG. (TO BE SAFE) @V304732 00912100
- LA TEMP,ERR05PGM SET 'TEMP' REG. FOR PROG. INT. @V304732 00912200
- OI DBGFLAGS,DBGRECUR SIGNAL WE MIGHT GET PROG INT @V304732 00912300
- L ARG,HEX PICK UP BINARY VALUE OF HEX NO. @V304732 00912400
- ICM TEMP,BIN1000,0(ARG) REFERENCE THE STORAGE ADDR @V305066 00912500
- A ARG,ORG ADD "ORIGIN" (IF ANY) @V304732 00912600
- ICM TEMP,BIN1000,0(ARG) REFERENCE THE STORAGE ADDR @V305066 00912700
- NI DBGFLAGS,255-DBGRECUR OK - RESET FLAGBIT @V304732 00912800
- LR TEMP,RETURN AND RECOVER 'TEMP' REGISTER. @V304732 00912900
- ST ARG,TSYM+8 ENTER INTO TABLE ENTRY 00919000
- TM JFLAGS+1,X'FF' CHECK PROPERTY OF DEFINED SYMBOL, 00920000
- BZ ERR04 ERROR IF ALL NUMERIC 00921000
- * DEFINED-SYMBOL SHOULD NOT START WITH AN ASTERISK (*) 00922000
- * (HARD TO CHECK BECAUSE ARGUMENT IS RIGHT-JUSTIFIED) 00923000
- MVC TSYM(8),ARGS+8 GET SYMBOL INTO ENTRY 00924000
- LA ARG,4 SET LENGTH ENTRY TO FOUR BYTES 00925000
- ST ARG,TSYM+12 00926000
- CLI ARGSCT,X'03' CHECK IF LENGTH SPECIFIED 00927000
- BC 8,NOLENG NOPE 00928000
- LA ARG,ARGS+24 GET LOCATION OF LENGTH 00929000
- LA R13,JFLAGS+3 SET R13 CORRESPONDING TO 'ARGS+24' 00930000
- BAL RETURN,DECIN CONVERT TO BINARY FROM DECIMAL 00931000
- LTR TEMP,TEMP CHECK LENGTH--STILL IN 'TEMP' AFTER DECIN 00932000
- BNP ERR04 ERROR IF = 0. 00933000
- C TEMP,MAXX IF > 0, MAKE SURE DOESN'T EXCEED 00934000
- BH ERR04 PRACTICAL LIMIT, ERROR IF IT DOES. 00935000
- ST TEMP,TSYM+12 IF OK, STORE IN ENTRY 00936000
- NOLENG LA ARG,TSYM ENTER ENTRY IN TABLE 00937000
- BAL RETURN,SYMSTO 00938000
- B NEWLIN GET NEXT COMMAND 00939000
- EJECT 00940000
- ********************************************************************** 00941000
- * * 00942000
- * 'EXAMINE' * 00943000
- * * 00944000
- ********************************************************************** 00945000
- EXAM LA ARG,ARGS+8 GET ARGUMENT 00946000
- BAL RETURN,SYMGET DETERMINE IF SYMBOL 00947000
- LTR ARG,ARG (-1 IF NOT SYMBOL) 00948000
- BC 4,TRYHEX IF NOT SYMBOL, TRY HEX 00949000
- LM R14,R15,8(ARG) GET VALUE & LENGTH FROM TABLE, 00950000
- STM R14,R15,EXAMLC STORE IN 'EXAMLC' AND 'EXAMLG' 00951000
- * NOTE -- R15 STILL HOLDS 'EXAMLG' -- NEEDED FOR USE BELOW 00952000
- B LENGTH CHECK IF LENGTH SPECIGIED 00953000
- TRYHEX LA ARG,ARGS+8 GET LOCATION OF ARGUMENT 00954000
- LA R13,JFLAGS+1 SET R13 CORRESPONDING TO 'ARGS+8' 00955000
- BAL RETURN,HEXIN CONVERT TO HEX 00956000
- L TEMP,HEX MAKE ABSOLUTE 00957000
- A TEMP,ORG 00958000
- ST TEMP,EXAMLC 00959000
- LA R15,4 ASSUME LENGTH IS FOUR BYTES 00960000
- ST R15,EXAMLG (AND LEAVE COUNT IN R15 FOR LATER) 00961000
- LENGTH EQU * 00962000
- CLI ARGSCT,X'02' CHECK IF LENGTH SPECIFIED 00963000
- BC 8,OK NOPE 00964000
- LA ARG,ARGS+16 GET LOCATION OF LENGTH 00965000
- BAL RETURN,DECIN2 CONVERT TO BINARY FROM DECIMAL 00966000
- * NOTE -- ON RETURNING FROM 'DECIN', 'TEMP' STILL HOLDS NO. 00967000
- LTR R15,TEMP BYTE-COUNT INTO R15 AND CHECK IT 00968000
- BNP ERR04 ERROR IF NOT > 0 (CAN'T TYPE 0 BYTES) 00969000
- C TEMP,MAXX CHECK NO. OF BYTES FOR PRACTICAL MAXIMUM 00970000
- BH ERR04 ERROR IF TOO LARGE A NUMBER 00971000
- ST TEMP,EXAMLG SAVE LENGTH IF NOT TOO LARGE 00972000
- * NOTE -- WHEN COMES TO 'OK', R15 MUST HOLD 'EXAMLG' ... 00973000
- OK L ARG,EXAMLC GET LOCATION 00974000
- SR COUNT,COUNT SET COUNT = 0 00975000
- * 00976000
- LA TEMP,ERR05PGM SET 'TEMP' REG. FOR PROG. INT. @V304732 00977100
- OI DBGFLAGS,DBGRECUR SIGNAL WE MIGHT GET PROG INT @V304732 00977200
- L R14,EXAMLC GET ADDRESS OF START OF DATA @V304732 00977300
- ICM TEMP,BIN1000,0(R14) REFERENCE THE STORAGE ADDR @V305066 00977400
- A R14,EXAMLG GET ADDRESS OF END OF DATA @V304732 00977500
- BCTR R14,0 ... @V304732 00977600
- ICM TEMP,BIN1000,0(R14) REFERENCE THE STORAGE ADDR @V305066 00977700
- NI DBGFLAGS,255-DBGRECUR OK - RESET FLAGBIT @V304732 00977800
- * 00981000
- BCTR R15,0 DECREMENT BYTE-COUNT FOR 'EX', 00982000
- EX R15,MVCINP MOVE BYTES TO BE EXAMINED TO 'INPUT' AND 00983000
- LA ARG,INPUT1 CONVERT THEM TO 'PRINTABLE' FROM THERE 00984000
- * (THE ABOVE TO AVOID ADDRESSING ERROR IF VERY NEAR 'COREND') 00985000
- * 00986000
- L TEMP,EXAMLG MULTIPLY LENGTH BY TWO 00987000
- AR TEMP,TEMP ... 00988000
- STC TEMP,OUTPT1 STORE COUNT FOR FINISHED DBGOUT. 00989000
- LA TEMP,DBGOUT SET LOCATION FOR DBGOUT 00990000
- OKLOOP BAL RETURN,HEXOUT CONVERT 4 BYTES AT A TIME 00991000
- MVC 0(8,TEMP),HEXHEX MOVE TO DBGOUT AREA 00992000
- LA COUNT,4(,COUNT) INCREASE COUNT 00993000
- C COUNT,EXAMLG TEST IF ENOUGH CONVERTED YET 00994000
- BNL JPRINT OK, FINISHED (DBGOUT ALL SET TO GO) 00995000
- LA TEMP,8(,TEMP) INCREASE COUNTERS 00996000
- LA ARG,4(,ARG) GET MORE 00997000
- B OKLOOP 00998000
- EJECT 00999000
- ********************************************************************** 01000000
- * * 01001000
- * 'GO' * 01002000
- * * 01003000
- ********************************************************************** 01004000
- GO OI XPSW,X'01' TURN INTERRUPT BIT ON 01005000
- CLI ARGSCT,X'01' IS ADDRESS SPECIFIED ? 01006000
- BE JCHECK NO, CHECK TO SEE WHICH ENTRY WE CAME IN 01007000
- LA ARG,ARGS+8 GET ADDRESS 01008000
- LA R13,JFLAGS+1 SET R13 CORRESPONDING TO 'ARGS+8' 01009000
- BAL RETURN,VALUE DETERMINE LOCATION 01010000
- * 01011000
- * NOTE -- VALUE IS STILL IN 'ARGSAV' 01012000
- * 01013000
- TM ARGSAV+3,X'01' MAKE SURE NOT AN ODD NUMBER 01014000
- BNZ ERR05 ERROR IF IT IS. 01015000
- ST ARG,HEX INSERT INTO PSW 01016000
- * 01017000
- * NOTE -- MAYBE SHOULD STORE IN SAVED-R15 HERE ??? 01018000
- * 01019000
- MVC XPSW+5(3),HEX+1 01020000
- B ISIO ... 01021000
- JCHECK EQU * 01022000
- TM DBGFLAGS,DBGABN+DBGEXINT+DBGPGMCK CHECK DEBUG ENTRY 01023000
- BZ ERR01 BZ IF YES, AN ERROR (SHOULD BE RETURN) 01024000
- * 01025000
- ISIO EQU * SEE IF 1050 ACTIVE UPON ENTERING 01026000
- MVC IOOPSW(20),LIOOPSW RESTORE IOOPSW,CAW,CSW 01034000
- MVC RSTNPSW,XPSW MOVE PSW TO LOWER CORE 01035000
- TM DBGSWTCH,2 SPECIAL EXTERNAL CASE ? @VA00770 01035100
- BZ RSTREGS NO..KEEP GOING @VA00770 01035150
- NI DBGSWTCH,253 RESET SPECIAL SWITCH @VA00770 01035200
- * VA05275 01035240
- MVC WAITSAVE(64),BALRSAVE RESTORE DMSIOW REGS @VA00770 01035250
- L R14,AIOSECT GET I/O SAVE AREA ADDR. @VA00770 01035300
- MVC 0(64,R14),GPRLOG RESTORE ALL I/O REGS @VA00770 01035350
- RSTREGS EQU * @VA00770 01035400
- LM R0,R15,GPRLOG RESTORE REGISTERS 01036000
- MVI DBGFLAGS,OFF CLEAR DBGFLAGS FLAG @V305066 01037100
- LPSW RSTNPSW GO AWAY 01038000
- EJECT 01039000
- ********************************************************************** 01040000
- * * 01041000
- * 'DUMP' * 01042000
- * * 01043000
- ********************************************************************** 01044000
- DUMP EQU * 01045000
- LA R13,JFLAGS+1 POINT R13 TO ARGUMENT FLAG 01046000
- LA ARG,ARGS+8 GET LOCATION OF PARAMETER 01047000
- BAL RETURN,VALUE GET VALUE OF PARAMETER 01048000
- N ARG,TRUNFUL TRUNCATE TO FULL-WORD BOUNDARY (JAS) 01049000
- ST ARG,FIRSTDMP SAVE BEGINNING LOCATION 01050000
- L ARG,VMSIZE END-OF-CORE (LESS ONE BYTE) 01051000
- BCTR ARG,0 INTO REGISTER 'ARG' FOR BELOW, 01052000
- CLI ARGS+23,C'*' IS ENDING-ADDRESS = '*' ??? 01053000
- BE STARGL BE IF YES, USE 'VMSIZE' FOR ENDING LIMIT. 01054000
- LA ARG,ARGS+16 GET LOCATION OF SECOND PARAMETER 01055000
- BAL RETURN,VALUE2 GET VALUE OF PARAMETER 01056000
- CLI ARGSCT,X'02' WAS SECOND LOC. SPECIFIED P0482 01057000
- BE STARGL NO, OMIT CHECK P0482 01058000
- C ARG,FIRSTDMP SEE IF LEXSS THAN 1ST LINIT 01059000
- BL ERR04 RIDICULOUS IF LESS THAN 1ST LIMIT. 01060000
- STARGL EQU * 01061000
- ST ARG,LASTDMP SAVE ENDING-ADDRESS 01062000
- LA R7,DMPTITLE R7 = A(DMPTITLE) 01063000
- MVI DMPTITLE,C' ' CLEAR BUFFER 01064000
- MVC DMPTITLE+1(L'DMPTITLE-1),DMPTITLE ALL OF IT 01065000
- MVC 42(8,R7),ARGS+24 INCLUDE ID IF GIVEN 01066000
- MVI 50(R7),C':' MAKE HEADING LINE PRETTY 01067000
- MVC 53(4,R7),=CL4'FROM' 01068000
- MVC 58(8,R7),ARGS+8 01069000
- MVC 67(2,R7),=CL2'TO' 01070000
- MVC 70(8,R7),ARGS+16 01071000
- LA R1,DUMPLIST POINT TO PARAMETER LIST 01072000
- L R15,=V(DMSDBD) GET ADDRESS OF DUMP EXECUTIONER 01073000
- TM DBGFLAGS,DBGEXINT WAS THIS AN EXTERNAL INTERRUPT 01074000
- BNO DUMP10 NO, PGRAMCHK OR ENTERED ON PURPOSE 01075000
- LA R0,EXTOPSW YES, SET R0 TO IT'S ADDRESS 01076000
- B DUMPOUT GO TO DEBDUMP 01077000
- DUMP10 EQU * 01078000
- LA R0,PGMOPSW SET R0 TO PROGRAM OLD PSW 01079000
- DUMPOUT EQU * GO TO DEBDUMP 01080000
- LA R14,NEWLIN FOR RETURN TO DEBUG 01081000
- BR R15 OFF TO DEBDUMP (DUMP EXEC.) 01082000
- EJECT 01083000
- ********************************************************************** 01084000
- * * 01085000
- * 'PSW' * 01086000
- * * 01087000
- ********************************************************************** 01088000
- PSWCMND EQU * 01089000
- LA ARG,XPSW SET LOCATION OF OLD PSW 01090000
- PSWPRT ST ARG,EXAMLC STORE STARTING LOCATION OF PRINT 01091000
- LA R15,8 SET NUMBER OF BYTES TO PRINT 01092000
- ST R15,EXAMLG LEAVING IN BOTH R15 AND 'EXAMLG' 01093000
- B OK LET EXAMINE ROUTINE DO REST OF WORK 01094000
- SPACE 2 01095000
- ********************************************************************** 01096000
- * * 01097000
- * 'GPR' * 01098000
- * * 01099000
- ********************************************************************** 01100000
- GPR LA ARG,ARGS+8 GET FIRST NUMBER 01101000
- LA R13,JFLAGS+1 SET R13 CORRESPONDING TO 'ARGS+8' 01102000
- BAL RETURN,DECIN CONVERT TO BINARY 01103000
- L AC,DEC SAVE IT 01104000
- C AC,F15 (MAKE SURE NO MORE THAN 15) 01105000
- BH ERR04 (ERROR IF > 15) 01106000
- LR ARG,AC EQUAL IF ONLY ONE 01107000
- CLI ARGSCT,X'02' IS ANOTHER GPR SPECIFIED ? 01108000
- BC 8,ONEREG ONLY ONE REGISTER 01109000
- LA ARG,ARGS+16 GET SECOND REGISTER 01110000
- BAL RETURN,DECIN2 CONVERT TO BINARY FROM DECIMAL 01111000
- L ARG,DEC GET SECOND REGISTER 01112000
- C ARG,F15 (MAKE SURE NO MORE THAN 15) 01113000
- BH ERR04 (ERROR IF > 15) 01114000
- CR ARG,AC MUST NOT BE LESS THAN 1ST REG. 01115000
- BL ERR04 ERROR IF IT IS--WE WON'T GIVE WRAP-AROUND 01116000
- ONEREG SR ARG,AC DETERMINE NUMBER OF REGISTERS DESIRED 01117000
- LA COUNT,1(,ARG) 01118000
- SLL AC,2 MULTIPLY BY 4 01119000
- LA AC,GPRLOG(AC) LOCATION OF FIRST REGISTER 01120000
- MVI DBGOUT-1,X'08' SET PRINTER COUNT 01121000
- GPRLOP LR ARG,AC SET ARGUMENT FOR HEX CONVERT 01122000
- BAL RETURN,HEXOUT CONVERT TO HEX 01123000
- MVC DBGOUT(8),HEXHEX MOVE TO PTINT BUFFER 01124000
- BAL IOLINK,IOPRT PRINT 01125000
- LA AC,4(,AC) ADVANCE COUNTER 01126000
- BCT COUNT,GPRLOP PRINT ALL REGISTERS DESIRED 01127000
- B NEWLIN GET NEXT COMMAND 01128000
- EJECT 01129000
- SPACE 2 01130000
- ********************************************************************** 01131000
- * * 01132000
- * 'STORE' * 01133000
- * * 01134000
- ********************************************************************** 01135000
- STORE EQU * STORE COMMAND 01136000
- NI DBGSWTCH,255-DBGSET INDICATE IT IN SWITCH 01137000
- LA ARG,ARGS+8 POINT TO THE LOCATION 01138000
- LA R13,JFLAGS+1 SET R13 CORRESPONDING TO 'ARGS+8' 01139000
- BAL RETURN,VALUE GET VALUE 01140000
- STOR2 LR TEMP,ARG SAVE VALUE 01141000
- SR COUNT,COUNT ZERO COUNT REGISTER 01142000
- IC COUNT,ARGSCT GET NUMBER OF PARAMETERS 01143000
- SLL COUNT,3 MULTIPLY B8 (DOUBLE WORDS) 01144000
- LA COUNT,ARGS(COUNT) GET LOCATION OF LAST PARAMETER 01145000
- BCTR COUNT,0 SUBTRACT 1 01146000
- ST COUNT,STOPAT SAVE TO TERMINATE LOOP 01147000
- LA COUNT,ARGS+15 INITIALIZE FOR LOOP 01148000
- STSAVE ST COUNT,BEGAT SAVE LOCATION OF PARAMETER POINTER 01149000
- STCONT LA COUNT,1(,COUNT) INCREMENT POINTER 01150000
- CLI 0(COUNT),X'00' TEST FOR '00' 01151000
- BC 8,STCONT KEEP LOOKING 01152000
- L ARG,BEGAT FIRST INPUT BYTE FOUND 01153000
- LA AC,10(,ARG) CALCULATE NUMBER OF BYTES INPUTTED 01154000
- SR AC,COUNT 01155000
- SRL AC,1 DIVIDE BY 2 (PACKING) 01156000
- LA ARG,1(,ARG) SET ARGUMENT FOR HEXIN 01157000
- LA R13,1(,R13) ALSO INCREMENT R13 ... 01158000
- BAL RETURN,HEXIN CONVERT TO BINARY 01159000
- LA ARG,HEX+4 DETERMINE WHICH BYTES TO MOVE 01160000
- SR ARG,AC 01161000
- BCTR AC,0 SUBTRACT 1 FOR MVC INSTRUCTION 01162000
- * NOTE: MODIFICATION OF A SHARED SEGMENT PERMITTED NOW 01163100
- LR RETURN,TEMP USE "RETURN" REG INSTEAD OF TEMP @V304732 01163200
- LA TEMP,ERR05PGM SET 'TEMP' REG. FOR PROG. INT. @V304732 01163300
- OI DBGFLAGS,DBGRECUR SIGNAL WE MIGHT GET PROG INT @V304732 01163400
- EX AC,STMOVE MOVE BYTES INTO STORAGE @V304732 01163500
- NI DBGFLAGS,255-DBGRECUR OK - RESET FLAGBIT @V304732 01163600
- LR TEMP,RETURN AND RECOVER 'TEMP' REGISTER. @V304732 01163700
- TM DBGSWTCH,DBGSET IS SET COMMAND REQUESTED 01165000
- BNO STORE10 NO, STORE COMMAND IS 01166000
- LA TEMP,4(,TEMP) YES, INCREMENT FULLWORD 01167000
- B STORE20 CONTINUE TO STORE NEXT ENTRY 01168000
- STORE10 EQU * INCREMENT STORAGE POINTER 01169000
- LA TEMP,1(TEMP,AC) TO NEXT ADDRESS. 01170000
- STORE20 EQU * STORE THE NEXT ENTRY 01171000
- L COUNT,BEGAT SET PARAMETER POINTER 01172000
- LA COUNT,8(,COUNT) INCREMENT 01173000
- C COUNT,STOPAT TEST FOR END OF PARAMETER LIST 01174000
- BC 6,STSAVE IF NOT CONTINUE 01175000
- B NEWLIN OTHERWISE, GET NEXT COMMAND 01176000
- EJECT 01177000
- ********************************************************************** 01179000
- * * 01180000
- * 'CSW' * 01181000
- * * 01182000
- ********************************************************************** 01183000
- DEBCSW EQU * 01184000
- LA ARG,LCSW SET ADDRESS OF CSW 01185000
- B PSWPRT USE PSW ROUTINE TO DO THE WORK 01186000
- SPACE 2 01187000
- ********************************************************************** 01188000
- * * 01189000
- * 'CAW' * 01190000
- * * 01191000
- ********************************************************************** 01192000
- DEBCAW EQU * 01193000
- LA AC,LCAW SET ADDRESS OF CAW 01194000
- LA COUNT,1 NECESSARY FUDGE 01195000
- B GPRLOP-4 LET GPR ROUTINE DO THE WORK 01196000
- SPACE 2 01197000
- ********************************************************************** 01198000
- * * 01199000
- * 'BREAK' * 01200000
- * * 01201000
- ********************************************************************** 01202000
- * 01203000
- * NEED 16 CONSECUTIVE ILLEGAL-INSTRUCTIONS FOR BREAKPOINT LOGIC 01204000
- * X'B2E0' THRU X'B2EF' ARE "ARCHITECTURE-SAFE" 01205000
- * 01209000
- BREAK LA ARG,ARGS+8 GET BREAKPOINT NUMBER 01210000
- LA R13,JFLAGS+1 SET R13 CORRESPONDING TO 'ARGS+8' 01211000
- BAL RETURN,DECIN CONVERT TO BINARY 01212000
- L AC,DEC GET BREAKPOINT NUMBER. 01213000
- C AC,F15 (MAKE SURE NO MORE THAN 15) 01214000
- BH ERR04 (ERROR IF > 15) 01215000
- LA ARG,ARGS+16 GET LOCATION OF BREAKPOINT 01216000
- BAL RETURN,VALUE2 CONVERT TO BINARY 01217000
- TM ARGSAV+3,X'01' MAKE SURE NOT AN ODD NUMBER 01218000
- BNZ ERR05 ERROR IF IT IS. 01219000
- L TEMP,ARGSAV GET TARGET ADDR. 01220000
- LA AC,1 LOAD OFFSET OF MAXIMUM ADDR 01221000
- * NOTE: MODIFICATION OF A SHARED SEGMENT PERMITTED NOW 01222000
- BAL RETURN,BRKADDR CHECK WHAT'S THERE. 01223000
- L AC,DEC GET THE BREAKPOINT NUMBER. 01224000
- BAL RETURN,BRKLKP GET IT'S TABLE ENTRY. 01225000
- LR R15,AC SAVE ENTRY ADDRESS. 01226000
- CLI 4(AC),X'FF' AVAILABLE? 01227000
- L AC,DEC JUST IN CASE. 01228000
- BE SETBRK JUST SET THE NEW ONE. 01229000
- L TEMP,4(,R15) GET ITS TARGET ADDRESS. 01230000
- BAL RETURN,BRKADDR CHECK IT OUT. 01231000
- L AC,DEC GET BREAKPOINT NUMBER @VA01159 01232100
- SETBRK ST ARG,4(,R15) STORE ADDRESS IN TABLE. 01243000
- MVC 0(2,R15),0(ARG) SAVE (PART OF) INSTR MADE INVALID 01244000
- MVC 0(2,ARG),=XL2'B2E0' MOVE INVALID OP-CODE INTO P3121 01245000
- EX AC,OI INSERT THE BREAKPOINT NUMBER P3121 01246000
- B NEWLIN NEXT COMMAND PLEASE P3121 01247000
- SPACE 01248000
- OI OI 1(ARG),0 EXECUTED-OR TO MOVE BREAKPOINT ID P3121 01249000
- SPACE 01250000
- * 01251000
- * PROGRAM INTERRUPTS CAUSE CONTROL TO RETURN HERE 01252000
- * 01253000
- BRKENT SR EVEN,EVEN ZERO OUT EVEN 01254000
- L ODD,PGMOPSW+4 GET ADDRESS IN PSW 01255000
- LA AC,0(,ODD) GET ADDRESS 01256000
- SLDL EVEN,2 GET ILC LENGTH (BACK SPACE ILC) 01257000
- AR EVEN,EVEN SHIFT LEFT 1 01258000
- SR AC,EVEN CORRECT ILC ADDRESS 01259000
- BM NOTBRK CAN'T BE A BREAKPOINT IF 'AC' < 0 (6 FEB 68) 01260000
- LA TEMP,NOTBRPGM SET 'TEMP' REG. FOR PROG. INT. @V304732 01261100
- OI DBGFLAGS,DBGRECUR SIGNAL WE MIGHT GET PROG INT @V304732 01261200
- CLI 0(AC),X'B2' DOES OP-CODE LOOK LIKE A BREAKPOINT P3121 01263000
- BNE NOTBRK LOOK NO FURTHER P3121 01264000
- TM 1(AC),X'E0' REST OF MASK THERE? 01265000
- BNO NOTBRK NO. NOT A BREAKPOINT. 01266000
- NI DBGFLAGS,255-DBGRECUR OK - RESET FLAGBIT @V304732 01266100
- IC TEMP,1(,AC) GET THE NUMBER-BYTE. P3121 01267000
- N TEMP,MASK DETERMINE BREAK POIJT NUMBER 01268000
- ST TEMP,DEC SAVE IT 01269000
- SLL TEMP,3 MULTIPLY BY 8. P3121 01270000
- LA TEMP,BRKPNTBL(TEMP) FIND ENTRY IN BREAKPOINT TABLE 01271000
- L ARG,4(,TEMP) GET THE N'TH BREAKPOINT ADDR P3121 01272000
- CR ARG,AC COMPARE ADDRESSES 01273000
- BC 6,NOTBRK NOT A BREAKPOINT 01274000
- ST AC,HEX SET PSW LOCATION 01275000
- MVC XPSW(5),PGMOPSW COPY FIRST 5 BYTES OF PSW 01276000
- MVC XPSW+5(3),HEX+1 01277000
- MVC 0(2,AC),0(TEMP) RESTORE ORIGINAL INSTRUCTION P3121 01278000
- MVI 4(TEMP),X'FF' MAKE NEG. (VERY BAD ADDR) 01279000
- LA ARG,DEC CONVERT NUMBER TO DECIMAL 01280000
- BAL RETURN,DECOUT 01281000
- MVC DBGOUT(LP4),P4 MOVE 1ST. PART OF MSG @VA01159 01281100
- MVC DBGOUT+LP4AA(2),DECDEC+6 INSERT BREAK NO. @VA01159 01281200
- BAL RETURN,JHEXOUT CONVERT ADDRESS (ALREADY IN 'HEX') 01284000
- MVC DBGOUT+LP4(6),HEXHEX+2 INSERT BREAK ADDR @VA01159 01285100
- MVI OUTPT1,LP4A SET LENGTH FOR CCW @VA01159 01285200
- B CHEKTYPE CHECK CONSOLE I/O TYPE. 01287000
- * 01288000
- * IF THE PROGRAM CHECK IS NOT A BREAKPOINT, THEN WE TRANSFER CONTROL 01289000
- * DMSITP. THAT ROUTINE WILL CHECK FOR A SPIE EXIT, AND IF THERE IS 01290000
- * NONE, WILL ABEND THE GUY. ONCE IN THE ABEND ROUTINE, THE USER MA Y 01291000
- * SPECIFY THAT HE WANTS TO COME RIGHT BACK TO DEBUG, THUS COMPLETING 01292000
- * THE CIRCLE. 01293000
- SPACE 01293200
- * PROGRAM INTERRUPT WHILE CHECKING FOR POTENTIAL BREAKPOINT: 01293400
- NOTBRPGM MVC PGMOPSW(8),LPGMOPSW PUT BACK PROG OLD PSW @V304732 01293600
- * NOT A BREAKPOINT: 01293800
- NOTBRK NI DBGFLAGS,255-DBGRECUR RESET FLAGBIT @V304732 01294000
- MVC IPLPSW,=A(0,DMSITP) POINT TO DMSITP ROUTINE 01295000
- EXTRN DMSITP 01296000
- LM R0,R15,GPRLOG RESTORE GPRS 01297000
- MVI DBGFLAGS,OFF CLEAR DBGFLAGS FLAG @V305066 01298000
- LPSW IPLPSW GO TO DMSITP 01299000
- * 01300000
- * GIVE TYPEOUT FOR 'EXTERNAL INTERRUPT' 01301000
- * 01302000
- INTENT MVC OUTPT1(LP2A),P2CNT EXTERNAL MSG TO BUFFER @VA01159 01303100
- MVC XPSW(8),EXTOPSW SAVE EXTERNAL OLD PSW 01304000
- TM EXTOPSW+1,2 IS EXT OLD PSW IN WAIT ? @VA00770 01305100
- BZ CHEKTYPE NO..GO CHECK TYPEWRITER @VA00770 01305150
- L R1,=V(DMSIOWR) GET CMS I/O WAIT RTNE @VA00770 01305200
- C R1,EXTOPSW+4 ARE WE IN CMS I/O WAIT ? @VA00770 01305250
- BNE CHEKTYPE NO..GO CHECK TYPEWRITER @VA00770 01305300
- NI XPSW+1,253 TURN WAIT BIT OFF @VA01159 01305350
- OI DBGSWTCH,2 SET SPECIAL EXTERNAL CASE @VA00770 01305400
- MVC BALRSAVE(64),WAITSAVE SAVE DMSIOW REGS @VA00770 01305450
- B CHEKTYPE GO CHECK TYPEWRITER AND GET GOING. 01306000
- SPACE 01307000
- SPACE 01308000
- SPACE 2 01309000
- ********************************************************************** 01310000
- * * 01311000
- * 'SET' * 01312000
- * * 01313000
- ********************************************************************** 01314000
- SET EQU * 01315000
- OI DBGSWTCH,DBGSET INDICATE SET COMMAND 01316000
- CLC APSW(3),ARGS+13 IS IT PSW 01317000
- BC 8,SPSW 01318000
- CLC ACAW(3),ARGS+13 IS IT CAW 01319000
- BC 8,SCAW 01320000
- CLC ACSW(3),ARGS+13 IS IT CSW 01321000
- BC 8,SCSW 01322000
- CLC AGPR(3),ARGS+13 IS IT GPR 01323000
- BC 8,SGPR 01324000
- B ERR04 INVALID ARGUMENT IF NONE OF THESE 01325000
- SPSW EQU * SET PSW LOCATION 01326000
- CLI ARGSCT,X'04' CHECK MAX.NUMBER OF AGS. 01327000
- BH ERR06 TOO MANY ENTERED, TYPE ERROR MSG. 01328000
- LA ARG,XPSW POINT TO PSW LOCATION 01329000
- B STOR2 USE STORE ROUTINE 01330000
- SCAW EQU * 01331000
- CLI ARGSCT,X'03' CHECK MAX.NUMBER OF ARGS. 01332000
- BH ERR06 TOO MANY ENTERED, TYPE ERROR MSG. 01333000
- LA ARG,LCAW SET CAW LOCATION 01334000
- B STOR2 01335000
- SCSW EQU * 01336000
- CLI ARGSCT,X'04' CHECK NO. OF ARGUMENTS 01337000
- BH ERR06 TOO MANY 01338000
- LA ARG,LCSW SET CSW LOCATION 01339000
- B STOR2 01340000
- SGPR EQU * 01341000
- CLI ARGSCT,X'04' BE SURE ALL ARGS. SPECIFIED 01342000
- BL MISSOP IF NOT TYPE OUT ERROR MESSAGE 01343000
- CLI ARGSCT,X'05' CHECK MAX. NUMBER OF ARGS. 01344000
- BH ERR06 TOO MANY ENTERED, TYPE ERROR MSG. 01345000
- LA ARG,ARGS+16 POINT TO GPR 01346000
- BAL RETURN,DECIN2 DETERMIN REGISTER NUMBER 01347000
- L ARG,DEC MULTIPLY BY 4 01348000
- C ARG,F15 (MAKE SURE NO MORE THAN 15) 01349000
- BH ERR04 (ERROR IF > 15) 01350000
- SLL ARG,2 01351000
- LA ARG,GPRLOG(ARG) FORM ACTUAL CORE LOCATION 01352000
- MVC ARGS(MVCNT),ARGS+8 MOVE ARGUMENTS LEFT 01353000
- SR COUNT,COUNT ZERO COUNT REGISTER 01354000
- IC COUNT,ARGSCT ADJUST PARAMETER COUNT TO FOOL STOR2 01355000
- BCTR COUNT,0 01356000
- STC COUNT,ARGSCT 01357000
- B STOR2 NOW CALL STOR2 01358000
- SPACE 2 01359000
- * 01360000
- * 'KX' (KILL-EXECUTION) ... 01361000
- * 01362000
- KX EQU * 01363000
- TM DBGFLAGS,DBGABN ENTRY FROM DMSABN MEANS THAT 01364000
- BO RTNABN 'KX' EQUALS 'RETURN' 01365000
- L R15,AKILLEX A(KILLEX) 01366000
- MVI DBGFLAGS,OFF CLEAR DBGFLAGS FLAG @V305066 01367000
- BR R15 ... 01368000
- EJECT 01369000
- ********************************************************************* 01370000
- * * 01371000
- * 'RETURN' * 01372000
- * * 01373000
- ********************************************************************* 01374000
- * 01375000
- RTURN TM DBGFLAGS,DBGABN ENTRY FROM DMSABN? 01376000
- BO RTNABN RETURN TO DMSABN 01377000
- TM DBGFLAGS,DBGPGMCK+DBGEXINT VERIFY DEBUG ENTRY 01378000
- BM ERR01 NO: PRGRAM CHECK OR EXTERNAL INTERRUPT 01379000
- MVI DBGFLAGS,OFF CLEAR DBGFLAGS FLAG @V305066 01380000
- LM R0,R14,GPRLOG RESTORE REGISTERS 01381000
- SR 15,15 INDICATE NO ERROR IN 15 01382000
- BR 14 NORMAL-TYPE CMS RETURN 01383000
- SPACE 2 01384000
- * RETURN TO DMSABN TO PROCEED WITH ABEND RECOVERY 01385000
- RTNABN EQU * 01386000
- MVI DBGFLAGS,OFF CLEAR DBGFLAGS FLAG @V305066 01387000
- L R14,=V(DMSABNRT) POINT TO RETURN LOCATION 01388000
- BR R14 AND JUST DROP IN 01389000
- SPACE 2 01403000
- EJECT 01404000
- ********************************************************************** 01405000
- * * 01406000
- * ERROR CODES * 01407000
- * * 01408000
- ********************************************************************** 01409000
- ERR01 EQU * INCORRECT DEBUG EXIT 01410000
- LA AC,MESS01 01411000
- B ERRPRT 01412000
- * 01413000
- * ('ERR02' = 'INVALID DEBUG REQUEST' CODE IS ELSEWHERE) 01414000
- * 01415000
- ERR03 EQU * SYMBOL TABLE OVERFLOW 01416000
- LA AC,MESS03 01417000
- B ERRPRT 01418000
- ERR04 EQU * INVALID ARGUMENT 01419000
- LA AC,MESS04 01420000
- B ERRPRT 01421000
- * 01422000
- * INVALID STORAGE-ADDRESS VIA PROGRAM INTERRUPT WHILE IN DEBUG: 01423100
- ERR05PGM MVC PGMOPSW(8),LPGMOPSW RESTORE PROGRAM OLD PSW @V304732 01423200
- * INVALID STORAGE ADDRESS SPECIFIED BY SOME DEBUG REQUEST: 01423300
- ERR05 NI DBGFLAGS,255-DBGRECUR ENSURE "RECUR" FLAG CLEAR @V304732 01423400
- LA AC,MESS05 SET FOR INVALID STORAGE ADDRESS; @V304732 01423500
- B ERRPRT TYPE OUT THE MESSAGE 01424000
- * 01425000
- ERR06 EQU * 01426000
- LA AC,MESS07 TOO MANY ARGUMENTS 01427000
- * CONTINUE TO "ERRPRT" ... 01428100
- * 01438000
- ERRPRT EQU * (PROCEED DIRECTLY TO ERROR MESSAGE) 01439000
- MVC DBGOUT-1(80),0(AC) PRINT ERROR MESSAGE 01440000
- B JPRINT GO GIVE TYPEOUT, AND THEN GET NEW LINE... 01441000
- SPACE 01442000
- EJECT 01443000
- * * 01444000
- * CONSTANTS 01445000
- * * 01446000
- SPACE 01447000
- DS 0D 01448000
- PSW1 DC 4X'00' PART OF WT 01450000
- DC A(DMSDBG) PART OF PSW1 01451000
- * 01452000
- EOLMVC MVC 2(*-*,R3),1(R3) INST. TO BLANK FILL PROCESSED STRIN 01453000
- MVCINP MVC INPUT1(*-*),0(ARG) MOVE WORDS TO INPUT1 AS SCRATCH AREA 01454000
- STMOVE MVC 0(*-*,RETURN),0(ARG) MOVE USER BYTES TO STORAGE @V304732 01455100
- * 01456000
- F15 DC F'15' FOR CHECKING MAXIMUM REGISTER NO. ETC. 01457000
- MAXX DC F'56' PRACTICAL MAXIMUM FOR 'X' COMMAND 01458000
- * 01459000
- TRUNFUL DC X'00FFFFFC' ROUNDER UPPER 01460000
- MASK EQU F15 = X'0000000F' @V304732 01461000
- BIN1000 EQU B'1000' @V305066 01461100
- SPACE 01463000
- * 01464000
- MESS01 DC AL1(MESS02-MESS01-1) 01465000
- DC C'INCORRECT DEBUG EXIT' 01466000
- MESS02 DC AL1(MESS03-MESS02-1) 01467000
- DC C'INVALID DEBUG REQUEST' 01468000
- MESS03 DC AL1(MESS04-MESS03-1) 01469000
- DC C'16 SYMBOLS ALREADY DEFINED' 01470000
- MESS04 DC AL1(MESS05-MESS04-1) 01471000
- DC C'INVALID OPERAND' 01472000
- MESS05 DC AL1(MESS06-MESS05-1) 01473000
- DC C'INVALID STORAGE ADDRESS' 01474000
- MESS06 DC AL1(MESS07-MESS06-1) 01475000
- DC C'MISSING OPERAND' 01476000
- MESS07 DC AL1(MESS08-MESS07-1) 01477000
- DC C'TOO MANY OPERANDS' 01478000
- MESS08 EQU * 01479000
- * 01480000
- P2CNT DC AL1(LP2A-1) COUNT FOR CCW @VA01159 01481100
- P2 DC C'EXTERNAL INTERRUPT' @VA01159 01481200
- LP2A EQU *-P2CNT SIZE FOR MVC @VA01159 01481300
- * 01495000
- P4AA DC C'BREAKPOINT ' @VA01159 01496100
- P4 EQU P4AA 01497000
- LP4AA EQU *-P4AA ITS LENGTH 01498000
- P4A DC C'XX AT ' MESSAGE TO USER 01500000
- LP4 EQU *-P4 (SIZE FOR 'MVC') 01501000
- LP4A EQU LP4+6 COUNT FOR CCW @VA01159 01502100
- * 01509000
- DS 0D (256 BYTES, PRECEDES LTORG) @V304732 01514100
- INVTBL DC 192X'FF' INVALID HEX REPRESENTATION TABLE 01515000
- DC 7X'00' THESE GUYS ARE VALID 01516000
- DC 41X'FF' THESE GUYS AREN'T 01517000
- DC 10X'00' NUMBERS 0-9 OK 01518000
- DC 6X'FF' 01519000
- * 01520000
- * REGISTER USAGE * 01521000
- * * 01522000
- EVEN EQU 2 01523000
- ODD EQU 3 01524000
- COUNT EQU 4 01525000
- TEMP EQU 5 01526000
- ARG EQU 6 01527000
- IOTEMP EQU 7 01528000
- AC EQU 8 01529000
- IOLINK EQU 14 01530000
- RETURN EQU 11 01531000
- BASE EQU 12 01532000
- OFF EQU X'00' @V305066 01532100
- SPACE 2 01533000
- LTORG 01534000
- EJECT 01535000
- DBGSECT 01536000
- NUCON 01537000
- * 01538000
- * EQUATES OF NUCON DEPENDENT PARAMETERS 01539000
- * 01540000
- SYMMAX EQU (BRKPNTBL-SYMTABLE)/16 NUMBER OF ENTRIES 01541000
- SPACE 2 01542000
- * 01543000
- * DEFINE DISPLACEMENTS OF NUCON VARIABLES LOCATED IN LOWSAVE 01544000
- * 01545000
- DEFINE PGMOPSW,IOOPSW,CSW,CAW V0004 01546100
- EJECT 01547000
- IO 01548000
- EQUATES 01549000
- DMSABW 01550000
- SVCSAVE 01551000
- * 01552000
- END 01553000
ibm/vm370-lib/cms/dmsdbg.assemble_src.txt · Last modified: 2023/08/06 13:35 by Site Administrator