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