Google
 

Trailing-Edge - PDP-10 Archives - ap-c800d-sb - cobddt.mac
There are 20 other files named cobddt.mac in the archive. Click here to see a list.
; UPD ID= 1934 on 6/18/79 at 10:45 AM by W:<WRIGHT>
TITLE	COBDDT VERSION 12A		
SUBTTL	COBOL DEBUG PACKAGE



;COPYRIGHT (C) 1974, 1979 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

EDIT==26
VERSION==1201

; EDIT 26 FIXED BUG IN 'ACCEPT TALLY'. (DIDN'T WORK)
;		FIXED BUG IN 'BREAK TALLY'. (DID AN ACCEPT!)
;		IMPLEMENTED 'DDT' COMMAND.
;		IMPLEMENTED 'LOCATE' COMMAND.
;		IMPLEMENTED 'STEP' COMMAND.
;		IMPLEMENTED 'GO' COMMAND.
;		IMPLEMENTED 'TRACE BACK' COMMAND.
;		ALLOWED BREAKPOINTS AT SECTION NAMES.
;		ALLOWED MODULES COMPILED WITH /P TO BE LINKED IN.
;		MOVED SOME CODE AROUND SO IT IS A LITTLE MORE UNDERSTANDABLE.
;		SUBSTITUTED MNEMONIC LABELS FOR IMPLEMENTORS'S INITIALS!!!!
; EDIT 25 ADDED BETTER COMMENTS, MINOR BUG FIXES.
;		ADDED REQUIREMENT THAT STOP COMMAND BE TYPED IN FULL.
;		ONLY THE CODE CHANGES ARE IDENTIFIED WITH ;[25] COMMENTS.
; EDIT 24 ADDED "NEXT <INTEGER>" COMMAND.
; EDIT 23 FIX BREAKPOINT INSERTION AFTER .REENTER.
; EDIT 22 FIX "? ITEM TOO LARGE FOR TEMP" ERROR TO DISPLAY CORRECTLY
; EDIT 21 IMPLEMENT REENTER COMMAND
; EDIT 20 ALLOW COBDDT TO UNDERSTAND LOWER CASE.
; EDIT 17 FIX SYMBOL TABLE SEARCH FOR QUALIFIED VARIABLES.
; EDIT 16 FIX MEMORY PROTECTION FAILURE FOR QUALIFIED ITEMS.
; EDITS 14 & 15 INADVERTANTLY FIXED IN V10.
; EDIT 13 FIX SO THAT MODULE COMMAND DOES NOT INTERFERE WITH RUNNING (TRACING)

;[12] /JEF	SKIP OVER FOUR START UP INSTRUCTIONS (DBMS)
;		TO AVOID ILL MEM REF.

	MLON
	SALL

	SEARCH	INTERM,COMUNI
IFN TOPS20,<	SEARCH		MONSYM		;[26]
>

	INFIX%			;DEFINE %FILES INDICES

;Entry and exit documentation for COBDDT.

;COBDDT can be invoked in various ways and at various entry points.
;Some invocations cause an action to take place followed by a return to
;the caller.  Other invocations cause an action to take place followed by
;entry to COBDDT's dialogue mode, in which it converses with the user at the
;terminal.  The user has various options for getting out of dialogue
;mode, and that gives COBDDT various ways of exiting.

ENTRY	CBDDT.	;Initialization code - user prog does JSP 16,CBDDT.
		;goes into dialogue mode.

ENTRY	C.TRCE	;Tracing code - user prog does PUSHJ 17,C.TRCE
		;If REEBRK switch is set, a simulated break is done
		;  and dialogue mode is entered.
		;Issues trace message if tracing is on.
		;Remembers procedure names for possible abort message.
		;Returns with POPJ 17, if not in dialogue mode.

ENTRY	BTRAC.	;Error abort code - entered from LIBOL by JRST BTRAC.
		;prints last seen sect/par names.
		;enters dialogue mode.

ENTRY	TRPD.	;PERFORM push code - entered from prog by PUSHJ 17,TRPD.
		;Remembers current sect/par names before executing PERFORM.
		;returns with POPJ 17,

ENTRY	TRPOP.	;PERFORM pop code - entered from prog by PUSHJ 17,TRPOP
		;Restores saved sect/par names after return from PERFORM range.
		;returns with POPJ 17,

;COBOL user code may not be resident either because it uses
;the COBOL program segmentation feature, or because it was linked
;into overlays.  In either case, breakpoints cannot be set if the
;code is not in memory at the time that the breakpoint is requested.
;LINK overlay code requires various bookkeeping functions so that
;the histogram featue and the breakpoint features will work.

ENTRY	SFOV.	;LINK overlay initialization - entered with PUSHJ 17,SFOV.
		;Does the bookkeeping each time a new LINK overlay is loaded.
		;If the user has turned on the OVERLAY break feature,
		;  dialogue mode is entered.  Otherwise, returns with POPJ.
		;Entered from the PUTF. routine in LIBOL, which is called
		;from the inline code at every ENTRY in a module.

ENTRY	SBPSG.	;Segmentation initialization - entered by PUSHJ 17,SBPSG.
		;Does the bookkeeping for non-resident segments each time
		;  they are loaded.
		;Returns with POPJ 17,

ENTRY	CNTRC.	;CANCEL bookkeeping - entered by PUSHJ 17,CNTRC.
		;When a module is CANCELled, all LINK overlays 'below it',
		;as well as the LINK overlay containing it are 'forgotten'.
		;This code does the necessary bookkeeping.
		;returns with a POPJ 17,

ENTRY	HSRPT.	;HISTORY report check - entered by PUSHJ 17,HSPRT.
		;If a STOP RUN is entered before terminating a histogram,
		;LIBOL guarantees the report is written by entering
		;COBDDT here.
		;returns by POPJ 17,

;The following are locations in COBDDT that are not defined as ENTRYs.

; CBREE.	;REENTER code - entered from monitor on REENTER command.
		;(address is supplied to monitor by COBDDT's init code.)
		;asks the user whether he wants to enter COBDDT, or just
		;take a RERUN dump.  If user indicates he wants to enter
		;COBDDT a switch is set so that a simulated break will
		;occur at the NEXT tracepoint.
		;returns by JRST @.JBOPC or by taking rerun dump (LIBOL).

; BCOM		;break code - entered from user program by the sequence:
		;	JSR	bptabl		;(in user's prog)
		;bptabl:JSA	TA,BCOM		;(in breakpoint table)
		;Prints breakpoint information
		;enters dialogue mode.

; DECOD		;dialogue code - entered by JRST DECOD from all over COBDDT.
		;prompts for COBDDT command,
		;reads and decodes the command, calls for command execution.
		;Stays in a loop until an 'exiting command' is read.
		;Exits by:
		;STOP - goes to LIBOL's STOP RUN code.
		;STEP or PROCEED - returns to the user program in various
		;		ways depending on how COBDDT got entered.
		;		IF entered at C.TRCE, or SFOV.,returns by POPJ.
		;		If entered at CBDDT., returns by JRST @PROGST.
		;		If entered at BCOM, returns by executing the
		;			user instruction at point of break,
		;			then a JRST.
		;GO - JRST to the location named.
EXTERNAL .JBREL,.JBSA,.JBDDT	;[26]

;AC DEFINITIONS

SW=0		;SWITCH REGISTER, RH IS CHARACTER POSITION
		;DURING SCANNING OF COMMAND LINE.

LIT=1		;STACK POINTER FOR LITERAL POOL
COD=2		;STACK POINTER FOR CODE ROLL
DT=3		;PNTR TO DATAB OR PROTAB

W1=6		;HOLDS XWD IN CODE GENERATION
W2=7		;EXTRA WORD FOR CODE GENERATORS

NM==10		;NMTAB INDEX
CH==11		;MOST RECENTLY RETRIEVED CHARACTER
		;FROM THE COMMAND LINE.

		;TE THRU TA ARE OFTEN USED TO HOLD UP TO A 30 CHAR
		;COBOL NAME FROM THE COMMAND LINE (IN SIXBIT).
TE=12		;TEMPORARIES
TD=13
TC=14
TB=15
TA=16
PP=17		;PUSH-DOWN POINTER

TK==1
TJ==2
TI==3
TH==4
TG==5
TF==10

;OPERATORS

DIS==3		;DISPLAY
ACC==1		;ACCEPT

;SWITCH DEFINITIONS FOR 'SW'

FASIGN==1B18	;"A" OPERAND IS SIGNED
FBSIGN==1B19	;"B" OPERAND IS SIGNED
FANUM==1B20	;"A" OPERAND IS NUMERIC
FBNUM==1B21	;"B" OPERAND IS NUMERIC

PRNMFG==1B1	;[26]PROCEDURE NAME EXPECTED IN COMMAND
BLNFLG==1B2	;AT LEAST ONE BLANK!TAB SEEN IN SKPBLN
FQFLAG==1B3	;CURRENT UPWARD SEARCH IS FULLY QUALIFIED (NO SKIPS YET)
NUQFLG==1B4	;TWO NON-FULLY QUALIFIED MATCHES HAVE BEEN FOUND
CLRFLG==1B5	;CLEAR COMMAND SEEN
NUIFLG==1B6	;TWO PROPER INITIAL SEGMENTS OF SYMBOLS HAVE BEEN FOUND
ALTFLG==1B7	;LINE TERMINATED W/ALTMODE
LOCFLG==1B8	;LOCATE COMMAND SEEN
GOFLG==1B9	;GO COMMAND SEEN

;FLAGS IN WORD RETURNED BY RPACS JSYS.
RDACC==1B2		;[26]PAGE IS READ ACCESSIBLE
EXCACC==1B4		;[26]PAGE IS EXECUTABLE
PGXSTS==1B5		;[26]PAGE EXISTS

;USEFUL TABLES AND DEFINITIONS FOR CODE GENERATORS


CODE9==1		;PICTURE CODE FOR "9"
CODEM==3		;FOR FLOATING "-"
CODES==10		;FOR INSERTED "-"
CODEP==11		;FOR "."

; THESE CODES ARE BASED UPON USAGE CODE -1
; INDEX IS CHANGED TO COMP-1 AND ITS # IS USED BY EDITED

D6MODE==0		;SIXBIT
D7MODE==1		;ASCII
D9MODE==2		;EBCDIC
DSMODE==2		;HIGHEST DISPLAY MODE
D1MODE==3		;1-WORD DECIMAL
D2MODE==4		;2-WORD DECIMAL
FPMODE==5		;FLOATING POINT
EDMODE==6		;EDITED -USES INDEX SLOT
C3MODE==7		;COMP-3

%US.IN==7		;ACTUAL USAGE CODE FOR INDEX TYPE

CHAC:	POINT 4,CH,12	;AC-FIELD IN "CH"

BYTE.S:	OCT 6		;SIXBIT BYTE SIZE
	OCT 7		;ASCII BYTE SIZE
	OCT 9		;EBCDIC BYTE SIZE

BYTE.W:	OCT 6		;SIXBIT BYTES PER WORD
	OCT 5		;ASCII BYTES PER WORD
	OCT 4		;EBCDIC BYTES PER WORD

;BYTE POINTERS BASED UPON MODE
BYPTRS:	POINT	6,0
	POINT	7,0
	POINT	9,0
	POINT	6,0
	POINT	6,0
	POINT	6,0
	0
	POINT	9,0	;COMP-3

;MULTIPLE-PRECISION ARITHMETIC OP-CODES


;OP CODES

DEFINE OPCODE (NAME,VAL,AC) <NAME==VAL'B26+AC'B30>

OPCODE (MOVE%,200,0)
OPCODE (MOVM%,214,0)
OPCODE (MOVEM%,202,0)
OPCODE (MOVMM%,216,0)


EXTERNAL	EDIT.S,EDIT.U
;NOTE COBDDT WILL USE EDIT.S AND EDIT.U EVEN WHEN RUNNING ON A KL-10

EXTERNAL	MAG.,DSPLY.,ACEPT.,MOVE.,C.D6D7,C.D6D9,C.D7D6,C.D7D9
EXTERNAL	C.D9D6,C.D9D7,PD6.,PD7.,PD9.,PC3.,GD6.,GD7.,GD9.,GC3.
EXTERNAL	FLOT.2,DSP.FP,GETNM.,PPOT4.,ISBPS.

;DATAB DEFINITIONS

DTLKP==1		;WORD # OF LINKAGE PTR
DTLVL==3		;WORD # OF WORD CONTAINING THE LEVEL NUMBER
DTFLAG==4		;WORD # OF FLAGS
DTSON==2		;WORD # OF FATHER/BROTHER/SON LINKS
DTBP==^D9		;WORD # OF EDIT MASK
DTSUBW==6		;WORD # OF SUBSCRIPT INFO
DTOCCL==000004		;OCCURS AT THIS LEVEL
CL.NUM==2		;CLASS NUMERIC

;BYTE POINTERS

DTCLAS:	POINT 2,DTFLAG(DT),1	;CLASS FIELD
DTDPL:	POINT 6,DTFLAG(DT),35	;DECIMAL PLACES FIELD
DTESIZ:	POINT 18,5(DT),17	;EXTERNAL SIZE
DTISIZ:	POINT 18,5(DT),35	;INTERNAL SIZE
DTNOCC:	POINT 15,DTSUBW(DT),14	;NUMBER OF OCCURANCES
DTRESD:	POINT 6,3(DT),11	;RESIDUE FIELD
DTUSAG:	POINT 4,3(DT),17	;USAGE FIELD

;BITS SET IN FIFTH WORD OF DATAB ENTRY

;LEFT HALF
	DTNUM==400000	;NUMERIC
	DTSYNL==100000	;SYNCHRONIZED LEFT
	DTSYNR==040000	;SYNCHRONIZED RIGHT
	DTSIGN==020000	;SIGNED
	DTBWZ==010000	;BLANK WHEN ZERO
	DTSUBS==004000	;MUST BE SUBSCRIPTED
	DTEDIT==002000	;EDITED
	DTLINK==001000	;FATHER (1) OR BROTHER (0) LINK
	DTDEF==000400	;DEFINED

;RIGHT HALF
	DTLKS==000100	;LINKAGE SECTION FLAG
	DTPLOC==1B30	;DECIMAL POINT IS TO RIGHT OF WORD
	DTSYLL==1B25	;SYNCS AT LOWER LEVELS


;CODE ROLL ALLOCATIONS

N.TMP==^D100		;MAX TEMP STORAGE
N.COD==^D30		;MAX CODE ROLL SIZE
N.LIT==^D30		;MAX LIT POOL SIZE

;BITS SET IN THIRD WORD OF PRTAB ENTRY

;RIGHT HALF
	PRLINK==1B25	;PARAGRAPH-NAME (1) OR SECTION-NAME (0)

;BYTE POINTERS

NMLINK:	POINT	15,(TD),17	;LINK UP TO NAMTAB
SECNAM:	POINT	15,1(TD),17	;LINK UP TO SECTION-NAME

;PARAMETERS FOR PRTAB

PRFLGS==2	;WORD # OF FLAGS

;TABLE TYPE PARAMETERS

DTTYPE==100000	;DATAB TYPE
PRTYPE==400000	;PRTAB TYPE
TYPMSK==700000	;MASK FOR TYPE FIELD
;DEFINITION OF FIELDS IN COBDDT'S LINK-10 OVERLAY BLOCKS.

OVLTN==0		;LINK TO NEXT.
OVNAM==1		;SIXBIT MODULE NAME.
OVSMD==2		;FIRST LOCATION IN MODULE (LH)
OVEPA==2		;MAIN ENTRY POINT ADDRESS (RH)
OV%NM==3		;%NM.
OV%DT==4		;%DT.
OV%PR==5		;%PR.
OVSLK==6		;FIRST LOCATION IN THE LINK (LH).
OVLKN==6		;LINK NUMBER (RH).

OVBKSZ==7		;SIZE OF THE BLOCK.


;DEFINITIONS OF FIELDS AND FLAGS IN LINK'S TABLES.

F.LIC==(1B0)		;LINK IN CORE
F.MDL==(1B1)		;ROUTINE IN MULTIPLE LINKS.
F.RLC==(1B2)		;LINK IS RELOCATED.

CS.NUM==2		;LINK NUMBER
CS.PTR==4		;PREVIOUS CONTROL SECTION,,NEXT CONTROL SECTION.
CS.COR==7		;LENGTH OF LINK,,FIRST LOC IN LINK.
CS.EXT==10		;AOBJN PTR TO EXTERNAL TRANSFER TABLES.
CS.INT==11		;AOBJN PTR TO INTERNAL TRANSFER TABLES.

JT.FLG==0		;FLAGS (BITS 0-8)
JT.ADR==0		;ADDRESS IF IN CORE (RH)
JT.CST==1		;ADDRESS OF THIS CONTROL SECTION (RH)
JT.MDL==1		;POINTER TO MULTIPLY DEFINED TABLE.
;GENERAL "SW" TESTER

DEFINE SWTEST (A,B) <
	XLIST
	IFLE A-777777,<TR'B SW,A>
	IFG A-777777,<
	    IFN A&777777,<TD'B SW,[A]>
	    IFE A&777777,<TL'B SW,(A)>
	>
	LIST
>

DEFINE SWON (A) <SWTEST A,O>	;TURN ON FLAGS
DEFINE SWOFF (A) <SWTEST A,Z>	;TURN OFF FLAGS
DEFINE TSWC (A) <SWTEST A,C>	;COMPLEMENT FLAG
DEFINE TSWF (A) <SWTEST A,NE>	;TEST FLAG AND SKIP IF OFF
DEFINE TSWT (A) <SWTEST A,NN>	;TEST FLAG AND SKIP IF ON
DEFINE TSWFZ (A) <SWTEST A,ZE>	;CLEAR FLAG, SKIP IF IT WAS OFF
DEFINE TSWTZ (A) <SWTEST A,ZN>	;CLEAR FLAG, SKIP IF IT WAS ON
DEFINE TSWFS (A) <SWTEST A,OE>	;SET FLAG, SKIP IF IT WAS OFF
DEFINE TSWTS (A) <SWTEST A,ON>	;SET FLAG, SKIP IF IT WAS ON
DEFINE TSWFC (A) <SWTEST A,CE>	;COMP. FLAG, SKIP IF IT WAS OFF
DEFINE TSWTC (A) <SWTEST A,CN>	;COMP. FLAG, SKIP IF IT WAS ON
DEFINE SWONS (A) <SWTEST A,OA>	;SET FLAG AND ALWAYS SKIP
DEFINE SWOFFS (A) <SWTEST A,ZA>	;CLEAR FLAG AND ALWAYS SKIP


	DEFINE	ERR0(FOO)	 <[JSP TA,PUTERR
			   ASCIZ FOO]>
	DEFINE	ERR(FOO)	<
				 JRST	ERR0(FOO)
				 >

;COME HERE FOR "ACCEPT" COMMAND EXECUTION.
;GENERATES CODE FOR A "MOVE A TO B" WHERE "A" IS THE LITERAL TYPED
;ON THE TERMINAL AND "B" IS THE IDENTIFIER TYPED IN ACCEPT COMMAND.

ACCGEN:	MOVEI	W1,BASEB	;SET UP 'B' OPERAND
	PUSHJ	PP,SETOPN
	MOVE	TE,[XWD BASEB,BASEA]
	BLT	TE,BASAX	;MAKE 'A' = 'B'
	MOVE	TE,DTFLAG(DT)	;GET FLAGS
	MOVEI	TD,EDMODE
	TLNE	TE,DTEDIT	;EDITED?
	HRRM	TD,MODEB	;YES: SET MODE

	HRLZ	W1,SIZEB	;SET UP SIZE IN PARAM
	TLO	W1,(<1B7>)	;SKIP TO CRLF
	LDB	TE,DTCLAS	;CHECK ON CLASS
	CAIN	TE,CL.NUM	;NUMERIC?
	JRST	ACEP15		;YES:

;FIELD IS ALPHANUMERIC

	HRRZ	TE,MODEB
	CAIN	TE,D7MODE	;ASCII?
	JRST	ACEP20		;OK TO USE DIRECTLY

;FIELD IS EITHER ASCII-EDITED OR NON-ASCII ALPHANUMERIC
; SO ACCEPT INTO ASCII TEMP AND MOVE AFTER

ACEP10:	MOVE	TE,SIZEA	;GET SIZE FOR TEMP CALC
	ADDI	TE,4
	IDIVI	TE,5		;NUMBER OF WORDS
	PUSHJ	PP,GETEMP	;ALLOCATE AND RETURN ADDR
	MOVEM	TE,INCRA
	MOVE	TE,[XWD ^D36,TEMROL]
	MOVEM	TE,BASEA
	MOVEI	TE,D7MODE	;'A' IS ASCII
	MOVEM	TE,MODEA
	PUSHJ	PP,ACEP20
	SWOFF	FASIGN!FANUM
	JRST	MXX.		;STASH AWAY

;FIELD IS NUMERIC OR NUMERIC EDITED
; SO ACCEPT INTO AC 0,1 AND THEN MOVE TO DESTINATION

ACEP15:	PUSHJ	PP,ACEP25
	SETZM	EAC		;AC := 0
	SWON	FASIGN!FANUM
	MOVEI	TE,D2MODE	;USE 2-WORD COMP
	MOVEM	TE,MODEA
	JRST	MACX.		;STASH AWAY

;CREATE LITERAL AND CALL FOR ALPHANUMERIC

ACEP20:	LSH	W1,6
	HLR	W1,RESA		;BYTE RESIDUE
	ROT	W1,-6
	HRR	W1,BASEA	;ADDRESS
	ADD	W1,INCRA	;INCREMENT

ACEP21:	PUSH	LIT,W1		;STORE LITERAL
	MOVSI	CH,(MOVEI 16,)
	HRR	CH,LIT		;LITERAL ADDR
	PUSH	COD,CH		;STASH CODE
	PUSH	COD,[PUSHJ	PP,ACEPT.]	;CALL ACCEPT
	POPJ	PP,

;CREATE LITERAL AND CALL FOR NUMERIC

ACEP25:	TLO	W1,(<1B6>)	;NUMERIC
	MOVE	TA,DPLA
	JUMPGE	TA,ACEP26	;OK IF POSITIVE
	MOVNS	TA
	TRO	TA,40		;SET SIGN
ACEP26:	HRR	W1,TA		;DECIMAL PLACES
	JRST	ACEP21

;COME HERE FOR "DISPLAY" COMMAND EXECUTION.
;GENERATES CODE FOR A "MOVE A TO B" WHERE "A" IS THE IDENTIFIER TYPED IN
;THE DISPLAY COMMAND AND "B" IS THE TERMINAL.

DISPGN:	LDB	TC,DTUSAG	;GET USAGE
	JRST	@DISPDO(TC)

;DISPLAY DISPATCH TABLE

DISPDO:	EXP	DISERR		;0 - NO SUCH
	EXP	DISPD6		;[22] 1 - DISPLAY 6
	EXP	DISPD7		;2 - DISPLAY 7
	EXP	STNDRD		;3 - DISPLAY 9
	EXP	STNDRD		;4 - 1 WORD COMP
	EXP	STNDRD		;5 - 2 WORD COMP
	EXP	DISPFP		;6 - COMP-1
	EXP	STNDRD		;7 - INDEX
	EXP	STNDRD		;10 - COMP-3

;CALL MOVE GENERATOR FOR A LITTLE HELP

	; MOVE TO AN ASCII TEMP - POSSIBLY EDITED
STNDRD:	PUSHJ	PP,MXTMP.

STND2:	TLZ	W1,(<1B7>)	;CRLF AT END OF LINE
	PUSH	LIT,W1
	MOVSI	CH,(MOVEI 16,)
	HRR	CH,LIT
	PUSH	COD,CH
	PUSH	COD,[PUSHJ	PP,DSPLY.]	;DISPLAY IT
	POPJ	PP,

;DISPLAY ASCII

DISPD7:	MOVEI	W1,BASEA	;SET UP 'A' OPERAND
	PUSHJ	PP,SETOPN
	TSWF	FANUM		;NUMERIC?
	JRST	STNDRD		;YES: USE STANDARD

	MOVE	TE,DTFLAG(DT)
	HRRZ	W1,SIZEA	;GET CORRECT SIZE
	TLNE	TE,DTEDIT	;IF EDITED
	LDB	W1,DTESIZ	;USE EXTERNAL SIZE
	CAILE	W1,1777		;[22] WILL IT FIT IN ONE OPERATION?
	JRST	[SUBI	W1,^D1020	;[22] NO
		PUSH	PP,W1		;[22] SAVE REMAINDER
		MOVEI	W1,^D1020	;[22] SAVE THE FIRST PART
		PUSHJ	PP,.+1		;[22] DO THE FIRST PART
		MOVEI	W1,^D1020/5	;[22]
		ADDM	W1,INCRA	;[22] POINT TO SECOND PART
		POP	PP,W1		;[22] GET BACK REMAINDER
		JRST	.+1]		;[22] CONTINUE
	ROT	W1,-^D12
	HLR	W1,RESA
	ROT	W1,-6
	HRR	W1,BASEA
	ADD	W1,INCRA
	JRST	STND2

;DISPLAY SIXBIT
DISPD6:	MOVEI	W1,BASEA	;[22] SET UP 'A' OPERAND
	PUSHJ	PP,SETOPN	;[22]
	TSWF	FANUM		;[22] NUMERIC?
	JRST	STNDRD		;[22] YES, USE STANDARD
	MOVE	TE,DTFLAG(DT)	;[22]
	HRRZ	W1,SIZEA	;[22] GET CORRECT SIZE
	TLNE	TE,DTEDIT	;[22] IF EDITED
	LDB	W1,DTESIZ	;[22] USE EXTERNAL SIZE
	CAILE	W1,1777		;[22] WILL IT FIT IN ONE OPERATION?
	JRST	[SUBI	W1,^D1020	;[22] NO
		PUSH	PP,W1		;[22] SAVE REMAINDER
		MOVEI	W1,^D1020	;[22] SIZE OF FIRST PART
		PUSHJ	PP,.+1		;[22] DO THE FIRST PART
		MOVEI	W1,^D1020/6	;[22]
		ADDM	W1,INCRA	;[22] POINT TO SECOND PART
		POP	PP,W1		;[22] GET BACK REMAINDER
		JRST	.+1]		;[22] CONTINUE
	ROT	W1,-^D12	;[22]
	HLR	W1,RESA		;[22]
	ROT	W1,-6		;[22]
	HRR	W1,BASEA	;[22]
	ADD	W1,INCRA	;[22]
	TLZ	W1,(<1B7>)	;[22] CRLF AT END OF LINE
	PUSH	LIT,W1		;[22]
	MOVSI	CH,(MOVEI 16,)	;[22]
	HRR	CH,LIT		;[22]
	PUSH	COD,CH		;[22]
	PUSH	COD,[PUSHJ PP,DSPL.6##]	;[22] DISPLAY IT
	POPJ	PP,		;[22]

;DISPLAY A COMP-1 FIELD

DISPFP:	MOVEI	W1,BASEA	;SET UP 'A' OPERAND
	PUSHJ	PP,SETOPN
	MOVEI	TE,4
	MOVEM	TE,EAC		;USE AC(5)
	MOVSI	CH,MOVE%
	TSWT	FASIGN		;SIGNED?
	MOVSI	CH,MOVM%	;NO: USE MAGNITUDE ONLY
	PUSHJ	PP,GENOPA
	PUSH	COD,[PUSHJ PP,DSP.FP]
	POPJ	PP,

;SET UP OPERAND PARAMETERS
;ENTER WITH EITHER BASEA OR BASEB IN W1 & PNTR TO 'DATAB'
;ENTRY IN DT. SUBSCRIPTING IS DONE IF NECESSARY AND 'INCRX'
;AND 'RESX' ARE UPDATED.

SETOPN:	HRRZ	TA,1(DT)	;GET ADDR OF ELEMENT
	HRRZM	TA,BASEX(W1)
	SETZM	INCRX(W1)	;CLR INCREMENT

	LDB	TE,DTUSAG	;GET USAGE
	SUBI	TE,1
	CAIN	TE,%US.IN-1		;INDEX
	MOVEI	TE,D1MODE	;YES: USE 1-WORD COMP
	MOVEM	TE,MODEX(W1)

	LDB	TE,DTRESD	;GET BYTE RESIDUE
	HRLM	TE,RESX(W1)	;AND STASH
	LDB	TE,DTDPL	;GET DECIMAL PLACES
	TRZE	TE,DTPLOC	;NEGATIVE?
	MOVNS	TE		;YES: NEGATE
	MOVEM	TE,DPLX(W1)	;ANS STASH IT
	LDB	TE,DTISIZ	;USE INTERNAL SIZE
	MOVEM	TE,SIZEX(W1)

	MOVE	TD,DTFLAG(DT)	;FLAGS
	TLNN	TD,DTDEF	;MAKE SURE DEFINED
	JRST	UNDEF

	TRNE	TD,DTLKS	;LINKAGE SECTION?
	JRST	SETOP1		;YES
	TLNN	TD,DTSUBS	;NEED SUBSCRIPTS?
	JRST	[SKIPE NSUBS
		 JRST NOSUB
		 JRST .+2]
SETOP1:	PUSHJ	PP,SUBSCR	;YES: DO CHECK

	MOVE	TD,DTFLAG(DT)	;GET FLAGS BACK
	CAIN	W1,BASEA	;DOING 'A'?
	JRST	SETOP2		;YES:

;'B' OPERAND

	TLNE	TD,DTSIGN	;SIGNED?
	SWONS	FBSIGN
	SWOFF	FBSIGN
	TLNN	TD,DTEDIT	;EDITED
	TLNN	TD,DTNUM	;NO: NUMERIC
	SWOFFS	FBNUM
	SWON	FBNUM
	POPJ	PP,		;RETURN

;'A' OPERAND

SETOP2:	TLNE	TD,DTSIGN	;SIGNED?
	SWONS	FASIGN
	SWOFF	FASIGN
	TLNN	TD,DTEDIT	;EDITED
	TLNN	TD,DTNUM	;NO: NUMERIC
	SWOFFS	FANUM
	SWON	FANUM
	POPJ	PP,		;RETURN

;DO SUBSCRIPTING

SUBSCR:	SKIPE	NSUBS		;DO WE HAVE ANY?
	JRST	SUBSC0		;YES
	TRNN	TD,DTLKS	;IN LINKAGE SECTION?
	JRST	NEDSUB		;NO: TOUGH
SUBSC0:	MOVEM	DT,SAVDT	;SAVE DATAB PNTR
	SETZB	CH,REMAN

	HLRZ	W2,RESX(W1)	;CALC B.P. TO 1ST ELEMENT
	ROT	W2,-6		;SET UP RESIDUE
	HRR	W2,INCRX(W1)

	MOVE	TD,DTFLAG(DT)	;LINKAGE SECTION?
	TRNN	TD,DTLKS
	JRST	SUBSC2		;NO
	HLRZ	TD,DTLKP(DT)	;YES, GET LINKAGE PTR
	ADD	W2,(TD)
	SKIPE	NSUBS		;0 SUBSCRIPTS?
	JRST	SUBSC2		;NO
	MOVE	TE,W2		;YES, GET TO THE END
	JRST	SUBSC8

SUBSC2:	MOVE	TE,DTSUBW(DT)	;OCCURS AT THIS LEVEL?
	TLNE	TE,DTOCCL
	JRST	SUBSCA
	LDB	DT,[POINT 15,DTSUBW+1(DT),17]
	ADD	DT,@%DT
SUBSCA:	;GET PROPER BYTE SIZE FOR RECORD
	LDB	TC,DTUSAG	;GET USAGE
	CAIN	TC,%US.IN	;INDEX?
	MOVEI	TC,D1MODE+1	;USE COMP
	HLRZ	TA,BYPTRS-1(TC)	;SKELETON BYTE POINTER
	TRZ	TA,770077	;JUST LEAVE BYTE SIZE
	TLO	W2,(TA)		;PUT BYTE SIZE IN
SUBSC1:	LDB	TA,DTNOCC	;NUMBER OF OCCURRANCES
	SKIPG	TC,SUB0.(CH)	;[24]SUBSCRIPT POSITIVE?
	JRST	SMLSUB		;[24]NO, ERROR
	CAMLE	TC,TA		;IN BOUNDS?
	JRST	LRGSUB
	SOS	TC		;OK, DECR
	LDB	TE,DTUSAG	;GET USAGE
	XCT	SUBSIZ(TE)	;GET # OF BYTES
	IMUL	TA,TC
	ADDM	TA,REMAN	;ACCUMULATE SUM
SUBSC3:	AOS	TE,CH		;NEXT SUBSCRIPT
	LDB	TA,[POINT 15,DTSUBW+1(DT),17]
	CAML	TE,NSUBS
	JRST	SUBSC4		;NO MORE TYPED
	JUMPE	TA,TOOFEW	;TOO MANY
	HRRZ	DT,TA		;PNTR TO NEXT LEVEL
	ADD	DT,@%DT
	JRST	SUBSC1		;LOOP

SUBSC4:	JUMPE	TA,SUBSC6	;ALL EVEN?
	JRST	NOTNUF		;NOT ENUF
SUBSC6:	MOVE	TD,REMAN	;GET COMPUTED OFFSET
	LDB	TE,[POINT 6,W2,11]
	MOVEI	TB,^D36
	IDIV	TB,TE		;BYTES/WORD
	IDIV	TD,TB		;NUMBER OF WORDS
	MOVE	TE,W2
	ADD	TE,TD		;CALC NEW OFS
SUBSC7:	SOJL	TC,SUBSC8	;ANY BYTES LEFT OVER?
	IBP	TE		;YES: BUMP BYTE PNTR
	JRST	SUBSC7		;LOOP

SUBSC8:	HRRZM	TE,INCRX(W1)	;STORE OFFSET
	LDB	TE,[POINT 6,TE,5]
	HRLM	TE,RESX(W1)	;AND RESIDUE
	MOVE	DT,SAVDT	;GET BACK DT PTR
	POPJ	PP,		;RETURN

;A TABLE WHICH DETERMINES SIZE OF ITEM (ALWAYS IN BYTES)

SUBSIZ:	JRST	BADBAD		;0
	PUSHJ	PP,SUBSZX	;1 SIXBIT
	PUSHJ	PP,SUBSZX	;2 ASCII
	PUSHJ	PP,SUBSZX	;3 EBCDIC
	MOVEI	TA,6		;4 1-WORD COMP
	MOVEI	TA,^D12		;5 2-WORD COMP
	MOVEI	TA,6		;6 COMP-1
	MOVEI	TA,6		;7 INDEX
	PUSHJ	PP,SUBSZC	;10 COMP-3

SUBSZX:	LDB	TA,DTESIZ	;EXTERNAL SIZE
SUBSZ1:	MOVE	TD,DTFLAG(DT)
	TDNN	TD,[XWD DTSYNL!DTSYNR,DTSYLL]
	POPJ	PP,		;NO SYNCS - OK
	EXCH	TE,TA
	IDIV	TE,BYTE.W-1(TA)
	SKIPE	TD
	ADDI	TE,1
	IMUL	TE,BYTE.W-1(TA)
	EXCH	TE,TA
	POPJ	PP,

SUBSZC:	;COMP - 3
	LDB	TA,DTESIZ	;EXTERNAL SIZE
	ADDI	TA,2		;FOR SIGN AND ROUND OUT BYTE
	LSH	TA,-1		;DIVIDE BY 2
	JRST	SUBSZ1
;MOVE AN ITEM TO TEMPORARY FOR USE BY "DISPLAY"
;ENTER WITH 'DT' POINTING TO AN OPERAND.
;EXIT WITH DISPLAY LITERAL IN 'W1'

MXTMP.:	SETZM	EAC		;START AN AC(0)
	MOVEI	W1,BASEA	;SET UP 'A' OPERAND
	PUSHJ	PP,SETOPN
	MOVE	TE,[XWD BASEA,BASEB]
	BLT	TE,BASBX	;MAKE 'B' = 'A'
	MOVEI	TE,D7MODE
	MOVEM	TE,MODEB	;ASCII

	TSWF	FANUM		;IS 'A' NUMERIC
	JRST	MXTMP4		;YES: TREAT SPECIAL

	MOVE	TE,DTFLAG(DT)
	TLNN	TE,DTEDIT	;EDITED FIELD?
	JRST	MXTMP1		;NO:
	LDB	TE,DTESIZ	;YES: USE EXTERNAL SIZE
	MOVEM	TE,SIZEA
	MOVEM	TE,SIZEB

;INPUT FIELD IS NON-ASCII, NON-NUMERIC

MXTMP1:	HRLZ	W2,SIZEA	;CONSTRUCT LIT IN W2
	MOVE	TE,SIZEB
	ADDI	TE,4		;GET SIZE OF 'B' IN WORDS
	IDIVI	TE,5
	PUSHJ	PP,GETEMP	;GET SOME TEMP LOCS
	MOVEM	TE,INCRB
	MOVE	TE,[XWD ^D36,TEMROL]
	MOVEM	TE,BASEB
	HRR	W2,BASEB
	ADD	W2,INCRB

	PUSHJ	PP,MXX.		;GENERATE MOVE

	TLO	W2,(<^D36B5>)	;BYTE RESIDUE
	MOVE	W1,W2		;RETURN LITERAL
	POPJ	PP,

;ITEM IS NUMERIC, AND THEREFORE MUST BE EDITED.

MXTMP4:	SWON	FBSIGN!FBNUM	;'B' IS ALWAYS SIGNED ETC.
	SKIPL	DPLA		;NEGATIVE DECIMAL PLACES?
	JRST	MXTMP5		;NO:
	MOVM	TE,DPLA		;YES: 'B' IS SIZE - DEC. PL.
	ADD	TE,SIZEA
	MOVEM	TE,SIZEB
	SETZM	DPLB
	JRST	MXTMP9

MXTMP5:	MOVE	TE,SIZEA	;NEGATIVE INTEGRAL PLACES?
	SUB	TE,DPLA
	JUMPGE	TE,MXTMP6	;NO: OK
	MOVE	TE,DPLA		;YES: SIZE IS # DECIMAL PLACES
	MOVEM	TE,SIZEB
	JRST	MXTMP9

MXTMP6:	;MOVE EVERYTHING TO A TEMP TO BE SURE NUMBER IS IN CORRECT FORM
;	HRRZ	TE,MODEA	;IS ITEM DISPLAY USAGE?
;	CAIG	TE,DSMODE
;	JRST	MXTM10		;YES: DON'T MOVE TO TEMP

MXTMP9:	MOVEI	TE,D6MODE	;NO: MOVE TO TEMP
	MOVEM	TE,MODEB
	MOVE	TE,SIZEB	;CALC # OF WORDS
	ADDI	TE,5
	IDIVI	TE,6
	PUSHJ	PP,GETEMP	;GET SOME SPACE
	MOVEM	TE,INCRB
	MOVE	TE,[XWD ^D36,TEMROL]
	MOVEM	TE,BASEB

	MOVE	TE,[XWD BASEB,SAVEA]
	BLT	TE,SAVAX	;SAVE 'B' PARAMETERS
	PUSHJ	PP,MXX.		;MOVE TO TEMP
	MOVE	TE,[XWD SAVEA,BASEA]
	BLT	TE,BASAX
	MOVE	TE,[XWD SAVEA,BASEB]
	BLT	TE,BASBX

;IT IS (OR HAS BEEN CONVERTED TO) DISPLAY USAGE.

	HRRZI	W1,1(LIT)	;ADDR OF LITERAL
	HRLI	W1,(<^D36B5>)
	SETZM	BASEB		;BYTE COUNTER
	MOVEI	TA,0
	MOVE	TB,[POINT 4,TA]	;INITIALIZE
	MOVE	TC,SIZEB
	SUB	TC,DPLB
	JUMPE	TC,MXT11B	;ALL TO RIGHT IF DECIMAL

	MOVEI	CH,CODES	;PRETEND THERE IS ONE INTEGER
	CAIE	TC,1		;IS THAT TRUE?
	AOSA	BASEB		;NO: LEAVE ROOM FOR SIGN
	PUSHJ	PP,MXTM20	;YES: JAM INSERT SIGN
	MOVEI	CH,CODEM	;SET UP FOR "FLOAT SIGN"

MXTM11:	SOJLE	TC,MXT11A	;ONLY ONE LEFT?
	PUSHJ	PP,MXTM20	;NO:
	JRST	MXTM11

MXT11A:	MOVEI	CH,CODE9	;USE "9" FOR LAST INTEGRAL PLACE.
	PUSHJ	PP,MXTM20
	JRST	MXTM12

MXT11B:	MOVEI	CH,CODES	;USE INSERT SIGN
	PUSHJ	PP,MXTM20

MXTM12:	SKIPN	TC,DPLB
	JRST	MXTM13
	MOVEI	CH,CODEP	;INSERT POINT
	PUSHJ	PP,MXTM20
	MOVEI	CH,CODE9	;FINISH OFF WITH "9"'S
	PUSHJ	PP,MXTM20
	SOJG	TC,.-1


;MASK HAS BEEN CREATED FOR NUMERIC ITEM--FINISH UP.

MXTM13:	MOVEI	CH,17
	IDPB	CH,TB
	PUSH	LIT,TA

	HRLZ	W2,BASEB	;FIELD SIZE TO LITERAL
	TLO	W2,(<^D36B5+1B6>)

	MOVE	TE,BASEB
	ADDI	TE,4
	IDIVI	TE,5		;SIZE IN WORDS
	PUSHJ	PP,GETEMP	;GET SOME PLACE TO PUT IT
	MOVEM	TE,INCRB
	MOVE	TE,[XWD ^D36,TEMROL]
	MOVEM	TE,BASEB
	HRR	W2,TE		;ADDR TO LIT ALSO
	ADD	W2,INCRB

	MOVEI	TE,D7MODE	;ASCII
	MOVEM	TE,MODEB
	MOVEI	TE,MDES.	;ASSUME SIGNED
	TSWT	FASIGN		;IS IT?
	MOVEI	TE,MDEU.	;NO: USE UNSIGNED ROUTINE
	PUSHJ	PP,(TE)
	MOVE	W1,W2		;RETURN LIT
	POPJ	PP,

;ROUTINE TO PUT NEXT EDIT CHAR IN WORD AND STASH LIT IF
;NECESSARY. CLEAR 'TA' AND PUT B.P. IN 'TB'.

MXTM20:	IDPB	CH,TB		;STORE AWAY
	AOS	BASEB		;KEEP COUNT
	TLNE	TB,770000	;FULL WORD?
	POPJ	PP,		;NO: JUST EXIT
	PUSH	LIT,TA		;YES: STASH LIT
	MOVEI	TA,0
	MOVE	TB,[POINT 4,TA]
	POPJ	PP,		;RE-INIT AND EXIT

;DISPATCH ROUTINES FOR MOVE GENERATORS

;MOVE THE AC'S TO SOMETHING

MACX.:	HRRZ	TE,MODEA	;CHECK MODES
	CAIE	TE,D2MODE	;ONLY LEGAL
	JRST	BADCOD
	HRRZ	TE,MODEB
	JRST	@MACX.T(TE)	;DO ROUTINE

MACX.T:	EXP	MACD.		; SIXBIT
	EXP	MACD.		; ASCII
	EXP	MACD.		; EBCDIC
	EXP	MAC1C.		; 1-WORD COMP
	EXP	MAC2C.		; 2-WORD COMP
	EXP	MACFP.		; COMP-1
	EXP	MACE.		; EDITED
	EXP	MACD.1		;COMP-3

;MOVE SOMETHING TO SOMETHING

MXX.:	HRRZ	TA,MODEA
	HRRZ	TB,MODEB	;CHECK LEGAL MODES
	CAILE	TB,EDMODE
	JRST	BADCOD
	CAILE	TA,D2MODE
	JRST	[ CAIN	TA,C3MODE
		  JRST	MDD.1	;COMP-3
		  JRST	BADCOD	]
	LSH	TA,2		;MOVT.(4*MODEA+MOBEB/2)
	ROT	TB,-1
	ADDI	TA,(TB)
	TLNE	TB,1B18		;LEFT HALT DISPATCH
	SKIPA	TC,MOVT.(TA)	;NO:
	MOVS	TC,MOVT.(TA)	;YES:
	JRST	(TC)		;GO DO ROUTINE

;TABLE OF ENTRANCE POINTS TO "MOVE" ROUTINES.

MOVT.:	XWD	MDD.,MDD.	;S-S,S-A
	XWD	MDD.,BADCOD	;S-E,S-1C
	XWD	BADCOD,BADCOD	;S-2C,S-F
	XWD	MDED.,BADCOD	;S-EDIT

	XWD	MDD.,MDD.	;A-S,A-A
	XWD	MDD.,BADCOD	;A-E,A-1C
	XWD	BADCOD,BADCOD	;A-2C,A-F
	XWD	MDED.,BADCOD	;A-EDIT

	XWD	MDD.,MDD.	;E-S,E-A
	XWD	MDD.,BADCOD	;E-E,
	XWD	BADCOD,BADCOD
	XWD	MDED.,BADCOD	;E-EDIT

	XWD	M1CD.,M1CD.	;1C-S,1C-A
	XWD	M1CD.,BADCOD	;1C-E,1C-1C
	XWD	BADCOD,BADCOD	;1C-2C,1C-FP
	XWD	BADCOD,BADCOD	;-,1C-EDIT

	XWD	M2CD.,M2CD.	;2C-S,2C-A
	XWD	M2CD.,BADCOD	;2C-E,2C-1C
	XWD	BADCOD,BADCOD	;2C-2C,2C-FP
	XWD	BADCOD,BADCOD	;-,2C-EDIT

BADCOD:	TTCALL	3,[ASCIZ "? ILLEGAL MOVE ARGS"]
	JRST	XECUTX

;GENERATE CODE TO MOVE FROM DISPLAY TO DISPLAY
;FOR UNEDITED FIELDS OF SAME SIZE
; NUMERIC DISPLAYS ALWAYS GO TO SIXBIT - TEMP FOR EDIT

MDD.:	MOVE	TE,SIZEB	;CHECK ARGS
	CAMN	TE,SIZEA	;FOR SAME SIZE AND
	TSWF	FBNUM		;NON-NUMERIC RECIEVER
	JRST	MDD.E

	PUSHJ	PP,BYTE.A	;GET 'A' PARAMETER
	PUSH	LIT,TA
	PUSH	COD,LIT		;ADDR OF LITERALS
	PUSHJ	PP,BYTE.C	;GET 'B' PARAMETER
	PUSH	LIT,TA
	MOVEI	CH,(MOVEI 16,)
	HRLM	CH,0(COD)	;MOVEI 16,PARAMS
	HRRZ	TC,MODEA	;GET CORRECT ROUTINE
	HRRZ	TE,MODEB
	PUSH	COD,@GMOVET(TC)	;GET ROUTINE
	POPJ	PP,

GMOVET:	GM6(TE)		;C.D6XX
	GM7(TE)		;C.D7XX
	GM9(TE)		;C.D9XX

GM6:	PUSHJ	PP,MOVE.		;SIXBIT TO SIXBIT
	PUSHJ	PP,C.D6D7
	PUSHJ	PP,C.D6D9

GM7:	PUSHJ	PP,C.D7D6
	PUSHJ	PP,MOVE.
	PUSHJ	PP,C.D7D9

GM9:	PUSHJ	PP,C.D9D6
	PUSHJ	PP,C.D9D7
	PUSHJ	PP,MOVE.

MDD.E:	;MOVING SAME TO SAME NOW
;	CAME	TE, SIZEA	; SAME SIZE NUMERIC FIELDS?
;	JRST	MDD.1		; NO - ITEM MUST BE SCALED
;	TTCALL	3,[ASCIZ "? ERROR AT MDD."]
;	JRST	XECUTX

MDD.1:	PUSHJ	PP, BYTE.A	; SAME SEQUENCE AS MDD.
	PUSH	LIT, TA
	PUSH	COD, LIT
	PUSHJ	PP, BYTE.C
	PUSH	LIT, TA

	MOVSI	CH, (MOVEI 16,)	; GET PARAMETER POINTER
	HLLM	CH, (COD)
	HRRZ	TE, (COD)	; SAVE POS IN LIT POOL
	HRRZ	TD,MODEA	;SOURCE MODE
	XCT	GDXTB(TD)	;GET PROPER ROUTINE
	HRLI	CH,(PUSHJ	PP,)
	PUSH	COD,CH		;STORE CODE

	SKIPL	TD, DPLA	; NUMBER SCALED ON LEFT OF DECIMAL POINT?
	JRST	MDD.2
	PUSH	PP,	TE		;YES, SAVE POINTER TO LITERAL POOL.
	SETZI	TE,			;THE NUMBER IS IN AC 0.
	PUSHJ	PP,	SCLE		;GO MULTIPLY THE NUMBER BY SOMETHING.
	POP	PP,	TE		;RESTORE LITERAL POOL POSITION
					; OF GD?. PARAMETERS.


MDD.2:	MOVSI	CH, (MOVEI 16,)	; NOW PUT CALL TO PD6.
	HRRI	CH, (TE)	; POINT TO ARG
	AOJ	CH,
	PUSH	COD, CH		; ADD THAT
	PUSH	COD,[PUSHJ	PP,PD6.]	;ALWAYS TO 6 BIT

	MOVE	CH, SIZEA
	TSWF	FASIGN
	TRO	CH,(1B6)
	DPB	CH, [POINT 12, (TE), 17]	; FIX ARG IN LITROL
	MOVE	CH, SIZEB
	TRO	CH, 4000	; FORCE LEAD BIT
	DPB	CH, [POINT 12, 1(TE), 17]	; FIX SECOND ARG
	POPJ	PP,

GDXTB:	;ROUTINE TO GET DISPLAY OR COMP-3
	MOVEI	CH,GD6.
	MOVEI	CH,GD7.
	MOVEI	CH,GD9.
	OUTSTR	[ASCIZ "?CBDINT GDXTB ERROR
"]
	XCT	.-1
	XCT	.-2
	XCT	.-3
	MOVEI	CH,GC3.
;MOVE A 1-WORD COMP TO A DISPLAY FIELD.

M1CD.:	MOVSI	CH,MOVE%	;MOVE TO AN AC
	TSWT	FASIGN!FBSIGN	;SIGNED?
	MOVSI	CH,MOVM%	;NOPE!
	PUSHJ	PP,GENOPA
	SKIPL	TD,	DPLA
	JRST	MACD.		;CONVERT AND RETURN
	MOVE	TE,	EAC		;FIND OUT WHERE THE NUMBER IS.
	ADDI	TE,	1
	MOVE	CH,	SIZEB		;GET THE SIZE OF THE RESULT.
	CAIG	CH,	^D10		;IF IT'S ONE WORD, ALL IS
	JRST		M2CD.3		; WELL, GO SCALE THE NUMBER.

	SOS	CH,	TE		;ALL IS NOT WELL, THE NUMBER
	DPB	CH,	CHAC		; IS IN THE WRONG AC, MOVE
	ADD	CH,	[MOVE	1]	; IT UP ONE AC.
	PUSH	COD,	CH
	JRST		M2CD.3

;MOVE A 2-WORD COMP TO A DISPLAY FILED.

M2CD.:	TSWT	FASIGN!FBSIGN	;SIGNED?
	JRST	M2CD.1		;NO: USE SPECIAL ROUTINE
	MOVSI	CH,MOVE%	;MOVE TO AC'S
	PUSHJ	PP,GENOPB
	AOS	INCRA
	MOVSI	CH,MOVE%
	PUSHJ	PP,GENOPA
	JRST		M2CD.2		;GO SEE IF THE NUMBER IS SCALED.

M2CD.1:	MOVE	CH,[PUSHJ	PP,MAG.]	;DOUBLE-PRECISION MOVE
	PUSHJ	PP,GENPUB	;OF MAGNITUDE
M2CD.2:	SKIPL	TD,	DPLA		;IS THE NUMBER SCALED?
	JRST		MACD.		;NO, GO CONVERT IT.
	MOVE	TE,	EAC		;FIND OUT WHERE IT WILL BE.
M2CD.3:	PUSHJ	PP,	SCLE		;GO GENERATE CODE TO SCALE IT.
	JRST		MACD.		;GO CONVERT IT.

;GENERATE CODE TO SCALE THE NUMBER IN THE AC WHOSE NUMBER IS IN TE BY
; THE POWER OF 10 WHOSE NEGATIVE IS IN TD.

SCLE:	MOVMS		TD		;MAKE THE POWER POSITIVE.

	CAILE	TD,	^D10		;IF IT'S TWO WORDS,
	JRST		SCLEH		; GO ON.

	MOVEI	CH,	STENS(TD)	;SELECT THE APPROPRIATE NUMBER.
	DPB	TE,	CHAC		;SET UP THE AC FIELD.

	MOVE	TE,	SIZEA		;SEE WHAT THE SIZE OF THE NUMBER
					; BEFORE THE MULTIPLICATION IS.

	CAILE	TE,	^D10		;IF IT'S TWO WORDS,
	JRST		SCLED		; GO ON.

	MOVE	TE,	SIZEB		;SEE WHAT THE SIZE OF THE NUMBER
					; WILL BE AFTER THE MULTIPLICATION.
	CAILE	TE,	^D10		;IF IT'S GOING TO BE TWO WORDS
	TLOA	CH,	(MUL)		; USE MUL, OTHERWISE USE IMUL SO
	TLO	CH,	(IMUL)		; THAT WE KEEP THE RESULT IN THE
					; SAME AC.

	PUSH	COD,	CH		;STASH THE INSTRUCTION.

	POPJ	PP,			;AND RETURN.

;THE NUMBER IS DOUBLE PRECISION.

SCLED:	PUSHJ	PP,	SCLEL		;GO SAVE THE PARAMETER.
	PUSH	COD,	[PUSHJ	17,	MUL.21##]
	POPJ	PP,

;THE POWER IS DOUBLE PRECISION.

SCLEH:	MOVEI	CH,	-^D11(TD)	;CONSTRUCT THE PARAMETER.
	LSH	CH,	1
	MOVEI	CH,	DTENS(CH)
	DPB	TE,	CHAC

	PUSHJ	PP,	SCLEL		;GOSAVE IT.
	PUSH	COD,	[PUSHJ	PP,	MUL.12##]
	POPJ	PP,
SCLEL:	PUSH	LIT,	CH
	HRRI	CH,	(LIT)
	HRLI	CH,	(<MOVE	16,0>)
	PUSH	COD,	CH
	POPJ	PP,

STENS:	DEC	1
	DEC	10
	DEC	100
	DEC	1000
	DEC	10000
	DEC	100000
	DEC	1000000
	DEC	10000000
	DEC	100000000
	DEC	1000000000
	DEC	10000000000


DTENS:	OCT	2			;11
	OCT	351035564000
	OCT	35			;12
	OCT	032451210000
	OCT	443			;13
	OCT	011634520000
	OCT	5536			;14
	OCT	142036440000
	OCT	70657			;15
	OCT	324461500000
	OCT	1070336			;16
	OCT	115760200000
	OCT	13064257		;17
	OCT	013542400000
	OCT	157013326		;18
	OCT	164731000000
;GENERATE CODE TO MOVE ACCUMULATORS TO A DISPLAY FIELD.

MACD.:	MOVE	TE,DTFLAG(DT)	;FLAGS
	TLNE	TE,DTBWZ	;BLANK WHEN ZERO?
	JRST	MACE.		;YES: USE EDIT

MACD.1:	HLRZ	TA,RESB		;GENERATE 'B' PARAMETER
	LSH	TA,^D12
	ADD	TA,SIZEB
	TSWF	FBSIGN		;SIGNED
	TRO	TA,(<1B6>)	;YES:
	HRLZS	TA
	HRR	TA,BASEB	;EFFECTIVE ADDR
	ADD	TA,INCRB
	PUSH	LIT,TA
	MOVEI	CH,(LIT)	;ADDR OF LIT
	MOVE	TE,SIZEB	;1 OR 2 WORD COMP
	MOVE	TD,EAC
	CAIG	TE,^D10		;?
	ADDI	TD,1
	DPB	TD,CHAC		;PLAC AC FIELD
	PUSH	LIT,CH		;SAVE PARAMETER WORD
	MOVEI	CH,(LIT)	;GET ITS ADDRESS
	HRLI	CH,(MOVE 16,)	;ADD IN MOVE 16,
	PUSH	COD,CH		;SAVE CODE
	HRRZ	TE,MODEB	;GET OUTPUT MODE
	XCT	MACDRU(TE)	;GET PROPER ROUTINE
	HRLI	CH,(PUSHJ PP,)	;CHANGE TO PUSHJ
	PUSH	COD,CH		;STASH CODE
	POPJ	PP,

MACDRU:	;AC'S TO DISPLAY OR COMP-3 ROUTINES
	MOVEI	CH,PD6.
	MOVEI	CH,PD7.
	MOVEI	CH,PD9.
	OUTSTR	[ASCIZ "?CDTINT MACD.1 ERROR
"]
	XCT	.-1
	XCT	.-2
	XCT	.-3
	MOVEI	CH,PC3.		;COMP-3

;GENERATE CODE TO MOVE AC'S TO A 1-WORD COMP OR INDEX.

MAC1C.:	MOVSI	CH,MOVEM%
	TSWT	FBSIGN		;SIGNED?
	MOVSI	CH,MOVMM%	;NO:
	JRST	GENOPD

;GENERATE CODE TO MOVE AC'S TO A 2-WORD COMP.

MAC2C.:	TSWT	FBSIGN		;SIGNED?
	JRST	MAC2C3		;NO: USE MAGNITUDE
MAC2C2:	MOVSI	CH,MOVEM%
	PUSHJ	PP,GENOPE
	MOVSI	CH,MOVEM%
	AOS	INCRB
	JRST	GENOPD

;HERE FOR POSSIBLE UNSIGNED MOVE

MAC2C3:	TSWT	FASIGN		;'A' SIGNED?
	JRST	MAC2C2		;NO - OK TO USE MOVE(S)
	HRRZ	CH,EAC
	MOVE	TE,EAC
	DPB	TE,CHAC
	PUSH	LIT,CH
	MOVEI	CH,(LIT)
	HRLI	CH,(MOVE 16,)
	PUSH	COD,CH
	PUSH	COD,[PUSHJ	PP,MAG.]
	SETZM	EAC
	JRST	MAC2C2

;GENERATE CODE TO MOVE AC'S TO COMP-1

MACFP.:	;CONVERT TO COMP-1
	HRRZ	CH,EAC
	MOVE	TE,EAC
	DPB	TE,CHAC
	PUSH	LIT,CH
	MOVEI	CH,(LIT)	;GET ADDRESS
	HRLI	CH,(MOVE 16,)
	PUSH	COD,CH
	PUSH	COD,[PUSHJ PP,FLOT.2]
	SOS	TE		;RESULT IN C(EAC)
	MOVEM	TE,EAC
	MOVEI	TE,FPMODE
	MOVEM	TE,MODEA
	JRST	MAC1C.

;GENERATE CODE TO MOVE AC'S TO EDITED FIELD.

MACE.:	MOVE	TE,[XWD BASEB,SAVMB]
	BLT	TE,SVMBX	;SAVE 'B' PARAMETERS
	MOVEI	TE,D6MODE	;SET MODE TO SIXBIT
	MOVEM	TE,MODEB
	MOVE	TE,SIZEB	;GET A TEMP LOC
	ADDI	TE,5
	IDIVI	TE,6
	PUSHJ	PP,GETEMP
	MOVEM	TE,INCRB
	MOVE	TE,[XWD ^D36,TEMROL]
	MOVEM	TE,BASEB
	MOVE	TE,[XWD BASEB,SAVMA]
	BLT	TE,SVMAX	;SAVE AS 'A' PARAMETER
	PUSHJ	PP,MACD.1	;MOVE TO DISPLAY FIELD
	MOVE	TE,[XWD SAVMA,BASEA]
	BLT	TE,BASBX	;GET BACK 'A' AND 'B'
	JRST	MDED.		;DO EDIT AND RETURN

;GENERATE CODE TO MOVE A DISPLAY FIELD TO AN EDITED FIELD.

MDED.:	;FIX UP MODEB IF NECESSARY
	MOVE	TE,MODEB
	CAIE	TE,EDMODE
	JRST	MDED.0		;OK
	LDB	TE,DTUSAG	;GET REAL USAGE
	SUBI	TE,1		;NORMALIZE
	CAIN	TE,%US.IN-1	;INDEX??
	MOVEI	TE,D1MODE	;USE COMP
	MOVEM	TE,MODEB	;AND STORE IT
MDED.0:	PUSHJ	PP,BMASK	;GET EDIT MASK
	TSWF	FASIGN		;ANY SIGNS
	TSWT	FBSIGN
	JRST	MDEU.		;NO: USE UNSIGNED ROUTINE

;BOTH FILEDS ARE SIGNED

MDES.:	MOVE	TE,[XWD BASEA,SAVMA]
	BLT	TE,SVMAX	;SAVE 'A'
	MOVE	TE,SIZEA
	SUBI	TE,1
	PUSHJ	PP,M.IA		;FIND SIGN
	HRRZ	TE,MODEA
	HRLZ	TE,BYTE.S(TE)
	MOVNS	TE
	ADDM	TE,RESA		;MESS PARAM
	PUSHJ	PP,MBYTEA	;GET FIRST LITERAL
	PUSH	COD,LIT

	MOVE	TE,[XWD SAVMA,BASEA]
	BLT	TE,BASAX	;GET 'A' BACK
	MOVE	CH,[PUSHJ	PP,EDIT.S##]
	JRST	MDEU.2		;STASH CODE AND EXIT

;GENERATE CODE FOR AN UNSIGNED EDITED FIELD.

MDEU.:	MOVE	CH,[PUSHJ	PP,EDIT.U##]
	MOVEI	TE,1(LIT)	;ADDR OF LIT
	PUSH	COD,TE

MDEU.2:	MOVEI	TE,(MOVEI 16,)
	HRLM	TE,0(COD)
	PUSH	COD,CH		;AND PUSHJ
	PUSHJ	PP,MBYTEA	;GET A BYTE POINTER
	HRRZ	TE,MODEB
	MOVE	TA,BYTE.S(TE)
	LSH	TA,6
	MOVE	TE,DTFLAG(DT)	;GET FLAGS
	TLNE	TE,DTBWZ	;BLANK WHEN ZERO?
	IORI	TA,40		;YES: SET BIT 12
	ROT	TA,-^D12
	HLR	TA,RESB
	ROT	TA,-6		;FORM B.P.
	HRR	TA,BASEB
	ADD	TA,INCRB
	PUSH	LIT,TA		;SASH AWAY
	PUSH	COD,W1		;ALSO XWD LITERAL
	POPJ	PP,		;AND EXIT

;CREATE THE MASK FOR THE "B" FIELD.

BMASK:	HRRZI	W1,1(LIT)	;LOC OF LITERAL
	HRLI	W1,(<^D36B5>)
	MOVE	TC,DTFLAG(DT)	;GET FLAGS
	TLNN	TC,DTEDIT	;EDITED
	JRST	BMASK4		;NO: BWZ THEN

	HRRZ	TC,DT		;FORM BYTEPNTRS
	ADD	TC,[POINT 4,DTBP,11]
	LDB	TD,[POINT 12,DTBP(DT),11]
	DPB	TD,[POINT 12,W1,17]	;SIGN CHARS

	MOVEI	TD,0		;INIT REPEAT COUNT
BMASK1:	MOVEI	TA,0
	MOVE	TB,[POINT 4,TA]
BMASK2:	ILDB	TE,TC
	CAIN	TE,16		;REPEAT??
	JRST	BMSK2B		;YES
BMSK2A:	IDPB	TE,TB		;STORE BYTE
	CAIN	TE,17		;END?
	JRST	BMASK3		;YES:
	TLNN	TB,770000	;WORD FULL?
	JRST	BMSK2C		;YES - SAVE LITERAL
BMSK2D:	SOJLE	TD,BMASK2	;GO TO TOP IF NOTHING TO REPEAT
	JRST	BMSK2A		;USE BYTE AGAIN

BMSK2C:	PUSH	LIT,TA		;YES: STASH
	MOVEI	TA,0		;INIT LITERAL BUFFER
	MOVE	TB,[POINT 4,TA]	;AND POINTER
	JRST	BMSK2D	;AND CONTINUE

	; REPEAT
;	THE CODE IS FOLLOWED BY A COUNT OF THE NUMBER
;	OF 4 BIT BYTES WHICH FOLLOW THE COUNT AND CONTAIN THE
;	NUMBER OF REPEATS IN BINARY.  THE BYTE FOLLOWING THE
;	NUMBER OF REPEATS IS THE CHARACTER TO BE REPEATED.

BMSK2B:
	PUSH	PP,TA		;SAVE A FEW REGS
	PUSH	PP,TB
	ILDB	TD,TC		;GET NUMBER OF BYTES HOLDING FACTOR
	LSH	TD,2		;COMPUTE BITS RIGHT
	MOVE	TE,[POINT 4,TD]	;RESULT POINTER
	DPB	TD,[POINT 6,TE,5]   ;STORE BITS RIGHT
	MOVEI	TD,0		;INITIALIZE REPEAT COUNT
	LDB	TA,TC		;GET BYTE COUNT BACK
BMSK2F:	ILDB	TB,TC		;GET BYTE OF COUNT
	IDPB	TB,TE		;SAVE IN REPEAT REGISTER
	SOJG	TA,BMSK2F	;MOVE??
	POP	PP,TB		;NO - DONE
	POP	PP,TA
	JRST	BMASK2		;GO BACK TO TOP

BMASK3:	PUSH	LIT,TA		;STASH LAST OP
	POPJ	PP,		;AND EXIT

;ITEM IS NOT EDITED SO IT MUST BE "BLANK WHEN ZERO".

BMASK4:	MOVE	TB,SIZEB
BMASK5:	CAIGE	TB,^D9
	JRST	BMASK6
	PUSH	LIT,[0]
	SUBI	TB,^D9
	JUMPG	TB,BMASK5	;LUP UNTIL DONE

BMASK6:	MOVEI	TA,0
	MOVE	TC,[POINT 4,TA]
	JUMPE	TB,BMASK7	;NO RESIDUE
	IBP	TC
	SOJG	TB,.-1

BMASK7:	MOVEI	TE,17
	IDPB	TE,TC
	JRST	BMASK3

;RANDOM BYTE POINTER DIDLERS

;GET A BYTE POINTER TO "A"

BYTE.A:	MOVEI	TE,BASEA

BYTE.X:	HRRZ	TC,MODEX(TE)
	HLRZ	TA,RESX(TE)
	LSH	TA,6
	ADD	TA,BYTE.S(TC)
	ROT	TA,-^D12

BYTE.Y:	HRR	TA,BASEX(TE)
	ADD	TA,INCRX(TE)	;ADDR OR WORD
	POPJ	PP,

;SIMILAR TO BYTE.A, EXCEPT FOR "B"

BYTE.B:	MOVEI	TE,BASEB
	JRST	BYTE.X

;SIMILAR TO BYTE.B, EXCEPT SIZE PUT IN BITS 6-17

BYTE.C:	MOVEI	TE,BASEB
	HLRZ	TA,RESB
	LSH	TA,^D12
	ADD	TA,SIZEB
	HRLZS	TA
	JRST	BYTE.Y

;CREATE BYTE POINTER TO 'A' AND PUT IN LITROL

MBYTEA:	HLRZ	TA,RESA
	ROT	TA,-6
	HRRZ	TC,MODEA
	MOVE	TC,BYTE.S(TC)
	DPB	TC,[POINT 6,TA,11]
	HRR	TA,BASEA
	ADD	TA,INCRA
	PUSH	LIT,TA
	POPJ	PP,

;INCREMENT PARAMETERS OF "A" OPERAND BY THE NUMBER
;OF BYTES WHOSE VALUE IS IN "TE".

M.IA:	MOVE	TC,MODEA
	IDIV	TE,BYTE.W(TC)	;ADJUST INCREMENT
	ADDM	TE,INCRA
	HLRZ	TE,RESA
	IMUL	TD,BYTE.S(TC)
	SUB	TE,TD
	CAML	TE,BYTE.S(TC)
	JRST	M.IA1
	CAIN	TC,D7MODE
	SUBI	TE,1
M.IA1:	JUMPG	TE,M.IA2	;TO BIT 35 OR BEYOND
	AOS	INCRA		;YES:
	ADDI	TE,^D36
M.IA2:	HRLM	TE,RESA		;NEW RESIDUE
	POPJ	PP,

;SOME RANDOM GENERATORS

;GEN <OP AC+1,"A">

GENOPA:	MOVE	TE,EAC
	AOSA	TE

;GEN <OP AC,"A">

GENOPB:	MOVE	TE,EAC
	DPB	TE,CHAC

;GEN <OP "A">

GENOPC:	HRR	CH,BASEA
	ADD	CH,INCRA
	PUSH	COD,CH
	POPJ	PP,

;GEN <OP AC+1,"B">

GENOPD:	MOVE	TE,EAC
	AOSA	TE

;GEN <OP AC,"B">

GENOPE:	MOVE	TE,EAC
	DPB	TE,CHAC

;GEN <OP "B">

GENOPF:	HRR	CH,BASEB
	ADD	CH,INCRB
	PUSH	COD,CH
	POPJ	PP,

;GEN <MOVE 16,LIT
;     PUSHJ 17,"B">
;
; PUSHJ PP,"B" IS IN CH

GENPUA:	MOVE	TE,EAC
	AOSA	TE

GENPUB:	MOVE	TE,EAC
	LSH	TE,22		;MOVE TO AC FIELD
	SKIPA


GENPUC:	SKIPA	TE,BASEA
	HRR	TE,BASEA
	ADD	TE,INCRA
	PUSH	LIT,TE
	MOVSI	TE,(MOVE 16,)
	HRR	TE,LIT
	PUSH	COD,TE
	PUSH	COD,CH		;PUSHJ PP,ROUTINE
	POPJ	PP,
;ERROR ROUTINES

BADBAD:	TTCALL	3,[ASCIZ "? ILLEGAL SUBCRIPT USAGE"]
	JRST	XECUTX
DISERR:	TTCALL	3,[ASCIZ "? DISPLAY INTERNAL ERROR"]
	JRST	XECUTX
SMLSUB:	TTCALL	3,[ASCIZ "? SUBSCRIPT NOT POSITIVE"] ;[24]
	JRST	XECUTX				;[24]
LRGSUB:	TTCALL	3,[ASCIZ "? SUBSCRIPT TOO LARGE"]
	JRST	XECUTX
NEDSUB:	TTCALL	3,[ASCIZ "? ITEM MUST BE SUBSCRIPTED"]
	JRST	XECUTX
NOSUB:	TTCALL	3,[ASCIZ "? NO SUBSCRIPTS ALLOWED"]
	JRST	XECUTX
NOTNUF:	TTCALL	3,[ASCIZ "? NOT ENOUGH SUBSCRIPTS"]
	JRST	XECUTX
TOOFEW:	TTCALL	3,[ASCIZ "? TOO MANY SUBSCRIPTS"]
	JRST	XECUTX
UNDEF:	TTCALL	3,[ASCIZ "? SYMBOL NOT DEFINED"]
	JRST	XECUTX
HIPART:	TTCALL	3,[ASCIZ '? NOT ALLOWED FOR HI-SEGMENT PROCEDURES']
	JRST	XECUTX

;ROUTINE TO GET SOME TEMP STORAGE

GETEMP:	ADD	TE,TEMPC	;GET NEW TOP
	CAIL	TE,N.TMP	;OVER?
	JRST	NOTEMP
	EXCH	TE,TEMPC	;RETURN BASE
	POPJ	PP,

NOTEMP:	TTCALL	3,[ASCIZ "? ITEM TOO LARGE FOR TEMP"]
	JRST	XECUTX
NOLAST:	TTCALL	3,[ASCIZ "? NO PREVIOUS DATA-NAME"]
	JRST	XECUTX

;COME HERE ON SECOND DISPATCH FOR WHERE COMMAND.
;PRINT SUMMARY OF BREAK POINTS

WHERE:	TTCALL	3,CRLF
	SKIPE	TA,	EBRKOV		;IF WE'RE STOPED AT AN ENTRY,
					; TYPE A SPECIAL MSG.
	JRST	[OUTSTR	[ASCIZ	"PROGRAM STOPPED UPON ENTRY TO MODULE "]
		PUSHJ	PP,	PRTMNM
		JRST	WHERE1]
	SKIPE	REEFLG		;[26]SPECIAL BREAK?
	JRST	WHERE1		;[26]YES, DON'T TRY TO REPEAT MESSAGE.
	SKIPN	CUR.BP		;[26]ARE WE AT NORMAL BREAK?
	JRST	WHERE1		;[26]SKIP BREAK MESSAGE
	TTCALL	3,[ASCIZ "PROGRAM STOPPED AT "]
	MOVEI	TD,	CBPADS		;PICK UP ADDRESS OF THE CURRENT
					; BREAK POINT'S PROTAB POINTERS.
	PUSHJ	PP,PRTBP	;PRINT BREAK MESSAGE
WHERE1:	OUTSTR	[ASCIZ	/
BREAKPOINTS:
/]
	MOVEI	TE,0		;INIT COUNTER OF FREE BPS
	MOVEI	TD,B1ADR	;INIT LOOP
WHERE2:	SKIPN	0(TD)		;IN USE?
	AOJA	TE,WHERE3	;NO: INCREMENT CNTR
	PUSHJ	PP,PRTBP	;YES: PRINT IT
	TTCALL	3,CRLF
WHERE3:	ADDI	TD,LBA
	CAIG	TD,BNADR	;DONE?
	JRST	WHERE2
	CAIL	TE,NBP		;WAS THERE ANY?
	TTCALL	3,[ASCIZ "**NONE**
"]
	PUSHJ	PP,PRNUM	;PRINT # OF FREE
	TTCALL	3,[ASCIZ " UNUSED BREAK POINTS"]
	JRST	XECUTX

CRLF:	BYTE (7)15,12

;PRINT BREAK POINT INFOR POINTED AT BY 'TD'

PRTBP:	PUSH	PP,	TE
	TTCALL	3,[BYTE (7)74,74]
	HLRZ	TE,	1(TD)
	HRRZ	TE,	1(TE)
	HRRZ	TA,0(TD)
	LDB	DT,[POINT 15,0(TA),17]
	ADD	DT,%%NM.(TE)
	PUSHJ	PP,PRNAM
	HRRZ	TA,1(TD)	;CHECK ON SECTION NAME
	JUMPN	TA,PRTBP1	;[26]NO SECTION NAME ADDRESS MEANS
				;THE NAME ITSELF IS A SECTION NAME
	OUTSTR	[ASCIZ " SECTION"] ;[26]
	JRST	PRTBP2		;[26]
PRTBP1:	LDB	DT,[POINT 15,0(TA),17] ;[26]GET NAMTAB POINTER
	ADD	DT,%%NM.(TE)
	MOVE	TA,1(DT)
	CAME	TA,[SIXBIT /:GENER/] ;DON'T PRINT IF IT ISN'T USER NAME
	PUSHJ	PP,[TTCALL 3,[ASCIZ " IN "]
		    JRST PRNAM]
PRTBP2:	HLRZ	TA,	1(TD)	;[26]
	SKIPE		SUBSPR	;SKIP IF NO MODULES BESIDES THE MAIN ONE
	PUSHJ	PP,	[OUTSTR	[ASCIZ	" IN MODULE "]
			JRST	PRTMNM]
	TTCALL	3,[BYTE (7)76,76]
	POP	PP,	TE
	POPJ	PP,

;YE OLDE RECURSIVE NUMBER PRINTER C(TE)

PRNUM:	IDIVI	TE,^D10
	HRLM	TD,0(PP)
	JUMPE	TE,PRNUM1
	PUSHJ	PP,PRNUM
PRNUM1:	HLRZ	TC,0(PP)
	ADDI	TC,"0"
	TTCALL	1,TC
	POPJ	PP,

;BREAK POINT LOGIC

;COME HERE TO EXECUTE A "BREAK" COMMAND.  NOTE THAT EXECUTING A
;BREAK COMMAND JUST MEANS SETTING UP THE PARAMETERS FOR THE BREAKPOINT.
;THE ACTUAL 'INSTALLATION' OF THE BREAK CODE (JSR) IS DONE LATER.
;AND THE 'BREAK' ITSELF OCCURS ONLY WHEN CONTROL PASSES THRU THE
;NAMED PROCEDURE NAME WHERE THE JSR HAS BEEN 'INSTALLED'.

;LOOK FOR FREE SLOT IN THE TABLE THAT CONTAINS THE 20 BREAKPOINT PARAMETERS.
SETBRK:	MOVEI	TE,B1ADR	;GET BASE ADDRESS
STBRK0:	HRRZ	TD,0(TE)
	CAIE	TD,0(DT)	;CHECK IF WE HAVE THIS BREAK ALREADY
	SKIPN	0(TE)		;NO, IS THIS SLOT EMPTY?
	JRST	STBRK1		;USE THIS ONE
	ADDI	TE,LBA		;NEXT ENTRY
	CAIG	TE,BNADR	;LAST?
	JRST	STBRK0

	TTCALL	3,[ASCIZ "? OUT OF BREAK-POINTS"]
	JRST	XECUTX

;GET ADDRESS OF PROTAB ENTRY FOR FATHER (SECTION)
STBRK1:	HRRZ	TA,PRFLGS(DT)	;[26]IS THIS NAME A SECTION NAME?
	ANDI	TA,PRLINK	;[26]
	JUMPE	TA,STBRK2	;[26]
	LDB	TA,[POINT 15,1(DT),17] ;[26]NO, GET FATHER'S ADDRESS
	ADD	TA,@%PR
STBRK2:	HRRZ	TD,1(DT)	;[26]GET ADDRESS OF THE BREAK

;PROHIBIT THE BREAK IF THE ADDRESS IS IN THE HIGH SEGMENT.
IFE TOPS20,<
	CAMLE	TD,.JBREL
	JRST	HIPART
>
	MOVEM	DT,0(TE)	;PROTAB ADDR OF PAR NAME.
	MOVEM	TA,1(TE)	;PROTAB ADDR OF SECT NAME.
	MOVE	TA,CUREPA	;SAVE THE CURRENT ENTRY POINT'S
	HRLM	TA,1(TE)	; ADDRESS TOO.
	SETZM	2(TE)		;CLR PROCEED COUNTER
	JRST	XECUTX
;COME HERE TO EXECUTE A CLEAR COMMAND.  NOTE THAT EXECUTING A CLEAR
;COMMAND MEANS ZEROING THE BREAK PARAMETERS.  THE ACTUAL 'REMOVAL'
;OF THE BREAK CODE (JSR) HAS ALREADY BEEN DONE.  THOSE THAT ARE STILL
;'SET' WHEN A 'PROCEED' OR 'GO' IS EXECUTED ARE AUTOMATICALLY REINSTALLED.

;CLEAR ALL BREAK PARAMETERS IF NO PROC NAME WAS GIVEN ON THE COMMAND.
CLRBRK:	JUMPN	DT,CLBRK0
	MOVE	TE,[XWD B1ADR,B1ADR+1]	;CLEAR ALL
	SETZM	B1ADR
	BLT	TE,BNADR+LBA-1
	JRST	XECUTX

;CLEAR ONLY THE ONE THAT WAS NAMED IN COMMAND.
CLBRK0:	MOVEI	TE,B1ADR	;GET TABLE BASE
CLBRK1:	HRRZ	TD,0(TE)
	CAIN	TD,0(DT)
	JRST	CLBRK2		;FOUND
	ADDI	TE,LBA		;NEXT ENTRY
	CAIG	TE,BNADR	;LAST ENTRY?
	JRST	CLBRK1		;LOOP UNTIL NO MORE
	JRST	XECUTX		;JUST QUIT

CLBRK2:	SETZM	0(TE)		;CLEAR 3 PARAMETER WORDS
	SETZM	1(TE)
	SETZM	2(TE)
	JRST	XECUTX

;COME HERE TO EXECUTE A STOP RUN COMMAND.
;JUST USE THE LIBOL CODE.  THE LIBOL CODE WILL REENTER COBDDT
;IF THERE IS A HISTORY THAT NEEDS TO BE TERMINATED.  IT HAS TO BE
;PREPARED TO DO THAT IF THE USER DID THE STOP RUN FROM HIS CODE
;INSTEAD OF FROM THE TERMINAL.

STOPR:	PUSHJ	PP,STOPR.##

;COMMON ROUTINE TO HANDLE BREAK
;ENTERED BY THE JSA TA,BCOM THAT IS IN THE BP TABLE.
;THE JSA GOT CONTROL FROM A JSR THAT WAS INSTALLED IN THE GENERATED CODE.
;AC'S ARE ALL IN USER PROGRAM STATE.  ONLY TA CAN BE USED.
;THIS COMMON CODE SETS UP INDIRECT POINTERS TO BE USED BY
;THE REST OF THE BREAK HANDLER CODE,  SO THE REST OF THE BREAK HANDLER
;CODE GOES INDIRECT TO THE PARAMETERS FOR THIS BREAK.

BCOM:	Z			;JSA TA,BCOM
	SETZM	EBRKOV		;[26]IN CASE AN OVERLAY
				;[26]MODULE HAD NO SYMBOLS
	POP	TA,LEAV		;GET EXIT INSTRUCTION
	MOVEI	TA,B1SEC-B1INS+1(TA) ;GET ADDRESS OF SECTION'S
				;PROTAB ENTRY
	HRRZM	TA,BCOM3
	MOVEI	TA,B1CNT-B1SEC(TA) ;GET ADDRESS OF PROCEED COUNT
	HRRZM	TA,BCOM2
	MOVE	TA,BP1-B1CNT(TA) ;GET RETURN ADDRESS
	HLLM	TA,LEAV1	;SAVE FLAGS
	EXCH	TA,BCOM
	SOSG	@BCOM2		;TEST PROCEED COUNTER
	JRST	BREAK		;BREAK - ALL AC'S IN PLACE

;NOT TIME TO BREAK YET, RETURN TO USER'S CODE.

	MOVEM	TA,SAV.TA	;STASH 'TA'
	LDB	TA,[POINT 9,LEAV,8] ;GET SWAPPED INSTRUCTION'S OPCODE
				;TO SEE OF WE CAN JUST EXECUTE IT,
				;OR WHETHER IT MUST BE INTERPRETED.
	CAIL	TA,(<JSR>/1000)
	CAILE	TA,(<JSA>/1000)	;JSA,JSP
	TRNN	TA,700		;UUO?
	JRST	PRCED1		;YES: USE PROCEED CODE
	CAIE	TA,(<PUSHJ>/1000)
	CAIN	TA,(<XCT>/1000)	;PUSHJ,XCT?
	JRST	PRCED1		;MUST ALSO BE INTERPRETED
	MOVE	TA,SAV.TA	;OK TO JUST EXIT
	JRSTF	@LEAV1		;EXIT
;HERE TO BREAK - SAVE WORLD AND SET UP PDL

BREAK:	JSR	SAVE		;...
	SKIPE		HFGTHR		;IF WE'RE DOING A HISTOGRAM, GO
	PUSHJ	PP,	HABP		; ACCUMULATE STATISTICS.
	PUSHJ	PP,REMOVB	;REMOVE BREAK-POINTS
	TTCALL	3,[ASCII "BREAK AT  "
		   BYTE (7)74,74]
	MOVE	TA,BCOM2
	SUBI	TA,2		;GET ADDR OF BP
	MOVEM	TA,CUR.BP	;SAVE IT
	MOVE	DT,1(TA)	;POINTER TO SECTION NAME.
	MOVEM	DT,CBPADS+1
	HRRZ	TA,0(TA)	;PNTR TO PROTAB
	MOVEM	TA,CBPADS	;SAVE IT IN CASE HE CLEARS
				; THE BREAK POINT.
	LDB	DT,[POINT 15,0(TA),17]
	HRRZ	TA,1(TA)	;ADDR IN USER'S PROGRAM
	HRRM	TA,PRCED0
	ADD	DT,@%NM		;NAMTAB ENTRY
	PUSHJ	PP,PRNAM	;PRINT BP NAME
	HRRZ	TA,@BCOM3	;GET SECTION NAME
	JUMPN	TA,BREAK1	;[26]NO SECTION NAME?
	OUTSTR	[ASCIZ / SECTION/] ;[26]MUST BE A SECTION NAME
	JRST	BREAK2		;[26]
BREAK1:	LDB	DT,[POINT 15,0(TA),17] ;[26]GET NAMTAB ENTRY FOR SECTION NAME
	ADD	DT,@%NM
	MOVE	TA,1(DT)	;GET FIRST WORD OF NAME
	CAME	TA,[SIXBIT /:GENER/] ;SKIP IF IT'S COMPILER GENERATED
	PUSHJ	PP,[TTCALL 3,[ASCIZ " IN "]
		    JRST PRNAM]
BREAK2:	HLRZ	TA,@BCOM3	;GET ENTRY POINT
	SKIPE	SUBSPR		;ARE THERE OTHER MODULES?
	PUSHJ	PP,	[OUTSTR	[ASCIZ	" IN MODULE "]
			JRST	PRTMNM]
	TTCALL	3,[BYTE (7)76,76]
;	SET UP FOR BREAKING- SO THAT LIBOL PARAMS HAVE MODULE PROG
; FIRST MOVE LIBOL TO RUN TIME PARAMS
	MOVE	TA,@%NM		; [13] ADDR OF %NM
	MOVEM	TA,PNM		; [13] STORE INTO PROCEED 
	MOVE	TA,@%DT		; [13] ADDR OF %DT
	MOVEM	TA,PDT		; [13] STORE INTO PROCEED 
	MOVE	TA,@%PR		; [13] ADDR OF %PR
	MOVEM	TA,PPR		; [13] STORE INTO PROCEED 
; NOW PUT BREAK PARAMS INTO LIBOL
	MOVE	TA,BNM		; [13] GET BREAK NM
	MOVEM	TA,@%NM		; [13] STORE INTO LIBOL NM
	MOVE	TA,BDT		; [13] GET BREAK DT
	MOVEM	TA,@%DT		; [13] STORE INTO LIBOL DT
	MOVE	TA,BPR		; [13] GET BREAK PR
	MOVEM	TA,@%PR		; [13] STORE INTO LIBOL PR
	JRST	XECUTX		;INTO MAIN LOOP

;COME HERE TO EXECUTE A 'STEP' COMMAND.

STEP:	MOVEM	W2,STPCTR	;[26]SAVE COUNTER, USE 'PROCEED' CODE.


;COME HERE TO EXECUTE A PROCEED COMMAND.

PROCED:	SKIPE		HFGTHR		;IF WE WERE DOING A HISTOGRAM
	JRST		HISSTE		; GO DO A BEGIN SO THAT WE DON'T
					; ADD THE TIME WE SPENT IN COBDDT
					; TO THE CURRENT PARAGRAPH.
PRCEDD:	SKIPE	DIED.		;ARE WE ALIVE?
	JRST	[TTCALL 3,[ASCIZ "?CANNOT PROCEED!"]
		 JRST XECUTX]	;NO
;IF THIS IS ONLY A SIMULATED BREAKPOINT (STEP OR ^C/REENTER),
;REEFLG WILL BE ON, MEANING WE ENTERED COBDDT WITH A PUSHJ AND CAN
;RETURN WITH A POPJ.
	SKIPE	REEFLG		; [21] TIME TO REENTER?
	JRST	REERTN		; [21] YES
; SET UP TO PROCEED-SO THAT LIBOL HAS RUN-TIME PARAMS
; FIRST MOVE LIBOL INTO BREAK
	MOVE	TC,@%NM		; [13] ADDR OF %NM
	MOVEM	TC,BNM		; [13] STORE INTO BREAK 
	MOVE	TC,@%DT		; [13] ADDR OF %DT
	MOVEM	TC,BDT		; [13] STORE INTO BREAK 
	MOVE	TC,@%PR		; [13] ADDR OF %PR
	MOVEM	TC,BPR		; [13] STORE INTO BREAK 
; NOW PUT PROCEED PARAMS INTO LIBOL
	MOVE	TC,PNM		; [13] GET PROCEED NM
	MOVEM	TC,@%NM		; [13] STORE INTO LIBOL NM
	MOVE	TC,PDT		; [13] GET PROCEED DT
	MOVEM	TC,@%DT		; [13] STORE INTO LIBOL DT
	MOVE	TC,PPR		; [13] GET PROCEED PR
	MOVEM	TC,@%PR		; [13] STORE INTO LIBOL PR
	SKIPE		EBRKOV		;ENTRY POINT BREAK?
	JRST		PROV		;YES, GO CONTINUE WITHOUT
					; RESTORING EVERYTHING.
	SKIPN	TA,CUR.BP	;CURRENT?
	JRST	START		;NO: START USERS PROG
	SKIPN	DT		;NUMBER GIVEN
	MOVEI	DT,1		;NO: ASSUME ONE
	MOVEM	DT,2(TA)	;SAVE COUNT
PRCED0:	HRRZI	TB,0		;ADDR MODIFIED !!!
	PUSHJ	PP,FETCH	;GET INSTRUCTION
	MOVEM	TA,LEAV
	PUSHJ	PP,INSRTB	;INSERT BREAK-POINTS
	JRST	PRCED2

;COME HERE FROM BREAK WHICH DID NOT ACTUALLY BREAK BECAUSE
;ITS PROCEED COUNT HAS NOT GONE TO 0 YET.
PRCED1:	MOVE	TA,SAV.TA	;GET SAVED AC
	JSR	SAVE		;SAVE WORLD

PRCED2:	MOVEI	TC,100		;SET MAX LOOP COUNT
	MOVEM	TC,TEMP1
	JRST	IXCT5

IXCT4:	CAIL	TA,40		;SYSTEM UUO?
	JRST	IXCT6		;YES: DON'T INTERPRET
	MOVEM	TB,40		;SAVE UUO
	MOVEI	TB,41

IXCT:	SOSG	TEMP1		;LOOPING
	JRST	BPLUP
	PUSHJ	PP,FETCH
	MOVEM	TA,LEAV		;STASH INSTR

IXCT5:	HRLZI	17,AC0		;TEMP FETCH OF ACS
	BLT	17,17
	MOVEI	TA,@LEAV	;GET EFFECTIVE ADDRS
	DPB	TA,[POINT 23,LEAV,35]
	LDB	TC,[POINT 4,LEAV,12]
	LDB	TA,[POINT 9,LEAV,8]
	CAIN	TA,(<PUSHJ>/1000)
	JRST	IPUSHJ		;INTERPRET PUSHJ
	CAIN	TA,(<JSR>/1000)
	JRST	IJSR		;INTERPRET JSR
	CAIN	TA,(<JSP>/1000)
	JRST	IJSP		;INTERPRET JSP
	CAIN	TA,(<JSA>/1000)
	JRST	IJSA		;INTERPRET JSA
	MOVE	TB,LEAV
	TRNN	TA,700
	JRST	IXCT4		;INTERPRET UUO
	CAIN	TA,(<XCT>/1000)
	JRST	IXCT		;INTERPRET XCT
IXCT6:	MOVEI	TA,LEAV
IXCT7:	SETOM	TEMP2
IXCT8:	JRST	RESTOR

;VARIOUS INTERPRETERS

IPUSHJ:	DPB	TC,[POINT 4,CPUSHP,12]
	SETZM	TEMP2		;STORE AC FIELD INTO A PUSH
	MOVE	TA,LEAV
	JRST	IXCT8

IJSA:	MOVE	TA,BCOM
	HRL	TA,LEAV
	EXCH	TA,AC0(TC)
	JRST	IJSR2

IJSR:	MOVE	TA,BCOM
	HLL	TA,FLGS.
IJSR2:	MOVE	TB,LEAV
	PUSHJ	PP,DEP
	AOSA	TA,LEAV
ISR3:	MOVE	TA,LEAV
	JRST	IXCT7

IJSP:	MOVE	TD,BCOM
	HLL	TD,FLGS.
	MOVEM	TD,AC0(TC)
	JRST	ISR3

;COME HERE IF BREAK POINT LOOPING

BPLUP:	PUSHJ	PP,REMOVB
	JSR	SAVE
	TTCALL	3,[ASCIZ "? FATAL BREAK-POINT ERROR!"]
	JRST	XECUTX

;SAVE AND RESTORE WORLD CODE

SAVE:	Z			;JSR ENTRY
	MOVEM	17,PDL.		;CURRENT PDL
	MOVEM	17,AC0+17
	HRRZI	17,AC0
	BLT	17,AC0+16	;SAVE AC'S
	MOVE	TA,SAVE		;SAVE PROCESSOR FLAGS
	HLLM	TA,FLGS.
	MOVE	PP,PDL.	;RESTORE STACK POINTER
	JRST	@SAVE

;PROCEED CODE FOR PROCEEDING FROM ^C/REENTER OR STEP COMMAND.
REERTN:	PUSHJ	PP,INSRTB	; [26] INSERT ANY BREAKPOINTS
	MOVE	TA,REEFLG	; [21] GET ORIGINAL PDL
	SETZM	REEFLG		; [21] CLEAR
	MOVE	TB,0(TA)	; [21] GET DATA + FLAGS
	CAME	TA,AC0+PP	; [21] SAME ?
	HALT	.		; [21] NO
	POP	TA,0(TA)	; [21] CORRECT FOR JUMP
	MOVEM	TA,AC0+PP	; [21]
	HLLZM	TB,FLGS.	; [21] SET FLAGS AND FALL THROUGH
	MOVEI	TA,0(TB)	; [21]
	SETOM	TEMP2		; [21] NO PUSH 0 NECESSARY

RESTOR:	HRRM	TA,SAVE		;SAVE EXIT ADDR
	MOVE	TA,FLGS.
	HLLM	TA,SAVE
	HRLZI	17,AC0
	BLT	17,17		;RESTORE AC'S
	SKIPL	TEMP2
CPUSHP:	PUSH	0,BCOM		;AC MODIFIED AT IPUSHJ
	JRSTF	@SAVE		;EXIT

;COME HERE TO START USER'S PROGRAM

START:	PUSHJ	PP,INSRTB	;INSERT BREAK-POINTS
	MOVE	PP,PDL.
	JRST	@PROGST

;CODE TO FETCH THE USER'S INSTRUCTION AT POINT OF BREAK.
FETCH:	TRNN	TB,-20		;IS IT IN AN AC?
	SKIPA	TA,AC0(TB)	;YES: FETCH FROM SAVED AC'S
	MOVE	TA,0(TB)	;NO
	POPJ	PP,

;CODE TO DEPOSIT AN INSTRUCTION AT THE POINT OF BREAK.
DEP:	TRNN	TB,-20		;IS IT IN AN AC?
	JRST	DEP1		;YES
	MOVEM	TA,0(TB)	;NO
	POPJ	PP,
DEP1:	MOVEM	TA,AC0(TB)	;STORE INTO THE SAVED AC
	POPJ	PP,

;CODE TO REMOVE OR INSERT BREAKPOINTS

INSRTB:	MOVE	TE,[JSR BP1]
	MOVEI	TD,B1ADR
INSRT1:	SKIPE	TB,	(TD)		;IF THE BP ISN'T ACTIVE OR IS
	PUSHJ	PP,	CHKBP		; IN A NON RESIDENT SEGMENT,
	JRST		INSRT2		; DON'T INSERT IT.
	HRRZ	TB,1(TB)	;YES: GET ADDR OF BP
	PUSHJ	PP,FETCH	;GET USER'S INSTRUCTION
	CAME	TA,TE		;[26]DON'T STORE IT IF A BREAK
				;IS ALREADY THERE (^C/REENTER PROBLEM)
	MOVEM	TA,2(TE)	;SAVE IT
	MOVE	TA,TE
	PUSHJ	PP,DEP		;DEPOSIT "JSR"
INSRT2:	ADDI	TE,LBP
	ADDI	TD,LBA
	CAIG	TD,BNADR	;DONE??
	JRST	INSRT1
	SETZM	CUR.BP		;[26]FORGET CURRENT BREAK
	POPJ	PP,		;YES:

REMOVB:	MOVEI	TE,BP1
	MOVEI	TD,B1ADR
REMOV1:	SKIPE	TB,(TD)		;IF THE BP ISN'T ACTIVE OR IS
	PUSHJ	PP,CHKBP	; IN A NON RESIDENT SEGMENT,
	JRST	REMOV2		; DON'T REMOVE IT.
	HRRZ	TB,1(TB)	;GET ADDR OF USER'S INSTRUCTION
	MOVE	TA,2(TE)	;GET USER'S INSTRUCTION
	PUSHJ	PP,DEP		;PUT IT BACK
REMOV2:	ADDI	TE,LBP
	ADDI	TD,LBA
	CAIG	TD,BNADR
	JRST	REMOV1
	POPJ	PP,
;COME HERE FROM LIBOL'S SEGMENT HANDLER TO PUT ANY BREAKPOINTS IN THE
; SEGMENT WHICH IT HAS JUST READ IN.

SBPSG.:	MOVE	TE,	[JSR	BP1]
	MOVEI	TD,	B1ADR
SBPSGD:	SKIPE	TB,	(TD)		;IF THERE ISN'T A BP SET OR
	PUSHJ	PP,	CHKBP		; IT ISN'T IN THIS SEGMENT OR
	JRST		SBPSGH		; IT'S IN THE RESIDENT SEGMENT,
	JUMPE	TC,	SBPSGH		; DON'T MESS WITH IT.
	HRRZ	TB,	1(TB)		;GET THE ADDRESS AT WHICH TO SET IT.
	PUSHJ	PP,	FETCH		;GO GET THE INSTR WHICH IS THERE.
	MOVEM	TA,	2(TE)		;SAVE IT AND REPLACE IT
	MOVE	TA,	TE		; WITH A JSR TO THE APPROPRIATE
	PUSHJ	PP,	DEP		; BREAK POINT.
SBPSGH:	ADDI	TE,	LBP		;BUMP UP TO THE NEXT BREAK
	ADDI	TD,	LBA		; POINT.
	CAIG	TD,	BNADR		;IF THERE ARE MORE,
	JRST		SBPSGD		; LOOP.
	POPJ	PP,			;OTHERWISE RETURN.


;CHECK TO SEE IF A BREAKPOINT IS IN A NON-RESIDENT SEGMENT WHICH IS
; NOT CURRENTLY IN CORE.  IF IT IS RESIDENT OR IS CURRENTLY IN CORE
; TAKE THE SKIP RETURN.  ENTER WITH (TB) = BREAKPOINT'S ADDRESS.
; LEAVE WITH (TC) = THE SEGMENT PRIORITY FOR THIS PARAGRAPH/SECTION.

CHKBP:	LDB	TC,	[POINT	7,2(TB),24]	;GET THE PRIORITY.
	TRNE	TC,	-1		;IF IT'S RESIDENT OR IT'S
	CAMN	TC,	SEGNO.##	; PRIORITY IS THE SAME AS THE
	AOS		(PP)		; CURRENT SEGMENT'S, TAKE
	POPJ	PP,			; THE SKIP RETURN.
;PRINT NAME FOUND POINTED AT IN DT

PRNAM:	HLRZ	TA,0(DT)	;GET # OF WORDS
	HRRZI	TB,1(DT)	;GET ADDR OF FIRST
	HRLI	TB,(<POINT 6,,>);MAKE BP
PRNAM1:	ILDB	TC,TB
	JUMPE	TC,PRNAM2	;DONE IF ZERO
	ADDI	TC,40		;CONVER TO ASCII
	CAIN	TC,":"
	MOVEI	TC,"-"
	TTCALL	1,TC
	TLNE	TB,770000	;WORD FINISHED
	JRST	PRNAM1		;NO: LOOP
	SOJG	TA,PRNAM1	;YES: CHECK IF THAT'S ALL
PRNAM2:	POPJ	PP,		;ALL DONE - EXIT


;PRINT THE MODULE'S NAME.  ENTRY POINT ADDR IS IN TA.

PRTMNM:	MOVE	TA,	-1(TA)
	JRST		SIXSIX

;PRINT THE OCTAL NUMBER IN TA.

PROCT:	PUSHJ	PP,	PROCTD
	OUTCHR	[","]
PROCTD:	SETOI	TB,
PROCTH:	HRRI	TB,	6
	LSHC	TB,	3
	OUTCHR	TB
	JUMPL	TB,	PROCTH
	POPJ	PP,
;COME HERE TO EXECUTE A TRACE COMMAND.  THIS CONSISTS IN SETTING
;A SWITCH WHICH CAUSES TRACING TO BE ON OR OFF.  THE ACTUAL 'TRACING'
;IS DONE BY THE FOLLOWING ROUTINE, WHICH IS ENTERED EACH TIME A
;'TRACEPOINT' IS ENCOUNTERED IN FLOW OF CONTROL IN THE USER PROGRAM.

SETTRC:	MOVEM	W2,PTFLG.	;SAVE ON/OFF VALUE
	JRST	XECUTX		;AND RETURN TO COMMAND LEVEL

;ENTER COBDDT HERE FROM ALL TRACEABLE POINTS IN THE USER PROGRAM.
;	PUSHJ	PP,C.TRCE
;	XWD			;ARGUMENT WORD
;THE ARGUMENT WORD CONTAINS:
;BITS 0-8	FLAGS
;	BIT 4	EXIT PROGRAM
;	BIT 5	GOBACK
;	BIT 7	PROGRAM ENTRY
;	BIT 8	ALTERNATE ENTRY
;BITS 9-17	ARGUMENT WORD COUNT (1 OR 2)
;BITS 18-35	POINTER TO PROTAB ENTRY FOR THIS PROCEDURE NAME.
;
;NAMES PRINTED BY THE TRACE ARE PRECEDED BY A STRING OF *'S AND !'S.
;A * INDICATES A PERFORM THAT IS ACTIVE, AND A ! INDICATES A CALL.
;TRACE KEEPS TRACK OF UP TO 35 OF THESE CHARACTERS.

;IS THIS THE FIRST TRACE CALL FOLLOWING A REENTER FROM MONITOR LEVEL?
C.TRCE:	SKIPE	REEBRK		;[26]REENTER BREAK?
	JRST	[OUTSTR	[ASCIZ /
PROGRAM INTERRUPTED AT /]
		SETZM	STPCTR
		JRST	.+1]		;[26]YES
	HRRZ	TA,(PP)		;[26]GET ARG PTR
	HRRZ	TB,(TA)		;GET PROTAB LINK IF ANY
	HLRZ	TA,(TA)		;GET ARG COUNT AND FLAGS
	LDB	TE,[POINT 9,TA,35]	;GET ARG COUNT
	TRNE	TA,10000	;GOBACK?
	JRST	TRACE0		;YES
	TRNE	TA,20000	;EXIT PROGRAM?
	JRST	TRACE1		;YES
	TRNE	TA,3000		;PROGRAM-ENTRY OR OTHER ENTRY?
	JRST	TRACE2		;YES
	SKIPE		HFGTHR		;IF WE'RE DOING A HISTOGRAM GO
	PUSHJ	PP,	HAPS		; ACCUMULATE STATISTICS.
; SAVE THIS PROTAB ADDRESS AS NAME TO BE PRINTED IF PROGRAM GETS
; AN ABORT ERROR.
	ADD	TB,@%PR		;MAKE REAL ADDR
	MOVEM	TB,L.PARA	;[26]ASSUME PARAGRAPH
	MOVE	TC,PRFLGS(TB)	;[26]GET PAR/SECT FLAG
	TRNN	TC,PRLINK	;[26]IS IT PARA?
	JRST	[MOVEM	TB,L.SECT
		SETZM	L.PARA
		JRST	.+1]	;[26]NO, NEW SECTION
	PUSHJ	PP,STPCHK	;[26]ARE WE STEPPING?
	SKIPE	REEBRK		;[26]TIME TO BREAK?
	JRST	CTRCE3		;[26]YES
	SKIPN	PTFLG.		;ARE WE PRINTING?
	JRST	CNPOPJ		;NO: JUST EXIT

; WE ARE TRACING SO WE MUST PRINT

CTRCE3:	PUSHJ	PP,	PTDPTH	;PRINT STRING OF !/*
	OUTSTR	[ASCIZ /<</]
	SKIPN	TB,L.PARA	;[26]IS THERE A CURRENT PARAGRAPH?
	JRST	[SKIPN	TB,L.SECT
		JRST	[OUTSTR	[ASCIZ /(NO NAME)/]
			JRST	CTRCE6]
		PUSHJ	PP,PRTPNM
		OUTSTR	[ASCIZ / SECTION/]
		JRST	CTRCE6]	;[26]NO, PRINT SECTION NAME ONLY.
	PUSHJ	PP,PRTPNM	;[26]YES, PRINT PARA NAME
	SKIPN	TB,L.SECT	;[26]SECT NAME TOO?
	JRST	CTRCE6		;[26]NO
	OUTSTR	[ASCIZ / IN /]	;[26]YES
	PUSHJ	PP,PRTPNM	;[26]PRINT SECT NAME
CTRCE6:CTRCE6:	OUTSTR	[ASCIZ />>
/]
	SKIPN	REEBRK		; [21] FROM A REENTER OR STEP?
	JRST	CNPOPJ		;NO, RETURN...
				; [21] YES, SETUP A BREAK
DEB:	MOVEM	PP,REEFLG	; [21] SET FLAGS FOR OTHERS
				;     AND SAVE STACK POINTER.
	HRRZ	TA,0(PP)	; [21] FIND RETURN ADDRESS BY
	ADD	TA,TE		; [21] ADDING ARGUMENT COUNT
	HRRM	TA,0(PP)	; [21]
	JSR	SAVE		; [21] GO SAVE THE STATE OF ALL
	SETZM	REEBRK		; [21] NEVER DO THIS TWICE
;;;	SETZM	PTFLG.		; [26] OR THIS NUMBER OF TIMES
	JRST	XECUTX		; [21]

;CHECKS WHETHER STEPPING IS BEING DONE AND PRINTS IF SO.

STPCHK:	SOSE	STPCTR		;[26]ARE WE STEPPING?
	POPJ	PP,		;[26]NO
	SETOM	REEBRK		;[26]YES. SET TO BREAK.
	OUTSTR	[ASCIZ /STEP AT /]  ;[26]
	POPJ	PP,		;[26]

;COMMON ENTRANCE TO PRNAM
PRTPNM:	LDB	DT,[POINT 15,0(TB),17]	;[26]GET NAMTAB ADDR
	ADD	DT,@%NM
	JRST	PRNAM

;TRACE A 'GOBACK' OR 'EXIT PROGRAM'

TRACE0:	PUSHJ	PP,	TRAC1D
	ASCIZ	/<<GOBACK>>
/

TRACE1:	PUSHJ	PP,	TRAC1D
	ASCIZ	/<<EXIT PROGRAM>>
/

TRAC1D:	SKIPE	HFGTHR		;IF WE'RE DOING A HISTOGRAM GO
	PUSHJ	PP,HAGBS	; ACCUMULATE STATISTICS.
	PUSHJ	PP,STPCHK	;[26]SEE IF WE ARE STEPPING
	SKIPE	REEBRK		;[26]SHOULD WE PRINT THE MESSAGE?
	JRST	TRAC1F		;[26]YES
	SKIPN	PTFLG.		;ARE WE TRACING?
	JRST	TRAC1H		;NO
TRAC1F:	PUSHJ	PP,PTDPTH	;PRINT STRING OF */!
	OUTSTR	@(PP)		;PRINT MESSAGE

TRAC1H:	AOS	DEPTH		;SHORTEN STRING
	POP	PP,0(PP)		;DISCARD POINTER TO TYPEOUT
	POP	PP,TA		;[26]SAVE TRACE EXIT
	POP	PP,CUREPA	;[26]UNSTACK ENTRY POINT
	POP	PP,TC		;[26]UNSTACK SECT AND PARA PRTAB ADDRS.
	HRRZM	TC,L.SECT	;[26]RESTORE SECTION NAME
	HLRZM	TC,L.PARA	;[26]RESTORE PARA NAME
	PUSH	PP,TA		;[26]RESTACK TRACE EXIT
	SKIPE	REEBRK		;[26]SIMULATE BREAK?
	JRST	DEB		;[26]YES
	JRST	CNPOPJ

;TRACE ENTRY OR PROGRAM-ENTRY

;CAUTION: DO NOT TAMPER WITH NEXT THREE LINES.
	XWD	0,"!"
TRACE2:	SOSL	DEPTH
	JSA	TA,TPDCHR	;ADD ! TO STRING
	SKIPE	HFGTHR		;IF WE'RE DOING A HISTOGRAM GO
	PUSHJ	PP,HAEPS	; ACCUMULATE STATISTICS.
	POP	PP,TA		;[26]SAVE TRACE EXIT
	POP	PP,TB		;[26]SAVE PTR TO PREVIOUS STACK FRAME
	PUSH	PP,L.SECT	;[26]STACK OLD SECTION NAME
	MOVE	TC,L.PARA	;[26]GET OLD PARA NAME
	HRLM	TC,0(PP)	;[26]STACK OLD PARA NAME
	PUSH	PP,CUREPA	;[26]STACK OLD ENTRY POINT
	PUSH	PP,TB		;[26]RESTACK PREV STACK FRAME'S PTR
	PUSH	PP,TA		;[26]RESTACK TRACE EXIT
;HAVE TO ADJUST THE VALUE OF THE STACK POINTER THAT PUTF. (IN LIBOL)
;SAVED IN SBPSA.  THIS ROUTINE JUST ADDS 2 TO IT.
	PUSHJ	PP,ISBPS.	;[26]
	SETZM	L.SECT		;[26]FORGET OLD
	SETZM	L.PARA		;[26]  PROCED NAMES
;NOW FIND THE ENTRY POINT BY SEARCHING BACKWARDS FROM CALL ON C.TRCE.
	MOVE	TB,[SKIPA 0]	;[26]ENTRY PT HAS SKIPA 0
	CAME	TB,(TA)		;[26]THIS IT?
	SOJA	TA,.-1		;[26]NO
	HRRZM	TA,CUREPA	;[26]YES, SAVE IT
	PUSHJ	PP,STPCHK	;[26]ARE WE STEPPING?
	SKIPE	REEBRK		;[26]SIMULATE BREAK?
	JRST	TRACE3		;[26]YES, SO PRINT
	SKIPE	PTFLG.		;TRACING?
	JRST	TRACE3		;YES
	SKIPN	TA,EBRKOV	;[26]BREAK ON OVERLAY?
	JRST	CNPOPJ		;[26]NO
;(IF MODULE IN OVERLAY HAD NO SYMBOLS, WE MISSED THAT BREAK)
	CAMN	TA,CUREPA	;[26]RIGHT ENTRY POINT?
	JRST	BROV		;[26]YES
	SETZM	EBRKOV		;[26]NO,FORGET IT
CNPOPJ:	ADDM	TE,(PP)		;NO, SKIP RETURN
CPOPJ:	POPJ	PP,

;PRINT THE PROGRAM OR ENTRY NAMES

TRACE3:	PUSHJ	PP,PTDPTH
	AOS	(PP)		;AIM AT NAME ARG
	TTCALL	3,[ASCIZ "<<"]
	TRNE	TA,2000		;PROGRAM ENTRY?
	TTCALL	3,[ASCIZ "PROGRAM "]
	TRNE	TA,1000		;OR OTHER ENTRY?
	TTCALL	3,[ASCIZ "ENTRY "]
TRACE5:	SOJLE	TE,TRACE4	;CHK COUNT OF NAME TO PRINT
	AOS	TA,(PP)		;BUMP ARG PTR
	MOVE	TA,-1(TA)	;GET ARG WORD
	PUSHJ	PP,SIXSIX
	JRST	TRACE5
TRACE4:	TTCALL	3,[ASCIZ ">>
"]
	SKIPN	TA,EBRKOV	;[26]BREAK ON OVERLAY?
	JRST	TRACE6		;[26]NO
;(IF MODULE IN OVERLAY HAD NO SYMBOLS, WE MISSED THAT BREAK)
	CAMN	TA,CUREPA	;[26]RIGHT ENTRY POINT?
	JRST	BROVA		;[26]YES
TRACE6:	SETZM	EBRKOV		;[26]NO,FORGET IT
	SKIPE	REEBRK		;[26]SIMULATE BREAK?
	JRST	DEB		;[26]YES
	POPJ	PP,

;GETS NAMTAB, DATAB AND PRTAB ADDRESSES FOR CURRENT ENTRY POINT.
;CUREPA MUST HAVE ENTRY POINT ADDRESS.

GTTABS:	HRRZ	TA,CUREPA	;[26]GET ENTRY ADDRESS
	HRRZ	TA,1(TA)	;[26]ADDR OF %FILES
	HRLI	TA,%%NM.(TA)	;[26]NAMTAB ADDR
	HRR	TA,%NM		;[26]
	HRRZ	TB,%NM		;[26]
	BLT	TA,2(TB)	;[26]GET ALL 3
	POPJ	PP,		;[26]
;ENTER HERE FROM KILL.

BTRAC.:	SETOM	DIED.		;WE ARE NOW DEAD
	SETZM	STPCTR		;[26]DON'T BREAK DURING PRINT
	SETZM	TE,REEBRK	;[26]ZERO ARG COUNT; NO BREAK
	TTCALL	3,[ASCIZ "ENTERING COBDDT FROM: "]
	SKIPN	@%DT		;[26]ANY SYMBOLS?
	JRST	[OUTSTR	[ASCIZ / (MODULE WITH NO SYMBOLS)/]
		JRST	BTRAC1]	;[26]NO...
	PUSHJ	PP,CTRCE3	;[26]PRINT WHERE WE ARE.
BTRAC1:	PUSHJ	PP,PPOT4.	;[26]AUTOMATIC TRACE BACK
	MOVEM	PP,PDL.		;[26]DON'T WIPE OUT ANY STACK
	JRST	XECUTX		;GO...


;ROUTINES TO KEEP TRACE CORRECT FOR PERFORMS.
;IN ORDER TO REMEMBER THE LAST-SEEN SECTION AND PARAGRAPH NAMES AT
;THE PERFORM STATEMENT, WE SAVE THEM ON THE STACK, THEN RESTORE THEM
;AT THE EXIT FROM THE PERFORM RANGE.
;	USE SAME REGISTERS THAT PERF. USES.
		PERFTA==10	;HOLDS ADDR OF START OF PERF RANGE.
		PERFTB==11	;HOLDS COPY OF RETURN ADDR ON STACK


;COME HERE FROM OBJECT PROGRAM DURING A PERFORM SETUP.
;SAVE PAR AND SECT NAMES AND ADD * TO STRING THAT GETS PRINTED
;IN FRONT OF ANY NAME THAT IS BEING TRACED.

;CAUTION: DO NOT TAMPER WITH THE NEXT THREE INSTRUCTIONS.
	XWD	0,	"*"
TRPD.:	SOSL		DEPTH
	JSA	TA,	TPDCHR	;ADD A * TO THE STRING
	SKIPE		HFGTHR		;IF WE'RE DOING A HISTOGRAM GO
	PUSHJ	PP,	HAPFS		; ACCUMULATE STATISTICS.
;LEAVE PERFORM EXIT ADDRESS ON TOP OF STACK, BUT SLIP SECTION AND
;PARAGRAPH NAME PRTAB ADDRESSES JUST BELOW IT.
	POP	PP,PERFTB	;SAVE EXIT WORD.
	PUSH	PP,L.SECT	;STACK SECTION
	MOVE	TA,L.PARA	;[26]AND PARAGRAPH
	HRLM	TA,0(PP)	;[26]PRTAB ADDRESSES
	PUSH	PP,PERFTB	;RESTACK EXIT WORD.
	JRST	-1(PERFTA)	;RETURN

;COME HERE FROM OBJECT PROGRAM WHEN EXITING A PERFORM RANGE.
;REMOVES A CHAR FROM STRING AND RESTORES SECT AND PAR NAMES.

TRPOP.:	SKIPE		HFGTHR		;IF WE'RE DOING A HISTOGRAM GO
	PUSHJ	PP,	HAEXS		; ACCUMULATE STATISTICS.
	AOS		DEPTH	;SHORTEN STRING
	POP	PP,TA		;UNSTACK RETURN ADDR
	POP	PP,PERFTA	;[26]UNSTACK SECTION
	HRRZM	PERFTA,L.SECT	;[26]AND PARAGRAPH
	HLRZM	PERFTA,L.PARA	;[26]PRTAB ADDRESSES
	JRST	(TA)		;RETURN
	IFNDEF MXDPTH,<MXDPTH==^D35>	;MAXIMUM DEPTH WE WILL KEEP TRACK OF.

;SUBROUTINE TO ADD A CHARACTER TO THE STRING.  ENTERED WITH THE WORLD'S
;WORST CALLING SEQUENCE:
;
;	XWD	0, "Z"		;THE CHARACTER TO BE ADDED.
;	SOSL	...		;ANY RANDOM INSTRUCTION.
;	JSA	TA,TPDCHR

TPDCHR:	Z				;CALLED VIA JSA.
	PUSH	PP,	TB		;DON'T MESS UP ANY AC'S.
	PUSH	PP,	TC
	MOVE	TB,	DEPTH
	SUBI	TB,	MXDPTH
	MOVE	TC,	TRSPTR
	AOJGE	TB,	TPDCHD
	IBP		TC
	AOJL	TB,	.-1
TPDCHD:	MOVE	TB,	-3(TA)
	IDPB	TB,	TC
	POP	PP,	TC
	POP	PP,	TB
	JRA	TA,	(TA)


;SUBROUTINE TO PRINT THE STRING OF *'S AND !'S.
PTDPTH:	PUSH	PP,	TA		;DON'T MESS UP ANY AC'S.
	MOVE	TA,	DEPTH
	SUBI	TA,	MXDPTH
	JUMPE	TA,	PTDPTP
	CAMG	TA,	[EXP	-MXDPTH]
	HRREI	TA,	-MXDPTH
	PUSH	PP,	TB
	PUSH	PP,	TC
	MOVE	TB,	TRSPTR
PTDPTL:	ILDB	TC,	TB
	OUTCHR	TC
	AOJL	TA,	PTDPTL
	POP	PP,	TC
	POP	PP,	TB
PTDPTP:	POP	PP,	TA
	POPJ	PP,


TRSPTR:	POINT	7,.+1
	BLOCK	<MXDPTH+4>/5
DEPTH:	EXP	MXDPTH
;COME HERE TO EXECUTE "OVERLAY" COMMAND.
;JUST SET SWITCH ON OR OFF.
SETOVR:	MOVEM	W2,	BRKONO		;SAVE ON/OFF VALUE.
	JRST		XECUTX		;CONTINUE.


;ROUTINE TO DO INITIALIZATION ON THE FLY FOR LINK-10 OVERLAYS.
; CALLED BY PUTF. BEFORE IT SWAPS THE TABLES (EVERY ENTRY).
; ENTER WITH (TA) = ENTRY POINT ADDRESS.
; ALL AC'S ARE PRESERVED.

SFOV.:	SKIPE		HFGTHR		;IF WE'RE DOING A HISTOGRAM GO
	PUSHJ	PP,	HAOVL		; ACCUMULATE STATISTICS.

	JSR		SVALL		;GO SAVE THE AC'S.

	MOVE	TB,	-2(TA)		;MAKE SURE WE ARE AT THE
	TRNE	TB,	-1		; MAIN ENTRY POINT.
	MOVEI	TA,	(TB)

	MOVE 	TB,	1(TA)		;IF WE HAVE ALREADY
	SKIPGE	TC,	%%NM.(TB)	; INITIALIZED THIS MODULE
	JRST		SFOVI		; LEAVE.
;WE HAVE TO INITIALIZE ANY NEW MODULES THAT WERE BROUGHT IN.

;  BUT FIRST REMOVE ANY BREAK POINTS AND ENTRY POINTS FOR MODULES THAT
;	WERE OVERLAYED.

	MOVE	NM,	ETYPTS		;GET POINTER TO THE ENTRY POINT TABLE.

	SKIPN	TA,	(NM)		;IS THERE ONE THERE?
SFOVB:	AOBJN	NM,	.-1		;NO, LOOP.
	JUMPGE	NM,	SFOVE		;IF THERE AREN'T ANY MORE, THERE
					; ARE NO ENTRY POINTS TO BE REMOVED,
					; GO ON.

	HLRZ	TA,	TA		;GET PONTER TO THE OVERLAY BLOCK.
	JUMPE	TA,	SFOVB		;IF IT'S RESIDENT, IGNORE IT.

	MOVE	TA,	OVLKN(TA)	;GET THE MODULE'S LINK NUMBER.
	SKIPE	TH,	OVLCHS		;GET THE ADDR OF THE ROOT'S
					; CONTROL SECTION.
SFOVC:	HRRZ	TH,	CS.PTR(TH)	;GET THE NEXT CONTROL SECTION.
	JUMPE	TH,	SFOVD		;NO MORE CONTROL SECTIONS,
					; GO REMOVE THE LINK.
	HRRZ	TI,	CS.NUM(TH)	;GET THE LINK NUMBER.
	CAIE	TI,	(TA)		;IS THIS THE ONE?
	JRST		SFOVC		;NO, GO LOOK AT THE NEXT ONE.
	JRST		SFOVB		;YES, DON'T REMOVE IT.

SFOVD:	HLRZ	TC,	TA		;GET THE LOWEST ADDRESS IN THE
					; LINK THAT WENT AWAY.
	MOVEI	TE,	[ASCIZ	/
[OVERLAYED /]
	PUSHJ	PP,	SFOVS		;GO REMOVE ANY ENTRY POINTS
					; AND BREAK POINTS THAT HAVE
					; BEEN OVERLAYED.

	SKIPE		PTFLG.
	OUTSTR	[ASCIZ	/WITH /]
	JRST		.+3
SFOVE:	SKIPE		PTFLG.
	OUTSTR	[ASCIZ	/
[BROUGHT IN MODULES /]
;NOW GO THROUGH ALL THE CONTROL SECTIONS AND INITIALIZE ANY MODULES
; WHICH HAVEN'T BEEN INTIALIZED YET.

	SETOM		SUBSPR		;NOTE THAT THERE ARE SUBROUTINES
					; PRESENT.
	SKIPE	TH,	OVLCHS		;GET THE ADDR OF THE ROOT'S CS.
SFOVF:	HRRZ	TH,	CS.PTR(TH)	;GET THE ADDR OF THE NEXT CS.
	JUMPE	TH,	SFOVH		;IF THAT'S ALL, WE'RE DONE.

	SKIPN	TI,	CS.INT(TH)	;GET POINTER TO THE INTERNAL
					; TRANSFER TABLES.
	JRST		SFOVF		;IF IT DOESN'T EXIST, GO LOOK
					; AT THE NEXT CS.
	PUSH	PP,	TH		;SAVE CS PTR.
SFOVG:	HRRZ	TA,	(TI)		;GET THE ADDR (OF AN ENTRY PT?)
	PUSH	PP,	TI		;SAVE THE POINTER.
	PUSHJ	PP,	SFOVK		;GO SEE IF WE HAVE TO LINK ANYTHING.
	POP	PP,	TI		;RESTORE THE POINTER.
	ADDI	TI,	1		;SKIP OVER A WORD.
	AOBJN	TI,	SFOVG		;IF THERE ARE MORE (ENTRY PTS.), LOOP.
	POP	PP,	TH		;RESTORE CS PTR.
	JRST		SFOVF		;GO LOOK FOR MORE CONTROL SECTIONS.

SFOVH:	SKIPE		PTFLG.
	OUTSTR	[ASCIZ	/]
/]

	MOVE	TA,	AC0+TA
	SKIPE		BRKONO		;IF HE WANT'S TO BREAK,
	MOVEM	TA,	EBRKOV		; REMEMBER TO DO SO LATER.

SFOVI:	HRLZI	17,	AC0		;RESTORE THE AC'S.
	BLT	17,	17

	POPJ	PP,		;RETURN.
;ROUTINE TO SET UP THE OVERLAY BLOCKS AND INITIALIZE
; MODULES IN A LINK-10 OVERLAY.
; ENTER WITH (TA) = ENTRY POINT ADDRESS.

SFOVK:	MOVE	NM,	ETYPTS		;GET THE POINTER TO THE ENTRY POINTS.

SFOVL:	MOVS	TB,	(TA)		;GET THE INSTRUCTION AT THE EP.
	CAIE	TB,	(<SKIPA 0,0>)	;IF IT ISN'T "SKIPA 0,0",
	POPJ	PP,			; LEAVE.

	HRRZ	TB,	-2(TA)		;MAKE SURE THAT WE ARE AT
	TRNE	TB,	-1		; THE MAIN ENTRY POINT.
	HRRZI	TA,	(TB)

	MOVE	TB,	1(TA)		;GET THE ADDR OF %FILES.
	SKIPGE		%%NM.(TB)	;IF THE MODULE HAS ALREADY BEEN
	POPJ	PP,			; INITIALIZED, LEAVE.

	MOVE	NM,	ETYPTS		;PUT THE MODULE'S MAIN ENTRY
	SKIPE		(NM)		; POINT IN THE ENTRY POINT
	AOBJN	NM,	.-1		; TABLE.
	JUMPGE	NM,	[CAIN	NM,	ETYTAB+^D100
			JRST	[OUTSTR	[ASCIZ	/
?TOO MANY SUBROUTINES FOR COBDDT TO COPE WITH.  PLEASE COMBINE SOME OF
?THEM SO THAT THERE ARE LESS THAN 100 MODULES./]
				CALLI	12]
			MOVS	TC,	ETYPTS
			SUBI	TC,	1
			MOVSM	TC,	ETYPTS
			JRST		.+1]
	HRRZM	TA,	(NM)		;PUT THE EP ADDR IN THE TABLE.
	HRRZM	NM,	NMSVD		;REMEMBER WHERE WE PUT IT.

	HRROS		%%NM.(TB)	;MARK THE MODULE.

	SKIPN		PTFLG.		;IF WE'RE TRACING, PRINT IT'S NAME.
	JRST		SFOVM
	MOVE	TD,	-1(TA)
	PUSHJ	PP,	SFOVU
	OUTCHR	[" "]
;BUILD AN OVERLAY BLOCK FOR THE MODULE.

;  FIRST FIND OUT WHICH LINK IT'S IN.

SFOVM:	MOVE	TH,	OVLCHS		;GET THE ADDR OF THE ROOT LINK'S
					; CONTROL SECTION.
SFOVN:	HRRZ	TH,	CS.PTR(TH)	;GET THE ADDR OF THE NEXT CS.
	MOVE	TI,	CS.COR(TH)	;GET BASE ADDR AND LENGTH OF
	HLRZ	TJ,	TI		; THE LINK.
	ADDI	TJ,	(TI)		;LAST ADDR IN THE LINK.
	CAIGE	TJ,	(TA)		;IF THIS ISN'T THE ONE,
	JRST		SFOVN		; GO LOOK AT THE NEXT ONE.

;  NOW SEE IF IT WAS IN CORE BEFORE.

	MOVE	TE,	-1(TA)		;GET THE MODULE'S NAME.
	MOVE	TF,	CS.NUM(TH)	;AND LINK NUMBER.

	SKIPA	TD,	OVRLHD		;GET THE POINTER TO THE OVERLAY BLOCKS.
SFOVO:	SKIPN	TD,	OVLTN(TD)	;GET THE NEXT OVERLAY BLOCK.
	JUMPE	TD,	SFOVP		;NO MORE OVERLAY BLOCKS, IT WAS
					; NEVER IN CORE BEFORE.
	HRRZ	TG,	OVLKN(TD)	;GET THE LINK NUMBER.
	CAMN	TE,	OVNAM(TD)	;NAMES MATCH?
	CAIE	TF,	(TG)		;YES, LINK NO'S MATCH?
	JRST		SFOVO		;NO, NOT A MATCH.
	JRST		SFOVQ		;MATCH, GO ON.


;  DIDN'T FIND A MATCH, BUILD A BLOCK FOR IT.

SFOVP:	PUSHJ	PP,	SFOVW		;GO FIND OUT WHERE .JBFF LIVES.

	CAIGE	TD,	OVBKSZ(TC)	;IF THERE ISN'T ENOUGH ROOM, COMPLAIN.
	JRST	[OUTSTR	[ASCIZ	-
?NOT ENOUGH ROOM BELOW LINK'S OVERLAY AREA, RELOAD WITH LARGER "/SPACE."-]
		CALLI	12]
;  LINK THE BLOCK IN AS THE LAST BLOCK IN THE LIST.

	SKIPN	TG,	OVRLHD
	HRLZI	TG,	OVRLHD
	HLRZS		TG
	HRRZM	TC,	(TG)
	HRLM	TC,	OVRLHD

	HRRI	TD,	OVBKSZ(TC)	;UPDATE .JBFF
	HRRM	TD,	(TE)

	HRLI	TC,	(TC)		;ZERO OUT THE BLOCK.
	SETZM		(TC)
	ADDI	TC,	1
	BLT	TC,	-1(TD)

	MOVEI	TD,	-OVBKSZ(TD)	;POINT AT THE FIRST LOCATION OF
					; THE BLOCK.

	MOVE	TE,	-1(TA)		;GET THE MODULE'S NAME
	MOVEM	TE,	OVNAM(TD)	; AND PUT IT IN THE BLOCK.

	HRL	TF,	CS.COR(TH)	;COMBINE THE LOWEST ADDR IN THE
					; LINK WITH THE LINK NUMBER AND
	MOVEM	TF,	OVLKN(TD)	; PUT THEM IN THE BLOCK.

;  PUT THE REST OF THE JUNK IN THE BLOCK.

	HLL	TA,	-2(TA)		;GET THE MODULE'S START ADDR.
	MOVEM	TA,	OVEPA(TD)	;SAVE FIRST LOC,,EP ADDR.
	HRRZ	TC,	%%NM.(TB)
	MOVEM	TC,	OV%NM(TD)
	MOVE	TC,	%%DT.(TB)
	MOVEM	TC,	OV%DT(TD)
SFOVQ:	HLLZ	TC,	OV%PR(TD)
	IORB	TC,	%%PR.(TB)
	MOVEM	TC,	OV%PR(TD)

	HRLM	TD,	@NMSVD		;PUT THE OVERLAY BLOCK'S ADDR
					; IN THE ENTRY POINT TABLE.
;  IF THE HISTOGRAM IS ACTIVE AND WE HAVEN'T SET UP A TABLE FOR THIS
;	MODULE, DO SO NOW.

	SKIPE		HFINIT
	TLNE	TC,	-1
	JRST		SFOVR

;  SET UP A HISTOGRAM TABLE.

	PUSHJ	PP,	SFOVW		;GO FIND .JBFF.

	MOVEI	TA,	(TB)		;GET THE SIZE OF PROTAB.
	MOVE	TB,	%%PR.(TA)
	HLRZ	TC,	%%DT.(TA)
	SUBI	TC,	(TB)

	HRRZ	TB,	(TE)		;GET THE HISTAB ADDR.

	ADDI	TC,	(TB)		;LAST LOCATION IN HISTAB.

	CAIL	TC,	(TD)
	JRST	[OUTSTR	[ASCIZ	-
?NOT ENOUGH SPACE FOR HISTOGRAM TABLES, RELOAD WITH LARGER "/SPACE".-]
		CALLI	12]
	HLRZ	TD,	(NM)		;GET THE OVERLAY BLOCK'S ADDR.
	HRLM	TB,	OV%PR(TD)	;PUT THE HISTAB ADDR IN IT.
	HRLM	TB,	%%PR.(TA)	; AND IN %PR.
	ADDI	TC,	1		;UPDATE .JBFF.
	MOVEM	TC,	(TE)

	PUSHJ	PP,	HISIRP		;GO CLEAN THE TABLE UP.

SFOVR:	HRRZ	TA,	@NMSVD		;GET THE ENTRY POINT ADDR BACK.
	HLRZ	TB,	1(TA)		;GET THE LIST OF PROGRAMS CALLED.

SFOVRH:	SKIPN	TA,	(TB)		;IF THIS MODULE DOESN'T
	POPJ	PP,			; CALL ANYONE, RETURN.
	PUSH	PP,	TB		;OTHERWISE, SAVE THE PTR.
	PUSHJ	PP,	SFOVL		;GO DO THIS PROGRAM.
	POP	PP,	TB		;RESTORE THE PTR.
	AOJA	TB,	SFOVRH		;AND GO SEE IF ANYONE ELSE IS CALLED.
;ROUTINE TO REMOVE ENTRY POINTS AND BREAK POINTS FOR ROUTINES THAT
; HAVE BEEN OVERLAYED OR CANCELED.  ENTER WITH (TC) = HIGHEST ADDRESS
; KNOWN TO STILL BE PRESENT.


SFOVS:	CAML	TC,	CUREPA		;SEE IF THE CURRENT MODULE
	JRST		SFOVSB		; WENT AWAY.

	HRRZ	TD,	ETYTAB		;IT DID, MAKE THE MAIN PROGRAM
	MOVEM	TD,	CUREPA		; THE CURRENT MODULE.
	HRRZ	TD,	1(TD)
	HRLI	TD,	%%NM.(TD)
	HRRI	TD,	BNM
	BLT	TD,	BPR

SFOVSB:	MOVE	NM,	ETYPTS		;GET THE POINTER TO THE ENTRY POINTS.
	SKIPN	TD,	(NM)		;IS THERE ONE THERE?
SFOVSD:	AOBJN	NM,	.-1		;NO, IF THERE ARE MORE, LOOP.
	JUMPGE	NM,	SFOVSL		;IF THERE ARE NO MORE, GO ON.

	CAIL	TC,	(TD)		;IF THE ENTRY POINT IS ABOVE
	JRST		SFOVSD		; THE STARTING ADDRESS, DO NOTHING.

	SKIPN		PTFLG.		;IF WE AREN'T TRACING, GO ON.
	JRST		SFOVSH

	TRNE	TE,	-1		;IF THERE IS SOMETHING TO TYPE,
	OUTSTR		(TE)		; TYPE IT.

	HLRZ	TD,	TD		;POINT AT THE OVERLAY BLOCK.
	MOVE	TD,	OVNAM(TD)	;GET THE NAME.
	PUSHJ	PP,	SFOVU		;GO TYPE IT OUT.
	OUTCHR	[" "]			;FOLLOWED BY A SPACE.

SFOVSH:	SETZB	TE,	(NM)		;REMOVE THE ENTRY POINT FROM THE TABLE.
	JRST		SFOVSD		;GO LOOK FOR MORE.

SFOVSL:	MOVEI	TD,	B1ADR		;POINT AT THE FIRST BREAK POINT.
SFOVSP:	SKIPE	TG,	0(TD)		;IF THERE ISN'T ANYTHING THERE
	CAIL	TC,	(TG)		; OR IT'S BELOW THE ADDRESS,
	JRST		SFOVST		; GO LOOK AT THE NEXT ONE.
	SETZM		(TD)		;OTHERWISE CLEAR THE BP.
	SETZM		1(TD)
	SETZM		2(TD)
SFOVST:	ADDI	TD,	LBA		;MOVE UP TO THE NEXT ONE.
	CAIG	TG,	BNADR		;IF THERE ARE MOVE,
	JRST		SFOVSP		; LOOP.
	POPJ	PP,			;OTHERWISE, RETURN.
;PRINT A SIXBIT WORD. WORD IS IN TD, USES TE.

SFOVU:	SETZI	TE,
	LSHC	TE,	6
	ADDI	TE,	40
	OUTCHR	TE
	JUMPN	TD,	SFOVU
	POPJ	PP,


SFOVW:	MOVEI	TE,	.JBFF##		;GET .JBFF'S ADDR.
	MOVE	TC,	.JBFF##		;GET .JBFF.
	SKIPE	TD,	HLOVL.##	;GET THE ADDR OF THE FIRST LOC
					; IN THE OVERLAY AREA.
	CAIG	TC,	(TD)		;IF .JBFF IS ABOVE THE OVERLAY
	POPJ	PP,			; AREA, USE THE SAVED .JBFF.
	MOVEI	TE,	SAVEF.##
	MOVE	TC,	SAVEF.##
;COME HERE WHEN BREAKING AFTER HAVING BROUGHT A LINK-10 OVERLAY IN.

BROV:	ADDM	TE,(PP)		;ADJUST THE RETURN ADDRESS.
BROVA:	JSR	SAVE		;GO SAVE THE WORLD.
	SKIPE	HFGTHR		;IF WE'RE DOING A HISTOGRAM, GO
	PUSHJ	PP,HAOVL	; ACCUMULATE STATISTICS.
	PUSHJ	PP,REMOVB	;REMOVE BREAK POINTS.
	OUTSTR	[ASCIZ	"BREAK UPON OVERLAY LOAD "] ;[26]
	HRL	TA,%NM		;SAVE POINTERS
	HRRI	TA,PNM
	BLT	TA,PPR
	PUSHJ	PP,GTTABS	;[26]GET NEW TABLE POINTERS
	PUSHJ	PP,MODH		;[26]TELL WHAT MODS ARE IN MEMORY
	JRST	XECUTX		;[26]DIALOGUE

;COME HERE TO PROCEED FROM THE ABOVE BREAK.

PROV:	SETZM	EBRKOV		;DON'T BREAK AGAIN.
	PUSHJ	PP,INSRTB	;GO INSERT BREAK POINTS.
	HRLZI	17,AC0		;RESTORE THE AC'S.
	BLT	17,17
	POPJ	PP,		;RETURN.
;ROUTINE TO REMOVE ANY BREAKPOINTS FROM LINK-10 OVERLAYS BEFORE THEY
; ARE CANCELED.
;CALLED BY CANCEL JUST BEFORE IT CALLS OVRLAY TO REMOVE THE LINK.
;ENTER WITH (TA) = PTR TO ARG WHCH POINTS TO LINK NUMBER OF LINK TO CANCEL.
;ALL AC'S ARE PRESERVED.

CNTRC.:	JSR		SVALL		;GO SAVE THE AC'S.

	MOVE	TA,	@(TA)		;GET THE LINK NUMBER.
	SKIPE	TH,	OVLCHS		;POINT AT THE ROOT'S CONTROL SECTION.
CNTRCB:	HRRZ	TH,	CS.PTR(TH)	;POINT AT THE NEXT CONTROL SECTION.
	JUMPE	TH,	CNTRCC		;IF THERE ARE NO MORE LINKS, LEAVE.
	HRRZ	TI,	CS.NUM(TH)	;GET THE LINK'S NUMBER.
	CAIE	TI,	(TA)		;IF THIS ISN'T THE ONE,
	JRST		CNTRCB		; GO LOOK AT THE NEXT ONE.

	HRRZ	TC,	CS.COR(TH)	;GET THE LOWEST ADDRESS IN THE LINK.

	MOVEI	TE,	[ASCIZ	/
[CANCELED /]
	PUSHJ	PP,	SFOVS		;GO REMOVE ANY BREAK POINTS AND
					; ENTRY POINTS IN THE CANCELED
					; ROUTINES.
	SKIPE		PTFLG.		;IF WE'RE TRACING,
	OUTCHR	["]"]			; TERMINATE THE STRING.

	SETZM		SUBSPR		;ASSUME THAT THERE ARE NO
					; SUBROUTINES LEFT.
	MOVE	NM,	ETYPTS		;GET POINTER TO ENTRY POINT TABLE.
	AOBJP	NM,	CNTRCC		;IF THE MAIN ROUTINE IS THE ONLY
					; THING THERE, GO ON.
	SKIPN		(NM)		;LOOK FOR A NON ZERO ENTRY IN
	AOBJN	NM,	.-1		; THE TABLE.
	JUMPGE	NM,	CNTRCC		;IF WE FOUND ONE, NOTE THAT
	SETOM		SUBSPR		; THERE ARE SUBROUTINES PRESENT.

CNTRCC:	HRLZI	17,	AC0		;RESTORE THE AC'S.
	BLT	17,	17

	POPJ	PP,			;RETURN.


;ROUTINE TO SAVE THE AC'S - JSR SVALL -

SVALL:	Z
	MOVEM	17,	AC0+17
	HRRZI	17,	AC0
	BLT	17,	AC0+16
	MOVE	17,	AC0+17
	JRST		@SVALL
;	REWRITE OF HISTOGRAM FEATURE 27-JUL-75	/ACK

;DEFINITIONS:

	DV.DSK==(1B1)		;DEVCHR FLAG - DEVICE IS A DISK.
	DV.CDR==(1B2)		;DEVCHR FLAG - DEVICE IS A CARD READER.
	DV.LPT==(1B3)		;DEVCHR FLAG - DEVICE IS A LINE PRINTER.
	DV.NUL==DV.CDR+DV.LPT	;IF THEY ARE BOTH ON, IT'S THE NULL DEVICE.
	DV.DIR==(1B15)		;DEVCHR FLAG - DEVICE IS A DIRECTORY DEVICE.

	EOL==12			;END OF LINE CHARACTER.

	HTTLSZ==^D70			;MAXIMUM SIZE FOR TITLE.
	IFNDEF	HPSPLN,<HPSPLN==^D20>	;MAXIMUM NUMBER OF ENTRY POINTS
					; AND PERFORMS TO KEEP TRACK OF.

;SOME USEFUL MACROS:

	DEFINE	WARN%	(X)<
	OUTSTR	[ASCIZ	\
%'X'\]
>

	DEFINE	WARN	(X)<
	OUTSTR	[ASCIZ	\'X'\]
>

	SALL
;INITIATE A HISTOGRAM.

HISINI:	PUSHJ	PP,	SHISCM		;GO SCAN THE REST OF THE LINE.

	PUSHJ	PP,	HISIND
	JRST		XECUTX

;SET UP THE TABLES.

HISIND:	SKIPE		HFTBST		;IF WE HAVE ALREADY SET THEM
	JRST		HISIRD		; UP, GO CLEAN THEM UP.

	PUSHJ	PP,	SFOVW		;GO FIND OUT WHERE .JBFF IS
					; HIDEING.

HISINF:	MOVEM	TC,	HSTSJF		;SAVE .JBFF IN CASE WE CAN'T
					; ALLOCATE ALL THE CORE WE NEED.

	MOVE	NM,	ETYPTS		;SET UP THE POINTER TO THE ENTRY POINTS.
	SKIPN	TA,	(NM)		;IS THERE AN ENTRY POINT THERE?
HISINH:	AOBJN	NM,	.-1		;NO, IF THERE ARE MORE, LOOP.
	JUMPGE	NM,	HISINX		;IF WE'RE DONE, GO CLEAR THE TABLES.

	HRRZ	TA,	1(TA)		;ADDRESS OF %FILES.
	MOVE	TB,	%%PR.(TA)	;PROTAB ADDR.
	TLNE	TB,	-1		;IF THIS ONE WAS SET UP BEFORE
	JRST		HISINH		; GO DO THE NEXT ONE.
	HLRZ	TC,	%%DT.(TA)	;LAST LOCATION IN PROTAB.
	SUBI	TC,	(TB)		;SIZE OF PROTAB.

	HRRZ	TB,	(TE)		;HISTAB ADDRESS.
	ADDI	TC,	(TB)		;LAST LOCATION IN HISTAB.

	JUMPE	TD,	HISINT		;IF THERE ARE NO LINK-10 OVERLAYS
					; ACTIVE GO ON.
	CAIG	TC,	(TD)		;IF THE LAST LOCATION IS BELOW
	JRST		HISINV		; THE OVERLAY AREA, ALL IS WELL.
	OUTSTR	[ASCIZ	-
?NOT ENOUGH SPACE FOR HISTOGRAM TABLES, RELOAD WITH LARGER "/SPACE".-]
HISINL:	MOVE	TA,	HSTSJF		;RESTORE ORIGIONAL .JBFF.
	MOVEM	TA,	(TE)
	JRST		XECUTX
HISINT:	CAMG	TC,	.JBREL##	;IF WE DON'T NEED TO ASK FOR
	JRST		HISINV		; MORE CORE, DON'T.
	MOVEI	TG,	(TC)		;ASK FOR THE CORE.
	CORE	TG,
	  JRST	[OUTSTR	[ASCIZ	/
?NOT ENOUGH CORE AVAILABLE FOR HISTOGRAM./]
		JRST	HISINL]

HISINV:	HRLM	TB,	%%PR.(TA)	;SAVE HISTAB ADDR.
	HRRI	TC,	1(TC)		;FORM NEW .JBFF.
	HRRM	TC,	(TE)		;SAVE IT.
	JRST		HISINH		;GO DO THE NEXT TABLE.


HISINX:	HRRZ	TB,	%PR		;GET CURRENT PR AND GO PUT THE
	PUSHJ	PP,	HISIT		; HISTOGRAM TABLE IN IT.

	HRRZI	TB,	PPR		;DITTO FOR THE RUN PR.
	PUSHJ	PP,	HISIT

	HRRZI	TB,	BPR		;AND THE BREAK PR.
	PUSHJ	PP,	HISIT

;NOW GO PUT THE HISTAB ADDRESSES IN ANY SAVED %PR'S.

	MOVE	NM,	ETYPTS		;GET THE POINTER TO THE ENTRY POINTS.

	SKIPN	TA,	(NM)		;IS THERE AN ENTRY POINT THERE?
HISIPD:	AOBJN	NM,	.-1		;NO, IF THERE ARE MORE LOOP.
	JUMPGE	NM,	HISIPE		;IF THAT'S ALL GO ON.

	PUSH	PP,	NM		;SAVE THE POINTER.

	MOVE	TA,	1(TA)		;ADDRESS OF %FILES.
	MOVEI	TB,	FIXNUM+%%PR.(TA)	;ADDRESS OF SAVED PROTAB POINTER.
	PUSHJ	PP,	HISIT		;GO CHECK IT OUT.

	POP	PP,	NM		;RESTORE THE ENTRY POINT POINTER.
	JRST		HISIPD		;AND LOOP.
;NOW PUT THE HISTOGRAM TABLE ADDRESSES IN ANY LINK-10 OVERLAY BLOCKS.

HISIPE:	MOVEI	TD,	OVRLHD		;GET THE ADDR OF THE LIST HEADER.
HISIPF:	SKIPN	TD,	(TD)		;ARE THERE MORE?
	JRST		HISIPH		;NO, GO ON.
	MOVEI	TB,	OV%PR(TD)	;POINT AT THE PROTAB WORD.
	PUSHJ	PP,	HISIT		;GO PUT THE HISTAB ADDR IN IT.
	JRST		HISIPF		;GO LOOK FOR MORE.


;PUT HISTOGRAM TABLE ADDRESS IN THE LOCATION WHOSE ADDRESS IS IN TB.

HISIT:	MOVE	TC,	(TB)		;GET THE PROTAB ADDR.
	TRNE	TC,	-1		;IF THERE IS NO PROTAB ADDR
	TLNE	TC,	-1		; OR HISTAB IS ALREADY SET UP,
	POPJ	PP,			; FORGET IT.

	MOVE	NM,	ETYPTS		;SET UP THE POINTER TO THE ENTRY POINTS.

	SKIPN	TA,	(NM)		;IS THERE AN ENTRY POINT THERE.
HISITD:	AOBJN	NM,	.-1		;NO, IF THERE ARE MORE LOOP.
	JUMPGE	NM,	CPOPJ		;MUST BE A LINK-10 OVERLAY THAT
					; WENT AWAY.
	HRRZ	TA,	1(TA)		;ADDRESS OF %FILES.
	MOVE	TA,	%%PR.(TA)	;HISTAB ADDR,,PROTAB ADDR
	CAIE	TC,	(TA)		;IS THIS THE ONE?
	JRST		HISITD		;NO, GO LOOK AT THE NEXT ONE.
	HLLM	TA,	(TB)		;YES, STASH THE HISTAB ADDR.
	POPJ	PP,			;RETURN.

HISIPH:	SETOM		HFTBST		;REMEMBER THAT WE HAVE SET UP
					; THE TABLES.
;ZERO OUT ALL OF THE TABLES.

HISIRD:	MOVE	NM,	ETYPTS		;SET UP THE POINTER TO THE ENTRY POINTS.

	SKIPN	TA,	(NM)		;IS THERE AN ENTRY POINT THERE?
HISIRH:	AOBJN	NM,	.-1		;NO, IF THERE ARE MORE LOOP.
	JUMPGE	NM,	HISIRI		;IF WE'RE DONE, GO ON.

	HRRZ	TA,	1(TA)		;ADDRESS OF %FILES.
	PUSHJ	PP,	HISIRP		;GO ZAP THE TABLE.

	JRST		HISIRH		;GO DO THE NEXT TABLE.

;CLEAR LINK-10 OVERLAY MODULE'S TABLES IN CASE THE MODULE ITSELF ISN'T
; CURRENTLY IN CORE.

HISIRI:	SKIPN	TD,	OVRLHD		;IF THERE AREN'T ANY LINK-10
	JRST		HISIRL		; OVERLAYS GO ON.

HISIRJ:	MOVEI	TA,	OV%PR-%%PR.(TD)	;POINT AT WHERE %FILES WOULD BE.
	PUSHJ	PP,	HISIRP		;GO ZAP THE TABLE.
	SKIPE	TD,	(TD)		;IF THERE ARE MORE,
	JRST		HISIRJ		; LOOP.


HISIRL:	SETZM		HOVCPU		;CLEAR THE OVERHEAD AND
	MOVE	TA,	[XWD	HOVCPU,HOVCPU+1]	;ELAPSED TIMES.
	BLT	TA,	HUNELP

	SETOM		HFINIT		;REMEMBER THAT AN INITIALIZATION
					; WAS DONE.
	POPJ	PP,			;RETURN.


;ROUTINE TO ZAP A HISTAB TABLE.
; ENTER WITH THE ADDR OF %FILES IN TA.

HISIRP:	MOVE	TB,	%%PR.(TA)	;HISTOGRAM TABLE ADDRESS,,PROTAB ADDRESS.
	TLNN	TB,	-1		;IS THERE A TABLE THERE?
	POPJ	PP,			;NO, LEAVE.
	HLRZ	TA,	%%DT.(TA)	;LAST LOCATION IN PROTAB.
	SUBI	TA,	(TB)		;GET SIZE OF PROTAB.
	HLR	TB,	TB		;FORM WORD FOR BLT.
	ADDI	TB,	1

	SETZM		-1(TB)		;ZERO THE FIRST WORD.
	ADDI	TA,	-1(TB)		;LAST LOCATION IN HISTAB.
	BLT	TB,	(TA)		;ZAP.

	POPJ	PP,			;RETURN.
;START GATHERING STATISITICS.

HISSTA:	PUSHJ	PP,	SHISCM		;GO SCAN THE REST OF THE LINE.

	SKIPL		HFINIT		;IF WE HAVEN'T DONE THE
	PUSHJ	PP,	HISIND		; INITIALIZATION YET, GO DO IT.

HISSTE:	SETOM		HFGTHR		;TURN ON THE GATHER FLAG.
	SETOM		HFGTST		;TURN ON THE INITIALIZE FLAG.

	MOVE	TA,	[IOWD	HPSPLN,HPSPLO]	;SET UP THE PDL.
	MOVEM	TA,	HPSPDL

	JRST		PRCEDD		;AUTOMATICALY PROCEED.
;STOP GATHERING STATISTICS.

HISSTO:	PUSHJ	PP,	CHSCMB		;GO MAKE SURE WE ARE AT THE
					; END OF A LINE.

	SETZM		HFGTHR		;TURN OFF THE GATHER FLAG.

	JRST		XECUTX


;COME HERE WHEN THE PROGRAM TERMINATES TO PRINT THE REPORT, IF NECESSARY.

HSRPT.:	AOSN		HFGTST		;DO WE HAVE STATISTICS THAT
					; WANT TO BE PRINTED.
	POPJ	PP,			;NO, RETURN.
	JRST		HISREB		;YES, GO PRINT THEM AND RETURN.
;PRINT THE REPORT.

HISREP:	PUSHJ	PP,	SHISCM		;GO SCAN THE REST OF THE LINE.

	SKIPN		HFINIT		;IF AN INITIALIZATION OR A BEGIN
					; WASN'T DONE, COMPLAIN.
	JRST	[OUTSTR	[ASCIZ	/
?HISTORY NOT INITIALIZED./]
		JRST	XECUTX]

	PUSHJ	PP,	HISREB		;GO PRINT THE REPORT.
	SETOM		HFGTST		;NOTE THAT WE HAVE PRINTED THE
					; REPORT.
	JRST		XECUTX		;GO SEE IF THERE ARE MORE COMMANDS.


;CALLED BY A PUSHJ SO WE CAN CALL IT IF THE PROGRAM TERMINATES WITHOUT
; PRINTING THE REPORT.

HISREB:	MOVEM	PP,	HSTPDL		;SAVE THE PDL IN CASE WE HAVE
					; AN ERROR.

	PUSHJ	PP,	HISSIO		;GO SET UP THE I/O ROUTINES.

	AOS	TE,	HSTRPN		;BUMP THE REPORT NUMBER.
	OUTSTR	[ASCIZ	/
[REPORT: /]				;AND TYPE IT OUT.
	PUSHJ	PP,	PRNUM
	OUTCHR	["]"]

	MOVEM	17,	HSTACS+17	;SAVE THE AC'S.
	HRRZI	17,	HSTACS
	BLT	17,	HSTACS+16
	MOVE	17,	HSTACS+17

	MOVE	NM,	ETYPTS		;SET UP THE POINTER TO THE
					; ENTRY POINTS.
HISRED:	SKIPE	TA,	(NM)		;IS THERE ONE THERE?
	PUSHJ	PP,	HISPRP		;YES, GO PRINT A PAGE.
	AOBJN	NM,	HISRED		;IF THERE ARE MORE MODULES, LOOP.
;PRINT OUT THE OVERHEAD FOR PERFORMS AND SUBROUTINE CALLS.

	SKIPN	TK,	HOVELP		;IF THERE WASN'T ANY FORGET IT.
	JRST		HISREF
	MOVEI	TE,	[ASCIZ	/
OVERHEAD:	ELAPSED:  /]
	PUSHJ	PP,	HISPST
	PUSHJ	PP,	HSPRTM
	MOVEI	TE,	[ASCIZ	/	CPU:  /]
	PUSHJ	PP,	HISPST
	MOVE	TK,	HOVCPU
	PUSHJ	PP,	HSPRTM

;PRINT OUT THE UNACCOUNTABLE TIME.

HISREF:	SKIPN	TK,	HUNELP		;IF THERE WASN'T ANY FORGET IT.
	JRST		HISREG
	MOVEI	TE,	[ASCIZ	/
UNACCOUNTED:	ELAPSED:  /]
	PUSHJ	PP,	HISPST
	PUSHJ	PP,	HSPRTM
	MOVEI	TE,	[ASCIZ	/	CPU:  /]
	PUSHJ	PP,	HISPST
	MOVE	TK,	HUNCPU
	PUSHJ	PP,	HSPRTM

HISREG:	PUSHJ	PP,	HISPEL

HISREH:	HRLZI	17,	HSTACS		;RESTORE THE AC'S.
	BLT	17,	17

HISREL:	PUSHJ	PP,	HISCLO		;GO CLOSE THE CHANNEL, RETURN IT
					; AND RETURN THE CORE.

	MOVE	PP,	HSTPDL		;RESTORE THE PDL.
	POPJ	PP,			;RETURN.
;ROUTINE TO PRINT THE STATISTICS FOR ONE MODULE.

HISPRP:	MOVEI	TE,	[ASCIZ	/

COBDDT HISTOGRAM FOR /]
	PUSHJ	PP,	HISPST

	MOVE	TD,	-1(TA)		;PRINT THE MODULE'S NAME.
HSPRPD:	SETZI	TE,
	LSHC	TE,	6
	JUMPE	TE,	HSPRPH
	MOVEI	CH,	40(TE)
	PUSHJ	PP,	HISPCH
	JRST		HSPRPD

HSPRPH:	MOVEI	CH,	"	"
	MOVEI	TE,	4
	PUSHJ	PP,	HISPCH
	SOJG	TE,	.-1

	MOVEI	TE,	[ASCIZ	/REPORT:  /]
	PUSHJ	PP,	HISPST

	MOVE	TE,	HSTRPN
	PUSHJ	PP,	HISPDC

	PUSHJ	PP,	HISPEL

	LDB	TE,	[POINT	7,HSTTTL,6]
	JUMPE	TE,	HSPRPJ
	MOVEI	TE,	HSTTTL
	PUSHJ	PP,	HISPST
	PUSHJ	PP,	HISPEL

HSPRPJ:	MOVEI	TE,	[ASCIZ	/
PROCEDURE			    ENTRIES	      CPU	ELAPSED

/]
	PUSHJ	PP,	HISPST
	SETZI	CH,			;REMEMBER THAT WE HAVE JUST
					; PRINTED THE HEADING.

	HRRZ	TA,	1(TA)		;ADDRESS OF %FILES
	MOVE	TB,	%%PR.(TA)	;HISTOGRAM TABLE ADDR,,PROTAB ADDR.
	TRNE	TB,	-1		;[26]IS PROTAB ADDRESS 0?
	JRST		HSPRPK		;[26]
	MOVEI	TE,	[ASCIZ /(NO SYMBOLS FOR THIS MODULE)
/]					;[26]
	PUSHJ	PP,	HISPST		;[26]
	POPJ	PP,			;[26]
HSPRPK:	AOBJN	TB,	.+1		;SKIP THE ZERO WORDS.
	HLLZ	TC,	%%DT.(TA)	;LAST LOCATION IN PROTAB.
	HRRZ	TA,	%%NM.(TA)	;NAMTAB ADDR.
	ADD	TA,	[POINT 6,1]	;POINTER TO TEXT.
	MOVSS		TB		;PROTAB ADDR,,HISTOGRAM TABLE ADDR.
HSPRPL:	SKIPN	TE,	(TB)		;IF THERE IS NO TIME FOR THIS
	SKIPE		2(TB)		; PROCEDURE AND IT WAS NEVER
	TRNA				; ENTERED, GO ON TO THE
	JRST		HSPRPX		; NEXT ONE.

	MOVSS		TB		;POINT AT PROTAB
	LDB	TG,	[POINT 15,(TB),17]	;GET THE NAMTAB LINK.
	ADD	TG,	TA		;POINT AT THE NAME.

	HRREI	TH,	-^D32		;SET THE POSITION COUNT.

	MOVE	TI,	PRFLGS(TB)	;IF THIS IS A PARAGRAPH,
	TRNE	TI,	PRLINK		; INDENT A SPACE.  IF IT'S
	JRST	[MOVEI	CH,	" "	; A SECTION AND WE HAVE
		JRST		HSPRPR]	; NOT JUST PRINTED THE HEADING
	PUSHJ	PP,	HISPCH		; SKIP A LINE.

HSPRPP:	ILDB	CH,	TG		;GET A CHAR.
	TRNN	CH,	60		;IS THIS THE END?
	JRST		HSPRPT		;YES, GO ON.
	CAIN	CH,	':'		;REPLACE COLONS BY HYPHENS.
	MOVEI	CH,	'-'
	CAIN	CH,	';'		; AND SEMICOLONS BY PERIODS.
	MOVEI	CH,	'.'
	ADDI	CH,	40		;MAKE IT ASCII.
HSPRPR:	PUSHJ	PP,	HISPCH		;PRINT IT.
	AOJA	TH,	HSPRPP		;BUMP POSITION AND LOOP.

HSPRPT:	MOVEI	CH,	" "		;PADD WITH BLANKS UNTIL
	PUSHJ	PP,	HISPCH		; WE ARE AT COLUMN 33.
	AOJL	TH,	.-1
HSPRTV:	IDIVI	TE,	^D10		;PRINT THE NUMBER OF TIMES
	PUSH	PP,	TD		; THIS ROUTINE WAS ENTERED
	TDNE	TE,	TE		; RIGHT JUSTIFIED IN AN
	SOJA	TH,	HSPRTV		; 11 CHAR FIELD.
	HRREI	TD,	^D10(TH)
	PUSHJ	PP,	HISPCH
	SOJG	TD,	.-1
HSPRTW:	POP	PP,	CH
	TRO	CH,	60
	PUSHJ	PP,	HISPCH
	AOJLE	TH,	HSPRTW

	MOVSS		TB		;POINT AT THE HISTOGRAM TABLE AGAIN.

	MOVE	TK,	1(TB)		;GET THE CPU TIME FOR THE
	PUSHJ	PP,	HSPRTM		; PARAGRAPH AND GO PRINT IT.

	MOVE	TK,	2(TB)		;GET THE ELAPSED TIME FOR THE
	PUSHJ	PP,	HSPRTM		; PARAGRAPH AND GO PRINT IT.

	PUSHJ	PP,	HISPEL		;PRINT A <CR><LF>

HSPRPX:	ADD	TB,	[XWD	4,4]	;BUMP UP TO THE NEXT ENTRY.
	SKIPE	C74FLG			;COBOL-74?
	AOBJP	TB,.+1			;YES, USE [5,,5]
	CAMLE	TC,	TB		;ARE WE PAST THE END?
	JRST		HSPRPL		;NO, GO LOOK AT THIS ENTRY.

	POPJ	PP,			;DONE WITH THIS TABLE, RETURN.
;ROUTINE TO PRINT A TIME AS HH:MM:SS.TTT, WITH LEADING ZEROS SUPPRESSED.

HSPRTM:	MOVEI	CH,	" "		;THROW OUT A COUPLE SPACES.
	PUSHJ	PP,	HISPCH
	PUSHJ	PP,	HISPCH

	IDIVI	TK,	^D1000		;GET FRACTIONAL SECONDS.
	PUSH	PP,	TJ		;SAVE THEM.
	IDIVI	TK,	^D60		;GET SECONDS.
	PUSH	PP,	TJ
	IDIVI	TK,	^D60		;MINUTES AND HOURS.
	PUSH	PP,	TJ

	SETZI	TI,			;SET THE NO SIGINFICANCE FLAG.

	PUSHJ	PP,	HSPRTU		;GO PRINT HOURS.
	POP	PP,	TK		;GET MINUTES BACK.
	PUSHJ	PP,	HSPRTU		;GO PRINT THEM.
	POP	PP,	TK		;GET SECONDS BACK.
	IDIVI	TK,	^D10
	TRON	TI,	-1		;TURN ON SIGNIFICANCE AND GO
	TRNE	TK,	-1		; PRINT A DIGIT OR A SPACE.
	MOVEI	CH,	60(TK)
	PUSHJ	PP,	HISPCH
	PUSHJ	PP,	HSPRTR		;GO PRINT DIGITS POSITION.
	MOVEI	CH,	"."		;PRINT THE DECIMAL POINT.
	PUSHJ	PP,	HISPCH
	POP	PP,	TK		;GET FRACTIONAL SECONDS.
	IDIVI	TK,	^D100
	PUSHJ	PP,	HSPRTT
	MOVEI	TK,	(TJ)
HSPRTO:	IDIVI	TK,	^D10
	PUSHJ	PP,	HSPRTS
HSPRTR:	MOVEI	TK,	(TJ)
HSPRTS:	TRNE	TK,	-1
	TROA	TI,	-1
	TRNE	TI,	-1
HSPRTT:	MOVEI	CH,	60(TK)
	JRST		HISPCH

HSPRTU:	PUSHJ	PP,	HSPRTO
	TRNE	TI,	-1
	MOVEI	CH,	":"
	JRST		HISPCH
;PRINT A <CR><LF>

HISPEL:	MOVEI	CH,	15
	PUSHJ	PP,	HISPCH
	MOVEI	CH,	12
	JRST		HISPCH


;PRINT THE ASCIZ STRING WHOSE ADDRESS IS IN RH TE.

HISPST:	HRLI	TE,	(<POINT 7,0>)
HPSTRD:	ILDB	CH,	TE
	JUMPE	CH,	CPOPJ
	PUSHJ	PP,	HISPCH
	JRST		HPSTRD


;PRINT THE DECIMAL NUMBER IN TE.

HISPDC:	IDIVI	TE,	12
	HRLM	TD,	(PP)
	TDNE	TE,	TE
	PUSHJ	PP,	HISPDC
	HLR	CH,	(PP)
	TRO	CH,	60
	JRST		HISPCH
;I/O ROUTINES.

;SET UP FOR OUTPUT.

HISSIO:	MOVEI	TA,	4		;CALL FUNCT. TO GET
	MOVEM	TA,	HSTFFN		; A CHANNEL.
	MOVEI	TA,	HSTFFB
	PUSHJ	PP,	FUNCT.##
	SKIPE		HSTFST		;IF WE DIDN'T GET ONE, COMPLAIN.
	JRST	[OUTSTR	[ASCIZ	/
?CAN'T FIND A FREE CHANNEL FOR HISTORY REPORT./]
		JRST	XECUTX]

	AOS	TA,	.JBREL##	;SAVE .JBREL AND .JBFF AND
	MOVEM	TA,	HSTSJR		; SET .JBFF TO (.JBREL)+1 SO
	EXCH	TA,	.JBFF##		; THAT WE ARE ABOVE THE
	MOVEM	TA,	HSTSJF		; LINK-10 OVERLAY AREA.

	MOVE	TA,	HSTFCH		;GET THE CHANNEL NUMBER.
	DPB	TA,	[POINT 4,HSTOPN,12]	;PUT IT IN THE OPEN,
	DPB	TA,	[POINT 4,HISETR,12]	; ENTER,
	DPB	TA,	[POINT 4,HISOPT,12]	; OUTPUT,
	DPB	TA,	[POINT 4,HISGST,12]	; GETSTS AND
	DPB	TA,	[POINT 4,HISCLO,12]	; CLOSE.

	MOVE	TE,	[XWD	HSTIOB,HSTLUB]	;SET UP THE LOOKUP
	BLT	TE,	HSTETB+3		; AND ENTER BLOCKS.

	MOVE	TE,	HSTDEV		;GET THE DEVICE.
	DEVCHR	TE,			;GET IT'S CHARACTERISTICS.
	TLNN	TE,	DV.DSK		;IF IT'S NOT A DISK,
	JRST		HISSID		; DON'T TRY TO APPEND.

;DEVICE IS A DISK, TRY TO APPEND TO THE FILE.

	DPB	TA,	[POINT 4,HISLKU,12]	;PUT THE CHANNEL NUMBER IN
	DPB	TA,	[POINT 4,HISUSI,12]	; THE LOOKUP AND USETI.

	XCT		HSTOPN		;DO THE OPEN.
	JRST		HISER1		;FAILED, COMPLAIN.

	SETOI	TA,			;ASSUME WE'RE GOING TO DO THE USETI.
HISLKU:	LOOKUP		HSTLUB		;DO THE LOOKUP.
	SETZI	TA,			;FAILED, REMEMBER NOT TO DO THE USETI.
	JRST		HISETR		;GO DO THE ENTER.
;COME HERE IF THE DEVICE ISN'T A DISK.

HISSID:	XCT		HSTOPN		;DO THE OPEN.
	JRST		HISER1		;FAILED, COMPLAIN.

HISETR:	ENTER		HSTETB		;DO THE ENTER.
	JRST		HISER0		;FAILED, COMPLAIN.

	TLNE	TA,	-1		;DO WE WANT TO DO THE USETI?
HISUSI:	USETI		-1		;YES, DO SO.

	XCT		HISOPT		;DO AN OUT TO ESTABLISH THE BUFFERS.
	POPJ	PP,			;RETURN.

HISER0:	OUTSTR	[ASCIZ	/
?ENTER FAILURE ON /]
	PUSHJ	PP,	HISPFN
	JRST		HISREL

HISER1:	OUTSTR	[ASCIZ	/
?OPEN FAILURE ON /]
	MOVE	TA,	HSTDEV
	PUSHJ	PP,	SIXSIX
	JRST		HISREL
;OUTPUT THE CHARACTER IN CH.

HISPCH:	SOSG		HSTOBF+2
	JRST		HISOPT
HISPCM:	IDPB	CH,	HSTOBF+1
	POPJ	PP,

HISOPT:	OUT
	JRST		HISPCM
	OUTSTR	[ASCIZ	/
?OUTPUT ERROR ON /]
	PUSHJ	PP,	HISPFN
	OUTSTR	[ASCIZ	/ STATUS (/]
HISGST:	GETSTS		TA
	HRLZI	TA,	(TA)
	PUSHJ	PP,	PROCTD
	OUTCHR	[")"]
	JRST		HISREH		;GO RESTORE EVERYTHING AND
					; RETURN TO COMMAND INTREPRETER.
;ROUTINE TO CLEAN UP AFTER THE REPORT.

HISCLO:	CLOSE				;CLOSE THE CHANNEL.

	MOVEI	TA,	5		;CALL FUNCT. TO RETURN
	MOVEM	TA,	HSTFFN		; THE CHANNEL
	MOVEI	TA,	HSTFFB
	PUSHJ	PP,	FUNCT.##

	SOS	TA,	HSTSJR		;RESTORE .JBREL
	CORE	TA,
	JFCL
	MOVE	TA,	HSTSJF		;RESTORE .JBFF
	MOVEM	TA,	.JBFF##
	POPJ	PP,

;ROUTINE TO TYPE OUT THE FILE SPEC.

HISPFN:	MOVE	TA,	HSTDEV
	PUSHJ	PP,	SIXSIX
	SKIPN	TA,	HSTIOB
	POPJ	PP,
	OUTCHR	[":"]
	PUSHJ	PP,	SIXSIX
	OUTCHR	["."]
	SKIPE	TA,	HSTIOB+1
	PUSHJ	PP,	SIXSIX
	SKIPN	TA,	HSTIOB+3
	POPJ	PP,
	OUTCHR	["["]
	PUSHJ	PP,	PROCT
	OUTCHR	["]"]
	POPJ	PP,
;ROUTINE TO SCAN THE REST OF THE COMMAND FOR HISTOGRAM COMMANDS.

SHISCM:	PUSHJ	PP,	HGTCOM		;GO SEE IF THERE IS A FILE
					; SPEC OR A TITLE.
CHSCMB:	PUSHJ	PP,	EOLCHK		;GO MAKE SURE WE ARE AT THE END
					; OF THE LINE.
	POPJ	PP,			;WE ARE, RETURN.
	WARN%	(<GARBAGE AFTER COMMAND IGNORED>)
CHSCMF:	PUSHJ	PP,	GETCHR		;GO GET THE NEXT CHAR.
	PUSHJ	PP,	EOLCHK		;ARE WE AT THE END OF A LINE NOW?
	POPJ	PP,			;YES, RETURN.
	JRST		CHSCMF		;NO, SKIP THIS CHAR.
;PARAGRAPHS AND SECTIONS COME HERE.
;	ENTER WITH TB CONTAINING THE PROTAB LINK.

HAPS:	PUSHJ	PP,	HACAPS		;GO INITIALIZE.

	HRLI	TB,	(TB)		;FORM HISTAB ADDR,, PROTAB ADDR.
	ADD	TB,	@%PR

	HLRZ	TC,	TB		;GET THE HISTAB ADDR.
	AOS		(TC)		;BUMP NUMBER OF TIMES ENTERED.

	MOVE	TC,	PRFLGS(TB)	;GET THE PROTAB FLAGS.
	TRNN	TC,	PRLINK		;IF IT'S A SECTION,
	JRST		HAPSD		; GO ON.

; IT'S A PARAGRAPH.

	LDB	TC,	[POINT 15,1(TB),17]	;GET THE SECTION LINK.
	HLR	TB,	@%PR		;GET HISTAB ADDR.
	ADDI	TB,	(TC)		;FORM NEW SECTION'S HISTAB ADDR.
	MOVEM	TB,	HCURPS		;SAVE PARAGRAPH/SECTION.
	TRNA

; IT'S A SECTION.

HAPSD:	HLRZM	TB,	HCURPS		;SAVE NEW SECTION AND CLEAR OLD PARAGRAPH.

; REINITIALIZE THE TIMES.

HARAR:	MSTIME	TB,
	MOVEM	TB,	HSTELP
	SETZI	TA,
	RUNTIM	TA,
	MOVEM	TA,	HSTCPU

; RESTORE AC'S AND RETURN.

HARAV:	MOVE	TA,	[XWD	HSTACS,TD]
	BLT	TA,	TA

	POPJ	PP,


;COME HERE ON A BREAKPOINT TO UPDATE THE CURRENT PARAGRAPH/SECTION.

HABP:	PUSHJ	PP,	HACAPS		;GO INITIALIZE.
	JRST		HARAV		;GO RESTORE AC'S AND RETURN.
;PERFORMS COME HERE.

HAPFS:	PUSHJ	PP,	HACAPS		;GO INITIALIZE.

	JSR		HPFEP		;GO SAVE CURRENT PARAGRAPH/SECTION.

	MOVEI	TA,	HOVRHD		;CHARGE TIME TO OVERHEAD UNTIL
	MOVEM	TA,	HCURPS		; WE SEE A PARAGRAPH OR SECTION.

	JRST		HARAR		;GO RESTORE AC'S AND RETURN.


;ENTRY POINTS COME HERE.

HAEPS:	PUSHJ	PP,	HACAPS		;GO INITIALIZE.

	JSR		HPFEP		;GO SAVE CURRENT PARAGRAPH/SECTION.

	JRST		HAEXSD		;GO CHARGE TIME TO UNACCOUNTABLE
					; UNTIL WE SEE A PARAGRAPH OR
					; SECTION.

HPFEP:	Z
	MOVE	TB,	HCURPS		;GET CURRENT PARAGRAPH/SECTION.
	CAIN	TB,	HOVRHD		;IF WE'RE CHARGING THIS TIME TO
	JRST		HARAR		; OVERHEAD, DON'T SAVE ANYTHING.

	MOVE	TA,	HPSPDL		;GET THE PUSH DOWN POINTER.
	AOBJP	TA,	.+2		;IF THERE IS ROOM FOR THIS
	MOVEM	TB,	(TA)		; PARAGRAPH/SECTION, SAVE IT.

	MOVEM	TA,	HPSPDL		;SAVE PUSH DOWN POINTER.
	JRST		@HPFEP		;RETURN.
;EXITS, EXIT PROGRAMS AND GOBACKS COME HERE.

HAGBS:
HAEXS:	PUSHJ	PP,	HACAPS		;GO INITIALIZE.

	MOVE	TA,	HPSPDL		;GET PUSH DOWN POINTER.
	JUMPL	TA,	HAEXSH		;IF WE SAVED SOMETHING, GO ON.

	SUB	TA,	[XWD 1,1]	;DECREMENT THE POINTER, BUT DON'T
HAEXSB:	MOVEM	TA,	HPSPDL		; TRY TO RESTORE ANYTHING.

HAEXSD:	MOVEI	TA,	HUNATD		;CHARGE TIME TO UNACCOUNTABLE
	MOVEM	TA,	HCURPS		; UNTIL WE SEE A PARAGRAPH OR
					; SECTION.
	JRST		HARAR		;GO RESTORE AC'S AND RETURN.

HAEXSH:	CAMN	TA,	[IOWD HPSPLN,HPSPLO]	;IF WE HAVE NOTHING
	JRST		HAEXSD			; TO RESTORE GO CHARGE
						; THIS TIME TO UNACCOUNTABLE.

HAEXSL:	POP	TA,	HCURPS		;RESTORE OLD PARAGRAPH/SECTION.
	MOVEM	TA,	HPSPDL		;SAVE THE POINTER.
	JRST		HARAR		;GO RESTORE THE AC'S AND RETURN.
;COME HERE BEFORE PROCESSING OVERLAYS.

HAOVL:	PUSHJ	PP,	HACAPS		;GO INITIALIZE.
	MOVEI	TA,	HOVRHD		; CHARGE TIME TO OVERHEAD UNTIL
	MOVEM	TA,	HCURPS		; WE SEE A PARAGRAPH OR SECTION.
	JRST		HARAR		;GO RESTORE AC'S AND RETURN.
;INITIALIZATION ROUTINE.
;	SAVE SOME AC'S AND IF THIS IS THE FIRST TIME WE HAVE BEEN
; CALLED SINCE THE BEGIN WAS DONE SET UP THE INITIAL TIMES OTHERWISE
; INCREMENT THE TIMES FOR THE CURRENT PARAGRAPH/SECTION.

HACAPS:	MOVEM	TA,	HSTACS+3
	SETZI	TA,
	RUNTIM	TA,
	MOVEM	TB,	HSTACS+2
	MSTIME	TB,
	MOVEM	TD,	HSTACS
	MOVEM	TC,	HSTACS+1

	AOSN		HFGTST		;IF THIS IS THE FIRST TIME WE
	JRST		HACAPU		; HAVE BEEN CALLED, GO SET UP
					; THE INITIAL TIMES.

;INCREMENT THE CURRENT PARAGRAPH/SECTION'S TIMES.

	MOVE	TC,	HCURPS		;GET THE HISTAB ADDRESSES.
	HLRZ	TD,	TC		;TC HAS THE SECTION.
					;TD HAS THE PARAGRAPH.
	SUB	TA,	HSTCPU
	ADDM	TA,	HSTCPU
	ADDM	TA,	1(TC)
	TRNE	TD,	-1
	ADDM	TA,	1(TD)
	SUB	TB,	HSTELP
	ADDM	TB,	HSTELP
	CAMGE	TB,	TA		;IF THE ELAPSED TIME IS LESS
	MOVE	TB,	TA		; THAN THE CPU TIME, USE THE
					; CPU TIME AS ELAPSED TIME.
					; THIS HACK IS NECESSARY
					; BECAUSE SYSTEMS WITH REAL
					; TIME CLOCKS GET CPU TIME IN
					; MS BUT ROUND MSTIME OFF TO
					; THE NEAREST 16 MS.
	ADDM	TB,	2(TC)
	TRNE	TD,	-1
	ADDM	TB,	2(TD)
HACAPT:	MOVE	TB,	HSTACS+2
	POPJ	PP,

;THIS IS THE FIRST TIME WE HAVE BEEN CALLED SINCE THE BEGIN WAS DONE.

HACAPU:	MOVEM	TA,	HSTCPU
	MOVEM	TB,	HSTELP

	MOVEI	TA,	HOVRHD		;CHARGE TIME TO OVERHEAD UNTIL
	MOVEM	TA,	HCURPS		; WE SEE A PARAGRAPH OR SECTION.

	JRST		HACAPT		;GO RESTORE TB AND RETURN.
;ROUTINE TO PICK UP THE REST OF THE HISTOGRAM COMMAND.

HGTCOM:	PUSHJ	PP,	SKPBLN		;GO SKIP LEADING BLANKS AND TABS.
	CAIN	CH,	EOL		;IF IT'S THE END OF THE LINE,
	POPJ	PP,			; RETURN.
	CAIN	CH,	"'"		;IF IT LOOKS LIKE A TITLE,
	JRST		HGTCOD		; SKIP THE FILE SPEC STUFF.
	PUSHJ	PP,	GFSPEC		;GO GET A FILE SPEC.
	JUMPE	TC,	[MOVE	TE,	TD	;IF THERE ISN'T A FILE
						; NAME, SEE IF IT'S A
						; DIRECTORY DEVICE.
			DEVCHR	TE,		;GET THE CHARACTERISITCS.
			TLC	TE,	DV.NUL	;IF IT'S THE NULL DEVICE
			TLCE	TE,	DV.NUL	; PRETEND IT'S NOT A
			TLNN	TE,	DV.DIR	; DIRECTORY DEVICE.
			JRST		.+1	;IT ISN'T ALL IS WELL.
			ERR	("FILE NAME REQUIRED FOR THIS DEVICE")]
	MOVEM	TD,	HSTDEV		;SAVE THE FILE SPEC.
	MOVEM	TC,	HSTIOB
	MOVEM	TB,	HSTIOB+1
	MOVEM	TA,	HSTIOB+3
	PUSHJ	PP,	SKPBLN		;GO SKIP OVER ANY INTERVENING BLANKS.
	CAIN	CH,	EOL		;IF IT'S THE END OF THE LINE,
	POPJ	PP,			; RETURN.

HGTCOD:	HRREI	TE,	-HTTLSZ		;SET UP FOR THE TITLE.
	MOVE	TF,	[POINT 7,HSTTTL]
	CAIN	CH,	"'"		;IF IT LOOKS LIKE A TITLE,
	SOJA	TE,	HGTCOL		; GO ON.
	WARN%	(<TITLE SHOULD START WITH "'">)
	WARN	(<, BUT I'LL LET IT SLIDE.>)

HGTCOH:	IDPB	CH,	TF		;SAVE THE CHAR.
HGTCOL:	PUSHJ	PP,	GETCHR		;GO GET THE NEXT ONE.
	CAIN	CH,	"'"		;IS THAT ALL?
	JRST		HGTCOT		;YES, GO FINISH UP.
	CAIN	CH,	EOL		;DID HE FORGET THE TERMINATING "'"?
	JRST		HGTCOP		;YES, GO TELL HIM ABOUT IT.
	AOJL	TE,	HGTCOH		;IF THERE IS ROOM FOR THIS CHAR,
					; GO STASH IT.
	JUMPG	TE,	HGTCOL		;NO ROOM, IF WE HAVE ALREADY
					; COMPLAINED, DON'T NAG.
	WARN%	(<TITLE IS TOO LONG - BUT DON'T WORRY, I'LL TRUNCATE IT.>)
	JRST		HGTCOL

HGTCOP:	WARN%	(<YOU FORGOT TO TERMINATE THE TITLE WITH "'">)
	WARN	(<, BUT I'LL LET IT SLIDE.>)
	TRNA
HGTCOT:	MOVEI	CH,	" "		;PRETEND THE ' IS A BLANK.
	SETZI	TE,			;MARK THE END OF THE
	IDPB	TE,	TF		; TITLE.
	POPJ	PP,			;RETURN.
;ROUTINE TO GET A FILE SPEC.

GFSPEC:	HRLZI	TD,	'DSK'		;SET UP DEFAULTS.
	HRLZI	TB,	'HIS'
	SETZB	TA,	TC
	PUSHJ	PP,	GETSIX		;GO GET, AT MOST, SIX CHARS.
	CAIE	CH,	":"		;IS IT A DEVICE?
	JRST		GFSPEG		;NO, MUST BE A FILE NAME THEN.
	JUMPE	TE,	[JSP	TA,	PUTERR	;IF IT'S NULL, COMPLAIN.
			ASCIZ	/NULL DEVICE IS NOT PERMITTED./]
	MOVE	TD,	TE		;SAVE DEVICE.
	PUSHJ	PP,	BGTSIX		;GO GET THE FILE NAME.
GFSPEG:	MOVE	TC,	TE		;SAVE IT.
	CAIE	CH,	"."		;ARE WE GOING TO HAVE AN EXTENSION?
	JRST		GFSPEK		;NO, GO ON.
	PUSHJ	PP,	BGTSIX		;GO GET IT.
	HLLZ	TB,	TE		;SAVE IT.
GFSPEK:	CAIE	CH,	"["		;ARE WE GOING TO HAVE A PPN?
	POPJ	PP,			;NO, RETURN.
	PUSHJ	PP,	BGHOCT		;GO GET PROJECT NO.
	HRLI	TA,	(TE)		;SAVE IT.
	CAIE	CH,	","		;DID IT TERMINATE PROPERLY.
	JRST	[JSP	TA,	PUTERR	;NO, COMPLAIN.
		ASCIZ	/MISSING "," IN PPN./]
	PUSHJ	PP,	BGHOCT		;GO GET PROGRAMMER NO.
	HRRI	TA,	(TE)		;SAVE IT.
	CAIN	CH,	"]"		;IF IT TERMINATED WITH "]",
	JRST		GETCHR		; IGNORE IT.
	POPJ	PP,			;RETURN.
;ROUTINE TO GET AT MOST SIX CHARS IN TE.

BGTSIX:	MOVEI	CH,	" "		;MAKE THE CURRENT CHAR A BLANK.
	PUSHJ	PP,	SKPBLN		;SKIP ANY LEADING BLANKS.
GETSIX:	SETZI	TE,			;INITIALIZE.
	MOVE	TF,	[POINT 6,TE]
GETSID:	CAIE	CH,	":"		;CHECK FOR TERMINATING CHARS.
	CAIN	CH,	"."
	POPJ	PP,
	CAIE	CH,	"'"
	CAIG	CH,	" "
	POPJ	PP,
	CAIE	CH,	"["
	CAIN	CH,	"]"
	POPJ	PP,
	CAIG	CH,	137		;MAKE IT SIXBIT.
	MOVEI	CH,	-40(CH)
	TRNN	TE,	77		;DO WE HAVE ROOM FOR IT?
	IDPB	CH,	TF		;YES, SAVE IT.
	PUSHJ	PP,	GETCHR		;GO GET THE NEXT ONE.
	JRST		GETSID		; AND GO CHECK IT OUT.

;ROUTINE TO GET HALF OF AN OCTAL NUMBER RIGHT JUSTIFIED IN TE.

BGHOCT:	MOVEI	CH,	" "		;MAKE THE CURRENT CHAR A BLANK.
	PUSHJ	PP,	SKPBLN		;SKIP ANY LEADING BLANKS.
GHFOCT:	SETZI	TE,
GHFOCD:	CAIL	CH,	60		;IS IT AN OCTAL DIGIT?
	CAILE	CH,	67
	POPJ	PP,			;NO, TERMINATE.
	LSH	TE,	3		;MULTIPLY BY 8.
	TRO	TE,	-60(CH)		;ADD THIS DIGIT IN.
	PUSHJ	PP,	GETCHR		;GO GET THE NEXT ONE
	JRST		GHFOCD		; AND GO CHECK IT OUT.
;DATA STORAGE AREA.

HSTIOB:	BLOCK	4		;PLACE FOR NAME.EXT[PPN].
HSTLUB:	BLOCK	4		;FOR LOOKING UP THE FILE.
HSTETB:	BLOCK	4		;FOR ENTERING THE FILE.

HSTTTL:	BLOCK	<HTTLSZ+5>/5	;PLACE FOR TITLE.

HFINIT:	Z		;NON ZERO IF AN INITIALIZATION OR BEGIN WAS DONE.
HFGTHR:	Z		;NON ZERO IF WE ARE GATHERING STATISTICS.
HFTBST:	Z		;NON ZERO IF WE HAVE SET UP THE TABLES.
HFGTST:	Z		;-1 ==> SET UP INITIAL ITMES.

HSTRPN:	Z		;REPORT NUMBER.

HSTACS:	BLOCK	20	;PLACE TO SAVE AC'S.
HSTSJR:	Z		;PLACE TO SAVE .JBREL
HSTSJF:	Z		;PLACE TO SAVE .JBFF

	XWD	-4,0		;ARG BLOCK FOR FUNCT. CALLS.
HSTFFB:	Z	2,	HSTFFN
	Z	2,	HSTFEC
	Z	2,	HSTFST
	Z	2,	HSTFCH
HSTFFN:	Z			;FUNCTION.
HSTFEC:	Z			;ERROR CODE.
HSTFST:	Z			;STATUS.
HSTFCH:	Z			;CHANNEL.

HSTOPN:	OPEN		HSTOPB	;JUNK FOR THE OPEN.
HSTOPB:	Z
HSTDEV:	Z
	XWD	HSTOBF,0
HSTOBF:	BLOCK	3

HCURPS:	Z		;CURRENT PARAGRAPH/SECTION.
HSTCPU:	Z		;HOLDS THE RUNTIME.
HSTELP:	Z		;HOLDS THE ELAPSED TIME.
HPSPDL:	Z		;HOLDS THE PUSH DOWN POINTER.
HPSPLO:	BLOCK	HPSPLN	;PUSHDOWN LIST FOR SAVING OLD PARAGRAPH/SECTION
			; WHEN WE START A PERFORM OR ENTER A SUBROUTINE.

	HOVRHD=.-1	;PLACE TO ACCUMULATE OVERHEAD TIME.
HOVCPU:	Z
HOVELP:	Z

	HUNATD=.-1	;PLACE TO SAVE UNACCOUNTABLE TIME.
HUNCPU:	Z
HUNELP:	Z

HSTPDL:	Z		;PLACE TO SAVE THE PUSHDOWN POINTER.
;COME HERE ON SECOND DISPATCH FOR HISTORY COMMANDS.
;SECOND WORD HAS BEEN DECODED IN W2 AS DISPATCH INDEX.

HISDIS:	MOVEI	W2,0*.JBFF-HISCOM(W2)	;HACK TO MAKE MACRO 52 WORK
	JRST	@HISDTB(W2)		;DISPATCH

HISERR:	ERR	("INITIALIZE/BEGIN/END/REPORT REQUIRED")

;HISTORY COMMANDS

HISCOM:	SIXBIT	/INITIA/
	SIXBIT	/BEGIN/
	SIXBIT	/END/
	SIXBIT	/REPORT/
	HISLEN==.-HISCOM

;HISTORY COMMAND DISPATCH TABLE

HISDTB:	HISINI
	HISSTA
	HISSTO
	HISREP

;PRINT A SIXBIT WORD
;WORD IS IN TA, USES TB.
;ENTERED WITH PUSHJ PP,SIXSIX

SIXSIX:	MOVEI	TB,0
	LSHC	TB,6
	ADDI	TB,40
	TTCALL	1,TB
	JUMPN	TA,SIXSIX
	POPJ	PP,
;COME HERE ON SECOND DISPATCH FOR DDT COMMAND.

GODDT:
IFE TOPS20,<
	SKIPE	.JBDDT		;IS DDT LOADED?
	JRST	GODDT1		;YES
>
IFN TOPS20,<
	MOVE	1,[400000,,770] ;[26]IS PAGE ACCESSIBLE?
	RPACS
	AND	2,[EXP RDACC!EXCACC!PGXSTS] ;[26]
	CAME	2,[EXP RDACC!EXCACC!PGXSTS] ;[26]
	JRST	GODDT0		;[26]NO
	MOVE	1,770000	;[26]DOES IT CONTAIN DDT?
	CAME	1,[JRST	770002]	;[26]PROBABLY, IF EQUAL.
>
GODDT0:	ERR	"DDT NOT ACCESSIBLE" ;[26]
GODDT1:	OUTSTR	[ASCIZ	/RETURN FROM DDT BY TYPING "POPJ 17,$X"
/]				;[26]

IFE TOPS20,<
	HRRZ	TA,.JBDDT	;[26]GET DDT ENTRY POINT
	PUSHJ	PP,(TA)		;[26]
>

IFN TOPS20,<
	PUSHJ	PP,770000	;[26]
>

	JRST XECUTX		;[26]
;COME HERE ON SECOND DISPATCH FOR LOCATE COMMAND

LOCTYP:	TSWT	PRNMFG		;[26]WERE WE GIVEN A PROC NAME?
	JRST	LCTYP0		;[26]NO, DATA NAME.
	HRRZ	TA,1(W2)	;[26]YES, GET OBJECT ADDRESS OUT OF PROTAB.
	JRST	LCTYP1		;[26]PRINT IT
LCTYP0:	MOVEI	W1,BASEA	;[26]SET UP 'A' OPERAND
	PUSHJ	PP,SETOPN	;[26]RESOLVE ADDRESSING.
	HRRZ	TA,BASEA	;[26]GET BASE ADDRESS
	ADD	TA,INCRA	;[26]ADD ANY SUBSCRIPT INCREMENT
	HLRZ	TB,RESA		;[26]GET BIT RESIDUE
	SKIPN	TB		;[26]BIT 0?
	AOJA	TA,LCTYP1	;[26]YES, NEXT WORD ADDRESS
	CAIN	TB,^D36		;[26]IS IT 0?
	JRST	LCTYP1		;[26]YES
	MOVEI	TE,^D36		;[26]CONVERT RESIDUE TO BIT NUMBER
	SUB	TE,TB		;[26]
	OUTSTR	[ASCIZ /BIT DISPLACEMENT = /]
	PUSHJ	PP,PRNUM	;[26]PRINT IT
	OUTSTR	CRLF		;[26]
LCTYP1:	MOVEI	TC,6		;[26]ALWAYS 6 OCTAL DIGITS
	LSH	TA,^D18		;[26]
LCTYP2:	SETZM	TB		;[26]
	LSHC	TB,3		;[26]ISOLATE OCTAL DIGIT
	ADDI	TB,60		;[26]MAKE ASCII
	TTCALL	1,TB		;[26]
	SOJG	TC,LCTYP2	;[26]MORE?
	JRST	XECUTX		;[26]
;COME HERE ON SECOND DISPATCH FOR GO COMMAND
;DESTINATION'S PROTAB ADDRESS IS IN W2.

GOXXX:	SKIPE	DIED.		;[26]ARE WE ALIVE?
	JRST	[OUTSTR	[ASCIZ	/?CANNOT GO!/]
		JRST	XECUTX]	;[26]DEAD
	SKIPE	REEFLG		;[26]NEED TO RESET STACK?
	JRST	[MOVE	PP,REEFLG
		POP	PP,0(PP)
		SETZM	REEFLG
		JRST	GOXXX4]	;[26]YES
	SKIPE	EBRKOV		;[26]OVERLAY BREAK?
	JRST	[OUTSTR	[ASCIZ	/MODULE/]
		JRST	GOXXX2]	;[26]YES
	SKIPE	CUR.BP		;[26]PROGRAM STARTED?
	JRST	GOXXX4		;[26]YES
	OUTSTR	[ASCIZ	/PROGRAM/] ;[26]NO
GOXXX2:	OUTSTR	[ASCIZ	/ NOT STARTED, DO STEP, THEN GO/]
	JRST	XECUTX		;[26]
GOXXX4:	HRRZ	TA,1(W2)	;[26]GET DESTINATION
	MOVE	TE,0(TA)	;[26]GET INSTRUCTION
	CAME	TE,[PUSHJ PP,C.TRCE] ;[26]IS IT TRACE INSTRUCTION?
	JRST	GOXXX6		;[26]NO
	HRRZ	TE,1(TA)	;[26]GET PROTAB LINK
	ADD	TE,@%PR		;[26]MAKE ADDRESS
	CAME	TE,W2		;[26]SAME ADDRESS?
	JRST	GOXXX6		;[26]NO
	PUSHJ	PP,INSRTB	;[26]SET ANY BREAKPOINTS THAT NEED IT.
	HRRZ	TA,1(W2)	;[26]REFETCH DESTINATION
	JRST	0(TA)		;[26]GO
GOXXX6:	OUTSTR	[ASCIZ	/LOCATION IS NOT RESIDENT/]
	JRST	XECUTX		;[26]
;THIS IS ENTRANCE TO DIALOGUE MODE

;THIS CODE READS AND PARSES THE COMMAND PORTION OF A COMMAND LINE.
;THE COMMAND IS DECODED AND PLACED IN W1 AS AN INDEX ON THE DISPATCH TABLE.

DECOD:	TTCALL	3,CRLF
DECOD0:	TTCALL	1,[EXP "*"]	;PROMPT USER
	MOVEI	SW,0		;CLEAR SWITCHES.  RH(SW)=CHAR-POSITION
	PUSHJ	PP,GETCHR	;CH ALWAYS HOLDS THE NEXT CHAR.
	CAIN	CH,12		;SKIP LEADING LF'S
	JRST	.-2
	PUSHJ	PP,GATOM	;GET COMMAND WORD IN C(TE-TA) IN SIXBIT
	JUMPN	TE,DECOD1	;ATOM FOUND?

;NOTHING WAS TYPED, IS ANYTHING THERE?

	PUSHJ	PP,EOLCHK	;CHECK EOL
				;HERE IF LINE EMPTY, HANDLE ESC.
	JRST	[TSWT ALTFLG
		 JRST DECOD0
		 JRST DECOD]
	AOJA	SW,ERR0("LINE TERMINATION ERROR")

DECOD1:	MOVE	W1,[-COMLEN,,COMTAB]	;USE COMMAND TABLE
	PUSHJ	PP,GETCOM	;GET LOC OF ENTRY WHOSE INIT. SEG IS C(TE)
	JUMPG	W1,ERR0('ILLEGAL COMMAND') ;FOUND?
				;GET INDEX ONLY
	MOVEI	W1,0*.JBFF-COMTAB(W1)	;HACK TO MAKE MACRO 52 WORK

;NOW DISPATCH TO HANDLE THE REST OF THE COMMAND DECODING.
;IF THERE IS MORE ON THE COMMAND LINE, IT IS ENCODED IN W2.  A REFERENCE
;TO A DATA ITEM (ACCEPT, DISPLAY ...) IS SCANNED, PARSED, AND A LOOK-UP
;IS DONE IN THE CURRENT NAMTAB TO FIND THE CORRECT DATAB ENTRY.  THE
;DATAB ADDRESS IS PLACED IN W2.  A REFERENCE TO A PROCEDURE NAME
;(BREAK, CLEAR ...) IS SCANNED, PARSED, AND A LOOK-UP IN THE CURRENT
;NAMTAB IS DONE TO FIND THE CORRECT PROTAB ENTRY.  THE PROTAB ADDRESS
;IS PLACED IN W2.
;THE KEYWORD 'ON' IS ENCODED IN W2 AS -1, THE KEYWORD 'OFF' AS 0.
;A PROCEED COUNT OR STEP COUNT IS PLACED IN W2.

;A SECOND DISPATCH WILL BE DONE TO HANDLE THE COMMAND EXECUTION.

	HRRZ	TA,COMDIS(W1)
	JRST	0(TA)		;DISPATCH

;RETURN FROM FIRST DISPATCH COMES HERE (UNLESS ERROR).

DECODX:	PUSHJ	PP,EOLCHK	;DID WE GET ALL OF THE COMMAND?
XECUT:	SKIPA	PP,PDL.		;HERE IF LINE EMPTY
	AOJA	SW,ERR0("LINE TERMINATION ERROR")

;COMMAND EXECUTION SECTION.
;ENTERED WITH W1 POINTING AT DISPATCH TABLE ENTRY, AND W2 HOLDING
;A DATAB OR PROTAB ADDRESS, OR SWITCH VALUE, OR DISPATCH CODE, ETC.

	MOVE	DT,W2
	HLRZ	W1,COMDIS(W1)	;GET SECOND DISPATCH ADDRESS
	CAIE	W1,ACCGEN	;CHECK FOR CODE GENERATORS
	CAIN	W1,DISPGN
	SKIPA	TE,[XWD CODFST,CODFST+1]	;YES,
	JRST	0(W1)		;NO, DISPATCH FOR ALL BUT ACCEPT/DISPLAY

;ACCEPT/DISPLAY CODE INIT AND EXECUTION

	SETZM	TEMPC
	SETZM	EAC
	SETZM	TEMROL
	BLT	TE,CODLST
	MOVE	LIT,[IOWD N.LIT,LITROL]
	MOVE	COD,[IOWD N.COD,CODROL]

;IF DT = 0, NO NAME WAS GIVEN WITH COMMAND, USE SAVED NAME.

	JUMPE	DT,[MOVE DT,LAST.	;GET LAST NAME
		 JUMPE DT,NOLAST	;WAS THERE ONE?
		 MOVE TE,[XWD SAVSUB,NSUBS] ;YES, GET SUBS TOO
		 BLT TE,NSUBS+3
		 JRST .+1]
	MOVEM	DT,LAST.		;SAVE FOR NEXT TIME
	MOVS	TE,[XWD SAVSUB,NSUBS]	;SAVE SUBS TOO
	BLT	TE,SAVSUB+3

	PUSHJ	PP,0(W1)		;DISPATCH TO ACCEPT OR DISPLAY

;THE ACCEPT OR DISPLAY CODE GENERATORS LOAD EXECUTABLE INSRUCTIONS
;INTO THE CODROL BLOCK AND THEN RETURN HERE.

	PUSH	COD,CPOPJ	;ADD A POPJ RETURN TO THE EXECUTABLE INSTRUCS
	PUSHJ	PP,CODROL	;CALL CODE


;RETURN FROM THE SECOND DISPATCH COMES HERE.

XECUTX:	SETZB	SW,NSUBS	;CLEAR FLAGS & INIT PARSE
	MOVE	PP,PDL.		;RESTORE PUSH-DOWN-LIST
	JRST	DECOD		;*** PARSE

;ROUTINES ENTERED BY FIRST DISPATCH FROM COMMAND TABLE.
;THESE ROUTINES COMPLETE THE DECODING OF THE COMMAND (GENERALLY).

;COME HERE ON FIRST DISPATCH FOR LOCATE COMMAND.
;SET SWITCH, THEN SHARE CODE FOR ACCEPT/DISPLAY.

LOC.:	SWON	LOCFLG		;[26]
	SWOFF	CLRFLG!PRNMFG!GOFLG  ;[26]CLEAR OTHER FLAGS
	JRST	ACC1		;[26]

;COME HERE ON FIRST DISPATCH FOR GO COMMAND.
;SET SWITCHES, THEN SHARE CODE FOR BREAK/CLEAR.

GO.:	SWON	GOFLG!PRNMFG	;[26]SET SWITCHES
	SWOFF	CLRFLG!LOCFLG	;[26]CLEAR SWITCHES
	JRST	ACC1		;[26]

;COME HERE ON FIRST DISPATCH FOR CLEAR AND BREAK COMMANDS.
;SET SWITCHES, THEN SHARE CODE WITH ACCEPT/DISPLAY.

CLR.:	SWON	CLRFLG		;CLEAR COMMAND
BRK.:	SWON	PRNMFG		;[26]LOOKING FOR PROCEDURE NAME
	SWOFF	LOCFLG!GOFLG	;[26]NOT LOCATE OR GO
	JRST	ACC1		;[26]

;COME HERE ON FIRST DISPATCH FOR ACCEPT AND DISPLAY COMMANDS.

DIS.:
ACC.:	SWOFF	LOCFLG!GOFLG!CLRFLG!PRNMFG	;[26]RESET FLAGS
ACC1:	SKIPN	@%NM		;[26]DO WE HAVE A NAMTAB?
	ERR	"NO SYMBOLS FOR THIS MODULE"	;[26]NO
	PUSHJ	PP,GATOM	;[26]GET NAME
				;HAVE TO TREAT 'TALLY' SPECIAL IF COBOL-68.
	SKIPE	C74FLG		;COBOL-74?
	JRST	ACC.0		;YES, NOTHING SPECIAL
	CAMN	TE,[SIXBIT 'TALLY']
	JRST	DOTAL		;TREAT TALLY SPECIALLY

; SEE IF CAN FIND NAME IN NAMTAB.
;IF THE NAME CAN BE FOUND IN NAMTAB, WE WILL BUILD A STACK OF
;NAMTAB ADDRESSES FOR THE NAME AND ITS QUALIFIERS. TOP-OF-STACK WILL
;HAVE HIGHEST LEVEL QUALIFIER.  A PARANTHESIZED SUBSCRIPT EXPRESSION
;IS ACCEPTED ANYWHERE IN THE LIST OF QUALIFIERS.
;THE SUBSCRIPTS ARE RESTRICTED TO INTEGER VALUES, AND ARE STORED
;AWAY, UP TO 3 OF THEM, IN THEIR OWN LIST.
;THIS IS A SYNTAX SCAN ONLY.  THE LOOK UP IN DATAB OR PROTAB COMES LATER.
;AND THE ACTUAL CALCULATON OF OBJECT ADDRESS COMES MUCH LATER.

ACC.0:	JUMPE	TE,CKCLR	;JUMP IF THERE WAS NO NAME AT ALL
	PUSHJ	PP,GETNAM	;RETURNS WITH NAMTAB ADDR IN TF
	JUMPE	TF,ACCEP2	;SYMBOL NOT IN TABLE?
	PUSH	PP,[OCT	-1]	;MARK BOTTOM OF STACK WITH -1
	PUSH	PP,TF		;PUSH NAMTAB ADDRESS ON STACK

;LOCATE COMMAND SETS PRNMFG IF FIRST NAME IS A PROCEDURE NAME.
	TSWT	LOCFLG		;[26]LOCATE COMMAND?
	JRST	DIS2		;[26]NO
				;[26]SEE WHICH TABLE (DATAB/PROTAB)
	HRRZ	TF,(TF)		;[26]GET LINK TO TABLE
	TRC	TF,DTTYPE	;[26]TEST TABLE TYPE BITS
	TRNE	TF,TYPMSK	;[26]
	SWON	PRNMFG		;[26]THIS IS LOCATE OF PROC NAME
DIS2:	PUSHJ	PP,SKPBLN	;GET NEXT NON-BLANK CHAR
	CAIE	CH,"("		;LOOK FOR SUBSCRIPTS
	JRST	MOREDN		;NO SUBSCRIPTS
	SKIPE	NSUBS		;SKIP IF FIRST OCCURANCE OF SUBSCRIPTS
	AOJA	SW,ERR0("SUBSCRIPT ERROR")

;LOOP FOR THE SUBSCRIPTS.
DIS3:	PUSHJ	PP,GETCHR	;SKIP PAST "(" OR ","
	PUSHJ	PP,GETNUM	;GET A NUMBER
;;;	JUMPLE	W2,ERR0("SUBSCRIPT ERROR")	;[24](DELETED)
	AOS	TA,NSUBS
	CAILE	TA,3		;CHECK MAX ALLOWABLE
	ERR	"ONLY 3 SUBSCRIPTS ALLOWED"
	MOVEM	W2,SUB0.-1(TA)	;STASH AWAY
	PUSHJ	PP,SKPBLN	;GET NEXT NON-BLANK
	CAIN	CH,","		;MORE?
	JRST	DIS3		;YES: CONTINUE
	CAIE	CH,")"		;NO: CHECK PROPER DELIM.
	AOJA	SW,ERR0("IMPROPER SUBSCRIPT DELIMITER")
	PUSHJ	PP,GETCHR	;OK: SKIP PAST IT

;REVERSE THE ORDER OF THE SUBSCRIPTS

	MOVE	TB,SUB0.	;GET FIRST SUBSCRIPT
	EXCH	TB,SUB0.-1(TA)	;EXCHANGE WITH LAST SUBSCRIPT
	MOVEM	TB,SUB0.	;STORE LAST AS FIRST

;LOOK FOR QUALIFIERS.

MOREDN:	PUSHJ	PP,GATOM
	JUMPE	TE,QUAL		;NO MORE QUALIFIERS IF 0
	CAME	TE,[SIXBIT /IN/]
	CAMN	TE,[SIXBIT /OF/]
	JRST	INOF
	AOJA	SW,ERR0("IN/OF MISSING")

INOF:	PUSHJ	PP,GATOM	;GET NAME
	JUMPE	TE,ERR0("MISSING QUALIFIER")
	PUSHJ	PP,GETNAM
	JUMPE	TF,ACCEP2	;SYMBOL NOT IN TABLE
	PUSH	PP,TF		;PUSH PTR TO SYMBOL TABLE HDR FOR DATA-NAME
	JRST	DIS2		;YES.  CHECK FOR MORE DATA-NAMES

;NO NAME GIVEN AFTER COMMAND. THAT'S OK, UNLESS 
;IT'S A BREAK, GO, OR LOCATE COMMAND.

CKCLR:	TSWT	GOFLG		;[26]GO COMMAND?
	TSWF	LOCFLG		;[26]LOCATE COMMAND?
	ERR	"MISSING NAME"	;[26]

	TSWT	CLRFLG		;SKIP IF CLEAR COMMAND
	TSWT	PRNMFG		;SKIP IF BREAK
	TDZA	W2,W2		;ZERO W2 AND SKIP
	ERR	"MISSING PROCEDURE-NAME"
	SWOFF	CLRFLG!PRNMFG
	JRST	DECODX

ACCEP2:	ERR	"UNDEFINED NAME"	;[26]

;SEARCH FOR (QUALIFIED) NAME.
;PP LOCATES STACK OF POINTERS TO NAMES IN NAMTAB,
;WITH HIGHEST LEVEL QUALIFIER ON TOP OF STACK, AND -1 MARKING BOTTOM.


QUAL:	SWOFF	NUQFLG		;CLEAR NON-UNIQUE FLAG
	SETZI	W2,		;CLEAR W2 INDICATING NO SUCCES YET

;GO DOWN THE STACK TO LOWEST LEVEL ENTRY.

	HRRZ	TB,PP
	SKIPL	-1(TB)
	SOJA	TB,.-1
;RH(TB) POINTS AT FIRST NAMPTR ON STACK
	HRRZ	TA,(TB)		;GET NAMTAB ADDRESS

;USE RH OF TB TO POINT TO THE STACK OF PNTRS TO THE NAMTAB.
;USE TA AS A WORKING REGISTER TO SEARCH THE LINKED LIST OF
;DATAB OR PROTAB ENTRIES THAT HAVE THE SAME NAME.
;MAKE LH OF TB POINT AT  DATAB ENTRY FOR FIRST SPECIFIED NAME

QUAL2:	SWON	FQFLAG		;SET CURRENT SEARCH IS FULLY-QUAL. FLAG
	HRRZ	TA,(TA)		;LOAD LINK TO NEXT DATAB OR PROTAB
				; ENTRY OF SAME NAME
	TRC	TA,DTTYPE	;WHICH TABLE DOES IT POINT AT?
	TRNE	TA,TYPMSK
	JRST	QUAL21		;PRTAB
	ADD	TA,@%DT		;DATAB.  ADD BASE ADDRESS
	TSWF	PRNMFG		;LOOKING FOR DATAB ENTRY?
	JRST	QUAL2		;NO.  KEEP SEARCHING
	JRST	QUAL22		;YES.  CARRY ON

;NOT A DATAB ENTRY

QUAL21:	TRC	TA,DTTYPE+PRTYPE
	TRNE	TA,TYPMSK	;CHECK FOR PRTAB
	JRST	QUAL6		;NO MORE ENTRIES
	ADD	TA,@%PR		;ADD OFFSET

;GOT THE TABLE ADDRESS, SAVE IN LH OF TB

QUAL22:	HRL	TB,TA		;SAVE DATAB ADDRESS
	HRRZ	TA,TB		;TA POINTS AT NAM PTRS IN STACK
	HLRZ	TD,TB		;TD POINTS AT DATAB

;WE HAVE A DATAB ENTRY (MAYBE NOT THE ONLY ONE) THAT HAS THE
;RIGHT NAME. ARE THERE MORE QUALIFIERS OF THIS ENTRY?

QUAL3:	CAIGE	TA,(PP)		;THROUGH NAME PTRS IN STACK?
	AOJA	TA,QUAL5	;NO. MAKE TA POINT AT NEXT NAME PTR
	HRRZ	TE,PRFLGS(TD)	;SUCCESSFUL MATCH.  FULLY QUALIFIED?
				;WE CAN TELL BY LOOKING AT THE FATHER LINK
				;OF DATAB ENTRY OR PAR/SECT FLAG OF
				;PROTAB ENTRY.
	ANDI	TE,PRLINK	;[26](TE)=0 IF SECTION-NAME
	TSWT	PRNMFG		;IS THIS PROTAB ENTRY?
	HLRZ	TE,DTSON(TD)	;DATAB ENTRY.  LOAD FATHER LINK
	TSWF	FQFLAG
	JUMPE	TE,[HLRZ W2,TB	;JUMP IF AT LEVEL 01 OR SECT NAME
		    JRST DECODX]
	SKIPE	W2		;NOT FULLY QUALIFIED
	SWON	NUQFLG		;NOT UNIQUE.  SET FLAG
	HLRZ	W2,TB		;SAVE PTR TO FIRST MATCH

QUAL4:	HLRZ	TA,TB		;GET READY TO UPDATE LH(TB)
	JRST	QUAL2		;GET LINK TO PROPER TYPE ENTRY

QUAL5:	TSWF	PRNMFG
	JRST	[LDB TD,SECNAM	;LOOK TO SEE IF SECT. NAM. MATCHES ((TA))
		ADD TD,@%PR
		JRST QUAL52 ]
QUAL51:	MOVE	TE,DTFLAG(TD)	;LOAD FLAG WORD
	HLRZ	TD,DTSON(TD)	;GET FATHER/BROTHER LINK
	JUMPE	TD,QUAL4	;JUMP IF NO FATHER
	TRZ	TD,TYPMSK	;CLEAR TYPE BIT
	ADD	TD,@%DT		;ADD OFFSET
	TLNN	TE,DTLINK	;IS THIS ENTRY LINKED TO FATHER
	JRST	QUAL51		;NO.  GO TO BROTHER

QUAL52:	LDB	TE,NMLINK	;DOES ANTECEDENT HAVE SAME NAME AS ((TA))?
	ADD	TE,@%NM		;ADD NAMTAB OFFSET
	HRRZ	TF,(TA)		;GET NAMTAB PTR OUT OF PDL
	CAIN	TF,(TE)
	JRST	QUAL3		;NAME MATCHES.  LOOK FOR FURTHER QUALIFIER
	SWOFF	FQFLAG		;NAME DIFFERS.  CLEAR NOT FULLY QUAL. FLAG
	TSWF	PRNMFG		;DATAB OR PROTAB?
	JRST	QUAL4		;PROTAB - CAN'T HAVE A FATHER.
	LDB	TE,[POINT 6,DTLVL(TD),5]	;[17] GET THE LEVEL NUMBER
	SOJE	TE,QUAL4	;IF IT'S "1", THIS ISN'T THE ONE WE WANT.
	JRST	QUAL51		;GO LOOK AT HIGHER LEVEL QUALIFIERS.

;THERE WERE NO MORE TABLE ENTRIES THAT SHARED THE SAME NAME.
;WAS ONLY ONE FOUND?

QUAL6:	TSWF	NUQFLG
	ERR	"NOT UNIQUELY QUALIFIED"
	JUMPN	W2,DECODX	;OK IF EXACTLY ONE FOUND
	ERR	"NOT DEFINED"

;COME HERE ON FIRST DISPATCH FOR PROCEED OR STEP COMMANDS
;GET THE PROCEED COUNT OR DEFAULT IT TO 1.

STP.:
PRO.:	MOVEI	W2,1
	PUSHJ	PP,EOLCHK
	JRST	XECUT		;HERE IF LINE EMPTY
	PUSHJ	PP,GETNUM	;GET PROCEED COUNT
	JUMPLE	W2,ERR0("ERROR IN COUNT")
	JRST	DECODX

;COME HERE ON FIRST DISPATCH FOR OVERLAY AND TRACE COMMANDS
;DECODE THE NEXT WORD: 'ON'=-1, 'OFF'=0. STORE IN W2.
;IF NEXT WORD IS 'BACK', USE LIBOL'S PRINT ROUTINE, THEN
;RETURN DIRECTLY TO XECUTX, BYPASSING THE SECOND DISPATCH FOR TRACE.

OVR.:	PUSHJ	PP,ONOFF	;[26]TEST NEXT WORD
	JUMPLE	W2,DECODX	;[26]
	ERR	("ON/OFF REQUIRED") ;[26]

TRC.:	PUSHJ	PP,ONOFF	;[26]TEST NEXT WORD
	JUMPLE	W2,DECODX	;[26]OK
	CAME	TE,[SIXBIT /BACK/] ;[26]
	ERR	("ON/OFF/BACK REQUIRED") ;[26]
	PUSHJ	PP,PPOT4.	;[26]USE LIBOL'S ROUTINE
	JRST	XECUTX		;[26]SKIP 2ND DISPATCH

;ONOFF ROUTINE RETURNS -1 OR 0 FOR "ON" AND "OFF",RESPECTIVELY.
;RETURNS +1 FOR ANYTHING ELSE.
ONOFF:	PUSHJ	PP,GATOM	;[26]GET WORD
	SETZ	W2,
	CAMN	TE,[SIXBIT /ON/]
	SOJA	W2,ONOFF9
	CAME	TE,[SIXBIT /OFF/]
	AOJ	W2,		;[26]NOT FOUND
ONOFF9:	POPJ	PP,		;[26]


;COME HERE ON FIRST DISPATCH FOR 'NEXT' COMMAND.
;GET A COUNT OR DEFAULT IT TO 1.
;SUM THE COUNT INTO THE LEAST SUBSCRIPT VALUE.

NEX.:	MOVEI	W2,1		;[24]DEFAULT
	PUSHJ	PP,EOLCHK	;[24]CHECK FOR END OF LINE
	JRST	NEXT1		;[24]HERE IF LINE EMPTY
	PUSHJ	PP,GETNUM	;[24]GET THE NUMBER IN W2
NEXT1:	SKIPN	SAVSUB		;[24]ANY SUBSCRIPTS ON LAST REFERENCE?
	ERR	("PREVIOUS NAME NOT SUBSCRIPTED") ;[24]
				;CAREFUL!! SUBSCRIPTS HAVE BEEN
				;STORED IN REVERSE ORDER
	SKIPN	@%NM		;[26]DO WE HAVE A NAMTAB?
	ERR	"NO SYMBOLS FOR THIS MODULE"	;[26]NO
	ADDM	W2,SAVSUB+1	;[24]INCR/DECR LEAST SUBSCRIPT
	SETZM	W2		;[24]SHOW NO NEW NAME TO DISPLAY.
	JRST	DECODX		;[24]
;COME HERE ON FIRST DISPATCH FOR MODULE COMMAND
;IF A PROGRAM NAME IS SUPPLIED, SWITCH DATAB,PROTAB,NAMTAB TO THAT
;MODULE'S TABLES.  IF NO PROGRAM NAME IS SUPPLIED, TELL THE USER
;WHAT THE CURRENT MODULE IS AND WHAT MODULES ARE IN MEMORY.

MOD.:	PUSHJ	PP,GATOM	;GET PROGRAM NAME.
	MOVE	NM,ETYPTS	;GET POINTER TO TABLE OF MAIN
				; ENTRY POINT ADDRESSES.
	JUMPE	TE,MODG		;[26]IF HE WANTS TO SEE WHAT MODULES
				; ARE IN CORE, GO TELL HIM.
MODD:	SKIPE	TG,(NM)		;IS THERE ONE THERE? (THEY MAY
				; DISAPPEAR, IF THEY ARE IN
				; LINK-10 OVERLAYS.)
	CAME	TE,-1(TG)	;YES, IS THIS THE ONE?
	AOBJN	NM,MODD		;NO, IF THERE ARE MORE, GO LOOK AT THEM.
	JUMPGE	NM,ERR0	("PROGRAM NOT LOADED")
	HRRZM	TG,CUREPA	;[26]SAVE AS CURRENT ENTRY PT
	HRRZ	TF,1(TG)	;GET ADDRESS OF %FILES FOR THE
				; SPECIFIED MODULE.
	HRRZ	TA,%%NM.(TF)	;[26]GET ADDR OF SYMBOL TABLE ADDRESSES
	JUMPE	TA,MODF		;[26]CHECK IT
	PUSHJ	PP,GTTABS	;[26]GET TABLE ADDRESSES
	JRST	DECODX		;RETURN.
MODF:	OUTSTR	[ASCIZ	/NO SYMBOLS FOR THAT MODULE/] ;[26]
MODG:	PUSHJ	PP,MODH		;[26]
	JRST	DECODX		;[26]

;SUBROUTINE TO SHOW WHAT MODULES ARE IN MEMORY

MODH:	OUTSTR	[ASCIZ	/
CURRENT MODULE:  /]
	MOVE	TA,CUREPA	;GET ENTRY POINT ADDRESS
	PUSHJ	PP,PRTMNM
	SKIPE	SUBSPR		;[26]ANY OTHERS?
	JRST	MODJ		;[26]NO
	HRRZ	TA,1(TA)	;[26]GET ADDR OF %FILES
	HRRZ	TA,%%NM.(TA)	;[26]GET NAMTAB BASE
	JUMPN	TA,MODX		;[26]DO WE HAVE ONE?
	OUTSTR	[ASCIZ / (NO SYMBOLS)/]	;[26]NO
	JRST	MODX		;[26]
MODJ:	OUTSTR	[ASCIZ	/
MODULES CURRENTLY IN CORE:/]
	MOVE	NM,ETYPTS	;[26]GET ENTRY PTS TABLE
MODL:	SKIPN	TA,(NM)		;IS IT THERE?
	AOBJN	NM,MODL		;NO, ARE THERE MORE?
	JUMPGE	NM,MODX		;[26]ALL DONE?
	OUTSTR	CRLF
	PUSHJ	PP,PRTMNM
	HRRZ	TA,(NM)		;[26]GET ENTRY PT AGAIN
	HRRZ	TA,1(TA)	;[26]GET ADDR OF %FILES
	HRRZ	TA,%%NM.(TA)	;[26]GET ADDR OF NAMTAB
	JUMPN	TA,MODM		;[26]IS IT THERE?
	OUTSTR	[ASCIZ / (NO SYMBOLS)/]	;[26]
MODM:	AOBJN	NM,MODL		;ANY MORE?
MODX:	POPJ	PP,		;[26]NO
;COME HERE ON FIRST DISPATCH FOR HISTORY COMMAND
;DECODE SECOND WORD OF COMMAND INTO W2.

HIS.:	PUSHJ	PP,GATOM	;GET SECOND WORD OF COMMAND
	JUMPE	TE,ERR0("HISTORY COMMAND REQUIRES AN ARGUMENT")
	MOVE	W2,W1		;SAVE W1
	MOVE	W1,[-HISLEN,,HISCOM] ;LOOK UP SECOND WORD
	PUSHJ	PP,GETCOM
	JUMPE	W1,ERR0("INIT/BEGIN/END/REPORT REQUIRED")
	EXCH	W1,W2		;RESTORE W1
	JRST	XECUT		;[26]COULD STILL BE A FILE SPEC
				;ON THE COMMAND LINE.  DON'T
				;GO BACK TO DECODX

	ERR	("HISTORY COMMAND REQUIRES AN ARGUMENT")

;COMMAND DEFINITIONS.

;TWO PARALLEL TABLES ARE BUILT, COMTAB CONTAINS THE COMMANDS, COMDIS
;CONTAINS A PAIR OF DISPATCH ADDRESSES.  THE FIRST DISPATCH GOES TO
;CODE THAT COMPLETES THE SYNTAX SCAN OF THE COMMAND LINE.  THE SECOND
;DISPATCH GOES TO CODE THAT EXECUTES THE COMMAND.  THE TABLES ARE
;IN APPROXIMATE ALPHABETICAL ORDER, BUT THIS IS FOR CONVENIENCE ONLY,
;SINCE A LINEAR SEARCH IS DONE ON THE COMMAND AS TYPED. THE COMMANDS
;CAN BE ABBREVIATED. NEW COMMANDS
;THAT HAVE THE SAME STARTING CHARACTERS MUST BE PLACED AFTER THE
;EXISTING COMMANDS, AND THEIR SHORTEST ALLOWABLE ABBREVIATION
;MUST BE LONG ENOUGH TO FAIL THE COMPARISON WITH THE PREVIOUS
;COMMAND. (EXAMPLE: 'D' IS AN ACCEPTABLE ABBREVIATION FOR 'DISPLAY'.
;'DD' WOULD BE AN ACCEPTABLE ABBREVIATION FOR 'DDT'.




	XALL

DEFINE	COMMANDS<
XX	ACCEPT,ACC.,ACCGEN
XX	BREAK,BRK.,SETBRK
XX	CLEAR,CLR.,CLRBRK
XX	DISPLAY,DIS.,DISPGN
XX	DDT,DECODX,GODDT
XX	GO,GO.,GOXXX
XX	HISTORY,HIS.,HISDIS
XX	LOCATE,LOC.,LOCTYP
XX	MODULE,MOD.,XECUTX
XX	NEXT,NEX.,DISPGN
XX	OVERLAY,OVR.,SETOVR
XX	PROCEED,PRO.,PROCED
XX	STEP,STP.,STEP
XX	STOP,DECODX,STOPR
XX	TRACE,TRC.,SETTRC
XX	WHERE,DECODX,WHERE
>


;COMMAND TABLE, ONE WORD ENTRIES, CONTAINING THE FIRST SIX 
;CHARACTERS OF THE COMMAND.


DEFINE	XX(A,B,C)<	<SIXBIT	/A/>>

COMTAB:	COMMANDS
	COMLEN==.-COMTAB



;COMMAND DISPATCH TABLE, ONE WORD ENTRIES, CONTAINING TWO ADDRESSES.
;RIGHT HALF IS FIRST DISPATCH ADDRESS, LEFT HALF IS SECOND DISPATCH ADDRESS.


DEFINE	XX(A,B,C)<	C,,B>

COMDIS:	COMMANDS

	SALL

;GETCOM RETURNS THE LOCATION IN W1 OF THE SIXBIT WORD,
;   WHOSE  (UNIQUE)  INITIAL SEGMENT IS IN C(TE), FROM THE 
;   TABLE OF SIXBIT WORDS POINTED AT BY (W1).
;  RETURNS W1 POSITIVE IF NOT FOUND.

GETCOM:	SETOI	TD,		;FIND MASK FOR TRAILING BLANKS
	LSH	TD,-6
	TDNE	TE,TD
	JRST	.-2

GETCM2:	MOVE	TB,(W1)		;GET TABLE ENTRY
	ANDCM	TB,TD		;AND MASK IT TO SAME LENGTH
	CAMN	TB,TE
	POPJ	PP,		;FOUND IT
	AOBJN	W1,GETCM2	;LOOP
	POPJ	PP,		;NOT IN TABLE


;SKPBLN SKIPS THE BLANKS AND TABS AND PUTS THE NEXT NON-BLANK/TAB
;   CHARACTER IN CH.  SETS BLNFLG SWITCH IF AT LEAST ONE BLANK
;   OR TAB IS FOUND

SKPBL2:	SWONS	BLNFLG		;BLANK/TAB SEEN.  SET FLAG
SKPBLN:	SWOFFS	BLNFLG		;CLEAR BLANK/TAB SEEN FLAG
	PUSHJ	PP,GETCHR	;GET NEXT CHAR. FROM BUFFER
	CAIE	CH," "
	CAIN	CH,"	"
	JRST	SKPBL2
	POPJ	PP,		;RETURN N0N-BLANK/TAB CHAR. IN CH.


;GETCHR PUTS NEXT CHAR. IN CH.  INCREMENTS CHAR
;POSITION COUNTER. NULLS AND CR'S ARE BYPASSED.
;LOWER CASE ALPHABETICS ARE CONVERTED TO UPPERCASE.
;VT AND FF ARE CONVERTED TO LF

GETCHR:	TTCALL	4,CH		;GET NEXT CHARACTER INTO CH
	JUMPE	CH,GETCHR	;SKIP NULLS
	CAIN	CH,15		;SKIP CARR RET'S
	JRST	GETCHR
	CAIL	CH,141		;[20] LOWER CASE "A"
	CAILE	CH,202		;[20] LOWER CASE "Z"
	CAIA			;[20] NOT LOWER CASE
	SUBI	CH,40		;[20] LOWER CASE, CONVERT TO UPPER CASE
	CAIE	CH,13		;CONVRT VT & FF TO LF
	CAIN	CH,14
	MOVEI	CH,12
	CAIE	CH,12		;LF ?
	AOSA	SW		;NO, SO INCREMENT CHAR COUNT
	POPJ	PP,
	CAIN	CH,"	"	;CHECK FOR TAB
	ORI	SW,7		;TAB SEEN. FIX UP POSITION CTR
	POPJ	PP,


;EOLCHK SKIPS INITIAL BLANKS/TABS AND GIVES SKIP RETURN
;   IF NEXT CHAR. IS NOT A LF OR AN ALTMODE (33,175,176).
;   SETS ALTFLG AND ECHOS 3 BLANKS IF ALTMODE FOUND.

EOLCHK:	PUSHJ	PP,SKPBLN	;SKIP BLANKS ETC.
	CAIN	CH,12		;LF ?
	POPJ	PP,
	CAIE	CH,33		;ESC?
	CAIN	CH,175		;ANY FLAVOR OF ESC WILL DO
	JRST	EOLCH2
	CAIN	CH,176
	JRST	EOLCH2
	AOS	0(PP)		;SKIP RETURN
	POPJ	PP,

EOLCH2:	SWON	ALTFLG		;SET ALT-MODE SEEN
	TTCALL	3,[ASCIZ "   "]
	POPJ	PP,

;GATOM GETS A STRING OF COBOL CHARACTERS THROUGH
;THE NEXT NON-ALPHA-NUMERIC-(- AND .) AND RETURNS THEM
;PACKED INTO SIXBIT IN (TE-TA).   DASHES ARE
;CONVERTED TO COLONS.  SCAN OFF, BUT IGNORE CHARACTERS
;IN EXCESS OF 30.
;C(TE)  CAN BE TESTED (=0 ?) TO SEE IF STRING IS EMPTY.

GATOM:	PUSHJ	PP,SKPBLN	;SCAN TO NON-BLANK
	SETZB	TA,TB		;ZERO THE RETURN VALUES
	SETZB	TC,TD
	SETZI	TE,
	MOVE	TF,[POINT 6,TE]

;LOOP FOR EACH CHARACTER

GATOM3:	CAIN	CH,"-"
	MOVEI	CH,":"
	CAIL	CH,"0"		;TEST FOR ALPH-NUMERICS
	CAILE	CH,"Z"
	POPJ	PP,		;OUT OF SIGHT
	CAILE	CH,":"
	CAIL	CH,"A"
	JRST	GATOM4		;LEGAL CHAR.
	POPJ	PP,		;NOT LEGAL CHAR.

GATOM4:	ADDI	CH,40		;CONVERT ASCII TO SIXBIT
	CAME	TF,[POINT 6,TA,35]	;IGNORE CHARS. IN EXCEES OF 30
	IDPB	CH,TF		;DEPOSIT CHAR. IN C(TE-TA)
	PUSHJ	PP,GETCHR
	JRST	GATOM3


;GETNUM INTERPRETS THE NEXT NON-BLANK CHARS. AS
;A (POSSIBLY) SIGNED INTEGER AND RETURNS ITS VALUE IN W2.

GETNUM:	SETZB	W2,SIGNSW	;[24]
	PUSHJ	PP,SKPBLN	;SKIP INITIAL BLANK/TABS IF ANY
	CAIE	CH,"-"		;[24]NEGATIVE?
	JRST	GETNU1		;[24]NO
	SETOM	SIGNSW		;[24]REMEMBER NEGATIVE SIGN
	JRST	GETNU2		;[24]
GETNU1:	CAIN	CH,"+"		;[24]POSITIVE?

GETNU2:	PUSHJ	PP,GETCHR	;[24]YES, GET NEXT CHAR.
	CAIL	CH,"0"
	CAILE	CH,"9"
	JRST	GETNU4		;[24]NON-NUMERIC.  DONE.
	IMULI	W2,^D10
	ADDI	W2,-60(CH)	;CONVERT ASCII TO AN INTEGER AND ADD
	JRST	GETNU2

GETNU4:	SKIPE	SIGNSW		;[24]DID WE SEE "-"?
	MOVN	W2,W2		;[24]YEP
	POPJ	PP,		;[24]RETURN

;GETNAM SEARCHES NAMTAB FOR AN ENTRY THE SAME AS C(TE-TA).
;RETURNS POINTER TO ENTRY IN TF. OTHERWISE RETURN
;PTR TO ENTRY IF C(TE-TA) IS INITIAL SEGMENT OF ONLY
;THAT ENTRY (PRINTS ERROR MESSAGE IF TWO SUCH ENTRIES).
;FAILING ALL THAT RETURN 0.

GETNAM:	SKIPN	@%DT		;[26]ARE SYMBOLS AVAILABLE?
	ERR	"NO SYMBOLS"

	SWOFF	NUIFLG		;CLEAR NOT UNIQUE INITIAL SEGMENT FLAG
	MOVEI	W2,5		;MAKE (TH)=# FULL WORDS IN (TE-TA)
	SETOI	TI,
	SKIPN	TJ,TE-1(W2)
	SOJA	W2,.-1
	LSH	TI,-6		;W2 HAS LENGTH OF SYMBOL TYPED
	TDNE	TJ,TI		;MAKE TI A MASK FOR TRAILING BLANKS OF PARTIAL WORD
	JRST	.-2
	HRRZ	TF,@%NM		;MAKE TF POINT AT HDR OF NAMTAB ENTRIES
	AOSA	TF		;LH(TF) IS PTR TO FIRST MATCHING PROPER INT. SEG
				;(=0, IF NONE YET)

GETNM2:	ADDI	TF,1(TG)	;GET NEXT ENTRY
	HLRZ	TG,(TF)		;TG=LH(HDR)
	JUMPE	TG,GETNM5	;JUMP IF THRU TABLE
	CAMLE	W2,TG		;DON'T BOTHER IFUSER SYMBOL LARGER
	JRST	GETNM2
	HRRZI	TK,(TF)		;INITIALIZE LOOP TO COMPARE (TE-TA) WITH ENTRY
	SETZI	TH,
GETNM3:	ADDI	TK,1
	MOVE	TJ,(TK)		;GET NEXT SIXBIT WORD FROM ENTRY
	CAME	TJ,TE(TH)
	JRST	GETNM4		;SYMBOL DOESN'T MATCH
	CAIGE	TH,-1(TG)
	AOJA	TH,GETNM3
	CAIE	TG,5
	SKIPN	TE+1(TH)
	POPJ	PP,		;SUCCESS
	JRST	GETNM2		;C(TE-TA) LONGER THAN CURRENT ENTRY

GETNM4:	MOVE	TK,TE(TH)	;TRY MASK ONLY IF C(TE(TH)) IS PARTIAL WORD
	JUMPE	TK,GETNM6
	TRNE	TK,77
	JRST	GETNM2		;FAILED ON FULL WORD FROM TE-TA
	ANDCM	TJ,TI		;MASK OUT TRAILING CHARS.
	CAME	TJ,TE(TH)
	JRST	GETNM2		;NOT INITIAL SEGMENT
GETNM6:	TLNE	TF,-1		;YES
	SWONS	NUIFLG		;WE HAVE SEEN AT LEAST 2 INIT. SEG.
	HRLS	TF		;SAVE PTR TO MATCHING INITIAL SEGMENT
	JRST	GETNM2

GETNM5:	TSWF	NUIFLG		;THRU TABLE
	ERR	"MATCHES INITIAL SEGMENTS OF 2 SYMBOLS"
	HLRZS	TF
	POPJ	PP,

;PUTERR OUTPUTS ^ PRECEDED (OR FOLLOWED BY) AN ERROR
;   MESSAGE TO POINT AT A SYNTAX ERROR ON USERS LINE ABOVE
;CALL:	JSP	TA,PUTERR
;	ASCIZ	/ERROR MESSAGE OF YOUR CHOICE/
;RETURNS TO XECUTX TO RESTART DEBUGGER

PUTERR:	HRRZ	TB,SW		;LOAD CHAR. POSITION FO LAST USED CHAR.
PUT1A:	PUSHJ	PP,EOLCHK
	JRST	PUT1B
	PUSHJ	PP,GETCHR
	JRST	PUT1A
PUT1B:	TSWF	ALTFLG
	TTCALL	3,CRLF		;NEED CRLF IF ALTMODE TYPED.
	HRRZ	TC,TA		;TC WILL CONTAIN BPTR TO MESSAGE
	HRLI	TC,(POINT 7,0)	
	MOVEI	TD,2
	ILDB	TE,TC
	SKIPE	TE
	AOJA	TD,.-2
	CAMLE	TD,TB		;COMPARE MESSAGE LENGTH WITH CHAR. POSITION
	SOJA	TB,PUTER2	;JUMP IF MESSAGE TOO LONG TO GO IN FRONT OF ^ .
	SUB	TB,TD		;MESSAGE SHORT ENOUGH TO GO IN FRONT OF ^
	JUMPE	TB,PUT2
PUT1:	TTCALL	1,[EXP "?"]	;PRINT "?" AT FRONT OF LINE
	SOJLE	TB,PUT2
PUT0:	TTCALL	1,[EXP " "]	;PRINT ENOUGH BLANKS IN FRONT OF MESSAGE
	SOJG	TB,PUT0
PUT2:	TTCALL	3,(TA)		;PRINT MESSAGE
	TTCALL	3,[ASCIZ " ^"]
	JRST	XECUTX		;RETURN TO MAIN LOOP

PUTER2:	TTCALL	1,[EXP "?"]	;"?" BEFORE ERROR MESSAGE
	SOJLE	TB,PUTER4
PUTER3:	TTCALL	1,[EXP " "]	;MESSAGE TOO LONG.  HAS TO GO AFTER ^
	SOJG	TB,PUTER3	;PRINT BLANKS BEFORE ^
PUTER4:	TTCALL	3,[ASCIZ "^ "]
	TTCALL	3,(TA)		;PRINT MESSAGE
	JRST	XECUTX


;SPECIAL TREATMENT FOR "TALLY" IN COBOL-68
;BYPASSES THE ENTIRE DISPATCH FUNCTION (BOTH OF THEM).
;EXECUTES THE ACCEPT OR DISPLAY AND GOES BACK FOR THE NEXT COMMAND

DOTAL:	MOVE	W1,COMTAB(W1)	;[26]GET COMMAND
	CAMN	W1,[SIXBIT /ACCEPT/] ;[26]
	JRST	DOTAL1
	CAME	W1,[SIXBIT /DISPLAY/]
	ERR	("ILLEGAL COMMAND")

;DISPLAY TALLY

	MOVE	TE,TALLY.##	;GET CONTENTS OF TALLY
	JUMPGE	TE,DOTAL0	;NEGATIVE?
	MOVEI	CH,"-"		;PRINT MINUS SIGN
	TTCALL	1,CH
	MOVM	TE,TE		;MAGNITUDE
DOTAL0:	PUSHJ	PP,PRNUM	;PRINT NUMBER
	JRST	DECOD

;ACCEPT TALLY

DOTAL1:	MOVSI	TE,6005		;PARAMETERS FOR LIBOL ACCEPT 
	MOVEI	16,TE		;GET VALUE FROM USER
	PUSHJ	PP,ACEPT.
	MOVEM	1,TALLY.##	;PUT LOW ORDER 5 DIGITS IN TALLY
	JRST	DECOD0

;MESSAGE TYPED UPON STARTING COBDDT

STRTUP:	ASCIZ "
STARTING COBOL DDT
"

;IMPURE AREA

INTERNAL PTFLG.

PTFLG.:	BLOCK 1		;NON-ZERO IF WE ARE TRACING
BRKONO:	BLOCK 1		;IF NON ZERO BREAK WHEN WE BRING AN OVERLAY IN.
EBRKOV:	BLOCK	1	;ENTRY POINT ADDRESS OF THE OVERLAY WE ARE
			; BREAKING ON.
SUBSPR:	BLOCK 1		;IF NON ZERO THERE ARE SUBROUTINES PRESENT.
CUREPA:	BLOCK 1		;CURRENT ENTRY POINT'S ADDRESS.
CBLIO.:	BLOCK 1		;ADDRESS OF 'RESET.' ROUTINE
PROGST:	BLOCK 1		;STARTING ADDRESS OF COBOL PROGRAM
NSUBS:	BLOCK 1		;NUMBER OF SUBSCRIPTS TYPED
SUB0.:	BLOCK 3		;PLACE FOR SUBS
SAV.TA:			;PLACE TO SAVE "TA" IN BCOM
SAVDT:	BLOCK 1		;PLACE TO SAVE "DT"
FLGS.:	BLOCK 1		;PLACE TO SAVE PROCESSOR FLAGS
TEMP1:			;TEMP STORAGE FOR BP CODE
EAC:	BLOCK 1		;AC NUMBER FOR ASSEMBLY
TEMP2:			;TEMP STORAGE FOR BP CODE
REMAN:	BLOCK 1		;TEMP STORAGE USED IN SUBSCR CALC
SIGNSW:	Z		;[24]REMEMBERS LEADING SIGN ON INTEGER

BASEA:	BLOCK 1		;ADDR OF "A" OPERAND (RH)
RESA==BASEA		;BYTE RESIDUE FOR "A" (LH)
INCRA:	BLOCK 1		;OFFSET FOR "A"
SIZEA:	BLOCK 1		;SIZE OF "A"
MODEA:	BLOCK 1		;USAGE OF "A"
DPLA:	BLOCK 1		;DECIMAL PLACES IN "A"

BASEB:	BLOCK 1		;ADDR OF "B" OPERAND (RH)
RESB==BASEB		;BYTE RESIDUE FOR "B" (LH)
INCRB:	BLOCK 1		;OFFSET FOR "B"
SIZEB:	BLOCK 1		;SIZE OF "B"
MODEB:	BLOCK 1		;USAGE OF "B"
DPLB:	BLOCK 1		;DECIMAL PLACES IN "B"

BASEX==0		;OFFSET OF BASE
RESX==0			;OFFSET OF RESIDUE
INCRX==1		;OFFSET OF OFFSET
SIZEX==2		;OFFSET OF SIZE
MODEX==3		;OFFSET OF USAGE
DPLX==4			;OFFSET OF DECIMAL PLACES

SAVEA:	BLOCK DPLX+1	;PLACE TO SAVE "A" PARAMETERS
SAVEB:	BLOCK DPLX+1	;PLACE TO SAVE "B" PARAMETERS
SAVMA:	BLOCK 2*DPLX+2	;PLACE TO SAVE PARAMETERS DURING MOVES
SAVMB=SAVMA+DPLX+1

SAVAX==SAVEA+DPLX
SAVBX==SAVEB+DPLX
BASAX==BASEA+DPLX
BASBX==BASEB+DPLX
SVMAX==SAVMA+DPLX
SVMBX==SAVMB+DPLX

;BREAK POINT IMPURE AREA

BCOM2:	BLOCK 1		;USED INDIRECT FOR PROCEED CNTR
BCOM3:	BLOCK 1		;USED INDIRECT FOR SECTION NAME
LEAV1:	XWD Z,LEAV	;USED JRST @ TO DISMISS
LEAV:	Z		;HOLDS USER OR OTHER DISMISS INSTR
	JRST	@BCOM	;IF INSTR HOPS
	AOS	BCOM	;IF INSTR SKIPS
	JRST	@BCOM

CUR.BP:	BLOCK 1		;HOLDS CURRENT BP (0 IF VIRGIN)
LAST.:	BLOCK 1		;HOLDS LAST DATA ITEM IN ACCEPT ETC.
SAVSUB:	BLOCK 4		;HOLDS SUBSCRIPT INFO AS ABOVE

DEFINE BP (D) <
IRP (D),<
BP'D:	Z		; JSR ENTRY FOR BREAKPOINT D
	JSA TA,BCOM	; INVOKE BP LOGIC
B'D'INS:	Z		; ORIGINAL INSTR AT BP D
>>

DEFINE BA (D) <
IRP (D),<
B'D'ADR:	Z	; PNTR TOP PROTAB FOR BP'D
B'D'SEC:	Z	; CURRENT ENTRY POINT ADDRESS (LH) AND
			; SECTION NAME PNTR (RH) FOR BP'D
B'D'CNT:	Z	; PROCEED COUNT FOR BP'D
>>

;BREAK POIN CONSTANTS

LBP==3
LBA==3
NBP==^D20

BP (<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20>)
BPN==.-LBP	;ADDR OF LAST BP ENTRY
PAGE
BA (<1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20>)
BNADR==.-LBA

CBPADS:	BLOCK 2		;PNTR TOP PROTAB AND SECTION NAME FOR CURRENT BP.
CBREE.:	PUSH	PP,TA		; [21] GET AN ACC
CBREEA:	OUTSTR	[ASCIZ	/Do you want to enter COBDDT? (Y or N)	/]
	INCHRW	TA		; [21] GET RESPONCE
	CAIE	TA,"Y"		; [21] LOOK FOR Y
	CAIN	TA,"y"		; [21] ALLOW LOWER CASE ALSO
	JRST	CBREEC		; [21] MATCH
	CAIE	TA,"N"		; [21] LOOK FOR N
	CAIN	TA,"n"		; [25] ALLOW LOWER CASE ALSO
	JRST	CBREED		; [21] MATCH
	OUTSTR	CRLF		; [21] NEITHER
	JRST	CBREEA		; [21] TRY AGAIN

CBREEC:	POP	PP,TA		; [21]
	SETZM	STPCTR		;[26]CLEAR STEP COUNTER ON REENTER
	SETOM	REEBRK		; [21] SAY WE WANT TO BREAK ON NEXT ENTER
	JRST	@.JBOPC##	; [21] AND CONTINUE AS PLANNED

CBREED:	POP	PP,TA		; [21] NO
	JRST	@RRDMP		; [21] ASSUME USER WANTED RERUN DUMP

;CODE GENERATION IMPURE AREAS

TEMPC:	BLOCK 1			;OFFSET IN TEMP
	CODFST==.		;FIRST LOC TO CLEAR
TEMROL:				;TEMP STORAGE

CBDDT.:	;START ADDR OF COBDDT, FOR USER PROGRAM

INIT.:	;;; ONCE-ONLY INITIALIZATION


	MOVEM	TA,PROGST	; SAVE ADDR OF BEGINNING OF USER PROG
	AOS	PROGST		;SKIP XWD PARAMETER
	HRRZ	TA,(TA)		;GET ADDR OF MAIN PROGRAM

	PUSHJ	PP,SETETY	;SET UP TABLE OF ENTRY POINT ADDRESSES.
	SUBI	NM,	ETYTAB		;FORM AN AOBJN TYPE POINTER FOR
	MOVNI	NM,	(NM)		; THE TABLE.
	HRLI	NM,	ETYTAB
	MOVSM	NM,	ETYPTS		;SAVE IT.
	SETZM		SUBSPR
	CAME	NM,	[XWD ETYTAB,-1]
	SETOM		SUBSPR

	MOVEI	16,%NM		;GET ADDRESSES OF %NM., %DT., %PR.
	PUSHJ	PP,GETNM.
	MOVE	TA,%NM		;GET ADDRESS ON %NM
	PUSH	PP,%COBVR-%%NM.(TA)
	POP	PP,COBVR	;COPY VERSION NUMBER
	MOVE	TA,%COBSW-%%NM.(TA)
	MOVEM	TA,COBSW	;COPY COMPILER SWITCHES
	TRNE	TA,1		;COBOL-74?
	SETOM	C74FLG		;YES

	MOVEM	PP,PDL.
	SETZM	LAST.
	SETZM	CUR.BP
	SETZM	DIED.
	SETZM	L.SECT
	SETZM	PTFLG.
	SETZM	BRKONO
	MOVE	TA,	ETYTAB
	MOVEM	TA,	CUREPA
	HRLZI	TA,	'TTY'
	MOVEM	TA,	HSTDEV
	SETZM		HFTBST
	SETZM		HFINIT
	SETZM		HFGTHR
	SETOM		HFGTST
	MOVE	TA,.JBREN##	; [21] GET RERUN DUMP ADDRESS
	MOVEM	TA,RRDMP	; [21] SAVE IT
	MOVEI	TA,CBREE.	; [21] REENTER ADDRESS
	MOVEM	TA,.JBREN	; [21] ESTABLISH IT
	MOVE	TA,INIT.9	;ZERO THE BREAKPOINTS
	SETZM	B1ADR
	BLT	TA,BNADR+LBA-1
	TTCALL	3,STRTUP
;PREVENT DOING A START AGAIN, EXCEPT TO GET INTO COBDDT.
	MOVEI	TA,[	SETOM	DIED.
			TTCALL	3,STRTUP
			JRST	XECUTX]
	HRRM	TA,.JBSA
	MOVE	TA,@%NM		; [13] ADDR OF %NM
	MOVEM	TA,PNM		; [13] STORE INTO PROCEED 
	MOVEM	TA,BNM		; [13] STORE INTO BREAK
	MOVE	TA,@%DT		; [13] ADDR OF %DT
	MOVEM	TA,PDT		; [13] STORE INTO PROCEED 
	MOVEM	TA,BDT		; [13] STORE INTO BREAK
	MOVE	TA,@%PR		; [13] ADDR OF %PR
	MOVEM	TA,PPR		; [13] STORE INTO PROCEED 
	MOVEM	TA,BPR		; [13] STORE INTO BREAK
	JRST	XECUTX

INIT.9:	XWD	B1ADR,B1ADR+1
;SET UP TABLE OF MAIN ENTRY POINT ADDRESSES FOR ALL RESIDENT SUBROUTINES.
; ENTER WITH ADDRESS OF MAIN PROGRAM'S ENTRY POINT IN TA.

SETETY:	MOVEI	NM,	ETYTAB		;POINT AT THE TABLE.
SETETD:	HRRZ	TB,	(TA)		;IF THE INSTRUCTION AT THE
	JUMPE	TB,	SETETH		; ENTRY POINT ISN'T "SKIPA 0,0",
	SKIPE		OVLCHS		; THE MODULE IS PROBABLY IN A
	POPJ	PP,			; LINK-10 OVERLAY.
	ADDI	TA,	1		;IF WE ALREADY HAVE THE ADDRESS
	MOVE	TB,	JT.FLG(TA)	; OF THE CONTROL HEADER SECTION
	TLNE	TB,	F.MDL		; FOR THE ROOT SEGMENT, LEAVE.
	HRRZ	TA,	JT.MDL(TA)	;OTHERWISE PICK IT UP.
	HRRZ	TA,	JT.CST(TA)
	MOVEM	TA,	OVLCHS
	POPJ	PP,
SETETH:	HRRZ	TB,	-2(TA)		;GET LINK TO MAIN ENTRY POINT.
	TRNE	TB,	-1		;WERE WE AT THE MAIN ENTRY POINT?
	HRRZI	TA,	(TB)		;NO, BUT WE ARE NOW.
	MOVE	TB,	1(TA)		;GET THE ADDR OF %FILES.
	SKIPGE		%%NM.(TB)	;IF WE HAVE ALREADY DONE THIS
	POPJ	PP,			; MODULE LEAVE.
	CAILE	NM,	ETYTAB+^D100	;IF THERE ISN'T ANY MORE ROOM, COMPLAIN.
	JRST	[OUTSTR	[ASCIZ	/
?TOO MANY SUBROUTINES FOR COBDDT TO COPE WITH.  PLEASE COMBINE SOME OF
?THEM SO THAT THERE ARE LESS THAN 100 MODULES./]
		CALLI	12]
	HRROS		%%NM.(TB)	;MARK THIS MODULE AS DONE.
	HRRZM	TA,	(NM)		;STASH THE ENTRY POINT'S ADDRESS.
	ADDI	NM,	1		;MOVE UP TO NEXT LOC IN THE TABLE.
	HLRZ	TB,	1(TA)		;GET THE ADDRESS OF THE LIST
					; OF PROGRAMS CALLED BY THIS MODULE.
SETETP:	SKIPN	TA,	(TB)		;DOES THIS MODULE CALL ANYONE?
	POPJ	PP,			;NO, RETURN.
	PUSH	PP,	TB		;SAVE POINTER TO LIST.
	PUSHJ	PP,	SETETD		;CURSE AND RECURSE.
	POP	PP,	TB		;GET THE POINTER BACK.
	AOJA	TB,	SETETP		;GO SEE IF THERE ARE MORE.
IFL <N.TMP-.+TEMROL>,<PRINTX DRYROT!!!>
IFGE <N.TMP-.+TEMROL>,<BLOCK <N.TMP-.+TEMROL>>

CODROL:	BLOCK N.COD		;CODE ROLL
LITROL:	BLOCK N.LIT		;LITERAL POOL
	CODLST==.-1		;LAST LOC TO CLEAR

C74FLG:	Z			;-1 IF COBOL-74 MAIN PROGRAM

REEBRK:	Z			; [21] -1 SAYS BREAK TO C.TRCE
				;USED BY ^C/REENTER AND STEP CODE.
REEFLG:	BLOCK	1		; [21] STACK ADDRESS FOR PROCEED
STPCTR:	BLOCK	1		;[26]NO. OF STEPS TO BYPASS
				;BEFORE NEXT BREAK, WHEN STEPPING.
RRDMP:	BLOCK	1		; [21] SAVE RERUN DUMP REENTER ADDRESS

AC0:	BLOCK	20
PDL.:	BLOCK	1		;PUSH DOWN POINTER
DIED.:	BLOCK	1		;FLAG FOR EX DEATH
L.PARA:	BLOCK	1		;PLACE TO SAVE LAST PARA
L.SECT:	BLOCK	1		;PLACE TO SAVE LAST SECTION

ETYPTS:	BLOCK	1		;POINTER INTO THE TABLE BELOW.
ETYTAB:	BLOCK	^D100		;ADDRESSES OF MAIN ENTRY POINTS FOR ALL MODULES.
NMSVD:	Z			;PLACE TO SAVE THE ADDRESS OF AN ENTRY POINT IN ETYTAB.
OVRLHD:	Z			;POINTER TO LIST OF OVERLAY BLOCKS.
OVLCHS:	Z			;ADDRESS OF CONTROL HEADER SECTION FOR
				; THE ROOT LINK.

;THE FOLLOWING THREE ITEMS CONTAIN THE ADDRESSES OF %NM., %DT., %PR.
;  IN THAT ORDER

%NM:	BLOCK	1	;ADDR OF %NM.
%DT:	BLOCK	1	;ADDR OF %DT.
%PR:	BLOCK	1	;ADDR OF %PR.
COBVR:	BLOCK	1	;COBOL VERSION
COBSW:	BLOCK	1	;COMPILER ASSEMBLY SWITCHES

PNM:	BLOCK	1 	; [13] RUN-TIME NM
PDT:	BLOCK	1 	; [13] RUN-TIME DT
PPR:	BLOCK	1 	; [13] RUN-TIME PR
BNM:	BLOCK	1 	; [13] BREAK NM
BDT:	BLOCK	1 	; [13] BREAK DT
BPR:	BLOCK	1 	; [13] BREAK PR



	END