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