;
;
;COPYRIGHT (C) 1975,1981,1982 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.
;
;
	SUBTTL ASSEMBLY SWITCHES AND GLOBALS


	SEARCH ALGPRM,ALGSYS	; SEARCH PARAMETER FILES

	.GTLIM=40		; [243] GETTAB INDEX FOR BATCH STATUS
	JB.LBT=200		; [243] "I'M A BATCH JOB" BIT IN GETTAB 40

	SALL

	%TITLE(ALGDDT,ALGOL OBJECT TIME SYSTEM DEBUGGING ROUTINES)
	INTERNAL .JBOPS

	IF2, <
	IFN FTDDT, <PRINTX Debugging system loaded.>
	IFE FTDDT, <PRINTX Debugging system not loaded.>>

	EXTERNAL .JBUUO,.JBREL,.JBHRL,.JBSA,.JBSYM,.JBAPR,.JBCNI,.JBTPC,.JBOPC
	EXTERNAL .JBINT,.JBDDT
	EXTERNAL CRLF%,IPRNT%,DPRNT%,PRFPR%,STSPR%,CNCTR%,DDCON%,DDFIN%,DDBEG%
	EXTERNAL SPACE%,%ALGDR,RSTRT%,FLABL%
	INTERNAL %ALGDD,BREAK%,DDERM%,DDTER%,DDTIN%,DDTOU%,DUMP%
	ENTRY	%ALGDD

	MLON
	SUBTTL DELOCATE PUSH AND RELOCATE POP MACROS

	DEFINE DPUSH(A)
<	SUBI	A,(DB)
	PUSH	SP,A
>

	DEFINE RPOP(A)
<	POP	SP,A
	ADDI	A,(DB)
>

	EDIT(232)

;[232]; RE-DEFINE DOUBLE-LENGTH LOAD/STORE FOR OTS KA/KI INDEPENDENCE
;[232]
;[232]	DEFINE	LRLOAD(A,B),<
;[232]	MOVE	A,B
;[232]	MOVE	1+A,1+B
;[232]>
;[232]
;[232]	DEFINE	LRSTOR(A,B),<
;[232]	MOVEM	A,B
;[232]	MOVEM	1+A,1+B
;[232]>

	OPDEF	X	[POPJ	SP,0]	; Make return to ALGDDT from regular
	OPDEF	Y	[JRSTF	@.JBOPC]; DDT easier (just type X$X)
	SUBTTL	Debugging system - Definitions.

	DDNEST==^D26		; depth of nesting of autolists.

	; Flags - in AC13 = FL.
	; Left half are temporary, for life of 1 DDT command.
	; Right half are more permanent.
	; Bits 28-35 are width of TTY line.
	; Bits 18-20 are action code for errors in autolists.

	DDTTYW==377		; MASK.
	DDTTYL==400		; 1= Lower Case available.
	DDTTYH==1000		; 1= Half Duplex TTY.
	DDTTYT==2000		; 1= TTY has Hardware Tabs.
	DDALIP==4000		; 1 = Inputting an auto-list.
	DDALST==10000		; 1 = Processing an auto-list.
	DDINDF==20000		; 1 = Processing an indirect file.

	; Left half.

	DDSUBS==400000		; 1= subscript typed.
	DDBYTS==200000		; 1= Byte Subscript typed.
	DD%FLG==100000		; 1= % typed on front of identifier (e.g. %DB).
	DDSLIC==40000		; 1= Array Slice requested (ARRY[*,2]).
	DDMTYP==10000		; 1= Doing a multi-variable typeout.
	DDTMP1==4000		; Temp.
	DDTMP2==2000		; Temp.
	DDMTY2==1000		 ; Used in multi-variable typeout.
	DDMPSC==400		; Scalars option to DUMP command.
	DDGTMP==200		; Temp for DDGTCH.
	; Accumulators.

	FL==A13			; Flags.
	; A4 is current or last char read from TTY:, during cmd scanner etc.
	; A6 is lexeme of current object (SYM).
	; A12 is autolist input pointer, when inputting a/l.

	; Characters.

	.CONT==37		; Continuation - control-backarrow.
	.QUERY=="?"		; Give full error message.
	.BYTES==200		; Pseudo-character for .[ (byte-subscript)
	.DEL==177		; Delete.
	.CTRLU==25		; Line delete (Control-U).
	.CTRLR==22		; Re-type input line.
	.CR==15
	.FF==14
	.VT==13
	.LF==12
	.HT==11			; Must not change !!
	.SPACE==" "		; Nor must this (code at DDGT3 depends).
	.ESC==33		; Altmode.
	.SCOL==";"
	.COMMA==","
	.LBRA=="["
	.RBRA=="]"
	.LPAR=="("
	.RPAR==")"
	.COLON==":"
	.AST=="*"
	.ASIGN=="_"		; Returned in A4 for ":=" also.
	.ZERO=="0"
	.SEVEN=="7"
	.EIGHT=="8"
	.NINE=="9"
	.PRCNT=="%"
	.DOLLR=="$"
	.HASH=="#"
	.SQUOTE=="'"
	.DQUOTE==""""
	.EQU=="="
	.PLUS=="+"
	.MINUS=="-"
	.SLASH=="/"
	.BSLSH=="\"
	.COMNT=="!"		; Introduces a comment.
	.A=="A"
	.F=="F"
	.S=="S"
	.T=="T"
	.Z=="Z"
	.LCA=="a"		; Lower-case.
	.LCZ=="z"		; Lower-case.
	.DOT=="."
	.AT=="@"


	; Bits in AC returned from GETLCH UUO (get TTY characteristics)

	GL.LCM==20
	GL.HDP==10000
	GL.TAB==10
	GL.LCP==4
	; Define Decrement Byte Pointer macro.
	; DBP Scratch-AC,Pointer,Size

DEFINE	DBP	(SCR,PTR,SIZE<7>,%A) <
	LDB	SCR,[
	POINT	6,PTR,5]	;; GET P-FIELD
	ADDI	SCR,SIZE
	CAIE	SCR,^D36	;; NEED PREVIOUS WORD ?
	  JRST	%A		;; NO
	SOS	PTR		;; YES - GET IT
	MOVEI	SCR,<^D36-<^D36/SIZE*SIZE>> ;; CALCULATE NEW P

%A:	DPB	SCR,[
	POINT	6,PTR,5]	;; SET P
>


	; Bits in l.h. of word 1 (BP.FLG) of breakpoint control block.

	BP.PSH==400000		; 1 = displaced instruction is a PUSHJ SP,
	BP.OCT==200000		; 1 = octal address, not line number
	BP.SIL==100000		; 1 = silent b/p (/silent)
	BP.PRO==40000		; 1 = procedure name, not line number
	BP.LAB==20000		; 1 = label name, not line number
	BP.PRI==10000		; 1 = private autolist.
	BP.ACT==7000		; mask for action-code (action on a/l error)
	BP.NXT==400		; 'NEXT' command.
	BP.STN==377		; mask for statement # (left half)

	; Words in breakpoint control block.

	BP.PTR==0		; xwd addr of module's LINK s.t.entry,
				;   addr of BLKIDX entry.
	BP.FLG==1		; left-half = flags, and statement #
	BP.LIN==1		; right half = line #, or ptr to SYM
				;   item if label or proc, or octal address.
	BP.CNT==2		; proceed-count
	BP.LIM==3		; Breakpoint activation upper limit
	BP.ALP==4		; xwd address of entry in b/p table,
				;   pointer to autolist, if private, or
				;      pointer to a/l list slot if public.
	BP.LNK==5		; Link to companion breakpoint, if 'NEXT'
	BP.INS==6		; displaced instruction (maybe first of sequence)

	DD.LPW==^D132		; width of line-printer line.
	DD.BTW==DD.LPW-^D16	; width of batch log line.
	SUBTTL	Common routines - DDT,KA10,KI10,ONTRACE,OFFTRACE action routines.

DDTDDT:	SKIPN	A3,.JBDDT		; IF REGULAR DDT IS LOADED
	  JRST	DDNODD			; NOT
	SETZM	.JBINT			; make sure no ^C intercept.
	OUTSTR	[ASCIZ/
Entering regular DDT. Type X$X to return to ALGOL debugger.
/]
	JRST	(A3)

DDNODD:	OUTSTR	[ASCIZ/
Regular DDT is not loaded.
/]
	POPJ	SP,

	; Processor type-change switches (simulation)
	; NOT documented!

DDONTR:	TLO	DB,STMTST
	POPJ	SP,

DDOFTR:	TLZ	DB,STMTST
	POPJ	SP,

	EDIT	(241)		; [241] DON'T LET ALGDDT START IF JACCT IS ON
;[241]	THIS SUBROUTINE CHECKS TO SEE IF THE JACCT BIT IS SET.  IF
;[241]	IT IS, AN ERROR MESSAGE IS TYPED AND THE PROGRAM ABORTS.  OTHERWISE
;[241]	THE SUBROUTINE RETURNS TO THE CALLING ROUTINE.  A6 IS ALTERED.
;[241]
CHKJCT:	HRROI	A6,0		; [241] SET UP A6 TO GETTAB PRIVS FOR OUR JOB
	GETTAB	A6,		; [241] GET PRIV WORD
GTBERR:	PORTAL	[OUTSTR [ASCIZ/
?GETTAB TO READ JACCT PRIVILEGE BIT FAILED
%Please contact your system manager
/]  ;[303]
		MOVEI	A6,GTBERR	; [241] LOAD REENTER ADDRESS
		MOVEM	A6,.JBREN	; [241] MAKE REENTER COME HERE
		EXIT]			; [241] EXIT AFTER GETTAB FAILS
	TLNN	A6,1		; [241] IS THE JACCT BIT SET FOR THIS PROG?
	AOS	(SP)		; [241] NO, PREPARE FOR SKIP RETURN
	POPJ	SP,		; [241] RETURN TO CALLING ROUTINE

PRVERR:	MOVEI	A6,PRVREN		; [241] LOAD REENTER ADDRESS
	MOVEM	A6,.JBREN		; [241] MAKE REENTER COME HERE
PRVREN:	PORTAL	.+1		; [303] HANDLE EXECUTE-ONLY
	OUTSTR	[ASCIZ/
?FATAL PROGRAM ERROR WHILE RUNNING WITH JACCT BIT SET
%Please contact your system manager
/]
		EXIT		; [241] STOP THE PROGRAM
	SUBTTL	Common routines - Byte I/O and break routines (DDTOU%,DDBRKB)

DDTOU%:	; Enter with address of message in A1 in ASCIZ.
	; Clobbers A1.
DDTOUT:	PUSH	SP,A10
	PUSH	SP,A11
	PUSH	SP,A12
	PUSH	SP,FL
	HRLI	A1,440700		; MAKE A BYTE-POINTER.

DDTOU1:	ILDB	A13,A1
	JUMPE	A13,DDPOP4		; RESTORE AC'S AND EXIT.
	PUSHJ	SP,OUBYTE
	  JFCL
	JRST	DDTOU1

DDBRKB:	; Breakoutput.
	PUSH	SP,A10
	PUSH	SP,A11
	PUSH	SP,A12
	PUSH	SP,FL
	PUSHJ	SP,BRKBYT
	  JFCL

DDPOP4:	POP	SP,FL

DDPOP3:	POP	SP,A12
	POP	SP,A11
	POP	SP,A10
	POPJ	SP,
	SUBTTL	Common routines - UNIQUE keyword scanner.

	; UNIQUE is a general-purpose unique keyword scanner.
	; On entry:
	;	A1 = AOBJN pointer to SIXBIT table of keyowrds.
	;	A2 = pointer to ASCIZ string to lookup.
	; Exits:
	;	Call+1 (no skip)	not found.
	;	Call+2 ( 1 skip)	not unique - A1 points to first entry.
	;					   - A0 is sixbit of typed string.
	;	Call+3 (2 skips)	found. A1 points to entry.
	; A0,(A1),A2,A3 clobbered.
	; Only looks up first 6 characters - table has 1-word entries.

UNIQUE:	HRLI	A2,440700		; MAKE BYTE-POINTER.
	MOVEI	A0,0

UNIQU2:	ILDB	A3,A2			; GET CHARACTER.
	JUMPE	A3,UNIQU1		; END.
	LSH	A0,6
	ADDI	A0,-40(A3)		; FORM 6-BIT IN A0
	TLNN	A0,770000		; 6 CHARS ?
	JRST	UNIQU2			; NO
	SETO	A3,			; MAKE MASK
	JRST	UNIQU3

UNIQU1:	SETO	A3,			; NOT LEFT-JUSTIFIED - MAKE IT SO.
	LSH	A3,6			;  AND MAKE A MASK.
	LSH	A0,6
	TLNN	A0,770000		; LEFT-JUSTIFIED NOW ?
	JRST	UNIQU1+1		; NO.

UNIQU3:	PUSH	SP,[0]
	MOVE	A2,(A1)			; GET TABLE ENTRY.
	AND	A2,A3			; MASK OFF UNTYPED CHARACTERS.
	CAMN	A2,A0			; FOUND ?
	JRST	UNIQU4			; YES.

UNIQU6:	AOBJN	A1,UNIQU3+1		; NO - NEXT ENTRY.
	POP	SP,A1			; DONE - RESCUE POINTER.
	POPJ	SP,			; RETURN. LINK ALREADY ADJUSTED.

UNIQU4:	; Found a match. Is it unique ?
	SKIPE	0(SP)			; FIRST MATCH ?
	  JRST	UNIQU5			; NO - ERROR.
	MOVEM	A1,0(SP)		; YES - SAVE POINTER.
	AOS	-1(SP)			; ADJUST
	AOS	-1(SP)			;  LINK
	JRST	UNIQU6			; AND CONTINUE.

UNIQU5:	POP	SP,A1			; RETRIEVE POINTER TO FIRST MATCH.
	SOS	0(SP)			; DECREMENT LINK
	POPJ	SP,
	SUBTTL	Skeleton ALGDDT (FTDDT=0)

	IFE	FTDDT,<

DDHELP:	OUTSTR	[ASCIZ/

Commands are:

Continue
Finish
Help
Start
Trace
Profile
Statistics
Ontrace
Offtrace

/]
	POPJ	SP,

DDSTART:	CAIE	DL,(DB)
	  JRST	[OUTSTR	[ASCIZ/
?Program has already been STARTed.
/]
	EXIT]
	MOVE	AX,%ACCS+AX(DB)
	JRST	DDBEG%


PR.HST::MOVEI	A7,@DDTDL(DB)		; Get topmost DL
	CAIE	A7,(DL)			; Is DL set to topmost level ?
	OUTSTR	[ASCIZ/during parameter evaluation /]; No - type message
	OUTSTR	[ASCIZ/in /]		;
HSTPR1:	SKIPN	A1,CONDL(A7)		; Main program ?
	JRST	HSTPR5			; Yes
	SKIPN	A3,PMBPTR(A7)		; No - Traced ?
	JRST	HSTPR3			; No - say so
	OUTSTR	[ASCIZ/procedure /]	; say procedure
	MOVEI	A1,2(A3)		; Get start of text
	TLO	A1,(POINT 6)		; Convert to SIXBIT byte pointer
HSTPR2:	ILDB	A3,A1			; Get next character
	JUMPE	A3,HSTPR4		; Done if this is a null
	ADDI	A3,"A"-'A'		; Otherwise convert to ASCII
	OUTCHR	A3			; And type it
	JRST	HSTPR2			; And loop
HSTPR3:	OUTSTR	[ASCIZ/an untraced procedure/]; Say procedure not traced
HSTPR4:	MOVEI	A4,@PRGLNK(A7)		; Get return address
	OUTSTR	[ASCIZ/)
Called from /]				; Tell user where we came from
	HRRZ	A1,CONDL(A7)		; Get 'context' DL
	ADDI	A1,(DB)			; and relocate it
	CAIE	A1,@LINKDL(A7)		; Is this the same ?
	OUTSTR	[ASCIZ/a parametgr of /]; No - tell user
	MOVEI	A7,@LINKDL(A7)		; Follow procedure chain down
	JRST	HSTPR1			; And carry on typeout

HSTPR5:	OUTSTR	[ASCIZ/main program/]	; Final message
	POPJ	SP,			; Return

%ALGDD:	MOVEI	A6,0
	MOVE	A2,[POINT 7,A6]		; LOAD BYTE POINTER TO A6
	OUTSTR	[BYTE(7)15,12,76,0,0]	; TYPE A CR-LF AND RT. ANGLE BKT

INLOOP:	INCHWL	A4		; GET CHARACTER.
	CAIE	A4,.SPACE	; IGNORE SPACES
	CAIN	A4,.HT		;  AND TABS
	  JRST	INLOOP
	CAIN	A4,.CR		; AND CARRIAGE-RETURNS.
	  JRST	INLOOP
	CAILE	A4,.Z		; LOWER-CASE ?
	  SUBI	A4,.LCA-.A	;  MAKE UPPER.
	CAIGE	A4,.SPACE	; ANY OTHER CONTROL CHAR
	  JRST	ALGDD2		;  IS TERMINATOR.
	TRNN	A6,377		; ROOM FOR MORE CHARS ?
	  IDPB	A4,A2		; YES - PUT IN.
	JRST	INLOOP

EDIT(065); Dont loop if a null command is typed
ALGDD2:	JUMPE	A6,%ALGDD	; [E065] IGNORE BLANK LINES
	MOVEI	A2,A6
	MOVEI	A7,0		; ASCIZ !
	MOVE	A1,[
	XWD	-DDCMLN,DDCOMT]
	PUSHJ	SP,UNIQUE	; LOOK UP COMMAND.
	  JRST	SYNERR		; UNKNOWN
	  JRST	SYNERR		; NOT UNIQUE.
	; FOUND - A1 POINTS TO ENTRY.
	MOVE	A1,DDISPT-DDCOMT(A1)	; GET DISPATCH ADDRESS.
	PUSHJ	SP,(A1)		;  AND GO THERE.
	JRST	%ALGDD		; NEXT COMMAND.

SYNERR:	OUTSTR	[ASCIZ/
?Command error. H for help.

/]
	JRST	%ALGDD


DDTIN%:DDERM%:BREAK%:DDTER%:

	OUTSTR[ASCIZ/

?Debugging UUO executed, but debugging system is not loaded.

/]

	EXIT			; ABORT


DDT.CC::DUMP%:	POPJ	SP,	; IGNORE.


GO.NXT::AOJA	AX,CNC.AX##	; GOLAB/FORLAB - RETURN TO PROGRAM
>			; END OF IFE FTDDT.
	SUBTTL	Debugging system - main entry-point and command loop.
	IFN	FTDDT,<

%ALGDD:	PUSHJ	SP,CHKJCT		; [241] CHECK JACCT BIT
	JRST	PRVERR			; [241] JACCT IS ON - PUNT!
	HRRI	A0,DDCCML		; [E1000] [241] CONTINUE IF JACCT IS OFF
	PUSHJ	SP,DDSETI		; [E1000] SET CMD LVL ^C INTERCEPT
	TLO	DB,INDDT		; REMEMBER WE ARE DDT.
	;
	; Ac's have already been saved by fault-monitor.
	;
	;
	Edit(147)  ; Don't assume DL safe over errors in ALGDDT.
	;
	MOVE	A0,SP
	SUBI	A0,(DB)			; DELOCATE STACK-POINTER
	MOVEM	A0,%ACCS+SP(DB)		;  AND SAVE (FOR RESET LATER)
	MOVE	A0,DL			; [E147] Save delocated DL
	SUBI	A0,(DB)			; [E147]	"
	MOVEM	A0,%ACCS+DL(DB)		; [E147]	"
	SKIPN	%DDTST(DB)		; SYMBOL TABLE BEEN READ ?
	PUSHJ	SP,DDINIT		; NO - DO SO.
	SKIPL	%DDTST(DB)		; READ SUCCESSFULLY ?
	  JRST	ALGDD1			; NO.
	SKIPE	A2,%DDTBE(DB)		; ANY CONTEXT YET ?
	JRST	ALGDD1			; YES
	MOVEI	A4,@%SYS0(DB)		; NO - SET UP AS %BEGIN:.
	MOVE	A4,(A4)
	HRRZM	A4,%DDTPC(DB)		; 
	;
	; Note that l.h. %DDTPC should be set up to the delocated DL.
	; But initial DL = DB, so delocated DL = 0, so no action needed !
	;
	PUSHJ	SP,FNDADR
	 DDTERR	^D18			; DISASTER - CAN'T RESOLVE ADDRESS.

ALGDD1:	MOVNI	A2,1			; SET O/P DEVICE = TTY.
	EXCH	A2,%CHAN(DB)
	MOVEM	A2,%DDTTY(DB)
	PUSHJ	SP,DDTTYC		; GET TTY CHARACTERISTICS TO %DDTFL

	; MAIN COMMAND LOOP.

DDTLUP:	HRRZI	A0,DDCONC		; [E1000] SET "ACTION ABANDONED"
	PUSHJ	SP,DDSTI1		; [E1000] ^C INTERCEPT
	SETOM	%DDERD(DB)		; [E1000] CLEAR ANY DETECTED ERROR
	HRRZ	FL,%DDTFL(DB)
	TRNN	FL,DDALST		; EXECUTING AUTOLIST ?
	  JRST	ALGDD2			; NO.
	MOVE	A1,@%DDTIP(DB)		; YES - GET POINTER TO IT
DDTLU1:	TLNE	A1,770000-440000	; POSITIONED CORRECTLY ?
	MOVEI	A1,1(A1)		; NO - ADVANCE TO NEXT WORD
	HRLI	A1,(POINT 7,0)		; SET UP BYTE POINTER
	MOVEM	A1,@%DDTIP(DB)		; AND REWRITE IN MEMORY
	SKIPE	(A1)			; END OF AUTOLIST ?
	JRST	ALGDD4			; NO  - READ COMMAND FROM A/L
	SOS	%DDTIP(DB)		; END OF A/L - GO TO NEXT
	SKIPE	A1,@%DDTIP(DB)		;  (IF THERE IS ONE)
	  JRST	DDTLU1			; THERE IS - USE IT.
	HRROI	FL,DDALST		; OUTERMOST - CLEAR FLAG, AND
	ANDCAB	FL,%DDTFL(DB)		; FALL THROUGH TO READ FROM TTY

ALGDD2:	PUSHJ	SP,DDGTLN		; OUTPUT PROMPT, READ LINE FROM TTY
ALGDD4:	PUSHJ	SP,DDIGCH		; GET FIRST CHARACTER.
	CAIN	A4,.AT
	  JRST	DDIND			; INDIRECT FILE.
	PUSHJ	SP,SCAN4		; GET FIRST FIELD.
	; Identifier is left in buffer %DDTIB(DB).
	; Whole field is in buffer %DDTFB(DB).
	; Pointer to end of ident in above buffer is in A10.
	; Delimiter is in A4 (spaces have been skipped).
	CAIE	A4,.EQU			; IS DELIMITER
	CAIN	A4,.ASIGN		;  AN OPERATOR ?
	JRST	ALGDD3			; YES.

	; No - Identifier should be a command keyword.

	TLNE	FL,DD%FLG!DDSUBS!DDBYTS	; SILLY SYNTAX ?
	DDTERR	2			; YES - COMPLAIN.
	MOVE	A1,[
	XWD	-DDCMLN,DDCOMT]		; GET PARAM FOR UNIQUE COMMAND SCANNER.
	MOVEI	A2,%DDTIB(DB)		; ADDRESS OF COMMAND TO LOOKUP.
	SKIPN	(A2)			; BLANK LINE ?
	  JRST	DDTLUP			; YES.
	PUSHJ	SP,UNIQUE		; USES A0,A2,A3
	  DDTERR 3			; UNKNOWN.
	  JRST	[			; NOT UNIQUE
	  MOVE	A2,DDISPT-DDCOMT(A1)
	  TLNN	A0,7700			; ONLY ONE CHAR TYPED ?
	  TLNN	A2,ONECHR		;  AND ONE-CHAR PREFERENCE SW ?
	  DDTERR 4			; NO - ERROR.
	  JRST	.+1]			; YES - USE IT.
	; Found - A1 is left pointing to its entry.
	MOVE	A1,DDISPT-DDCOMT(A1)	; GET DISPATCH TABLE ENTRY.
	TRNE	FL,DDALIP		; IN AUTOLIST INPUT ?
	  JRST	DDALI0			; YES - DON'T DISPATCH.
	PUSHJ	SP,(A1)			; DISPATCH.
	JRST	DDTLUP			; DO NEXT COMMAND.

ALGDD3:	; A4 = ELEMENT</ = _ :=>
	MOVEI	A1,0			; REMEMBER NOT KEYWORD CMD.
	TRNE	FL,DDALIP		; IN AUTOLIST INPUT ?
	  JRST	DDALI0			; YES.
	PUSHJ	SP,SEARCH		; FIND IDENTIFIER IN SYMBOL-TABLE.
	 DDTERR	^D23			; CANT FIND IT.
	CAIN	A4,.EQU			; TYPEOUT ?
	PUSHJ	SP,DDTYP.		; YES
	CAIN	A4,.ASIGN		; SET ?
	PUSHJ	SP,DDSET		; YES - DO IT.
	JRST	DDTLUP			; NEXT COMMAND.

DDIND:	; Indirect command file.
	TRZE	FL,DDINDF		; NESTED ?
	  DDTERR ^D66			; YES - ILLEGAL.
	TRNE	FL,DDALST		; PROCESSING AUTOLIST ?
	 DDTERR	^D82			; NOT ALLOWED.
	PUSHJ	SP,DDIGCH
	MOVSI	A0,'DSK'		; DEFAULT DEVICE.
	MOVSI	A6,'CMD'		; SET DEFAULT EXTN.
	PUSHJ	SP,DDIPFL		; READ FILE-NAME & OPEN IT.
	HRLM	A1,%CHAN(DB)		; SELECT IT.
	TRO	FL,DDINDF		; REMEMBER
	HRRM	FL,%DDTFL(DB)		; PERMANENTLY.
	JRST	DDTLUP			; START PROCESSING IT.

; ROUTINE TO FIND OUT ABOUT TTY: AND SET BITS IN FL & %DDTFL(DB)

DDTTYC:	MOVE	A2,[-1,,.GTLIM]		; [243] LOAD GETTAB TABLE INDEX
	GETTAB	A2,			; [243] GET THE TABLE INFORMATION
	LIBERR	5,			; [243] COMPLAIN IF GETTAB FAILS
	TLNE	A2,JB.LBT		; [243] IS THIS A BATCH JOB?
	JRST	DDTTY3			; [243] YES, JUMP AHEAD
	PJOB	A2,			; [243] NO, GET OUR JOB #
	TRMNO.	A2,			; ASK MONITOR.
	JRST	DDTTY2			; WON'T TELL.
	MOVEI	A1,1012
	MOVE	FL,[
	XWD	2,A1]			; GET WIDTH FUNCTION.
	TRMOP.	FL,

DDTTY2:	  MOVEI	FL,^D72			; ASSUME 72. IF MONITOR WON'T TELL.
	MOVNI	A1,1			; US
	GETLCH	A1			; GET LINE CHARACTERISTICS.
	TLNE	A1,GL.LCM		; LOWER-CASE ?
	TRO	FL,DDTTYL		; REMEMBER.
	TLNE	A1,GL.HDP		; HALF-DUPLEX ?
	TRO	FL,DDTTYH
	TLNE	A1,GL.TAB		; HARDWARE TABS ?
	TRO	FL,DDTTYT
	HRRZM	FL,%DDTFL(DB)
	POPJ	SP,

DDTTY3:	MOVEI	FL,DD.BTW!DDTTYT!DDTTYL ; BATCH - USE LONG LINE ETC.
	HRRZM	FL,%DDTFL(DB)		;
	POPJ	SP,
	SUBTTL	Debugging system - read autolist routine.

DDALI0:	; A1 (may be) dispatch table entry - B0 = 1 if illegal in A/L
	; A4 is next i/p char (might be =, or first char of 2nd field.
	; As much syntax (command exists, valid arrangement of .[ etc)
	; as possible is checked, but not semantics (identifier exists,
	; is of correct type, etc.) because that is context-dependent.
	; The list is stored in ASCII in a chain of blocks taken from
	; the HEAP.  Each block holds ALSIZE data words, and the last
	; word is a pointer to the next block (0 if this is the end).
	; R.H. of A12 is pointer to start of this block,  L.H. of A12
	; is address of next free word in it.
	; The end of the list is marked by a zero word. (Put there by
	; the 'END' command, the only way of ending an autolist.)

	ALSIZE=20

	JUMPL	A1,DDER5		; COMMAND ILLEGAL IN A/L
	TLZ	A1,-1
	CAIN	A1,DDEND		; END COMMAND ?
	  JRST	DDEND			; YES - WE'D BETTER DISPATCH!
	HLRZ	A7,A12			; NEXT FREE WORD.
	MOVEI	A7,-1(A7)		; STEP BYTE POINTER BACK
	HRLI	A7,(POINT 7,0,34)	; SO THAT DDALI7 WORKS

EDIT(106); Remember buffers can move if stack shifts.
DDALI1:	MOVE	A6,[POINT 7,%DDTFB(DB)]	; [E106] POINT TO SCAN'S OUTPUT BUFFER

DDALI2:	ILDB	A2,A6			; GET CHAR FROM SCAN BUFFER.
	JUMPE	A2,DDALI3		; NULL - END.
	PUSHJ	SP,DDALI7		; NO - DEPOSIT.
	JRST	DDALI2			; NEXT.

DDALI3:	CAIE	A1,DDTYPE		; TYPE CMD ?
	  JRST	DDALI4			; NO.
	CAIN	A4,.SCOL		;  FINISHED ?
	  JRST	DDALI5			; YES.
	CAIN	A4,.COMMA		; COMMA BETWEEN FIELDS ?
	  SKIPA	A2,A4			; YES - GET IT.
	  MOVEI	A2,.SPACE		; NO - GET SPACE.
	PUSHJ	SP,DDALI7		; PUT IN.
	CAIN	A4,.COMMA		; IF IT WAS COMMA,
	  PUSHJ	SP,DDIGCH		; GET NEXT.
	PUSHJ	SP,SCAN4		; GET IDENTIFIER.
	JRST	DDALI1			;  & PUT IN.

DDALI4:	MOVEI	A2,.SPACE		; PUT IN
	PUSHJ	SP,DDALI7		; SEPARATOR SPACE.

DDALI5:	; SCAN part done. Get rest from TTY: buffer.
	MOVEI	A2,(A4)			; GET SCAN'S TERMINATOR.
	PUSHJ	SP,DDALI7		; PUT IN.
	CAIE	A4,.EQU			; FOO =, OR
	CAIN	A4,.SCOL 		; END OF COMMAND ?
	  JRST	DDALI6			; YES.
	PUSHJ	SP,DDGTCH		; NOT - GET A CHAR.
	JRST	DDALI5			;  & PUT IN.

DDALI6:	; End. Update contents of A12.
	HRLI	A12,1(A7)		; GET "NEXT FREE WORD".
	JRST	DDTLUP			; TO MAIN LOOP.

DDALI7:	; Deposit a character from A2 (which it clobbers).
	TLNE	A7,760000		; IF SPACE LEFT IN WORD
	JRST	DDALOK			; JUST INSERT CHAR
	MOVEI	A3,ALSIZE-1(A12)	; ELSE GET LAST DATA WORD
	CAILE	A3,(A7)			; OVERFLOWING TO LINK WORD ?
	JRST	DDALI9			; NO  - JUST CLEAR WORD FIRST
	SKIPE	A7,ALSIZE(A12)		; YES. GOT ANOTHER CHUNK ?
	JRST	DDALI8			; YES (REDEFINING A/L)
	PUSH	SP,A2			; NO. SAVE CHAR
	PUSH	SP,A1			;  AND DISPATCH
	MOVEI	A0,ALSIZE+1		; GET SIZE OF CHUNK
	PUSHJ	SP,GETOWN		; ASK FOR IT
	SETZM	ALSIZE(A1)		; AND CLEAR LINK
	MOVEI	A7,(A1)			; GET ADDRESS INTO A7
	POP	SP,A1			; AND RESTORE ORIGINAL
	POP	SP,A2			; DISPATCH AND CHAR
	MOVEM	A7,ALSIZE(A12)		; LINK IN NEW CHUNK
DDALI8:	HRLS	A12,A7			; POINT A12 TO THIS CHUNK
	MOVEI	A7,-1(A7)		; AND MAKE A7 INTO
	HRLI	A7,(POINT 7,0,34)	;  A BYTE POINTER
DDALI9:	SETZM	1(A7)			; CLEAR NEXT WORD
DDALOK:	IDPB	A2,A7			; STORE CHAR IN LIST
	POPJ	SP,			; AND RETURN

>	; End IFN FTDDT
	SUBTTL	Debugging system - command tables.


	NOTAL==400000			; NOT ALLOWED IN AUTOLIST. (MUST BE BIT 0).
	ONECHR==200000			; ONE-CHAR PREFERENCE - SWITCH WITH THIS
					; SET IS USED IN PREFERENCE TO OTHERS
					; WITH SAME FIRST CHAR, IF ONLY 1 CHAR IS TYPED.
					; ***SWITCH WITH THIS SET MUST BE BEFORE OTHERS
					;  WITH SAME FIRST CHAR. ***

	IFN	FTDDT,<

	DEFINE	COMAND,<
	;V	NAME,DISPATCH-ADDRESS,FLAG,FLAG
	V	TYPE,DDTYPE,ONECHR
	V	CONTIN,CONTIN,ONECHR
	V	BREAK,PAUSE,ONECHR
	V	PAUSE,PAUSE,ONECHR
	V	END,DDEND,ONECHR
	V	LIST,LIST,ONECHR
	V	DEFINE,DEFINE,ONECHR,NOTAL
	V	KILL,KILL,ONECHR
	V	FINISH,DDFINISH,ONECHR,NOTAL
	V	HELP,DDHELP,ONECHR
	V	WHERE,DDWHERE,ONECHR
	V	GOTO,DDGOTO,ONECHR
	V	START,DDSTART,ONECHR
	V	UNWIND,UNWIND,ONECHR
	V	AUTO,DDAUTO,ONECHR
	V	NEXT,DDNEXT,ONECHR
	V	REDIRECT,REDIRECT
	V	RETRY,RETRY
	V	SOURCE,DDSORS
	V	DDT,DDTDDT
	V	DIMENSIONS,DDDIMS
	V	EXPERT,EXPERT,NOTAL
	V	EXTEND,EXTEND,NOTAL
	V	NOVICE,NOVICE,NOTAL
	V	DUMP,DDUMP
	V	TRACE,TRLPRT
	V	PROFILE,PRFPR%
	V	STATISTICS,STSPR%
	V	OBJECT,OBJECT
	V	ONTRACE,DDONTR
	V	OFFTRACE,DDOFTR
	V	BACK,DDBACK
>
>	; END OF IFN FTDDT

	IFE	FTDDT,<

	DEFINE	COMAND,<
	V	CONTIN,DDCON%
	V	FINISH,DDFIN%
	V	HELP,DDHELP
	V	START,DDSTART
	V	DDT,DDTDDT
	V	TRACE,TRLPRT
	V	PROFILE,PRFPR%
	V	STATISTICS,STSPR%
	V	ONTRACE,DDONTR
	V	OFFTRACE,DDOFTR
>
	> ; END OF IFE FTDDT.


	DEFINE	V(A,B,C,D),<
	<SIXBIT/A/>>

DDCOMT:	COMAND				; GENERATE NAME TABLE.

DDCMLN==.-DDCOMT			; NUMBER OF COMMANDS.

	DEFINE	V(A,B,C,D),<
	IFB<D>,<
	IFB<C>,<
	EXP	B>
	IFNB<C>,<
	XWD	C,B>>
	IFNB<D>,<
	XWD	C!D,B>>

DDISPT:	COMAND				; GENERATE DISPATCH TABLE.

	PURGE	V,NOTAL,COMAND

	IFN	FTDDT,<

	SUBTTL	Debugging system - command routines - CONTINUE, FINISH

CONTIN:	SETZB	A5,%SYS17(DB)		; MAKE ALL ERRORS CONTINUABLE (AT HIS PERIL!)
	CAIL	A4,.ZERO		; IS NEXT CHARACTER NUMERIC ?
	CAILE	A4,.NINE		; (PROCEED COUNT SPECIFIED)
	JRST	CONTN1			; NO  - CARRY ON
	PUSHJ	SP,DDGTV1		; YES - GET VALUE
CONTN1:	HLRZ	A6,%DDTAL(DB)		; GET B/P CONTROL BLOCK ADDRESS
	SKIPE	A6			; ARE WE IN A BREAKPOINT ?
	MOVEM	A5,BP.CNT(A6)		; YES - RESET PROCEED COUNT
	JSP	A0,CONRES		; RESTORE STACK ETC.
	JRST	DDCON%


DDFINI:	SETZM	.JBINT			; CLEAR ^C INTERCEPT.
	HRRZS	%DDTER(DB)		; ZAP REDIRECT CHAN # (INIT5 WILL RELEASE)
	TLZ	DB,INDDT		; JUST IN CASE.
	JRST	DDFIN%

	; Common subroutine to restore stack, i/o channels etc.
	; Called by JSP A0 - don't want to disturb the stack.

CONRES:	TRZN	FL,DDINDF		; IN INDIRECT FILE ?
	  JRST	CONTN2			; NO.
	HRRM	FL,%DDTFL(DB)		; CLEAR FLAG.
	HLRE	A1,%CHAN(DB)		; RELEASE
	SKIPL	A1
	PUSHJ	SP,RELESE		;  CHANNEL.
	  JFCL

CONTN2:	MOVE	A6,%DDTTY(DB)		; RESET I/O
	MOVEM	A6,%CHAN(DB)		;  CHANNELS.
	TLZ	DB,INDDT
	SETZM	%DDTBE(DB)		; ZAP CONTEXT
	MOVE	FL,%DDTFL(DB)
	HLRZ	A6,%DDTAL(DB)
	JUMPN	A6,BREAKX		; IN A B/P - CONTIN IS DIFFERENT.
	HRRZ	A1,%ACCS+SP(DB)		; DELOCATED SP
	ADDI	A1,(DB)			; RELOCATE IT.
	MOVEI	A2,(SP)
	SUBI	A2,(A1)			; GET AMOUNT TO RETARD SP BY
	HRLI	A2,(A2)
	SUB	SP,A2			; RESET SP.
	JRST	@A0			; GO ENTER/CONTINUE PROGRAM.
	SUBTTL	HSTPRT - Print history (WHERE command, or runtime error)

DDWHERE:	; TYPE CURRENT HISTORY.
	PUSHJ	SP,CRLF%
	CAIN	DL,(DB)			; [E127]  LEVEL 0.0 ?
	 JRST	HSPR10			; [E127] YES - SPECIAL CASE
	TLZ	DB,TMPFL3		; NO - MAKE SURE NOT IN SILENT MODE.
	PUSH	SP,%DDTUW(DB)		; SAVE "UNWOUND" POINTER
	PUSH	SP,%DDUWB(DB)		; [E127] AND UNWOUND BLOCK LVLS
	PUSHJ	SP,HSTPRT		; TYPE HISTORY.
	POP	SP,A5			; [E127] RECOVER BLOCK LVLS
	HLRZ	A5,A5			; [E127] AND SET A5 TO REQUD BLK LVL
	POP	SP,A7			; [E127] RECOVER UNWIND COUNT
	TLZE	A7,-1			; [E127] WERE WE UNWOUND ?
	SOJA	A7,DDUW0		; [E127] YES - UNWIND US AGAIN !
	POPJ	SP,


PR.HST::HRRZM	A4,%DDTPC(DB)		; Save address for later.
	PUSH	SP,%CHAN(DB)		; Entry from ALGOTS. Save channel
	SETOM	%CHAN(DB)		; Force channel -1 (TTCALL I/O)
	AOSE	%DDERD(DB)		; [E1000] Set error detected flag
	  JRST	DD2ERR			; [E1000] Second error - die gracefully
	SKIPN	%DDTST(DB)		; Have we tried to read symbol table ?
	PUSHJ	SP,DDINIT		; Not yet - do it now
	PUSHJ	SP,HSTPRT		; Do the actual work
	POP	SP,%CHAN(DB)		; Then restore channel selection
	POPJ	SP,			; And return

HSTPRT:	HRRZ	A1,%DDTER(DB)		; Is this an 'expert' user ?
	JUMPN	A1,HSTPR0		; (R.H. of  %DDTER non-zero)
	TLZ	DB,TMPFL3		; No - give him the typeout
HSTPR0:	HRRZS	A4,%DDTPC(DB)		; Get address we stopped at.
	SETZM	%DDTBE(DB)		; Clear context
	SETOM	%DDTUW(DB)		; and dynamic (UNWOUND) P.L.
	CAIN	DL,(DB)			; [E1001] Level 0.0?
	  JRST	HSTPR9			; [E1001] Yes - special case
	SKIPGE	%DDTST(DB)		; Unless symbol table unavailable,
	PUSHJ	SP,FNDADR		; Try to find out where error occurred
	 SETZB	A4,%DDTBE(DB)		; No S.T., or can't resolve address.
	TLNE	DB,TMPFL3		; Expert ?
	JRST	HSTPR2			; Yes - no messages
	JUMPE	A4,HSTPR1		; A4 zero if could not resolve address
	PUSH	SP,A5			; Save module name
	MOVEI	A1,[ASCIZ/On /]		; Print first part of message
	PUSHJ	SP,DDTOUT		; ..
	PUSHJ	SP,STNPRT		; Print line #[, statement #] from A4
	POP	SP,A4			; Then get module name to A4
	PUSHJ	SP,MODPRT		; And print that also
	PUSHJ	SP,CRLF%		; followed by <CR><LF>
HSTPR1:	CAIN	DL,@%DDTDL(DB)		; Is DL set to topmost level ?
	JRST	HSTPR2			; Yes - all is well
	MOVEI	A1,[ASCIZ/during parameter evaluation /]; No - get message address
	PUSHJ	SP,DDTOUT		; And include message in typeout
HSTPR2:	PUSH	SP,[-1]			; Initialize context markers
	SUBI	DL,(DB) 		; Delocate DL
	SKIPE	%DDTBE(DB)		; [E127] If FNDADR established context
	HRLM	DL,%DDTPC(DB)		; [E127] Save correct DL
	TLO	DL,DB			; Set DB into index field
	PUSH	SP,DL			; And save it on the stack
	MOVEI	DL,@%DDTDL(DB)		; Set DL to topmost level
	SETZM	%UWCON(DB)		; [E127] Initialize unwind limit
	MOVEI	A4,@LINKPC(DL)		; [E127] Get best-guess PC
	PUSHJ	SP,UWTEST		; [E127] And test for context

	TLNE	DB,TMPFL3		; Is typeout suprressed ?
	JRST	HSTPR3			; Yes - no message
	MOVEI	A1,[ASCIZ/in /]		; No  - get prefix address
	PUSHJ	SP,DDTOUT		; And print it
HSTPR3:	PUSHJ	SP,PRPROC		; Now print procedure name
	AOS	A3,%DDTUW(DB)		; Count one more level
	CAIN	DL,@0(SP)		; And if this is correct DL
	HRRM	A3,-1(SP)		; Save current depth
	SKIPN	%DDTBE(DB)		; Has FNDADR established context ?
	JRST	HSTPR4			; Not yet
	HLRZ	A0,%DDTPC(DB)		; Yes - first time ?
	JUMPN	A0,HSTPR4		; No
	MOVEI	A0,(DL)			; Yes - set delocated value of
	SUBI	A0,(DB)			; DL into L.H. of %DDTPC
	HRLM	A0,%DDTPC(DB)		; (needed by DDGTDL)
	HRLM	A3,-1(SP)		; and remember current depth
HSTPR4:	SKIPN	CONDL(DL)		; Is this main program ?
	JRST	HSTPR7			; Yes - finished
	MOVEI	A4,@PRGLNK(DL)		; No  - get return address
	;
	Edit(150);  Make line number correct if PC a return address.
	;
	SOJ	A4,			; [E150] This is the next statement
	SKIPGE	%DDTST(DB)		; And unless debugger is turned off,
	PUSHJ	SP,FNDADR		; Convert to line number
	 SETZ	A4,			; Can't resolve address !
	TLNE	DB,TMPFL3		; Expert ?
	JRST	HSTPR6			; Yes - no messages
	PUSH	SP,A4			; No  - save statement #
	MOVEI	A1,[ASCIZ/(level/]	; Output dynamic procedure
	PUSHJ	SP,DDTOUT		; level, which can be
	SETCM	A0,%DDTUW(DB)		; calculated as the difference
	ADD	A0,%DDTPL(DB)		; between the current value of
	PUSHJ	SP,IPRNT%		; %DDTUW+1 and the maximum (%DDTPL)
	MOVSI	A4,'.  '		; [E127] Then type a dot
	PUSHJ	SP,DDOSIX		; [E127] . . .
	HRRZ	A0,PLBLKL(DL)		; [E127] Followed by the
	PUSHJ	SP,DPRNT%		; [E127]  current block level
	MOVEI	A1,[ASCIZ/)
Called from /]				; Tell user where we came from
	PUSHJ	SP,DDTOUT		; ..
	POP	SP,A4			; Restore line number, if any
	JUMPE	A4,HSTPR5		; Did we resolve address ?
	PUSHJ	SP,STNPRT		; Yes - tell user
	MOVEI	A1,[ASCIZ/ in /]	; and put in next bit of
	PUSHJ	SP,DDTOUT		; message
HSTPR5:	HRRZ	A1,CONDL(DL)		; Get 'context' DL
	ADDI	A1,(DB)			; and relocate it
	CAIN	A1,@LINKDL(DL)		; Is this the same ?
	JRST	HSTPR6			; Yes - easy
	MOVEI	A1,[ASCIZ/a parameter of /]; No - tell user
	PUSHJ	SP,DDTOUT		;  stopped during parameter evaluation
HSTPR6:	MOVEI	A4,@PRGLNK(DL)		; [E127] Get return link again
	PUSHJ	SP,UWTEST		; [E127] And test for context
	MOVEI	DL,@LINKDL(DL)		; Follow procedure chain down
	JRST	HSTPR3			; And carry on typeout

HSTPR7:	MOVE	A1,%DDTUW(DB)		; [E127] Get full UNWOUND count
	ADDM	A1,%UWTOP(DB)		; [E127]  and adjust maximum.
	TLNE	DB,TMPFL3		; [E127] EXPERT ?
	JRST	HSTPR8			; [E127] Yes - no message
	MOVEI	A1,[ASCIZ/, level 0./]	; [E127] No  - tell user
	PUSHJ	SP,DDTOUT		; [E127]  what block level
	HRRZ	A0,PLBLKL(DL)		; [E127]  we are at in
	PUSHJ	SP,DPRNT%		; [E127]  the main program.
HSTPR8:	PUSHJ	SP,DDBRKB		; Force any output to terminal
	POP	SP,DL			; Restore DL
	TLZ	DL,DB			; Clear DB from index field
	ADDI	DL,(DB)			; And relocate R.H.
	POP	SP,A1			; Get context counters
	SKIPGE	A1			; [E127] Original context set ?
	HRL	A1,A1			; [E127] Yes - get correct level
	AOS	%DDTUW(DB)		; [E127] Correct unwound count
	JUMPE	A1,CPOPJ		; [E127] Return if context correct
	HLRZ	A5,A1			; Get correction to %DDTUW
	MOVNI	A5,(A5)			; From the left half of A1
	ADD	A5,%DDTUW(DB)		; (Where FNDADR first found context)
	HRROM	A5,%DDTUW(DB)		; [E127] and mark as "UNWOUND"
	TLNE	DB,TMPFL3		; [E127] Typeout suppressed ?
	POPJ	SP,			; [E127] Yes - just return
	MOVEI	A1,[ASCIZ/
Context established at level/]		; [E127] No  - tell the user
	PUSHJ	SP,DDTOUT		; What level the error was detected
	MOVEI	A0,-1(A5)		; [E127] (or at least what context is)
	PUSHJ	SP,IPRNT%		; [E127] . .
	MOVSI	A4,'.  '		; [E127] And assume block level
	PUSHJ	SP,DDOSIX		; [E127]  is set to the maximum
	HLRZ	A1,%DDTPC(DB)		; [E127] Get context DL
	ADDI	A1,(DB)			; [E127]  (relocated)
	HRRZ	A0,PLBLKL(A1)		; [E127] Get relevant block level
	PJRST	DPRNT%			; [E127] Exit via print routine


HSTPR9:	SETZM	%UWCON(DB)		; [E1001] Clear context for UNWIND
	MOVEI	A4,%SYS0(DB)		; [E1001] Set P.C. to %BEGIN
	MOVE	A4,(A4)			; [E1001]
	HRRZM	A4,%DDTPC(DB)		; [E1001]
	PUSHJ	SP,FNDADR		; [E1001] Establish context
	  JFCL				; [E1001] No symbol info for main pgm ...
					; [E1001] ... ignore for now
	TLNE	DB,TMPFL3		; [E1001] Typeout suppressed ?
	POPJ	SP,			; [E1001] Yes - return
; ****	JRST	HSPR10			; [E1001] No  - tell user where we are

HSPR10:	MOVEI	A1,[ASCIZ/At level 0.0/] ; [E1001]
	PUSHJ	SP,DDTOUT		; [E127] Print basic message
	HRRZ	A1,%DDTER(DB)		; [E127] Expert ?
	JUMPN	A1,HSPR11		; [E1001] If not ..
	MOVEI	A1,[ASCIZ/ (program not yet started or execution complete)/]	
					; [E127]  more message
	PUSHJ	SP,DDTOUT		; [E127]
HSPR11:	PUSHJ	SP,DDBRKB		; [E1001] Force output to terminal
	POPJ	SP,			; [E127] and return

STNPRT:	PUSH	SP,A4			; Save line number
	MOVEI	A1,[ASCIZ/line/]	; Print line identification
	PUSHJ	SP,DDTOUT		; ..
	HRRZ	A0,(SP)			; Get line number into A0
	PUSHJ	SP,IPRNT%		; and go print it
	POP	SP,A4			; Restore line number
	TLNN	A4,777777		; Any statement number ?
	POPJ	SP,			; No  - return
	MOVEI	A1,[ASCIZ/, statement/]	; Yes - say so
	PUSHJ	SP,DDTOUT		; ..
	HLRZ	A0,A4			; Then get number
	PJRST	IPRNT%			; Print it, and return

PRPROC:	TLNE	DB,TMPFL3		; Expert ?
	POPJ	SP,			; Yes - no typeout
	SKIPN	A1,CONDL(DL)		; Main program ?
	JRST	PRMAIN			; Yes
	SKIPN	A3,PMBPTR(DL)		; No - Traced ?
	JRST	PRUNTR			; No - say so
	MOVEI	A1,[ASCIZ/procedure /]	; say procedure
	PUSHJ	SP,DDTOUT		; ..
	MOVEI	A1,2(A3)		; Get start of text
	TLO	A1,(POINT 6)		; Convert to SIXBIT byte pointer
	PUSH	SP,FL			; Save FL (=A13)
PRPRO1:	ILDB	A13,A1			; Get next character
	ADDI	A13,"A"-'A'		; Otherwise convert to ASCII
	PUSHJ	SP,DDOUCH		; Print single character
	CAIE	A13," "			; Terminating space ?
	JRST	PRPRO1			; No  - loop
	POP	SP,FL			; Yes - Restore FL
	POPJ	SP,			; and return

UWTEST:	SKIPE	%UWCON(DB)		; [E127] Already found maximum ?
	POPJ	SP,			; [E127] Yes - return
	PUSH	SP,%DDTBE(DB)		; [E127] No  - save S.T. pointer
	PUSH	SP,A4			; [E127]  and PC value
	SKIPG	%DDTST(DB)		; [E1000] Unless no S.T.,
	PUSHJ	SP,FNDADR		; [E127] Convert to line number
	 SETZB	A4,(SP)			; [E127] Failed !
	POP	SP,%UWCON(DB)		; [E127] Set unwind limit
	POP	SP,%DDTBE(DB)		; [E127] Restore S.T. pointer
	JUMPE	A4,UWTST1		; [E127] Return if failed
	MOVEI	A4,(DL)			; [E127] Otherwise get DL
	SUBI	A4,(DB)			; [E127] value which corresponds
	HRLM	A4,%UWCON(DB)		; [E127] to this context
	MOVN	A4,%DDTUW(DB)		; [E127] Get current UNWIND depth
	MOVEM	A4,%UWTOP(DB)		; [E127] Save as maximum possible
UWTST1:	POPJ	SP,			; [E127] and return

PRMAIN:	TROA	A1,[ASCIZ/main program/]; Say this is main program
PRUNTR:	MOVEI	A1,[ASCIZ/an untraced procedure /]; Say procedure not traced
	PJRST	DDTOUT			; Exit via type routine
	SUBTTL	Debugging system - command routines - START,GOTO,RETRY

DDSTART:	; start program execution.
	HRRZ	A0,.JBSA
	CAIN	A0,RSTRT%		; SECOND START ?
	 DDTERR	^D86			; YES - NO GO
	;
	Edit(146);  Fix various bugs with scope of GOTO command.
	;
DDSTA1:	JSP	A0,CONRES		; [E146] RESTORE STACK ETC.
	MOVE	AX,%ACCS+AX(DB)		; [E021] RESTORE THE ONLY AC WHICH CONTAINS ANYTHING !
	;
	EDIT(021); AX is clobbered by the debugger - make REE work.
	;
	JRST	DDBEG%			; GO ENTER PROGRAM.

DDGOTO: ;GOTO label:, or GOTO switch[#] (or GOTO line-no,statement-no)
; Note that we certainly do not allow GOTO L: IN FOO; since this is,
;  by definition, illegal: a label in another external procedure has to
;   be out of scope.

	HLRZ	A2,%DDTUW(DB)		; GET ORIGINAL CONTEXT
	SKIPE	A2			; ARE WE AT TOP LEVEL
	 DDTERR	^D93			; NO  - WARN USER
	CAIL	A4,.A			; NEXT CHARACTER ALPHA ?
	CAILE	A4,.Z			; (IDENTIFIER, OR "GO TO")
	JRST	DDGOT7			; NO
	PUSHJ	SP,SCAN3		; YES - READ NEXT WORD
	CAIE	A4,.COLON		; LABEL IDENTIFIER ?
	CAIN	A4,.LBRA		; OR SWITCH ?
	JRST	DDGOT1			; YES - ALL IS WELL
	HLRZ	A2,%DDTIB(DB)		; NO  - READ FIRST TWO CHARS (+4 BITS)
	CAIE	A2,(ASCII "TO")		; IS IT CORRECT ?
	 DDTERR	^D42			; NO
	CAIL	A4,.A			; IS THIS FOLLOWED BY AN IDENTIFIER ?
	CAILE	A4,.Z			; (LABEL OR SWITCH NAME)
	JRST	DDGOT7			; NO  - COULD BE LINE[,STATEMENT]
	PUSHJ	SP,SCAN3		; YES - READ NAME INTO BUFFER
	CAIE	A4,.COLON		; TERMINATED BY COLON
	CAIN	A4,.LBRA		; OR OPENING BRACKET ?
	JRST	DDGOT1			; YES - O.K.
	DDTERR	^D42			; NO  - SYNTAX ERROR

DDGOT1:	;We get here if we have read an identifier, terminated by ":" or "["
	PUSHJ	SP,SEARCH		; LOOK IDENTIFIER UP IN TABLE
	 DDTERR	^D23			; CANT FIND IT
	TLNE	A6,$TYPE		; MAKE SURE IT IS OF TYPE LABEL
	TLNE	A6,$TYPE-$L		; (SWITCH = LABEL PROC)
	 DDTERR	^D62			; ERROR IF IT ISN'T.
	CAIE	A4,.COLON		; LABEL OR SWITCH WANTED ?
	TLC	A6,300000		; SWITCH :- <KIND> MUST BE $PRO
	TLNE	A6,300000		; LABEL  :- <KIND> MUST BE $VAR
	 DDTERR	^D62			; <KIND> IS INCORRECT
	CAIE	A4,.LBRA		; IS THIS A SWITCH ?
	JRST	DDGOT2			; NO - MUST BE A LABEL !
	PUSH	SP,A11			; YES - SAVE A11 (DL OF SWITCH)
	PUSHJ	SP,DDGTVL		; READ VALUE TO A5
	POP	SP,A11			; RESTORE A11
	CAIE	A4,.RBRA		; CORRECT TERMINATOR ?
	 DDTERR	^D38			; NO
	MOVEI	A2,(A5)			; YES - GET INDEX INTO A2

DDGOT2:	TLNE	A6,400			; IS THIS A FORMAL LABEL
	TLNN	A6,300			; (BY NAME OR VALUE) ?
	JRST	DDGOT3			; NO  - IT ISN'T
	DPUSH	DL			; YES - SAVE OUR DL
	PUSH	SP,FLABL%		; AND BUILD UP A FAKE FORMAL
	MOVEI	AX,(SP)			; (F[0],F[1] & F[2]) ON
	PUSH	SP,AX			; THE STACK, POINTED TO BY AX
	MOVE	DL,A11			; ASSUME DL OF THE FORMAL
	HRL	A11,CONDL(DL)		; SET A11 TO F[2] FOR A LABEL
	SUBI	A11,(DB)		; (CONDL,,DELOCATED F[0] ADDRESS)
	ADDI	A11,(A6)		; ..
	PUSH	SP,A11			; AND STACK IT.
	XCT	(AX)			; CALL OTS ROUTINE TO EVALUATE FORMAL
	SUB	SP,[3,,3]		; TIDY UP THE STACK
	JRST	DDGOT5			; GO JOIN COMMON CODE

DDGOT3:	;Here for a non-formal label or switch.
	CAIE	A4,.COLON		; WHICH IS IT ?
	JRST	DDGOT4			; SWITCH - NEED TO EVALUATE IT
	HLRZ	A2,%DDTPT(DB)		; LABEL - GET ADDR OF MOD ENTRY
	HRRZ	A2,1(A2)		; GET MODULE RELOCATION
	ADDI	A2,(A6)			; ADD IN RELATIVE ADDRESS
	JRST	DDGOT6			; AND DISPATCH
DDGOT4:	DPUSH	DL			; SWITCH - SAVE CURRENT DL
	MOVE	DL,A11			; ASSUME CONTEXT DL
	HLRZ	AX,%DDTPT(DB)		; GET ADDRESS OF MOD ENTRY
	HRRZ	AX,1(AX)		; GET MODULE RELOCATION
	ADDI	AX,(A6)			; ADD IN RELATIVE ADDRESS
	PUSHJ	SP,(AX)			; EVALUATE THE SWITCH
	PORTAL	.+1			; [303] HANDLE EXECUTE-ONLY
DDGOT5:	RPOP	DL			; AND RESTORE CORRECT DL
	MOVE	FL,%DDTFL(DB)		; RESET FLAGS (THUNKS DESTROY THEM)
	SKIPN	A2			; WAS TARGET A SWITCH OUT OF RANGE ?
	 DDTERR	^D63			; YES - INFORM THE USER
DDGOT6:	MOVEM	A2,%ACCS+A2(DB)		; SET VALUE IN CASE FORLAB NEEDS IT
	JRST	DDGO11			; AND LET CONTINUE CODE DO THE JUMP

DDGOT7:	CAIN	A4,.DOT			; GO TO . ?
	JRST	RETRY			; YES - THIS IS A 'RETRY' IN DISGUISE
	PUSH	SP,[0]			; INITIALIZE LINE NUMBER
	CAIL	A4,.ZERO		; IS NEXT CHARACTER A 
	CAILE	A4,.NINE		; DECIMAL DIGIT ?
	 DDTERR	^D22			; NO  - SYNTAX ERROR
	PUSHJ	SP,DDGTV1		; YES - GET VALUE
	HRRM	A5,(SP)			; AND REMEMBER IT
	CAIE	A4,.COMMA		; STMT NUMBER TO COME ?
	JRST	DDGOT8			; NO  - CARRY ON
	PUSHJ	SP,DDIGCH		; YES - READ NEXT NON-BLANK
	CAIL	A4,.ZERO		; IS THE NEXT CHARACTER
	CAILE	A4,.NINE		; A DECIMAL DIGIT ?
	 DDTERR	^D22			; NO  - SYNTAX ERROR
	PUSHJ	SP,DDGTV1		; YES - READ VALUE
	HRLM	A5,(SP)			; AND REMEMBER THIS ALSO
DDGOT8:	POP	SP,A0			; RESTORE STMT #,,LINE #
	CAIE	A4,.SCOL		; IF NOT AT END OF LINE
	 DDTERR	^D22			; THEN SYNTAX ERROR
	SETZ	A1,			; OTHERWISE CLEAR MODULE NAME
	PUSHJ	SP,FNDLIN		; AND CONVERT ADDRESS
	SKIPA	A1,%DDTBE(DB)		; INITIALIZE SCOPE CHECK

DDGOT9:	HLRZ	A1,(A1)			; GET BLKIDX ADDRESS
	CAIE	A3,(A1)			; GOT TO DESIRED BLOCK YET ?
	JUMPN	A1,DDGOT9		; NO  - TRY NEXT ONE OUT
	SKIPN	A1			; DID WE FIND BLOCK ?
	 DDTERR	^D95			; NO  - SCOPE ERROR
	CAIE	DL,(DB)			; [E146] Are we at level 0.0 ?
	JRST	DDGO12			; [E146] No -  all is well.
	HRRZ	A0,@%SYS0(DB)		; [E146] Yes - trying to start ?
	CAMN	A2,A0			; [E146]	...
	JRST	DDSTA1			; [E146] Yes, so START properly.
	JRST	DDFIN%			; [E146] Otherwise we want to FINISH.
DDGO12:	HRRZ	A3,(A3)			; GET OFFSET OF BLK ITEM
	ADD	A3,%DDTST(DB)		; AND CONVERT TO ACTUAL ADDRESS
	SKIPE	A1,%DDTGO(DB)		; HAVE WE GOT A GOTO BLOCK ?
	JRST	DDGO10			; YES - ALL IS WELL
	MOVEM	A2,%DDTGO(DB)		; NO  - SAVE TARGET PC
	HRLM	A3,%DDTGO(DB)		; AND BLK ITEM ADDRESS
	MOVEI	A0,3			; SET SIZE OF BLOCK
	PUSHJ	SP,GETOWN		; AND ASK FOR IT
	MOVSI	A2,[
		JSP	AX,GOLAB	; INITIALIZE THE BLOCK TO
		Z	0(DL)		; A CALL TO GETOWN, AND
		JRST	0	]	; A JUMP TO NOWHERE
	HRRI	A2,(A1)			; BY MEANS OF A BLT
	BLT	A2,2(A1)		; ..
	HLRZ	A3,%DDTGO(DB)		; THEN RESTORE A3
	HRRZ	A2,%DDTGO(DB)		; AND A2
	HRRZM	A1,%DDTGO(DB)		; AND REMEMBER ADDRESS OF BLOCK

DDGO10:	HRRM	A2,2(A1)		; STORE TARGET ADDRESS IN GOTO
	MOVE	A2,A1			; GET NEW TARGET ADDRESS INTO A2
	HRRZ	A1,2(A3)		; GET PL OF BLK ITEM
	SUBI	A1,1			; CORRECT IT..
	HRRM	A1,1(A2)		; STORE IT IN R.H.
	HRRZ	A1,1(A3)		; THEN GET BL
	SUBI	A1,1			; CORRECT IT..
	DPB	A1,[POINT 12,1(A2),12]	; STORE IN BITS 1-12
EDIT(113); Trap GO TO [JSP AX,PARAM] (Normally GO TO 1)
	HRRZ	A1,2(A2)		; [E113] Get transfer address
	MOVE	A3,(A1)			; [E113] Get transfer instruction
	CAME	A3,[JSP AX,PARAM]	; [E113] Procedure entry point ?
	JRST	DDGO11			; [E113] No  - carry on
	HRRZ	A1,3(A1)		; [E113] Yes -get number of parameters
	ADDI	A1,3			; [E113] Allow for overhead words
	ADDM	A1,2(A2)		; [E113] Correct transfer address
DDGO11:	HRRM	A2,.JBOPC		; SET UP ADDRESS FOR CONTINUE
	HRRZS	%DDTAL(DB)		; CLEAR CURRENT BREAKPOINT
	HRRZ	A2,BLKPTR(DL)		; RESET (DELOCATED) STACK
	MOVEM	A2,%ACCS+SP(DB)		; IN CASE OF ERRORS
	JRST	CONTIN			; AND LET CONTIN DO THE WORK

RETRY:	; "RETRY" COMMAND, OR "GO TO ."
	SKIPL	%DDTST(DB)		; HAVE WE GOT THE SYMBOL TABLE ?
	 DDTERR	1			; NO  - CANT FIND STATEMENT START
	HRRZ	A4,%DDTPC(DB)		; GET OBJECT PROGRAM ADDRESS
	PUSHJ	SP,FNDADR		; RESOLVE LINE NUMBER, ETC.
	 DDTERR	^D87			; NOT IN ALGOL CODE
	CAIE	DL,(DB)			; [E146] Are we at level 0.0 ?
	JRST	RETRY1			; [E146] No - all is well.
	HRRZ	A0,.JBSA		; [E146] Yes - have we STARTed yet
	CAIE	A0,RSTRT%		; [E146]	...
	JRST	DDSTA1			; [E146] No - so START it.
	JRST	DDFIN%			; [E146] Yes - so FINISH it.
RETRY1:	HLRZ	A1,%DDTPT(DB)		; GET LINK G.S.T. ADDRESS
	SKIPN	A2,1(A1)		; AND HENCE MODULE RELOCATION
	 DDTERR	^D17			; NO LINK G.S.T. !
	HRRZ	A1,%DDTPT(DB)		; GET ADDRESS OF 'STN' ENTRY
	ADD	A2,1(A1)		; ADD IN OFFSET WITHIN MODULE
	JRST	DDGO11			; AND CONTINUE FROM THERE
	SUBTTL	Debugging system - teletype input.

	; DDGTLN gets a line from the TTY in 1 character input mode.
	; Breaks on <CR><LF> etc., <altmode> := ;
	; also outputs prompt. Uses A1,A2,A10,A11.
	; Result is in buffer %DDTCB(DB) (up to 132 chars long).

DDGTLN:	TLZA	FL,DDTMP1

DDGTLX:	TLO	FL,DDTMP1		; SPECIAL "NO-PROMPT" ENTRY.
	MOVSI	A1,%DDTCB(DB)		; I/P BUFFER ADDRESS
	HRRI	A1,%DDTCB+1(DB)
	SETZM	-1(A1)			; ZERO-FILL
	BLT	A1,%DDTCB+^D26(DB)
EDIT(106); Remember buffers can move if stack shifts.
	MOVE	A10,[POINT 7,%DDTCB(DB)]; [E106] GET POINTER TO BUFFER
	TRNE	FL,DDINDF		; IN INDIRECT FILE ?
	  JRST	DDGTIN			; YES - GET A LINE FROM THERE.
	HRRI	A2,DDCCML		; [E1000] SET CMD LVL
	HRRM	A2,%CONC(DB)		; [E1000] ^C INTERCEPT
	SKPINC				; TURN OFF CONTROL-O
	  JFCL
	TRNE	FL,DDTTYH		; IF HALF-DUPLEX...
	  JRST	DDGTLA			; DON'T MESS ABOUT WITH ECHO.
	MOVNI	A2,1
	GETLCH	A2
	TLZ	A2,GL.LCP		; TURN ON
	SETLCH	A2			; ECHO.

DDGTLA:	PUSHJ	SP,DDBRKB		; [E121] FORCE OUT ALL OUTPUT
	TLNN	FL,DDTMP1		; UNLESS NO-PROMPT MODE,
	OUTSTR	[BYTE (7)15,12,76,76,40,0] ; CR LF PROMPT SPACE 
	TRNE	FL,DDALIP		; IF IN AUTOLIST INPUT MODE
	 OUTSTR	[ASCIZ/	/]		;  OUTPUT A TAB TOO.
	MOVEI	A1,-5(FL)		; GET MAX LINE LENGTH, LESS PROMPT ETC.
	ANDI	A1,DDTTYW		; CLEAR OTHER BITS.
	MOVEI	A11,(A1)		; SAVE
	TLZ	FL,DDTMP2		; USED TO REMEMBER IF IN DELETE.
	INCHRW	A2
	TLZN	FL,DDTMP1		; IN NORMAL MODE ?
	CAIE	A2,.QUERY		; IS IT ?
	  JRST	DDGTL5+1		; NO.
	HRRE	A2,%DDTER(DB)		; YES - GET ADDR OF LAST ERR MSG.
	JUMPE	A2,DDGTLN		; NONE, OR NOVICE MODE.
	AOJE	A2,DDGTLN
	OUTSTR	[ASCIZ/
/]					; MSG & EXPERT MODE.
	OUTSTR	-1(A2)			; TYPE LONG MSG - HE'S NOT A REAL EXPERT
	JRST	DDGTLN			; TRY AGAIN.

DDGTL5:	INCHRW	A2			; READ A CHARACTER.
	JUMPE	A2,DDGTL5		; NULL.
	CAIN	A2,.DEL			; CHARACTER DELETE ?
	  JRST	DDGTL1			; YES - GO PROCESS.
	;
	Edit(163);  Treat backspace as a delete character.
	;
	CAIN	A2,10			; [E163] Backspace ?
	  JRST	DDGTBS			; [E163] Yes - go process
	TLZE	FL,DDTMP1		; WERE WE DELETING ?
	TRNE	FL,DDTTYH		;  & FULL-DUPLEX ?
	  JRST	DDGTLB			; NO.
	 OUTCHR	[.BSLSH]		; YES - FINISH OFF (TYPE \)
	OUTCHR	A2			;  AND NEW CHAR.
	PUSH	SP,A2
	MOVNI	A2,1
	GETLCH	A2
	TLZ	A2,GL.LCP		; TURN ON ECHO.
	SETLCH	A2
	POP	SP,A2

DDGTLB:	CAIN	A2,.CTRLR		; RETYPE LINE ?
	  JRST	DDGTL0			; GO PROCESS.
	CAIN	A2,.CTRLU		; LINE DELETE ?
	  JRST	DDGTL2			; YES - GO PROCESS.
	CAIL	A2,.LF
	CAILE	A2,.FF			; ANY SORT OF END-OF-LINE ?
	  JRST	DDGTL4			; NO.
	JRST	DDGTL6			; NO - LINE TERMINATED.

DDGTL4:	CAIN	A2,.ESC			; ALTMODE ?
	  JRST	DDGTL6			; YES

DDGTL7:	CAIE	A2,.SCOL		; COMMAND TERMINATOR ?
	  JRST	DDGTL8			; NO

DDGTL6:	IDPB	A2,A10
	MOVE	A2,[POINT 7,%DDTCB(DB)]	; [E106] SET UP BYTE POINTER
	MOVEM	A2,%DDTIP(DB)		;  FOR DDGTCH

	HRRZI	A0,DDCONC		; [E1000] SET "ACTION ABANDONED"
	HRRM	A0,%CONC(DB)		; [E1000] ^C INTERCEPT
	POPJ	SP,			; [E1000] RETURN


DDGTL8:	TLZN	FL,DDTMP2		; WAS LAST CHAR A : ?
	CAIE	A2,.EQU			; [271] NO, IS THIS ONE AN = ?
	  JRST	DDGTL9			; [271] NO, SKIP AHEAD
	JRST	DDGTL6			; YES - FINISHED

DDGTL9:	CAIN	A2,.CONT		; CONTINUATION ?
	  JRST	DDGTL6			;  YES - IS A BREAK CHAR.
	CAIN	A2,.COLON
	  TLO	FL,DDTMP2		; REMEMBER : FOR := TEST.
	IDPB	A2,A10			; NO - PUT IN BUFFER.
	SOJG	A1,DDGTL5		; & GET NEXT, UNLESS TOO LONG.

DDGTL2:	; CONTROL-U, OR SIMULATED FOR LONG LINE.
	OUTSTR	[ASCIZ /^U/]		; OUTPUT ECHO.
	JRST	DDGTLN			; 'NOTHER LINE

DDGTBS:	; [E163] Backspace.
	TLNE	FL,DDTMP1		; [E163] Deleting already ?
	  JRST	DDGTL1			; [E163] Yes - treat as rubout
	CAIL	A1,(A11)		; [E163] Start of line ?
	  JRST	DDGTL2			; [E163] Yes - force ^U
	DBP	A2,A10			; [E163] Decrease pointer.
	AOJA	A1,DDGTL5		; [E163]  and try again.

DDGTL1:	; Character delete.
	CAIL	A1,(A11)
	  JRST	DDGTL2			; START OF LINE - FORCE ^U
	TRNN	FL,DDTTYH		; IF 1/2 DUPLEX, ALWAYS DO \, ELSE
	TLON	FL,DDTMP1		; ALREADY DONE \ ?
	 OUTCHR [.BSLSH]		; NO - DO IT.
	LDB	A2,A10			; GET DELETED BYTE
	OUTCHR	A2			; OUTPUT IT
	DBP	A2,A10			; DECREMENT BYTE-POINTER (A2 IS SCRATCH)
	TRNE	FL,DDTTYH		; IF 1/2 DUPLEX,
	  AOJA	A1,DDGTL5		;  PROCEED.
	MOVNI	A2,1
	GETLCH	A2			; OTHERWISE
	TLO	A2,GL.LCP		; TURN OFF
	SETLCH	A2			; ECHO,
	AOJA	A1,DDGTL5		;  AND PROCEED.

DDGTL0:	; Control-R. Retype input line, and let him go on typing.
	MOVEI	A2,0
	IDPB	A2,A10			; MAKE ASCIZ.
	OUTSTR	[BYTE(7)15,12,76,76,40,0]  ; [264] DISPLAY ALGDDT PROMPT
	OUTSTR	%DDTCB(DB)
	DBP	A2,A10			; BACK UP OVER THE NULL.
	JRST	DDGTL5
; DDTIN% is called from READ (in the main OTS) to get a char to A13.

DDTIN%:	PUSH	SP,A4
	PUSHJ	SP,DDGTLC		; GET CHAR TO A4.
	MOVEI	A13,(A4)
	POP	SP,A4
	JRST	(AX)			; CALLED FROM READ.

DDGTLC:	; Gets a character to A4. Ignores comments.
	; %DDTIP(DB) is pointer in input buffer.
	; Converts TAB to space, terminators to ;.
	PUSHJ	SP,DDGCA0		; GET A CHAR.
	  JRST	DDGCA3			; A TERMINATOR.
	CAIN	A4,.HT
	  MOVEI	A4,.SPACE
	CAIN	A4,.CR			; IF CARRIAGE-RETURN,
	  JRST	DDGTLC			;  IGNORE IT.
	CAIE	A4,.COMNT		; COMMENT ?
	  POPJ	SP,			; NO - DONE.
	PUSHJ	SP,DDGCA4		; YES - GET NEW LINE.
	JRST	DDGTLC			; TRY  AGAIN.

DDGCA3:	CAIE	A4,.EQU			; LEAVE TERM IF =,
	  MOVEI	A4,.SCOL		;  ELSE MAKE IT A ;
	POPJ	SP,

DDGTCA:	; Get a character to A4. No terminator. Ignores nothing.
	; Does know about continuation-lines. 
	; Intended only to be called from quoted-string input.
	PUSHJ	SP,DDGCA0		; GET CHAR - HANDLE CONTINUATION.
	  JRST	DDGCA1			; TERMINATOR CHAR.
	POPJ	SP,			; NOT - DONE.

DDGCA1:	PUSH	SP,A1			; SAVE AC'S
	PUSH	SP,A2			;  THAT
	PUSH	SP,A10			;   DDGTLN
	PUSH	SP,A11			;    CLOBBERS.
	PUSHJ	SP,DDGTLX		; GET MORE INPUT - NO PROMPT.
	POP	SP,A11
	POP	SP,A10
	POP	SP,A2
	POP	SP,A1
	POPJ	SP,

DDGCA0:	MOVE	A4,%DDTFL(DB)		; GET FLAGS
	TRNN	A4,DDALST		; IN AUTOLIST ?
	  JRST	DDGC.I			; NO  - READ FROM INPUT DEVICE
	MOVE	A4,@%DDTIP(DB)		; YES - GET AUTOLIST POINTER
	TLNE	A4,760000		; AT END OF A WORD ?
	JRST	DDGC.A			; NO  - CARRY ON
	MOVE	A4,1(A4)		; YES - GET NEXT WORD
	TLNE	A4,-1			; LINK TO NEXT WORD ?
	JRST	DDGC.A			; NO  - JUST READ CHAR
	HRLI	A4,(POINT 7,0)		; YES - FORM NEW POINTER
	MOVEM	A4,@%DDTIP(DB)		; AND REWRITE TO MEMORY
DDGC.A:	ILDB	A4,@%DDTIP(DB)		; READ CHAR FROM AUTOLIST
	CAIA				; AND SKIP
DDGC.I:	ILDB	A4,%DDTIP(DB)		; NOT AUTOLIST - GET CHAR.
	CAIN	A4,.CONT		; CONTINUATION ?
	  JRST	DDGCA2			; YES 
	CAIE	A4,.SCOL
	CAIN	A4,.ESC
	  POPJ	SP,			; TERMINATOR - NON-SKIP RETURN.
	CAIN	A4,.EQU			; = ?
	TLNE	FL,DDGTMP		; YES - PRECEDED BY : ?
	  SKIPA
	  POPJ	SP,			; NO - IS TERMINATOR.
	CAIN	A4,.COLON
	  TLOA	FL,DDGTMP		; REMEMBER : (FOR := CHECK)
	  TLZ	FL,DDGTMP
	CAIL	A4,.LF			; VERTICAL
	CAILE	A4,.FF			;  PAPER-MOVER ?
	  JRST	CPOPJ1			; NO - SKIP RETURN.
	POPJ	SP,			; YES.

DDGCA2:	PUSHJ	SP,DDGCA4		; GET LINE (WITH PROMPT)
	JRST	DDGCA0			;

DDGCA4:	PUSH	SP,A1
	PUSH	SP,A2
	PUSH	SP,A10
	PUSH	SP,A11
	PUSHJ	SP,DDGTLN		; CONTINUATION - GET LINE (PROMPT)
	POP	SP,A11
	POP	SP,A10
	POP	SP,A2
	POP	SP,A1
	POPJ	SP,			;

DDGTCH:	; Get a character. Convert lower to upper-case.
	PUSHJ	SP,DDGTLC
	CAIL	A4,.LCA
	CAILE	A4,.LCZ
	  POPJ	SP,
	SUBI	A4,.LCA-.A		; CONVERT TO UPPER.
	POPJ	SP,

DDIGCH:	; Gets a character to A4. Ignores blanks.
	PUSHJ	SP,DDGTCH
	CAIN	A4,.SPACE		; TABS HAVE ALREADY BEEN MADE SPACES.
	  JRST	DDIGCH
	POPJ	SP,

DDGTIN:	; Get a line from an indirect file.
	; Clobbers A10, A11.
	MOVEI	A1,^D130		; MAX LINE LENGTH.
	PUSH	SP,FL
	PUSH	SP,A12			; MAY BE IN AUTOLIST I/P MODE.
	MOVE	A2,A10			; INBYTE CLOBBERS A10.

DDGTI3:	PUSHJ	SP,INBYTE		; GET CHAR TO A13 (==FL !!)
	  JRST	DDGTI2			; EOF.
	CAIN	A13,.CR			; EOL ?
	  JRST	DDGTI6			; YES.
	CAIL	A13,.LF			; VERTICAL
	CAILE	A13,.FF			;  PAPER-MOVER ?
	  JRST	DDGTI5			; NO.
	JRST	DDGTI3			; YES - IGNORE.

DDGTI5:	IDPB	A13,A2
	CAIN	A13,.SCOL		; END OF COMMAND ?
	  JRST	DDGTI7			; YES.
	SOJG	A1,DDGTI3		; NO - GET NEXT CHAR, UNLESS
	 DDTERR	^D83			;  TOO LONG.

DDGTI6:	; Return a semi-colon.
	MOVEI	A13,.SCOL
	JRST	DDGTI5

DDGTI7:	; End of command.
	MOVE	A2,[POINT 7,%DDTCB(DB)]	; [E106] SET UP BUFFER POINTER
	MOVEM	A2,%DDTIP(DB)
	POP	SP,A12
	POP	SP,FL
	POPJ	SP,

DDGTI2:;	End-of-file.
	MOVEI	FL,DDINDF		; CLEAR
	ANDCAM	FL,%DDTFL(DB)		;  INDIRECT FILE FLAG.
	HLRZ	A1,%CHAN(DB)		; GET CHAN #
	PUSH	SP,A3
	PUSHJ	SP,RELESE		; RELEASE IT.
	  JFCL				; IGNORE ERROR.
	POP	SP,A3
	HRROS	%CHAN(DB)		; RESET I/P TO TTY:
	JRST	DDGTI6
	SUBTTL	Debugging system - command scanner subroutines.

SCAN:	; Gets an identifier. Puts in buffer %DDTIB(DB), in ASCII.
	; Also puts it,  complete with upper- and lower-case,  and
	; "."'s (readability symbols) in buffer %DDTFB(DB); A10 is
	; left pointing to end of identifier in this last buffer.
	; Delimiter is left in A4.
	; Enter with first non-blank character in A4.

EDIT(106); Remember buffers can move if stack shifts.
	MOVE	A10,[POINT 7,%DDTFB(DB)]; [E106] SET UP BYTE POINTERS
	MOVE	A6,[POINT 7,%DDTIB(DB)]	; [E106] TO OUTPUT BUFFERS
	MOVSI	A5,%DDTFB(DB)		; [E106] AND CLEAR OUT
	HRRI	A5,%DDTFB+1(DB)		; [E106] BOTH BUFFERS
	SETZM	%DDTFB(DB)		; [E106] BEFORE SCANNING
	BLT	A5,%DDTFB+^D26(DB)	; [E106] OVER  IDENTIFIER
	MOVSI	A5,%DDTIB(DB)		; ..
	HRRI	A5,%DDTIB+1(DB)		; ..
	SETZM	%DDTIB(DB)		; ..
	BLT	A5,%DDTIB+^D13(DB)	; ..
	MOVEI	A5,^D64			; MAX LENGTH.
	CAIL	A4,.A
	CAILE	A4,.Z			; UPPER-CASE ALPHABETIC ?
	JRST	SCANA1			; NO

SCANA4:	IDPB	A4,A6			; YES.
	SOJL	A5,DDER6		; MORE THAN 64 CHARS ?

SCANA2:	IDPB	A4,A10			; TO OTHER BUFFER.

SCANA6:	PUSHJ	SP,DDGTLC		; GET CHARACTER TO A4
	CAIL	A4,.A			; IS IT
	CAILE	A4,.Z			;  UPPER-CASE ALPHA ?
	JRST	SCANA3			; NO
	JRST	SCANA4			; YES - PUT IN BOTH BUFFERS.

SCANA1:	CAIE	A4,.PRCNT		; "%" ?
	  JRST	SCANA3			; NO
	TLO	FL,DD%FLG		; YES - REMEMBER
	JRST	SCANA2			; PUT IN TYPEOUT BUFFER ONLY - GET NEXT

SCANA3:	CAIN	A4,.DOT			; PERIOD ?
	  JRST	SCANA7			; YES - TYPEOUT BUFFER ONLY GETS THESE
	CAIL	A4,.ZERO		; IS IT
	CAILE	A4,.NINE		;  A DIGIT ?
	  JRST	SCANA5			; NO
	JRST	SCANA4			; YES

SCANA5:	CAIL	A4,.LCA			; IS IT A
	CAILE	A4,.LCZ			;  LOWER-CASE LETTER ?
	  POPJ	SP,			; NO - IT'S A DELIMITER !
	IDPB	A4,A10			; YES - AS IT IS TO TYPEOUT BUFFER
	SUBI	A4,.LCA-.A		;  AND IN UPPER-CASE
	IDPB	A4,A6			;   TO IDENTIFIER BUFFER
	SOJL	A5,DDER6		; TOO LONG ?
	JRST	SCANA6			; NO - GET NEXT.

SCANA7:	; dot
	PUSHJ	SP,DDGTCH
	CAIE	A4,.LBRA		; BYTE-SUBSCRIPT ?
	  JRST	SCANA8			; NO - READABILITY SYMBOL
	MOVEI	A4,.BYTES		; YES - GET .[ PSEUDO-CHAR
	POPJ	SP,			; EXIT

SCANA8:	PUSH	SP,A4			; SAVE NEW CHAR
	MOVEI	A4,.DOT
	IDPB	A4,A10
	POP	SP,A4			; RESCUE NEW CHAR.
	JRST	SCANA6+1		; DEAL WITH NEXT CHAR (WE ALREADY HAVE IT)
SCAN3:	; Same as SCAN, but see if delimiter is a space.
	; If so, skip spaces.

	PUSHJ	SP,SCAN
	CAIE	A4,.SPACE
	  POPJ	SP,
	PJRST	DDIGCH			; GET NEXT NON-SPACE.
SCAN4:	; Used to scan first element of command line.
	; Understands about subscripts etc.
	; Leaves the identifier in ASCII in buffer %DDTIB(DB).
	; Whole field is left in buffer %DDTFB(DB), just as typed.
	; A10 points to first character in %DDTFB-buffer after the identifier.
	; Also sets flags in FL to say whether subscripted etc.
	; Enter with non-blank character in A4.
	; Exits with non-blank character in A4.

	PUSHJ	SP,SCAN3		; GET IDENTIFIER.
	CAIE	A4,.SLASH
	CAIN	A4,.EQU
	  POPJ	SP,			; IDENTIFIER IS COMMAND.
	CAIN	A4,.COMMA
	  POPJ	SP,
	CAIN	A4,.SCOL
	  POPJ	SP,			; END OF COMMAND LINE
	MOVE	A11,A10
	CAIE	A4,.LBRA		; SUBSCRIPT ?
	  JRST	SCAN4A			; NO
	TLO	FL,DDSUBS		; YES - REMEMBER

SCAN4E:	IDPB	A4,A11			;  AND SAVE THE "[" IN TYPEOUT BUFFER
	PUSHJ	SP,DDIGCH		; GET NON-BLANK CHAR TO A4
	CAIE	A4,.PLUS		; +
	CAIN	A4,.MINUS		;  OR - ?
	  JRST	SCAN4D			; YES - OK
	CAIL	A4,.ZERO		; DIGIT ?
	CAILE	A4,.NINE		;  ?
	  JRST	SCAN4C			; NO

SCAN4D:	IDPB	A4,A11			; YES - SAVE
	PUSHJ	SP,DDGTCH
	CAIL	A4,.ZERO
	CAILE	A4,.NINE
	  SKIPA				; NOT DIGIT 
	JRST	SCAN4D			; DIGIT - LOOP
	CAIN	A4,.SPACE
	  PUSHJ	SP,DDIGCH		; IGNORE SPACES.
	CAIE	A4,.COLON		; ARRAY SLICE ?
	  JRST	SCAN4F			; NO
	TLO	FL,DDSLIC		; YES - REMEMBER
	JRST	SCAN4E

SCAN4C:	CAIE	A4,.AST			; * ?
	  DDTERR 7			; NO - NO MORE LEGAL ONES LEFT !
	TLO	FL,DDSLIC		; YES - ARRAY SLICE (ARRY[*,2])
	IDPB	A4,A11
	PUSHJ	SP,DDIGCH

SCAN4F:	CAIN	A4,.COMMA		; COMMA (NEXT SUBSCRIPT) ?
	  JRST	SCAN4E			; YES - LOOP.
	CAIE	A4,.RBRA		; NO - ] ?
	  DDTERR 7			; ONLY POSSIBILITY LEFT.
	IDPB	A4,A11			; IT WAS
	PUSHJ	SP,DDIGCH		; GET NEXT.
	CAIE	A4,.DOT			; BYTE-SUBSCRIPTED STRING ARRAY?
	  JRST	SCAN4Z			; NO
	IDPB	A4,A11
	PUSHJ	SP,DDGTCH		; BETTER BE [
	CAIE	A4,.LBRA
	  DDTERR ^D8			; WASN'T.
	JRST	SCAN4G

SCAN4A:	CAIE	A4,.BYTES		; BYTE SUBSCRIPT ?
	  JRST	SCAN4Z			; NO - DONE.
	MOVEI	A4,.DOT
	IDPB	A4,A11
	MOVEI	A4,.LBRA

SCAN4G:	TLOE	FL,DDBYTS		; SET FLAG. ALREADY SET ?
	  DDTERR ^D9			; YES - SILLY.
	JRST	SCAN4E			; TREAT LIKE ARRAY SUBSCRIPT.

SCAN4Z:	CAIE	A4,.COLON		; TEST FOR :=
	  POPJ	SP,
	PUSHJ	SP,DDGTCH		; NO SPACE ALLOWED BETWEEN : AND =
	CAIE	A4,.EQU			; OK ?
	  DDTERR ^D10			; NO
	MOVEI	A4,.ASIGN		; YES - SUBSTITUTE "_"
	POPJ	SP,
	SUBTTL	Debugging system - entry routine - read symbol table.

DDGTCN:	; Get a free channel - returns with chan # in A1. Uses A0,A1,A2,A3,A4.
	MOVEI	A1,17(DB)		; START AT THE TOP.

DDGTC1:	SKIPN	%IODR(A1)		; IN USE ?
	JRST	DDGTC4			; NO
	CAILE	A1,(DB)			; YES - MORE ?
	SOJA	A1,DDGTC1		; YES
	MOVEI	A1,0
	MOVE	A4,[-1,,.GTLIM]		; [243] LOAD GETTAB TABLE INDEX
	GETTAB	A4,			; [243] GET THE TABLE INFORMATION
	LIBERR	5,			; [243] COMPLAIN IF GETTAB FAILS
	TLNE	A4,JB.LBT		; [243] IS THIS A BATCH JOB?
	JRST	DDGTC6			; [243] YES, USE CHANNEL 0
	OUTSTR	[ASCIZ/
?ALGNFC No free channel for debugging system. Which one can I free ? /]

DDGTC2:	INCHWL	A4			; GET CHAR OF ANSWER.
	CAIE	A4,.SPACE
	CAIN	A4,.HT
	  JRST	DDGTC2			; IGNORE SPACES & TABS.
	CAIL	A4,.ZERO
	CAILE	A4,.NINE
	  JRST	DDGTC3
	IMULI	A1,^D10
	ADDI	A1,-.ZERO(A4)
	JRST	DDGTC2

DDGTC3:	CAIN	A4,.CR			; IF CR
	 INCHWL	A4			;  THEN SUCK UP LF TOO
	CAILE	A1,^D15			; SENSIBLE # ?
	  JRST	DDGTC5			; NOT VERY.

DDGTC6:	PUSHJ	SP,RELESE		; YES - GET IT BACK.
	  JFCL				; REGARDLESS.
	POPJ	SP,

DDGTC4:	SUBI	A1,(DB)			; "DELOCATE" CHANNEL #
	POPJ	SP,



DDGTC5:	OUTSTR	[ASCIZ/
Bad channel # - must be less than 16. Try again:/]
	MOVEI	A1,0
	JRST	DDGTC2
DDINIT:	SETZM	.JBINT			; TURN OFF CONTROL-C INTERCEPT.
	PUSHJ	SP,DDGTCN		; GET FREE CHANNEL.
	MOVEI	A2,1
	MOVEM	A2,%DDTST(DB)		; SAY UNSUCCESSFUL, UNTIL DONE.
					; READ SWITCH.INI, IF THERE.
	MOVE	A4,[-1,,.GTLIM]		; [243] LOAD GETTAB TABLE INDEX
	GETTAB	A4,			; [243] GET THE TABLE INFORMATION
	LIBERR	5,			; [243] COMPLAIN IF GETTAB FAILS
	TLNE	A4,JB.LBT		; [243] IS THIS A BATCH JOB?
	TLO	A1,400000		; [243] YES, REMEMBER.
	JUMPL	A1,DDINTF		; [243] DON'T READ SWITCH.INI IF BATCH
	PUSH	SP,%CHAN(DB)		; [243] ELSE SAVE OLD CHANNELS
	HRLM	A1,%CHAN(DB)		; SET OURS
	MOVEI	A10,(A1)		;
	MOVEI	A2,0			;
	HRLZI	A0,'DSK'		; SET DEVICE.
	PUSHJ	SP,INPT			; OPEN IT.
	JUMPN	A1,DDINTA		; FAILED.
	MOVEI	A1,(A10)		; RETRIEVE CHANNEL #
	MOVE	A2,[
	SIXBIT/SWITCH/]			; FILENAME.
	HRLZI	A3,'INI'		; EXTENSION.
	SETZB	A4,A5			; PPN.
	PUSHJ	SP,OPFILE		; OPEN IT.
	JUMPN	A0,DDINTA		; FAAIL.

DDINTB:	SETZ	A2,
	JSP	A3,DDINTD		; GETCHAR.
	CAIL	A13,.A			; LETTER
	CAILE	A13,.Z			;   ?
	  JRST	DDINTE			; NO.
	LSH	A2,6			; YES.
	IORI	A2,-40(A13)		; YES - PUT IN, IN SIXBIT.
	JRST	DDINTB+1		;  AND GET NEXT.

DDINTE:	CAMN	A2,[
	SIXBIT/ALGDDT/]			; US ?
	CAIE	A13,.SLASH		; YES - SWITCH ?
	  JRST	DDINTC			; NO - IGNORE IT.
	JSP	A3,DDINTD		; GET 1ST CHAR OF SWITCH.
	CAIN	A13,"E"			; EXPERT ?
	  HLLOS	%DDTER(DB)		; YES - REMEMBER.
	JRST	DDINTC			;

DDINTA:	HLRZ	A1,%CHAN(DB)		; GET OUR CHAN #
	POP	SP,%CHAN(DB)		; RESTORE ORIGINAL ONES.
	PUSHJ	SP,RELESE		; RELEASE IT.
	  JFCL				;

DDINTF:	SKIPN	%SFILE(DB)		; ANY SYMBOL FILE ?
	 DDTERR	1,^D94			; NO - /PRODUCTION OR SOMETHING.

DDINTY:	PUSH	SP,A1			; [241] SAVE A1 TEMPORARILY
	PUSHJ	SP,DDINTX		; [241] TRY TO READ SYMBOL TABLE
	POP	SP,A1			; [241] (RESTORE A1)
	SKIPGE	%DDTST(DB)		; [241] SUCCESSFUL ?
	POPJ	SP,			; [241] YES, RETURN
	JUMPL	A1,CPOPJ		; [241] NO, DON'T PROCEED IF BATCH JOB
	PUSHJ	SP,CHKJCT		; [241] CHECK JACCT BIT IF NOT BATCH JOB
	POPJ	SP,			; [241] JACCT IS ON - RETURN NOW!
	PUSH	SP,A1			; [241] JACCT IS OFF - CONTINUE
	OUTSTR	[ASCIZ/
Is one available (Y or N)?/]		; [241] ASK USER ABOUT .SYM FILE

DDINT1:	PUSHJ	SP,DDGTLN		; GET REPLY.
	PUSHJ	SP,DDGTCH		; GET CHARACTER.
	CAIN	A4,"N"			; NO ?
	JRST	[OUTSTR	[ASCIZ/
The debugging system will not know about line-numbers or identifiers.
/]					; [241] TELL USER ABOUT ALGDDT'S PROBLEM
		POP	SP,A1
		POPJ	SP,]
	CAIN	A4,"Y"			; YES ?
	  JRST	DDINTZ			; YES - GET ITS NAME.
	OUTSTR	[ASCIZ/
Respond with Y or N./]			; [241] USER GAVE BAD INPUT - HELP HIM
	JRST	DDINT1			; TRY AGAIN.

DDINTZ:	TTCALL	3,[ASCIZ/
Enter symbol filename: /]
	PUSHJ	SP,DDGTLN		; GET IT.
	PUSHJ	SP,DDGTCH		; GET FIRST CHAR.
	MOVSI	A6,'SYM'		; DEFAULT EXTENSION.
	MOVSI	A0,'DSK'		; DEFAULT DEVICE.
	PUSHJ	SP,DDGTFL		; GET FILE-NAME.
	; RETURNS IT IN A5, EXT IN A6, PPN IN A7, DEVICE IN A0.
	  JRST	DDINTZ			; NON-SKIP RETURN SAYS SYNTAX ERROR.
	MOVEM	A5,%SFILE+1(DB)
	MOVEM	A0,%SFILE(DB)
	MOVEM	A6,%SFILE+2(DB)
	MOVEM	A7,%SFILE+3(DB)
	POP	SP,A1
	JRST	DDINTY			; TRY TRY TRY AGAIN.

; SUBROUTINES FOR SWITCH.INI

DDINTC:	; Skip rest of line.
	JSP	A3,DDINTD		; GET CHAR.
	CAIL	A13,.LF			; LINE 
	CAILE	A13,.FF			;   TERMINATOR ?
	  JRST	DDINTC			; NO.
	JRST	DDINTB			; YES.

DDINTD:	; GET CHAR TO A13. IGNORE BLANKS ETC. CONV L/C TO U/C.
	; CALL BY JSP A3,
	PUSHJ	SP,INBYTE		; GET CHAR.
	  JRST	DDINTA			; EOF.
	CAIE	A13,.SPACE		; [ P77]
	CAIN	A13,.HT			; IGNORE SPACES ETC.
	  JRST	DDINTD			; YES.
	CAIL	A13,.LCA		; L/C ?
	  SUBI	A13,.LCA-.A		; YES.
	JRST	(A3)			;
DDINTX:	LSH	A1,^D23			; MOVE CHAN # TO ACC FIELD
	MOVE	A6,A1			; SAVE
	ADD	A1,[
	OPEN	A2]			; MAKE A UUO.
	MOVEI	A2,16			; DUMP MODE *****
	MOVE	A3,%SFILE(DB)		; DEVICE, LEFT BY COMPILER.
	MOVEI	A4,0
	XCT	A1			; DO AN OPEN
	  DDTERR 1,^D11			; NO DEVICE.
	MOVE	A1,A6			; GET CHAN #
	ADD	A1,[
	LOOKUP	A2]			; MAKE ANOTHER UUO.
	SKIPN	A2,%SFILE+1(DB)		; FILENAME
	  MOVE	A2,%IFDAT+1(DB)		; DEFAULT - USE LOAD-FILE NAME
	SKIPN	A3,%SFILE+2(DB)		; EXTENSION
	  MOVSI	A3,'SYM'		; DEFAULT TO .SYM
	MOVE	A5,%SFILE+3(DB)		; PPN
	SKIPN	%SFILE+4(DB)		; SFD'S ?
	  JRST	DDINT6			; NO
	SETZM	%SFILE+2(DB)		; YES - CLEAR SCAN SWITCH
	MOVEI	A5,%SFILE+1(DB)		; PATH BLOCK ADDRESS (1ST WORD IGNORED)

DDINT6:	SETZM	A4
	XCT	A1			; LOOKUP .SYM FILE
	DDTERR	1,^D12			; LOOKUP FAILED, TELL USER
	HLRE	A4,A5			; GET WORD-COUNT
	SKIPL	A4
	DDTERR	1,^D13
	MOVN	A0,A4
	ADDI	A0,1			; ALLOW FOR ZERO WORD ON END.
	PUSHJ	SP,GETOWN		; GET SOME SPACE FOR S.T.
	HRL	A1,A4			; -COUNT,,ADDR
	SUBI	A1,1			; MAKE IOWD
	MOVEI	A2,0			; STOP WORD
	MOVE	A3,A6
	ADD	A3,[
	IN	A1]			; MORE UUO'S
	XCT	A3			; DUMP MODE READ WHOLE THING.
	SKIPA				; WORKED
	DDTERR	1,^D14			; DIDN'T
	ADD	A6,[
	RELEASE	]
	XCT	A6			; RELEASE CHANNEL.

	; WE NOW HAVE SYMBOL TABLE IN CORE.

	ADDI	A1,1			; MAKE IOWD INTO AOBJN WORD.
	HLRZ	A5,(A1)			; GET FIRST WORD.
	CAIN	A5,1044			; IF IT'S S.T. TYPE,,LENGTH,
	  AOBJN	A1,.+1			;  IGNORE IT,
	CAIN	A5,1044			;   
	  ADDI	A4,1			;   AND UPDATE (-LENGTH)
	MOVEM	A1,%DDTST(DB)		; SAVE IT
	SUBI	A1,(A4)			; GET ADDRESS OF WORD AFTER S.T.
	SETOM	(A1)			;  AND MARK IT (A4 = -LENGTH).
EDIT(066); Calculate BLKIDX correctly
	SETZB	A0,A1			; [E066] SET COUNTS TO ZERO
	HRRZ	A2,%DDTST(DB)		; [E066] GET START OF S.T.

DDINT7:	SKIPN	A3,(A2)			; [E066] GUARD AGAINST ZERO WORDS
	AOS	A3,(A2)			; [E066] WHICH NOW HAVE LENGTH ONE !
	ADDI	A2,(A3)			; [E066] STEP ON TO NEXT ADDRESS
	ADDI	A4,(A3)			; [E066] AND ACCOUNT FOR LENGTH
	HLRZ	A3,A3			; [E066] NOW GET ITEM TYPE
	CAIN	A3,'BLK'		; [E066] BLOCK HEADER ?
	SUBI	A1,1			; [E066] YES - COUNT ONE MORE
	SUBI	A0,1			; [E066] COUNT ONE MORE ITEM
	JUMPL	A4,DDINT7		; [E066] REPEAT FOR ALL ITEMS
	HRLM	A0,%DDTST(DB)		; [E066] THEN UPDATE ITEM COUNT
	HRLZM	A1,%DDTBI(DB)		; [E066] SAVE SIZE OF BLKIDX
	MOVN	A0,A1			; [E066] GET +SIZE OF BLKIDX
	PUSHJ	SP,GETOWN		; [E066] AND ASK FOR THE SPACE
	ADDB	A1,%DDTBI(DB)		; [E066] FORM AOBJN POINTER TO BLKIDX
	MOVE	A2,%DDTST(DB)		; [E066] AND GET POINTER OVER SYMBOL TABLE

	TDZA	A3,A3			; [E066] SET DEPTH COUNT TO ZERO
DDINT8:	AOBJP	A2,STBERR		; [E066] CHECK NOT OFF END !
	PUSH	SP,[EXP 0]		; [E066] INITIALIZE BACK-LINK TO ZERO
DDINT9:	MOVEI	A4,(A2)			; [E066] GET CURRENT ADDRESS
	MOVE	A5,(A2)			; [E066] PICK OUT AN ITEM
	ADDI	A2,-1(A5)		; [E066] AND STEP OVER IT
	HLRZ	A5,A5			; [E066] GET CODE INTO R.H.
	CAIN	A5,'BKS'		; [E066] BLOCK START ?
	AOJA	A3,DDINT8		; [E066] YES - PROCESS INNER BLOCK
	CAIE	A5,'BLK'		; [E066] BLOCK HEADER ?
	JRST	DDNT12			; [E066] NO  - TRY NEXT ITEM
	SOJL	A3,STBERR		; [E066] DO WE EXPECT ONE ?
	POP	SP,A5			; [E066] YES - GET BACK LINK
DDNT10:	SKIPN	A6,A5			; [E066] IS LINK ZERO ?
	JRST	DDNT11			; [E066] YES - ALL LINKED
	HLRZ	A5,(A6)			; [E066] NO  - GET NEXT ADDRESS
	HRLM	A1,(A6)			; [E066] POINT IT TO HERE
	JRST	DDNT10			; [E066] AND TRY AGAIN
DDNT11:	HRL	A4,(SP)			; [E066] PICK UP BACK LINK
	MOVEM	A4,(A1)			; [E066] STORE LINK,,ADDRESS
	SKIPE	A3			; [E066] IF NOT AT LEVEL 0
	HRRZM	A1,(SP)			; [E066] SET NEW BACK LINK
	AOBJP	A1,DDNT13		; [E066] AND STEP BLKIDX POINTER
DDNT12:	AOBJN	A2,DDINT9		; [E066] READ NEXT ENTRY FROM S.T.
STBERR:	HRRZS	%DDTST(DB)		; [E066] SYMBOL TABLE FOULED UP
	DDTERR	1,^D16			; [E066] MARK AS UNREAD, TELL USER

DDNT13:	JUMPN	A3,STBERR		; [E066] CHECK DEPTH IS NOW 0
	POP	SP,A0			; [E066] O.K. - TIDY UP STACK
	HRRZ	A0,%DDTST(DB)		; [E066] GET BASE ADDRESS OF S.T.
	MOVN	A0,A0			; [E066] AND GET THE NEGATIVE
	MOVE	A1,%DDTBI(DB)		; [E066] GET AOBJN POINTER
	ADDM	A0,(A1)			; [E066] CONVERT ADDRESS TO OFFSET
	AOBJN	A1,.-1			; [E066] LOOP FOR EACH ENTRY
;
; Here, BLKIDX is completed. Its format is:
; 1 word for each block of the program in the same order as the blocks in the S.T.
; L.H.	pointer-to-BLKIDX-entry-for-containing-block
; R.H.	offset-in-s.t.-of-this-block's-block-header.
; The outermost block (which had better be the last entry!) has LH = 0.
;
; Now link the 'MRK' sentinel records through the L.H. of the second word.
; The links are as follows :-
;	Type 0	'exit'	not used
;	Type 1	'for'	points to matching 'do'
;	Type 2	'do'	 "  "   "   "  "   'od'
;	Type 3	'od'	 "  "   "   "  "   'for'
;	Type 4	'if'	 "  "   "   "  "   'then'
;	Type 5	'then'	 "  "   "   "  "   'else' or 'fi'
;	Type 6	'else'	 "  "   "   "  "   'fi'
;	Type 7	'fi'	not used
;	Type 8	'go'	points to matching 'to'
;	Type 9	'to' contains relative PC of transfer instruction

	HRRZ	A3,%DDTST(DB)		; Get start address of S.T.
DDNT14:	PUSHJ	SP,GETMRK		; Get next sentinel record
	 JRST	[CAIN	A2,'MOD'	; No more. End of module, or S.T. ?
		 JRST	DDNT14		; Another module - process it
		 POPJ	SP,]		; End of S.T. - all done
	PUSHJ	SP,DDNT15		; Go process one construct
	 JRST	MRKERR			; Bad match - give up
	JRST	DDNT14			; and repeat until S.T. exhausted

DDNT15:	HRLM	A3,(SP)			; Save current address on stack
	CAIG	A2,^D9			; Is item type within range ?
	XCT	DDNT16(A2)		; Yes - dispatch on item type
	POPJ	SP,			; No  - error

DDNT16:	PHASE	0		; To define symbols M.XXXX
M.EXIT:	JRST	CPOPJ1		; Type 0 ('exit') - return
M.FOR:	JRST	DDNT17		; Type 1 ('for')
M.DO:	POPJ	SP,		; Type 2 ('do')
M.OD:	POPJ	SP,		; Type 3 ('od')
M.IF:	JRST	DDNT21		; Type 4 ('if')
M.THEN:	POPJ	SP,		; Type 5 ('then')
M.ELSE:	POPJ	SP,		; Type 6 ('else')
M.FI:	POPJ	SP,		; Type 7 ('fi')
M.GO:	JRST	DDNT25		; Type 8 ('go')
M.TO:	POPJ	SP,		; Type 9 ('to')
	DEPHASE

SCANST:	ADD	A3,(A3)			; Add length (step to next entry)
	MOVEI	A3,(A3)			; Clear L.H. to avoid overflow
	HLRZ	A2,(A3)			; Get record type
	CAIE	A2,'MOD'		; If this is next module,
	CAIN	A2,777777		; or end of S.T.
	POPJ	SP,			; Take non-skip return
	JRST	CPOPJ1			; otherwise skip

GETMRK:	PUSHJ	SP,SCANST		; Get next entry from S.T.
	 POPJ	SP,			; No more in this module
	CAIE	A2,'MRK'		; Is this a sentinel record ?
	JRST	GETMRK			; No  - try next entry
	HRRZ	A2,1(A3)		; Yes - get sub-type
	JRST	CPOPJ1			; And take skip return

MRKERR:	HRRZS	%DDTST(DB)		; Mark symbol table as unuseable
	DDTERR	1,^D97			; And give error message

DDNT17:	; 'for' statement linkage
	PUSHJ	SP,DDNT18		; Perform forward linkage
	 POPJ	SP,			; Can't - error
	HLRZ	A2,(SP)			; Then get address of 'for' entry
	HRLM	A2,1(A3)		; and point 'od' item to it
	JRST	CPOPJ1			; Take skip return

DDNT18:	HRLM	A3,(SP)			; Store address for LNKMRK
	JSP	A1,CHKMRK		; Find next sentinel record
	  JFCL	M.DO			; And check that is a 'do'
DDNT19:	PUSHJ	SP,GETMRK		; Get next sentinel record
	 POPJ	SP,			; Error (end of module)
	CAIN	A2,M.OD			; Is this the terminator ?
	JRST	DDNT20			; Yes - link it, and exit
	PUSHJ	SP,DDNT15		; No  - process substatement
	 POPJ	SP,			; Failed
	JRST	DDNT19			; And try again

DDNT20:	; Found desired terminator
	JSP	A1,LNKMRK		; Perform forward linkage
	JRST	CPOPJ1			; And return

DDNT21:	; 'if' statement linkage
	JSP	A1,CHKMRK		; Find next sentinel record,
	  JFCL	M.THEN			; and check that it is a 'then'
DDNT22:	PUSHJ	SP,GETMRK		; Get next sentinel record
	 POPJ	SP,			; Error (end of module)
	CAIN	A2,M.FI			; Is this the end ?
	JRST	DDNT20			; Yes - link it, and return
	CAIN	A2,M.ELSE		; No  - if .. then .. else ?
	JRST	DDNT23			; Yes
	PUSHJ	SP,DDNT15		; No  - process substatement
	 POPJ	SP,			; Error
	JRST	DDNT22			; And try again
DDNT23:	JSP	A1,LNKMRK		; 'else' - link from 'then'
DDNT24:	PUSHJ	SP,GETMRK		; Get next sentinel record
	 POPJ	SP,			; Error (end of module)
	CAIN	A2,M.FI			; Is this the terminator ?
	JRST	DDNT20			; Yes - link it, and return
	PUSHJ	SP,DDNT15		; No  - process substatement
	 POPJ	SP,			; Error
	JRST	DDNT24			; And try again

DDNT25:	; 'goto' statement linkage
	JSP	A1,CHKMRK		; Find next sentinel record,
	  JFCL	M.TO			; And check that it is a 'to'
	JRST	CPOPJ1			; Then return

CHKMRK:	PUSHJ	SP,GETMRK		; Get next sentinel record
	 POPJ	SP,			; Error (end of module)
	CAIE	A2,@(A1)		; Is it the correct type ?
	POPJ	SP,			; No  - error
LNKMRK:	HLRZ	A2,(SP)			; Yes - get previous address
	HRLM	A3,1(A2)		; Store forward link
	HRLM	A3,(SP)			; Update previous address
	JRST	(A1)			; And return
	SUBTTL	Debugging system - find address routine.

	; Given a PC value (in A4) this routine finds it in the S.T.
	; Returns with the line #(right half) and statement-with-line #(left half)
	; in A4.  It also sets up %DDTBE(DB) to the address of the context-block's
	; entry in BLKIDX (which in turn points to the block's block header in the
	; S.T. and to the containing block), and %DDTBT to xwd address of the LINK
	; S.T.E., address of STN item, if not already set.
	; Also returns Radix-50 module-name in A5. Skips if O.K.
	; Uses AC's A0-A6.
	; ASSUMPTION : that LINK s.t. is in descending order of addresses
	;  (at least for type-0 items, i.e. titles.)

FNDADR:	PUSH	SP,A4
	SKIPN	%DDTST(DB)		; S.T. IN CORE?
	  PUSHJ	SP,DDINIT		; NO - GET IT THERE.
	POP	SP,A4
	SKIPL	%DDTST(DB)		; SUCESSFULL ?
	 DDTERR	1,1			; NO.

FNDAD0:	SKIPN	A6,.JBSYM		; GET POINTER TO LINK S.T.
	  JRST	[
		MOVEI	A1,1		; NOT THERE -
		MOVEM	A1,%DDTST(DB)	;  THIS IS FAIRLY FATAL, SO
		DDTERR	1,^D17	]	;   TURN OFF DEBUGGER.

FNDAD3:	MOVE	A5,(A6)			; GET LINK S.T. ITEM
	TLNN	A5,740000		; TYPE = 0 ?
	  JRST	FNDAD1			; YES.

FNDAD2:	AOBJN	A6,.+1			; ADVANCE TO NEXT ITEM OF LINK S.T.
	AOBJN	A6,FNDAD3
	 POPJ	SP,			; [E1000] NONE - CAN'T RESOLVE ADDR.

FNDAD1:	HRRZ	A2,1(A6)		; TYPE 0 - GET ADDR.
	CAIGE	A4,(A2)			; FOUND ?
	  JRST	FNDAD2			; NO.

	; Here, A5 is module-name, in right-justified RADIX50.
	;  A6 is pointer to item in LINK symbol-table.

	MOVE	A7,A5			; Get module name into A7
	PUSHJ	SP,FNDMOD		; Get address of Link S.T. entry
	 POPJ	SP,			; ? Don't be silly !
	MOVEI	A10,(A10)		; Clear possible junk from L.H.
	CAIE	A10,(A6)		; Is this the same entry ?
	POPJ	SP,			; No - return

;   The above test can only fail if there are two link S.T. entries with the
; same 'name'. This is most likely to occur when the name of the users Algol
; main program is the same as the name of a library routine.
	SUBI	A4,(A2)			; DELOCATE REQUIRED ADDR.
	SKIPL	A3,%DDTST(DB)		; GET POINTER TO OUR S.T.
	 DDTERR	1,1			; NONE.
	MOVEI	A0,0			; INITIALIZE BLOCK COUNTER.

FNDAD9:	HLRZ	A2,(A3)			; GET TYPE CODE FROM OUR S.T.
	CAIN	A2,'BLK'		; BLOCK HEADER ?
	  AOJA	A0,FNDAD4		; YES - COUNT IT.
	CAIN	A2,'MOD'		; NO - MODULE HEADER ?
	CAME	A5,2(A3)		; YES - RIGHT ONE ?
	  JRST	FNDAD4			; NO.

	; here, we've found module. Scan for STN with appropriate addr.

	PUSH	SP,A5			; SAVE MODULE NAME
	SETZB	A1,A5			; INIT 'PREVIOUS' POINTER.
					; **NOTE THAT THIS WORKS, BECAUSE 1(A1) = A1 I.E. 0
					; D O  N O T    CHANGE AC USAGE TO OTHER THAN A1 !!

FNDAD5:	MOVE	A2,(A3)			; ADVANCE TO NEXT ITEM IN OUR S.T.
	ADDI	A3,-1(A2)		; ACCOUNT FOR LENGTH
	AOBJP	A3,FNDAD6		; EXIT IF AT END
	HLRZ	A2,(A3)			; GET TYPE CODE.
	CAIN	A2,'MOD'		; NEXT MODULE ?
	  JRST	FNDAD6			; YES - NO FIND.
	CAIN	A2,'BKS'		; BLOCK START ?
	  AOJA	A5,FNDAD5		; YES - COUNT IT
	CAIN	A2,'BLK'		; BLOCK HEADER ?
	  AOJA	A0,[SOJA A5,FNDAD5]	; YES - COUNT IT.
	CAIE	A2,'STN'		; STATEMENT # ?
	  JRST	FNDAD5			; NO - SKIP.
	CAML	A4,1(A1)		; REQUIRED ADDR BETWEEN 'PREVIOUS'
	CAML	A4,1(A3)		;  AND 'THIS' ?
	  JRST	FNDAD8			; NO.

	; Found.
	; Now look for appropriate block-end (BLK) item,
	; to establish context.

FNDAD6:	JUMPE	A1,.+3			; IF BEFORE FIRST STN, USE THAT.
	MOVE	A3,A1			; RESTORE S.T. POINTER TO CONTEXT'S
	HLRZ	A0,A0			; RESTORE BLOCK-COUNT.
	MOVE	A4,2(A3)		; GET LINE # WORD.
	SKIPE	%DDTBE(DB)		; ANY CONTEXT YET ?
	 JRST	[POP	SP,A5
		 JRST	CPOPJ1]		; YES - DON'T SET AGAIN.
	HRLM	A6,%DDTPT(DB)		; SAVE ADDR OF LINK S.T.E., AND
	HRRM	A3,%DDTPT(DB)		; SAVE ADDR OF STN ITEM.
	MOVE	A6,A5			; GET BLOCK COUNT TO A6
	POP	SP,A5			; AND RESTORE MODULE NAME TO A5
	TDZN	A1,A1			; IF WE HAVE SET UP CONTEXT
	SOSL	A1,A6			; TO OR BEFORE A STN ITEM
	AOJA	A1,FNDAD7		; THEN CARRY ON
	POPJ	SP,			; BAD LUCK - GIVE UP

FNDAD7:	SKIPN	A6,(A3)			; GUARD AGAINST
	  MOVEI	A6,1			;  ZERO WORDS.
	HRLI	A6,1
	ADD	A3,A6			; ADVANCE TO NEXT ITEM.
	JUMPGE	A3,DDER16		; HORRORS - OFF THE END.
		;This means that compiler output fewer BLK's than BKS's.
	HLRZ	A6,(A3)			; GET ITEM TYPE.
	CAIN	A6,'BKS'		; BLOCK START ?
	  AOJA	A1,FNDAD7		; YES - COUNT IT.
	CAIE	A6,'BLK'		; BLOCK END ?
	  JRST	FNDAD7			; NO
	ADDI	A0,1			; YES - COUNT IT.
	SOJG	A1,FNDAD7		; SEE IF RIGHT LEVEL
	ADD	A0,%DDTBI(DB)		; GET ADDR OF BLKIDX ENTRY.
	SUBI	A0,1			; ADJUST.
	MOVEM	A0,%DDTBE(DB)		; AND SAVE.
	JRST	CPOPJ1			; AND EXIT.

FNDAD8:	MOVE	A1,A3			; SAVE THIS AS PREVIOUS
	HRL	A0,A0			; & SAVE BLOCK-COUNT
	JRST	FNDAD5			;  AND TRY NEXT.


FNDAD4:	; advance to next item in our S.T.
	MOVE	A2,(A3)			; GET ITEM LENGTH
	ADDI	A3,-1(A2)		; ACCOUNT FOR IT
	AOBJN	A3,FNDAD9		; AND REPEAT IF MORE LEFT
	POPJ	SP,			; MODULE NOT FOUND IN OUR S.T.
	; This means that the address was either in a non-ALGOL procedure,
	; or in an ALGOL procedure compiled with the /P switch.


DDER16:	DDTERR	1,^D16			; SEE NOTE ABOVE.
	SUBTTL	Debugging system - find line # routine.

FNDLIN:	; Converts a line-# (and statement-#-within-line) and module-name
	; into an address.
	; Enter with stmnt-#,,line-# in A0, module-name (in right-just RADIX50) in
	; A1 (zero means this module).
	; Exits with address in A2, pointer to BLKIDX entry in A3.
	; Also sets up A5 to point to STN item in S.T.
	; Also right-justified RAD50 module-name in A1 (always).
	JUMPE	A0,DDER20		; MUST HAVE A LINE NUMBER
	MOVSS	A0			; MAKE LINE#,,STMNT#
	MOVEI	A5,0			; INIT BLOCK COUNT.
	JUMPN	A1,FNDLN1		; THIS MODULE ?
	HLRZ	A1,%DDTPT(DB)		; YES - GET ITS NAME
	JUMPE	A1,FNDLN1		; IF ZERO, LEAVE IT.
	MOVE	A1,0(A1)		; FROM CURRENT LOADER S.T. ENTRY.

FNDLN1:	SKIPL	A3,%DDTST(DB)		; POINTER TO OUR SYMBOL-TABLE.
	 DDTERR	1			; NOT THERE.

FNDLN2:	HLRZ	A2,(A3)
	CAIN	A2,'MOD'		; MODULE HEADER ?
	  JRST	FNDLN4			; YES
	CAIN	A2,'BLK'		; BLOCK HEADER ?
	  ADDI	A5,1			; COUNT IT.

FNDLN3:	HRRZ	A2,(A3)			; ADVANCE TO
	HRLI	A2,1			; NEXT
	ADD	A3,A2			; ENTRY
	JUMPL	A3,FNDLN2		; IF ANY.
	  DDTERR ^D19			; MODULE NOT FOUND.

FNDLN4:	SKIPN	A1			; If no current module, use main 
			; program. (Which by LOADER-law is the first module.)
	MOVE	A1,2(A3)
	CAME	A1,2(A3)		; RIGHT MODULE ?
	  JRST	FNDLN3			; NO

	; Module found - now find line-#

FNDLN5:	HRRZ	A2,(A3)			; GET SIZE OF ITEM
	ADDI	A3,-1(A2)		; STEP OVER IT
	AOBJP	A3,DDER20		; LINE-# NOT FOUND.
	HLRZ	A2,(A3)			; GET TYPE CODE
	CAIN	A2,'BLK'		; END OF BLOCK ?
	  AOJA	A5,FNDLN5		; YES - COUNT IT
	CAIE	A2,'MOD'		; NEXT MODULE ?
	CAIN	A2,777777		; OR END OF TABLE ?
	 DDTERR	^D20			; YES - HE LOSES
	CAIE	A2,'STN'		; STATEMENT ITEM ?
	  JRST	FNDLN5			; NO.
	MOVS	A2,2(A3)		; YES - GET ITS LINE#,,STMNT#
	CAMGE	A2,A0			; SPOT-ON, OR GOOD GUESS ?
	  JRST	FNDLN5			; NO.

	; FOUND - NOW FIND CORRESPONDING BLOCK ITEM

	PUSH	SP,A3			; SAVE ADDRESS OF STN ITEM
	PUSH	SP,A7			; GET A WORK REGISTER
	SETZ	A7,			; AND CLEAR IT
FNDLN6:	HRRZ	A2,(A3)			; GET SIZE OF ITEM
	ADDI	A3,-1(A2)		; STEP OVER IT
	AOBJP	A3,DDER20		; ERROR IF OFF END
	HLRZ	A2,(A3)			; GET TYPE CODE
	CAIN	A2,'BKS'		; BLOCK START ?
	  AOJA	A7,FNDLN6		; YES - COUNT IT
	CAIE	A2,'MOD'		; IF NEXT MODULE,
	CAIN	A2,777777		; OR END FLAG
	 DDTERR	^D16			; SOMETHING IS WRONG
	CAIE	A2,'BLK'		; BLOCK HEADER ?
	JRST	FNDLN6			; NO  - TRY NEXT ITEM
	SOJL	A7,FNDLN7		; [E146] Any more blocks ?
	ADDI	A5,1			; YES - STEP BLKIDX
	JRST	FNDLN6			; [E146] CONTINUE IF INNER BLOCKS FOUND

	; now we have to find this module in LOADER S.T.

FNDLN7:	PUSH	SP,A10			; [E146]
	MOVE	A7,A1			; GET RADIX50 NAME.
	PUSHJ	SP,FNDMOD		; GET POINTER TO A10
	 DDTERR	^D21			; NOT FOUND - SYSTEM ERROR.
	MOVE	A2,A10			; FOUND -  GET POINTER.
	POP	SP,A10
	POP	SP,A7

	HRRZ	A2,1(A2)		; GET MODULE'S RELOCATION.
	HRRZ	A3,(SP)			; GET STN ADDRESS AGAIN
	ADD	A2,1(A3)		; RELATIVE PC OF LINE.
	HRRZ	A3,%DDTBI(DB)		; GET BLKIDX ADDRESS
	ADDI	A3,(A5)			; OF CORRECT ENTRY
	POP	SP,A5			; RESTORE STN ADDRESS
	POPJ	SP,
	SUBTTL	Debugging system - search symbol table.

	; SEARCH looks up an identifier in the symbol table, having
	; regard to scope rules.
	; A symbol table symbol entry looks like:
	;	XWD	Code,length-in-words	; Code is SIXBIT/SYM/
	;	XWD	Lexeme,Value
	;	ASCII	/name/
	;
	; On entry:
	; Identifier is in buffer %DDTIB(DB);
	; %DDTBE(DB) is pointer to current block's BLKIDX entry.
	; Sets A11 to be DL of identifier's context.
	; Also A7 to point to containing block's BLKIDX entry.

SEARCH:	TLNE	FL,DD%FLG		; %IDENT (PSEUDO-VARIABLE) ?
	JRST	SERCH%			; YES - SPECIAL CASE
	SKIPL	%DDTST(DB)		; NO  - MUST HAVE SYMBOL TABLE
	 DDTERR	1			; NOT THERE - ERROR
	SKIPA	A7,%DDTBE(DB)		; O.K. - GET BLOCK INDEX POINTER
SERCH1:	HLRZ	A7,(A7)			; GET CONTAINING BLOCK POINTER
	JUMPE	A7,SERCH4		; NO OUTER BLOCK - ERROR
	HRRZ	A1,%DDTST(DB)		; GET BASE ADDRESS OF SYMBOL TABLE
	ADD	A1,(A7)			; FORM ADDRESS OF ACTUAL BLK ITEM
SERCH2:	MOVEI	A5,%DDTIB(DB)		; GET ADDRESS OF IDENTIFIER BUFFER
	SKIPN	A3,(A5)			; AND FIRST WORD OF IDENTIFIER
	 DDTERR	^D22			; COMPLAIN IF BLANK

; Note that we fall in to this code directly from SERCH1 and SERCH2,
; but this can not cause any items to be missed, as the item pointed
; to by A1 will either be a BLK item (arrived via SERCH1),  or a STN
; item with a partial match (arrived via SERCH2).

SERCH3:	MOVEI	A1,(A1)			; CLEAR LEFT HALF TO AVOID OVERFLOW
	ADD	A1,(A1)			; AND STEP ON TO NEXT ITEM
	HLRZ	A2,(A1)			; GET TYPE CODE OF NEXT ITEM
	CAIN	A2,'BLK'		; BLOCK HEADER OF NEXT BLOCK ?
	JRST	SERCH1			; YES - MOVE TO CONTAINING BLOCK
	CAIE	A2,'MOD'		; MODULE HEADER OF NEXT MODULE
	CAIN	A2,777777		; OR END-OF-SYMBOL-TABLE MARKER ?
SERCH4:	POPJ	SP,			; YES - SYMBOL CAN NOT BE FOUND
	CAIN	A2,'SYM'		; IS THIS A SYMBOL ITEM ?
	CAME	A3,2(A1)		; IF SO, IS FIRST WORD RIGHT ?
	JRST	SERCH3			; NO TO EITHER - TRY NEXT ITEM
	SETCM	A2,(A1)			; SET LEFT HALF OF A2 TO MINUS
	MOVSI	A2,3(A2)		; THE NUMBER OF WORDS IN SYMBOL
	HRRI	A2,2(A1)		; (A2 IS AOBJN POINTER TO SYMBOL)

SERCH5:	AOBJP	A2,SERCH6		; JUMP IF NO MORE SYMBOL TO CHECK
	SKIPE	A3,1(A5)		; GET NEXT WORD OF TYPED IN IDENTIFIER
	CAME	A3,(A2)			; AND CHECK IT AGAINST SYM ENTRY
	JRST	SERCH2			; DIFFERENT - TRY NEXT ITEM IN S.T.
	AOJA	A5,SERCH5		; STILL MATCHES - CHECK REST OF NAME
SERCH6:	SKIPE	1(A5)			; REACHED END OF TYPED IDENTIFIER ?
	JRST	SERCH2			; NO  - NOT REALLY A MATCH
; A match has been found. A1 points to SYM item in S.T.,
; A7 points to BLKIDX entry for the block containing it.

	PUSHJ	SP,DDGTDL		; SET CONTEXT DL INTO A11
	MOVE	A6,1(A1)		; AND GET "LEXEME".
	TLNN	FL,DDSUBS		; DID HE TYPE A SUBSCRIPT ?
	JRST	SERCH7			; NO
	TLNE	A6,$KIND		; YES - IS THIS AN ARRAY
	TLNE	A6,$KIND-$ARR		; IDENTIFIER ?
	 DDTERR	^D24			; NO - SUBSCRIPT IS ILLEGAL
SERCH7:	TLNE	FL,DDBYTS		; BYTE SUBSCRIPT TYPED ?
	TLNN	A6,$TYPE-$S		; YES - MUST BE STRING VARIABLE
	AOSA	(SP)			; ALL O.K. - SKIP RETURN
	DDTERR	^D25			; BAD SYNTAX - COMPLAIN.
	POPJ	SP,			; RETURN

SERCH%:	TLNE	FL,DDSUBS!DDBYTS	; IS A PSEUDO. SUBSCRIPTED ?
	  DDTERR ^D26			; COMPLAIN IF SO.
	MOVSI	A1,-DD%TBL
	MOVEI	A2,%DDTIB(DB)		; GET ADDRESS OF TEXT BUFFER
	SKIPN	A2,(A2)			; GET 1ST WORD OF IDENT.
	 DDTERR	^D22			; ERROR IF BLANK
SERCH8:	CAMN	A2,DD%TAB(A1)		; COMPARE
	  JRST	SERCH9			; FOUND
	AOBJN	A1,SERCH8		; TRY NEXT
	DDTERR	^D23			; NO FIND.
SERCH9:	MOVE	A6,DD%LEX(A1)		; GET FAKE LEXEME,,VALUE
	AOS	(SP)			; SET UP SKIP
	POPJ	SP,			; AND RETURN

DDGTDL:	; Enter with pointer to BLKIDX entry in A7. Returns
	; context DL in A11.
	PUSH	SP,A1
	MOVE	A11,(A7)		; GET ADDRESS OF BLKHDR
	ADD	A11,%DDTST(DB)		; ADD START OF S.T.
	HRRZ	A11,2(A11)		; GET PROCEDURE LEVEL.
	HLRZ	A1,%DDTPC(DB)		; GET APPROPRIATE DISPLAY
	ADDI	A1,(DB)			; (RELOCATE)
;
;	See note at ERRM3B above for logic of this.
;
	ADDI	A11,-1(A1)		; GET APPROPRIATE CONTEXT DL FROM DISPLAY
	MOVEI	A11,@(A11)		; AND RELOCATE IT.
	POP	SP,A1
	POPJ	SP,
;	Define the table of pseudo-identifiers, such as %DB, %PLBLKL etc.
;	Each one has a V macro call in the definition of macro DDT%.
;	Format:	V	Name,Value,Type
;		where:	Name	is (up to 5 ASCII chars) its name (without %)
;			Value	is its address - can have index reg and @.
;			Type	is its (fake) type, $B to get typed in octal,
;						    $I to get typed in decimal
;

DEFINE	DDT%	<
	;V	NAME,VALUE,TYPE
	V	SP,SP,$B
	V	DB,DB,$B
	V	DL,DL,$B
	V	AX,AX,$B
	V	FL,FL,$B
	V	CONDL,CONDL(DL),$B
	V	PRGLNK,PRGLNK(DL),$B
	V	PMBPTR,PMBPTR(DL),$B
	V	BLKPTR,BLKPTR(DL),$B
	V	CHAN,%CHAN(DB),$B
	V	TTYCH,%TTYCH(DB),$B
	V	RAND,%RAND(DB),$B
	V	PLBLKL,PLBLKL(DL),$I
	V	VERSHN,%SYS23(DB),$B
	V	SHIFTS,%SYS20(DB),$I
	V	DYNLVL,%TRLV(DB),$I
	V	TRPTR,%TRPTR(DB),$B
	V	TRLNTH,%TRLNTH(DB),$I
	V	HEPWDS,%SYS24(DB),$I
	V	DDTST,%DDTST(DB),$B
	V	DDTBK,%DDTBK(DB),$B
	V	DDTAL,%DDTAL(DB),$B
	V	DDTBI,%DDTBI(DB),$B
	V	DDTTY,%DDTTY(DB),$B
	V	DDTPT,%DDTPT(DB),$B
	V	DDTIP,%DDTIP(DB),$B
	V	DDTER,%DDTER(DB),$B
	V	DDTFL,%DDTFL(DB),$B
	V	DDTPC,%DDTPC(DB),$B
	V	DDTUW,%DDTUW(DB),$B
	V	HEPBAS,%SYS2(DB),$B
	V	TRCVEC,%SYS22(DB),$B
	; ETC.
	>

DEFINE	V(A,B,C) <
	<ASCII/A/>
>

DD%TAB:	DDT%

DD%TBL==.-DD%TAB			; # OF ENTRIES.

DEFINE	V(A,B,C) <
	<<C_^D18>+B>
>

DD%LEX:	DDT%

	PURGE	DDT%,V
	SUBTTL	Debugging system - fetch or store a variable.

; Value in or out is in A0 (and perhaps A1), except for tricky cases
;  (i.e. whole or sliced arrays, and unsubscripted strings), when the
;  address of the header (of string or array) is left in A2.
; Skip returns, except for address-in-A2 cases.

; May clobber all AC's (because of thunks), except FL (preserved).
;
; On entry: Context DL is in A11. Lexeme,,value is in A6.
; Understands formals by name and value, etc.

DDGET:	TLOA	FL,DDTMP2		; FLAG GET

DDPUT:	TLZ	FL,DDTMP2
	MOVEM	FL,%DDTFL(DB)		; SAVE FL OVER THUNKS.
	TLNE	FL,DD%FLG		; PSEUDO ? (%DB  ETC)
	  JRST	DDGT12			; YES
	HRRZ	A2,A6			; GET VALUE
	JUMPE	A2,DDER27		; UNREFERENCED - CAN'T DO.
	TLNN	A6,$DEC			; DECLARED ?
	  DDTERR ^D28			; NO - VERY SILLY.
	TLNN	A6,$TYPE-$L		; LABEL ?
	  DDTERR ^D29			; CAN'T DO THOSE.
	TLNE	A6,200000		;  OR
	TLNN	A6,100000		;   PROCEDURES
	  JRST	.+2
	  DDTERR ^D30
	TLNE	A6,200000		; ARRAY ?
	  JRST	DDGT5			; YES.
	TLNN	A6,$TYPE-$S		; STRING ?
	  JRST	DDGT5			; YES
	TLNE	A6,200			; OWN ? (200)
	TLNE	A6,500			; ?
	  JRST	DDGT1			; NO
	HLRZ	A3,%DDTPT(DB)		; GET RELOCATION
	HRRZ	A3,1(A3)		; FROM LOADER S.T. ENTRY
	ADDI	A3,(A6)			;  AND RELOCATE VALUE.
	HRRZ	A2,(A3)			; GET VARIABLE'S ADDR FROM AN INSTRUCTION.
EDIT(067); Allow for displaced instructions
	HLRZ	A4,(A3)			; [E067] GET OPCODE
	CAIN	A4,(BREAK)		; [E067] IS IT A BREAKPOINT UUO ?
	HRRZ	A2,BP.INS(A2)		; [E067] YES - GET REAL INSTRUCTION

DDGT3:	; Here, address of variable is in A2.
	MOVEI	A2,@A2			; STATISCISE IT.
	TLNE	FL,DDTMP2		; GET OR PUT ?
	SKIPA	A3,(A2)			; GET
	MOVEM	A0,(A2)			; PUT
	TLNN	A6,20000		; 1-WORD ?
	  JRST	DDGT2			; YES - DONE
	TLNE	FL,DDTMP2
	SKIPA	A1,1(A2)
	MOVEM	A1,1(A2)

DDGT2:	TLNE	FL,DDTMP2		; IF GET
	MOVE	A0,A3			;  RETRIEVE FIRST WORD
	JRST	CPOPJ1

DDGT12:	; It's a pseudo-variable, e.g. %DB
	MOVE	A0,@A6			; MUST BE GET !
	TLNN	A6,20000		; 1-WORD ?
	  JRST	CPOPJ1			; YES - DONE.
	MOVE	A1,A6
	ADDI	A1,1
	MOVE	A1,@A1			; GET SECOND WORD.
	; Fall into CPOPJ1

CPOPJ1:	AOS	(SP)			; SKIP RETURN (GENERALLY AVAILABLE)

CPOPJ:	POPJ	SP,

DDGT1:	; Not OWN. Local, or formal-by-name or by-value.
	TLO	A2,A11			; PREPARE TO INDEX BY CONTEXT DL
	TLNE	A6,100			; FORMAL-BY-NAME ? (500)
	TLNN	A6,400			; (TEST WORKS BECAUSE 700 CAN'T HAPPEN)
	  JRST	DDGT3			; NO.
	TLNN	FL,DDTMP2		; GET OR PUT ?
	  JRST	DDGT4			; PUT
	PUSH	SP,A6
	PUSH	SP,A10			; THESE & FL ARE ONLY AC'S NOT SMASHED
	TLO	A2,(<XCT>)		; MAKE INTO XCT F[0]
	PUSH	SP,A2
	PUSH	SP,[JRST .+2]		; [303]
	JRST	-1(SP)			; EXECUTE THUNK.
	PORTAL	.+1			; [303] HANDLE EXECUTE-ONLY
	SUB	SP,[2,,2]		; CLEAR STACK.
	POP	SP,A10
	POP	SP,A6
	MOVE	FL,%DDTFL(DB)		; RESTORE FL
	JRST	CPOPJ1			; DONE.

DDGT4:	MOVEI	A3,@A2			; STATISCISE. (CAN'T STORE INTO THUNK.)
	PUSH	SP,A0			; SAVE VALUE OVER THUNK.
	PUSH	SP,A1
	XCT	1,(A3)			; PUT - GET ADDRESS TO A2  F[0]
	PORTAL	.+1			; [303] HANDLE EXECUTE-ONLY
	POP	SP,A1			; RESCUE VALUE.
	POP	SP,A0
	XCT	1(A3)			; PUT VALUE	F[1]
	PORTAL	.+1			; [303] HANDLE EXECUTE-ONLY
	JRST	CPOPJ1			; DONE

DDGT5:	; It's an array or string.
	TLNE	A6,200			; OWN
	TLNE	A6,500			;  ?
	  JRST	DDGT6			; NO
	HLRZ	A3,%DDTPT(DB)		; YES - GET RELOCATION
	HRRZ	A3,1(A3)		; FROM LOADER S.T. ENTRY
	ADDI	A3,(A6)			;  RELOCATE VALUE
	HRRZ	A2,(A3)			;   AND GET ADDRESS OF OBJECT.
	TLNE	A6,200000		; ARRAY ?
	  JRST	DDGT8			; YES.
	JRST	DDGT11

DDGT6:	TLO	A2,A11			; PREPARE TO INDEX BY CONTEXT DL
	TLNE	A6,200000		; ARRAY ?
	  JRST	DDGT8			; YES - ALWAYS STATIC
	TLNE	A6,100			; FORMAL-BY-NAME ?
	TLNN	A6,400
	  JRST	DDGT11			; NO
	TLNN	FL,DDTMP2		; [E016] IF PUT,
EDIT (016) ; MAKE STRING TYPE-OUT WORK FOR PROC ACTUAL PARAMS.
	  PUSH	SP,A0			; THUNK WILL CLOBBER VALUE
	PUSH	SP,A6
	PUSH	SP,A10
	TLNN	FL,DDTMP2		; [E016] IF PUT,
	  TLOA	A2,(<XCT  1,>)		; [E016] PROHIBIT CLOBERING EXPR A.P.'S
EDIT(016) ; MAKE STRING TYPE-OUT WORK FOR PROC ACTUAL PARAMS.
	  TLO	A2,(<XCT>)		; ELSE, MAKE INTO XCT F[0]
	PUSH	SP,A2
	PUSH	SP,[JRST .+2]		; [303]
	JRST	-1(SP)			; EXECUTE THUNK.
	PORTAL	.+1			; [303] HANDLE EXECUTE-ONLY
	SUB	SP,[2,,2]		; RESET STACK.
	POP	SP,A10
	POP	SP,A6
	MOVE	FL,%DDTFL(DB)		; RESTORE FL (MAY BE CLOBBERED BY THUNKS).
	TLNN	FL,DDTMP2		; [E016] IF PUT,
	  POP	SP,A0

	; String. A10 should point to the "." in i/p buffer.
	; Syntax has already been checked and spaces removed.

DDGT11:	TLNN	FL,DDBYTS		; BYTE-SUBSCRIPTED ?
	  POPJ	SP,			; NO - NON-SKIP RETURN.
	TLZ	A6,$TYPE		; YES - MAKE IT
	TLO	A6,$I			;  AN INTEGER.
	IBP	A10			; SKIP "."
	IBP	A10			;  AND "["
	PUSHJ	SP,DDGTNM		; GET SUBSCRIPT.
	SOJL	A4,DDER31		; 0 OR -VE IS ILLEGAL
	PUSH	SP,A0			; [E016]
	PUSH	SP,A1			; [E016] THESE MAY CONTAIN STRING HDR.
	TDNN	A2,A2			; [E016] IF HDR IS IN A0/A1,
	  MOVEI	A2,-1(SP)		; [E016]  USE STACK INSTEAD.
EDIT(016)
	MOVEI	A1,1(A4)		; 1 IS FIRST BYTE.
	JSP	AX,PBYTE		; GET BYTE-POINTER TO A2.
	SUB	SP,[2,,2]		; [E016] PUT STACK BACK.
	TLNN	FL,DDTMP2		; GET OR PUT ?
	  JRST	DDGT9			; PUT
	LDB	A0,A2			; GET
	JRST	CPOPJ1

DDGT9:	DPB	A0,A2			; PUT
	JRST	CPOPJ1

DDGT8:	; Array. Header address is in A2.
	; A10 should point to the "[" in the i/p buffer.
	; Syntax has been checked and spaces removed.

	MOVEI	A2,@A2			; STATISCISE.
	TLNE	FL,DDSUBS		; IF UNSUBSCRIPTED
	TLNE	FL,DDSLICE		;  OR SLICE
	  POPJ	SP,			; THEN TOO HARD FOR US.
	PUSH	SP,A0			; SAVE VALUES
	PUSH	SP,A1			; AGAINST CHKARR.
	MOVEI	A0,1			; SUBSCRIPT COUNT
	IBP	A10			; SKIP "["

DDGT10:	PUSHJ	SP,DDGTNM		; GET NUMBER
	PUSH	SP,A4			; GIVE TO CHKARR
	CAIN	A3,.COMMA		; LOOK AT NUMBER TERMINATOR.
	  AOJA	A0,DDGT10		; COMMA - GET NEXT SUBSCRIPT.
	JSP	AX,CHKARR		; NOT - GET ADDRESS OF ELEMENT.
	POP	SP,A1			; GET VALUE BACK
	POP	SP,A0
	TLNN	A6,$TYPE-$S		; STRING - MIGHT BE BYTE-SUBSCRIPTED!
	  JRST	DDGT11			; DO IT IF NEEDED.
	JRST	DDGT3			; NOT - DO VALUE GET OR PUT.


DDGTNM:	; Get a number to A4 from buffer whose pointer is in A10.
	; Buffer contains syntax-checked and space-suppressed string, so
	;  no checks needed here.
	; Leaves number in A4 and its terminator character in A3.

	TLZ	FL,DDTMP1
	MOVEI	A4,0

DDGTN1:	ILDB	A3,A10
	CAIE	A3,.MINUS
	  JRST	.+2
	TLOA	FL,DDTMP1		; REMEMBER NEGATIVE.
	CAIN	A3,.PLUS
	  JRST	DDGTN1			; IGNORE + SIGN
	CAIL	A3,.ZERO		; DIGIT ?
	CAILE	A3,.NINE		;  ?
	  JRST	DDGTN2			; NO
	IMULI	A4,^D10			; YES
	ADDI	A4,-.ZERO(A3)		; PUT IN 
	JRST	DDGTN1			; AND GET NEXT

DDGTN2:	TLZE	FL,DDTMP1		; NEGATIVE ?
	  MOVN	A4,A4			; YES - NEGATE
	POPJ	SP,

	SUBTTL	Debugging system - command routine - TYPE

DDTYPE:	TLZ	FL,DD%FLG!DDSUBS!DDSLIC!DDBYTS
	PUSHJ	SP,SCAN4		; GET NAME.
	CAIN	A4,.COMMA		; TERMINATED BY COMMA ?
	  TLOA	FL,DDMTYPE!DDMTY2	; YES - MULTI-TYPE MODE
	TLZ	FL,DDMTY2		; NO.
	PUSHJ	SP,SEARCH		; GET LEXEME.
	 DDTERR	^D23			; CANT FIND IT

DDTYP.:	; Type out a variable.
	; On entry, A10 points to end of identifier in field buffer.
	; A6 contains lexeme,,value
	;
	; ***WARNING*** PRINT etc. clobber many AC's, notably FL (A13)!

	PUSHJ	SP,DDBRKB
	TDNN	FL,[
	DDMTYPE,,DDINDF!DDALST]		; IN AUTOLIST, OR MULTI-VARIABLE TYPEOUT?
	  JRST	DDTYP0
	OUTSTR	[ASCIZ/
/]
	OUTSTR	%DDTFB(DB)		; YES - PRINT NAME
	OUTSTR	[ASCIZ/ = /]

DDTYP0:	MOVEM	FL,%DDTFL(DB)
	PUSHJ	SP,DDGET		; GET VALUE OF VARIABLE.
					; CLOBBERS ALL AC'S EXCEPT A6,A10,FL
	  JRST	DDTYP1			; NASTY ONE - ADDRESS IN A2
					; EASY ONE - VALUE IN A0 (AND A1)
	TLNN	A6,$TYPE-$B		; BOOLEAN ?
	  JRST	DDTYP2			; SPECIAL

	;Integer, real or long-real. Easy - use PRINT.

	LDB	A2,[
	POINT	2,A6,5]			; 0=INT, 1=REAL, 2=LONG REAL! LUCKY.
	SETZB	A3,A4			; ASK FOR STANDARD MODE.
	TRNN	A2,3			; INTEGER ?
	  MOVEI	A3,1			; YES - ASK FOR NO LEADING SPACES.
	PUSHJ	SP,PRINT.		; PRINT IT 
	JRST	DDTYPZ

DDTYP2:	; BOOLEAN.
	TLNE	FL,DD%FLG		; IF PSEUDO..
	  JRST	DDTP5A			;  ALWAYS DO IN OCTAL.
	JUMPN	A0,DDTYP4		; NOT FALSE
	MOVEI	A1,[ASCIZ/ False/]
	JRST	DDTYPD

DDTYP4:	CAME	A0,[-1]			; ASSIGNED TRUE ?
	  JRST	DDTP5A			; NO
	MOVEI	A1,[ASCIZ/ True /]

DDTYPD:	PUSHJ	SP,DDTOU%
	JRST	DDTYPZ

DDTP5A:	PUSHJ	SP,DDTYP5
	JRST	DDTYPZ
DDTYP5:	; Neither assigned TRUE nor FALSE. Print in octal half-words.
	HLRZ	A1,A0			; GET FIRST HALF-WORD
	PUSHJ	SP,PROCT		; PRINT
	HRRZ	A1,A0			; SECOND HALF
	PUSHJ	SP,PROCT
	MOVE	FL,%DDTFL(DB)
	MOVEI	A1,[ASCIZ/(true)/]
	TLNN	FL,DD%FLG		; IF NOT PSEUDO...
	  PUSHJ	SP,DDTOU%		;  SAY 'TRUE'
	PJRST	DDBRKB

DDTYP1:	; Unsubscripted string, or
	; sliced or whole array.
	; Address of header is in A2.

	MOVEI	A2,@A2			; STATISCISE
	TLNN	A6,200000		; ARRAY ?
	  JRST	DDTPSA			; NO - SIMPLE STRING.
	TLNN	FL,DDSLIC		; YES - SLICE ?
	TLNN	FL,DDSUBS		;  OR WHOLE THING ?
	  JRST	DDTYP3			; YES.
	; NO - SINGLE ELEMENT OF STRING ARRAY (STRING ADDR ALREADY IN A2)

DDTPSA:	PUSHJ	SP,DDTYPS
	JRST	DDTYPZ

DDTYPS:	SKIPN	STR1(A2)		; IF FIRST WORD ZERO...
	  JRST	DDTYPF			;  ...COMPLETELY NULL.
	PUSH	SP,A7			; [E016] SAVE A7 (USED IN STRING ARRAY TYPEOUT).
	;
	; WARNING!!! A2 may be pointing to A0 !!!
	;
EDIT(016) ; MAKE STRING TYPE-OUT WORK FOR PROC ACTUAL PARAMS.
	JUMPN	A2,.+4			; [E016] STRING IN A0,A1?
	MOVE	A6,A0			; [E016] YES - FIX THAT.
	MOVE	A7,A1			; [E016]
	MOVEI	A2,A6			; [E016] AND SAY SO.
	MOVE	A0,STR2(A2)		; LENGTH.
	TLZ	A0,STRBCC
	MOVEI	A1,[ASCIZ/(/]
	PUSH	SP,A2
	PUSHJ	SP,DDTOU%
	PUSHJ	SP,DPRNT%		; PRINT LENGTH.
	MOVEI	A13,.COMMA
	JSP	AX,OUCHAR
	LDB	A0,[
	POINT	6,@(SP),11]		; BYTE-SIZE
	PUSHJ	SP,DPRNT%		; PRINT BYTE-SIZE
	MOVEI	A1,[ASCIZ/)/]
	PUSHJ	SP,DDTOU%
	POP	SP,A2
	LDB	A0,[
	POINT	6,STR1(A2),11]
	MOVE	A5,STR1(A2)		; GET BYTE-POINTER
	MOVE	A6,STR2(A2)		;  AND LENGTH
	POP	SP,A7			; [E016]
	TLZ	A6,STRBCC		; CLEAR OTHER BITS
	JUMPN	A6,.+3			; NULL ?

DDTYPF:	MOVEI	A1,[ASCIZ/ Null/]		; SAY SO.
	PJRST	DDTOU%
	CAIE	A0,7			; ASCII
	CAIN	A0,6			;  OR SIXBIT ?
	  JRST	DDTYP6			; YES

DDTYP8:	ILDB	A4,A5			; GET A BYTE
	MOVEI	A1,^D12			; AND PRINT
	MOVEI	A3,0			; IN ZERO-SUPPRESSED OCTAL.

DDTYP7:	LSHC	A3,3
	SOSLE	A1
	JUMPE	A3,DDTYP7		; SKIP LEADING ZEROS
	MOVEI	A13,.ZERO(A3)		; MAKE ASCII
	PUSHJ	SP,DDOUCH
	HRLZI	A3,40000		; SIGNIFICANCE TRIGGER
	JUMPG	A1,DDTYP7		; END OF BYTE ?
	SOJLE	A6,CPOPJ		; YES - ANY MORE ?
	MOVEI	A13,.COMMA		; YES
	PUSHJ	SP,DDOUCH		; OUTPUT COMMA,
	JRST	DDTYP8			;  AND DO NEXT BYTE.
	POPJ	SP,

DDTYP6:	; Ascii or sixbit.
	MOVEI	A13,.DQUOTE
	PUSHJ	SP,DDOUCH

DDTYPB:	ILDB	A13,A5			; GET BYTE
	CAIN	A0,6			; SIXBIT ?
	ADDI	A13,40			; YES - MAKE ASCII
	CAIL	A13,40			; CONTROL CHARACTER ?
	  JRST	DDTYP9			; NO (UNLESS IT'S <DEL>)
	MOVE	A3,DDCTTB(A13)		; YES - GET ITS NAME
	MOVEI	A4,0
	MOVEI	A1,A3
	PUSHJ	SP,DDTOU%

DDTYPA:	SOJG	A6,DDTYPB		; MORE BYTES ?
	MOVEI	A13,.DQUOTE
	PJRST	DDOUCH

DDTYP9:	CAIE	A13,.DEL		; DELETE ?
	  JRST	DDTYPC			; NO
	MOVEI	A1,[ASCIZ/<DEL>/]		; YES
	PUSHJ	SP,DDTOU%
	JRST	DDTYPA

DDTYPC:	PUSHJ	SP,DDOUCH
	PUSHJ	SP,DDBRKB
	JRST	DDTYPA

DDTYPZ:	PUSHJ	SP,DDBRKB		; CLEAR OUT BUFFERS.
	MOVE	FL,%DDTFL(DB)
	TLZN	FL,DDMTY2		; MULTI-TYPE ?
	  POPJ	SP,			; NO - DONE.
	PUSHJ	SP,DDIGCH		; YES - GET NEXT.
	JRST	DDTYPE
DDTYP3:	; Sliced or whole array.
	; Address of header is in A2.
	; A10 points to the [ if any.

EDIT(074);SAVE HEADER ADDRESS DELOCATED
	MOVEI	A7,(A2)			; GET HEADER ADDRESS
	CAIL	A7,(DB)			; IS HEADER ADDRESS
	CAILE	A7,(SP)			;  DYNAMIC ?
	JRST	.+3			; NO
	SUBI	A7,(DB)			; YES - DELOCATE IT
	HRLI	A7,DB			; AND SET DB IN INDEX
	PUSH	SP,A7			; STACK ADDRESS
	HLRE	A7,1(A2)		; - # SUBSCRIPTS.
	MOVN	A0,A7			; + # SUBSCRS.
	LSH	A0,1			; * 2
	PUSHJ	SP,GETOWN		; GET CONTROL BLOCK.
	POP	SP,A2
	MOVEI	A2,@A2			; STATICIZE ADDRESS AGAIN
	MOVEI	A5,(A1)
	TLNE	FL,DDSUBS		; WHOLE THING ?
	  JRST	DDSLC1			; NO - SLICE.
	MOVE	A7,1(A2)		; POINTER TO DOPE-VECTOR.

DDSLCD:	HRLZ	A3,(A7)			; LOBOUND
	HRR	A3,1(A7)		; HIBOUND.
	MOVEM	A3,(A1)			; TO CONTROL-BLOCK.
	AOS	A1
	AOS	A7
	AOBJN	A7,DDSLCD		; & GET NEXT
	JRST	DDSLC0

DDSLC1:	IBP	A10			; THROW [
	MOVE	A7,1(A2)		; ADDRESS OF DOPE-VECTOR.

DDSLC5:	PUSHJ	SP,DDGTNM		; GET NUMBER TO A4, TERM TO A3.
	CAIE	A3,.AST			; WHOLE OF THIS DIMENSION ?
	  JRST	DDSLC2			; NO
	HRLZ	A4,(A7)			; YES - COPY
	HRR	A4,1(A7)		;  DOPE-VECTOR ELEMENT
	MOVEM	A4,(A1)			;   TO CONTROL-BLOCK.
	ILDB	A3,A10			; GET NEXT CHAR (COMMA OR ])
	JRST	DDSLC4

DDSLC2:	CAIE	A3,.COLON		; SLICE ?
	  JRST	DDSLC3			; NO - SINGLE SUBSCRIPT.
	CAMGE	A4,(A7)			; YES - LOBOUND VALID ?
	  DDTERR ^D32			; NO.
	HRLM	A4,(A1)			; YES - TO CONTROL-BLOCK.
	PUSHJ	SP,DDGTNM		; GET HIBOUND OF SLICE.
	CAMLE	A4,1(A7)		; IN RANGE ?
	  DDTERR ^D32			; NO.
	HRRM	A4,(A1)
	JRST	DDSLC4
DDSLC3:	CAML	A4,(A7)			; SINGLE VALUE - IN RANGE ?
	CAMLE	A4,1(A7)
	  DDTERR ^D32			; NO
	HRL	A4,A4			; YES - MAKE IT BOTH BOUNDS OF SLICE.
	MOVEM	A4,(A1)

DDSLC4:	AOS	A1			; ADVANCE
	AOS	A7			;  POINTERS.
	CAIN	A3,.COMMA		; MORE ?
	  AOBJN	A7,DDSLC5		; YES - MORE WANTED ?
	CAIE	A3,.RBRA		; END - ] COINCIDES ?
	  DDTERR ^D33			; NO - WRONG # OF SUBSCRS.
	AOBJN	A7,.-1			; TOO FEW.

DDSLC0:	; here, our "pseudo-dope-vector" is set up in the control-block
	; (each dimension has one word: FROM,,TO.)
	; Its address is in A5.
	; Array header's address is still in A2.

	PUSH	SP,A6			; -4(SP)
	PUSH	SP,A2			; -3(SP)
	HLL	A5,1(A2)		; - # DIMENSIONS.
	PUSH	SP,A5			; -2(SP) : POINTER TO PSEUDO-D.V.
	HLRE	A0,A5
	MOVN	A0,A0			; # DIMS
	MOVE	A10,A5
	ADD	A10,A0			; POINTER TO SUBSCRS IN CONTROL-BLK
	PUSH	SP,A10			; -1(SP)
	HLRE	A4,(A5)			; GET A LOBOUND
	MOVEM	A4,(A10)		; PUT IN SUBSCR IN CONTROL-BLK
	AOBJN	A5,.+1			; ANOTHER
	AOBJN	A10,.-3
	SUBI	A10,1			; POINTER TO JUNIOR SUBSCR
	PUSH	SP,A10			; 0(SP)
	HRRZI	A0,DDCONC		; [E1000] SET "ACTION ABANDONED"
	PUSHJ	SP,DDSTI1		; [E1000] ^C INTERCEPT
	PUSHJ	SP,DDSLC6		; COMPUTE # ELEMENTS/LINE OF OUTPUT,
		; ALSO TYPE FIRST SUBSCRIPTS. CLOBBERS A0-A6, A10-A13!
DDSLCL:	MOVE	A4,-1(SP)		; POINTER TO ACTUAL SUBSCRS.
	MOVEI	A1,[ASCIZ/  /]		; TWO SPACES
	PUSHJ	SP,DDTOU%
	HLRE	A0,A4
	MOVN	A0,A0			; # DIMS
	MOVE	A2,-3(SP)		; GET ADDR OF HEADER.
	PUSH	SP,(A4)			; PUT SUBSCRIPTS
	AOBJN	A4,.-1			;  ON STACK.
	JSP	AX,CHKARR		; GET ELEMENT ADDRESS.
	MOVE	A6,-4(SP)
	TLNN	A6,$TYPE-$S		; STRING ?
	  JRST	DDSLC8			; YES - SPECIAL.
	MOVE	A0,(A2)			; NO - GET VALUE.
	TLNE	A6,20000		; TWO-WORD ?
	  MOVE	A1,1(A2)		; YES - GET SECOND WORD.
	TLNN	A6,$TYPE-$B		; BOOLEAN ?
	  JRST	DDSLC9			; YES.
	LDB	A2,[
	POINT	2,A6,5]			; NO - 0=INT, 1=REAL, 2=LONG-REAL.
	SETZB	A3,A4			; STANDARD PRINT
	PUSH	SP,A7
	PUSHJ	SP,PRINT.
	POP	SP,A7
	JRST	DDSLCX			; END OF THIS ELEMENT.

DDSLC9:	; Boolean.
	JUMPN	A0,DDSLCA		; NOT FALSE.
	MOVEI	A1,[ASCIZ/             False/] ; 18. CHARS FOR BOOLS.
	PUSHJ	SP,DDTOU%
	JRST	DDSLCX

DDSLCA:	CAME	A0,[-1]			; GENUINE TRUE ?
	  JRST	DDSLCB			; NO
	MOVEI	A1,[ASCIZ/              True/]
	PUSHJ	SP,DDTOU%
	JRST	DDSLCX

DDSLCB:	PUSHJ	SP,DDTYP5		; OCTAL (TRUE).
DDSLCX:	; End of element. Increment subscripts etc.
	; If other than the most junior subscript is incremented,
	; we force a new-line & type the subscripts.
	; # of elements/line of output is in A7.
	MOVE	A4,(SP)			; POINTER TO JUNIOR SUBSCR.
	MOVE	A3,-1(SP)		; POINTER TO FIRST SUBSCR.
	SUBI	A3,1			; NOW PTR TO JUNIOR BOUND-PAIR.
	HLRE	A0,-2(SP)
	MOVN	A0,A0			; # DIMS

DDSLCW:	AOS	A1,(A4)			; INCREMENT A SUBSCRIPT.
	HRRE	A5,(A3)			; GET HIBOUND
	CAMG	A1,A5			; OVER THE TOP ?
	  JRST	DDSLCY			; NO - OK.
	MOVEI	A7,1			; YES - ENSURE NEWLINE HAPPENS.
	SOJLE	A0,DDSLCZ		; ANY MORE DIMS ?
	HLRE	A5,(A3)			; YES - RESET THIS ONE
	MOVEM	A5,(A4)			; TO LOBOUND.
	SUBI	A3,1			; TRY NEXT MOST SENIOR
	SOJA	A4,DDSLCW

DDSLCY:	SOJG	A7,.+2			; NEED NEWLINE ?
	  PUSHJ	SP,DDSLC6		; YES - DO IT (SETS UP A7 TOO).
	JRST	DDSLCL			; AND LOOP.

DDSLCZ:	HRRZ	A1,-2(SP)
	MOVEI	A0,0
	PUSHJ	SP,GETOWN		; RELEASE CONTROL-BLK
	SUB	SP,[5,,5]		; RETARD STACK.
	JRST	DDTYPZ			;  & EXIT.

DDSLC8:	; String.
	PUSHJ	SP,DDTYPS		; DO STRING.
	JRST	DDSLCX			;  & GET NEXT ELEMENT.
DDSLC6:	; Type newline & subscripts. Also compute # elements / line of typeout,
	; & put in A7.
	MOVEI	A1,[ASCIZ/
[/]
	PUSHJ	SP,DDTOU%
	MOVE	FL,%DDTFL(DB)
	MOVEI	A7,-1(FL)		; GET
	ANDI	A7,DDTTYW		;  LINE-WIDTH.
	SKIPA	A6,-2(SP)		; GET PTR TO CURRENT SUBSCRS.

DDSL6A:	PUSHJ	SP,DDOUCH
	MOVE	A0,(A6)			; GET SUBSCR
	PUSHJ	SP,DPRNT%		; PRINT; RETURNS # DIGITS IN A3.
	SUBI	A7,1(A3)		; ALLOW FOR CHARS DPRNT% PRINTED.
	MOVEI	A13,.COMMA
	AOBJN	A6,DDSL6A		; LOOP OVER ALL SUBSCRS.
	MOVEI	A13,.RBRA
	PUSHJ	SP,DDOUCH

	; Now, compute # entries / line.

	MOVE	A6,-5(SP)		; RESTORE A6.
	TLNN	A6,$TYPE-$S		; STRING ?
	  MOVEI	A1,(A7)			; YES - ALWAYS 1 PER LINE.
	TLNN	A6,$TYPE-$B		; BOOLEAN ?
	  MOVEI	A1,^D20
	TLNN	A6,$TYPE-$I		; INTEGER ?
	  MOVEI	A1,INTDIG+3
	TLNN	A6,$TYPE-$R		; REAL ?
	  MOVEI	A1,SRDIG+^D8		; ALLOW FOR SIGN, &, ETC.
	TLNN	A6,$TYPE-$LR		; LONG-REAL ?
	  MOVEI	A1,^D25
	IDIVI	A7,(A1)			; CALC HOW MANY WILL FIT.
	MOVE	FL,%DDTFL(DB)
	POPJ	SP,
	; Table of names of control characters. 1 word only each please !

DDCTTB:	ASCII/<NUL>/
	ASCII/<^A>/
	ASCII/<^B>/
	ASCII/<^C>/
	ASCII/<^D>/
	ASCII/<^E>/
	ASCII/<^F>/
	ASCII/<^G>/
	ASCII/<^H>/
	ASCII/<TAB>/
	ASCII/<LF>/
	ASCII/<VT>/
	ASCII/<FF>/
	ASCII/<CR>/
	ASCII/<^N>/
	ASCII/<^O>/
	ASCII/<^P>/
	ASCII/<^Q>/
	ASCII/<^R>/
	ASCII/<^S>/
	ASCII/<^T>/
	ASCII/<^U>/
	ASCII/<^V>/
	ASCII/<^W>/
	ASCII/<^X>/
	ASCII/<^Y>/
	ASCII/<^Z>/
	ASCII/<ESC>/
	ASCII/<^\>/
	ASCII/<^]>/
	ASCII/<^^>/
	ASCII/<^_>/


	SUBTTL	Debugging system - command routine - DUMP.

DDUMP:	; Dump a block or blocks. Syntax is :

	;    DUMP  [SCALARS]  [n] or [ALL]

	; where n (default = 1) is the number of blocks "outwards" to dump.
	; If SCALARS is present, arrays are not dumped.

	TLZ	FL,DDMPSC
	MOVEI	A7,1
	SKIPL	%DDTST(DB)		; WAS SYMBOL TABLE READ OK ?
	 DDTERR	1			;  NO : NO DUMPS THEN !

DDUMP0:	CAIL	A4,.ZERO
	CAILE	A4,.NINE
	  JRST	DDUMP1			; NOT NUMBER.
	PUSHJ	SP,DDGTV1		; # - GET IT.
	MOVEI	A7,(A5)			; SAVE IT.
	JRST	DDUMP0

DDUMP1:	CAIN	A4,.SPACE
	  PUSHJ	SP,DDIGCH		; SKIP BLANKS.
	CAIN	A4,.SCOL		; END OF LINE ?
	  JRST	DDUMP2			; YES.
	CAIL	A4,.A			; ALPHA ?
	CAILE	A4,.Z
	 DDTERR	^D56			; NO - BAD CHAR.
	PUSHJ	SP,SCAN3		; GET WORD.
	MOVEI	A2,%DDTIB(DB)
	MOVE	A1,[
	XWD	-2,[
	SIXBIT/ALL/
	SIXBIT/SCALAR/]]
	PUSHJ	SP,UNIQUE		; CHECK LEGAL ABBREVIATION.
	 DDTERR	^D57			; NOT
	 DDTERR	^D57
	TLNE	A1,1			; -1 MEANS "SCALARS"
	TLOA	FL,DDMPSC		;  SO SET FLAG.
	MOVEI	A7,-1			; OTHERWISE IT'S "ALL" - GET BIG #.
	JRST	DDUMP0

	; End of command.

DDUMP2:	HLRE	A4,%DDTER(DB)		; GET REDIRECT CHANNEL.
	HRRM	A4,%CHAN(DB)		; SET UP.
	JUMPL	A4,DDUMP8

	; Not TTY: - do headings.

DUMP%:	PUSH	SP,A7			; ENTRY FROM ALGLIB.
	SKIPN	%DDTST(DB)		; S.T. READ IN ?
	  PUSHJ	SP,DDINIT		; NO - DO IT.
	SKIPL	%DDTST(DB)		; WORKED ?
	  PJRST	DDPOPF			; NO - LOSE SAVED A7 & EXIT.
	MOVEM	FL,%DDTFL(DB)
	MOVEI	A1,[ASCIZ/

Dump of ALGOL-60 program /]
	PUSHJ	SP,DDTOU%
	HRROI	A4,JBTPRG		; GET OUR
	GETTAB	A4,			;  PROGRAM NAME.
	  SKIPA	A4,[
	  SIXBIT/NONAME/]		; DEFAULT
	JUMPE	A4,.-1			;  IF HE WON'T TELL.
	PUSHJ	SP,DDOSIX		; PRINT NAME.
	MOVEI	A1,[ASCIZ/ at /]
	PUSHJ	SP,DDTOU%
	PUSHJ	SP,DDOTIM		; TIME.
	MOVEI	A1,[ASCIZ/ on /]
	PUSHJ	SP,DDTOU%
	PUSHJ	SP,DDODAT		; DATE.
EDIT(121); Tidy up DUMP output
	PUSHJ	SP,CRLF%		; [E121] Start new line
	TLNE	DB,INDDT		; [E121] Called from library via DUMP UUO ?
	JRST	DMPNOW			; [E121] No  - just do the DUMP
	MOVEI	A4,@-1(SP)		; [E121] Yes - get return PC
	HRRM	A4,%DDTPC(DB)		; [E121] Save it for HSTPRT
	TLZ	DB,TMPFL3		; [E121] Ensure typeout
	PUSHJ	SP,HSTPRT		; [E121] Print history & set context
DMPNOW:	POP	SP,A7
	MOVEI	FL,DD.LPW		; GET LPT: WIDTH.
	MOVE	A1,[-1,,.GTLIM]		; [243] LOAD GETTAB TABLE INDEX
	GETTAB	A1,			; [243] GET THE TABLE INFORMATION
	LIBERR	5,			; [243] COMPLAIN IF GETTAB FAILS
	TLNE	A1,JB.LBT		; [243] IS THIS A BATCH JOB?
	MOVEI	FL,DD.BTW		; [243] YES, USE SHORTER LINE .
	HRRM	FL,%DDTFL(DB)		; [243] NO, SAVE.
	MOVE	FL,%DDTFL(DB)

DDUMP8:	TLNE	DB,INDDT		; IF IN DDT (IE NOT CALLED FROM LIB)
	 PUSHJ	SP,[			; [E1000]
	  HRRZI	A0,DDCONC		; [E1000] SET "ACTION ABANDONED"
	  PJRST	DDSETI ]		; [E1000] ^C INTERCEPT.

EDIT(143)	; Reset context if unknown on entry from batch.

	SKIPE	%DDTBE(DB)		; [E143] Context found yet ?
	JRST	DDUM10			; E143] Yes - so OK
	MOVEI	A4,@%SYS0(DB)		; [E143] No - so set it at %BEGIN
	MOVE	A4,(A4)			; [E143]	...
	HRRZM	A4,%DDTPC(DB)		; [E143]	...
	PUSHJ	SP,FNDADR		; [E143]	...
	 DDTERR	^D18			; [E143]	...
DDUM10:	MOVE	A4,%DDTBE(DB)		; PTR TO CURRENT BLKIDX ENTRY

DDUMP6:	EXCH	A7,A4			; GET BLKIDX PTR TO A7, SAVE OLD A7.
	PUSHJ	SP,DDGTDL		; SET UP CONTEXT DL IN A11.
	EXCH	A7,A4			; RESTORE AC'S AS THEY WERE.
	PUSH	SP,A4			; SAVE A4 FOR LATER.
	HRRZ	A4,(A4)			; OFFSET IN S.T. OF ITS BLK ITEM.
	ADD	A4,%DDTST(DB)		; MAKE ADDRESS.
	MOVEI	A1,[ASCIZ/

**BLOCK /]				; NEW BLOCK -
	PUSH	SP,A4
	PUSH	SP,A11			; SAVE CONTEXT OVER OUTPUT CALLS
	PUSHJ	SP,DDTOU%		;  TELL HIM.
	HLRZ	A0,1(A4)		; GET CURBLK
	PUSHJ	SP,DPRNT%		;  & TELL HIM.
	POP	SP,A11			; RESTORE CONTEXT.
	POP	SP,A4

DDUMP5:	HRRZ	A3,(A4)			; LENGTH OF ITEM.
	ADDI	A4,(A3)			; ADVANCE TO NEXT ITEM.
	HLRZ	A2,(A4)			; GET ITEM TYPE
	CAIN	A2,'SYM'		; SYMBOL ?
	  JRST	DDUMP4			; YES - GO DUMP IT.
	CAIE	A2,-1			; END OF S.T., OR
	CAIN	A2,'MOD'		; NEW MODULE ?
	  JRST	DDUMP9			; YES - END.
	CAIE	A2,'BLK'		; NEW BLOCK ?
	  JRST	DDUMP5			; NO - NOT INTERESTING.
	SOJLE	A7,DDUMP9		; NEED MORE BLOCKS ?
	POP	SP,A4
	HLRZ	A4,(A4)			; CONTAINING BLOCK.
	JUMPN	A4,DDUMP6		; IF ANY.
	SKIPA
DDUMP9:	; All done.
	POP	SP,A6			; IF NOT DONE ALREADY.
	MOVEI	A1,[ASCIZ/
/]
	PUSHJ	SP,DDTOU%
	PUSHJ	SP,DDBRKB
	TLNE	DB,INDDT		; IF NOT CALLED FROM LIB
	  HLLOS	%CHAN(DB)		; SET O/P = TTY:
	ANDI	FL,DDALST!DDINDF	; REMEMBER IMPORTANT FLAGS
	PUSH	SP,FL			; DESTROYED BY DDTTYC
	PUSHJ	SP,DDTTYC		; GET TTY: CHARACTERISTICS
	POP	SP,FL			; GET FLAGS AGAIN
	IORB	FL,%DDTFL(DB)		; AND RESTORE INPUT FLAGS
	POPJ	SP,			; AND RETURN

DDUMP4:	; Dump a symbol.
	MOVE	A6,1(A4)		; A6 = LEXEME
	TLNE	A6,200000		; IS IT
	TLNN	A6,100000		;  A PROCEDURE
	TLNN	A6,$TYPE-$L		;   OR A LABEL ?
	  JRST	DDUMP5			; YES - DON'T DUMP THOSE.
	TRNN	A6,-1			; IS IT UNREFERENCED ?
	  JRST	DDUMP5			; YES - INACCESSIBLE.
	TLNE	A6,200000		; SCALAR ?
	 TLNN	FL,DDMPSC		; NO - WANTED ?
	JRST	DDUMP7			; YES - PRINT IT.
	JRST	DDUMP5			; NOT WANTED.

	;
	Edit(157); Save context DL over stack shift when typing arrays.
	;
DDUMP7:	DPUSH	A11			; [E157] Save delocated CONDL
	ADDI	A11,(DB)		; [E157]  but relocate it for DDDIM0
	PUSH	SP,A7
	PUSH	SP,A4
	MOVEI	A1,[ASCIZ/
/]
	PUSHJ	SP,DDTOU%
	HRRZ	A3,(A4)			; LENGTH.
	MOVEI	A1,2(A4)		; FROM
	ADDI	A3,-2(A1)		; END
	MOVEI	A4,0
	EXCH	A4,(A3)			; MAKE ASCIZ
	PUSHJ	SP,DDTOU%		; PRINT NAME.
	EXCH	A4,(A3)			; PUT WORD BACK.
	TLNE	A6,200000		; ARRAY ?
	  PUSHJ	SP,DDDIM0		; YES - GIVE CURRENT BOUNDS.
	MOVEI	A1,[ASCIZ/ = /]
	PUSHJ	SP,DDTOU%
	MOVE	A11,-2(SP)		; RESCUE CONTEXT DL.
	ADDI	A11,(DB)		; [E157] and relocate it
	PUSHJ	SP,DDTYP0		; TYPE VALUE.
	POP	SP,A4
	POP	SP,A7
	RPOP	A11			; [E157] Restore & relocate CONDL
	JRST	DDUMP5
	SUBTTL	Debugging system - Command routine - DIMENSION

DDDIMS:	; Type current dimensions of an array.

	PUSHJ	SP,SCAN4		; GET NAME
	PUSHJ	SP,SEARCH		; GET LEXEME
	 DDTERR	^D23			; CANT FIND IT
	TLNE	A6,$KIND
	TLNE	A6,$KIND-$ARR		; ARRAY ?
	  DDTERR ^D34			; NO
	TRNN	FL,DDALST!DDINDF	; IN AUTO-LIST
	  JRST	DDDIM0			; NO
	OUTSTR	[ASCIZ/
Dimensions of array /]
	OUTSTR	%DDTFB(DB)		; YES - TYPE NAME, ETC.
	OUTSTR	[ASCIZ/ = /]

DDDIM0:	PUSHJ	SP,DDGET		; GET ADDRESS TO A2
					; CLOBBERS ALL AC'S EXCEPT A6,A10,FL.
	  SKIPA	A7,1(A2)		; OK - GET DOPE-VECTOR POINTER
	DDTERR	^D35			; SYSTEM ERROR.
	MOVEM	FL,%DDTFL(DB)
	MOVEI	A13,.LBRA

DDDIM1:	PUSHJ	SP,DDOUCH
	MOVE	A0,(A7)			; GET LOBOUND
	PUSHJ	SP,DPRNT%		; PRINT
	AOS	A7
	MOVEI	A13,.COLON
	PUSHJ	SP,DDOUCH
	MOVE	A0,(A7)			; HIBOUND
	PUSHJ	SP,DPRNT%
	MOVEI	A13,.COMMA
	AOBJN	A7,DDDIM1		; MORE ?
	MOVEI	A13,.RBRA
	PUSHJ	SP,DDOUCH
	PUSHJ	SP,DDBRKB
	MOVE	FL,%DDTFL(DB)
	POPJ	SP,
	SUBTTL	Debugging system - Command routine - SET

DDSET:	; Change a varaible.
	; On entry, A10 points to the end of the identifier in field buffer.
	; SEARCH has been called, and A6=lexeme,,value.
	;
	; **WARNING** READ clobbers many AC's, especially FL (=A13).

	TLNE	FL,DD%FLG!DDSLICE	; PSEUDO, OR ARRAY-SLICE ?
	  DDTERR ^D36			; CAN'T SET THOSE.
	TLNE	A6,$KIND
	TLNE	A6,$KIND-$ARR		; ARRAY ?
	  JRST	DDSET1			; NO
	TLNN	FL,DDSUBS		; YES - SUBSCRIPTED ?
	  DDTERR ^D36			; NO - CAN'T SET WHOLE ARRAYS.

DDSET1:	TLNN	A6,$TYPE-$S		; STRING ?
	TLNE	FL,DDBYTS		; AND NOT BYTE-SUBSCRIPTED ?
	  JRST	DDSET2			; NO.
	PUSHJ	SP,DDPUT		; YES - GET ADDRESS TO A2
	  SKIPA				; YES. CLOBBERS ALL AC'S EXCEPT A6,A10,FL.
	DDTERR	^D35			; SYSERR - DDPUT THINKS IT'S NOT STRING!

	; Read string

	HRRI	A2,@A2			; STATISCISE ADDRESS.
	MOVE	A10,STR2(A2)		; GET LENGTH.
	TLZ	A10,STRBCC		; CLEAR FLAGS
	LDB	A6,[
	POINT	6,STR1(A2),11]		; GET BYTE-SIZE
	TLNE	A2,17			; IF DYNAMIC...
	  SUBI	A2,(DB)			; ...DELOCATE (STACK MAY SHIFT).
	PUSHJ	SP,DDIGCH		; GET CHAR, IGNORE BLANKS
	CAIE	A4,.LPAR		; ( ?
	  JRST	DDSST1			; NO - DOESN'T WANT TO CHANGE LENGTHS.
	PUSHJ	SP,DDGTVL		; YES - READ NUMBER (DECIMAL)
	CAIE	A4,.COMMA		; ANOTHER ?
	  JRST	DDSST4			; NO - THAT WAS BYTE SIZE
	MOVE	A10,A5			; YES - THAT WAS LENGTH
	PUSHJ	SP,DDGTVL		; SO GET BYTE-SIZE.

DDSST4:	CAILE	A5,^D36			; SENSIBLE ?
	  DDTERR ^D37			; NO
	MOVEI	A6,(A5)
	CAIE	A4,.RPAR		; ) ?
	  DDTERR ^D38
	PUSHJ	SP,DDIGCH		; GET CHAR, IGNORE BLANKS
DDSST1:	SETO	A0,
	PUSH	SP,A2
	PUSHJ	SP,GETOWN		; FLEX GET SPACE.
	POP	SP,A2
	HLRZ	A12,-1(A1)		; FIND TOP OF
	ADDI	A12,-2(A1)		;  PIECE GIVEN.
	MOVEI	A11,(A1)		; SAVE START ADDR.
	MOVEI	A3,(A6)
	LSH	A6,^D24			; ALIGN BYTE-SIZE FIELD
	TLO	A6,440000		; ADD POSITION FIELD
	HRRI	A6,(A1)			; MAKE BYTE-POINTER
	PUSH	SP,A6			; SAVE (FOR STRING HEADER LATER.)
	MOVEI	A7,0			; BYTE COUNTER
	CAIE	A4,.SQUOTE		; SINGLE-QUOTE
	CAIN	A4,.DQUOTE		;  OR DOUBLE-QUOTE ?
	  JRST	DDSST5			; YES - QUOTED STRING
	SETO	A5,
	LSH	A5,(A3)			; NO - MAKE TRUNCATION TEST MASK

DDSST8:	PUSHJ	SP,DDGTOC		; GET OCTAL VALUE.
	TDNE	A0,A5			; WILL IT BE TRUNCATED ?
	  SETO	A5,			; YES - REMEMBER.
	CAILE	A12,1(A6)		; SAFE TO STORE ?
	  JRST	DDSST6			; YES
	CCORE1	^D128			; NO - GET MORE.
	HRLZI	A3,^D128
	ADDM	A3,-1(A11)		; UPDATE LENGTH
	ADDI	A12,^D128		;  AND TOP ADDRESS

DDSST6:	IDPB	A0,A6
	CAIN	A4,.SPACE
	  PUSHJ	SP,DDIGCH		; IGNORE BLANKS
	CAIE	A4,.COMMA		; MORE BYTES ?
	  AOJA	A7,DDSST7		; NO
	PUSHJ	SP,DDIGCH
	AOJA	A7,DDSST8		; YES - COUNT & GET NEXT.

DDSST7:	AOSN	A5			; ANY BYTES TRUNCATED ?
	 OUTSTR	[ASCIZ/
%Byte(s) too long - truncated./]
DDSSTC:	TLNE	A2,17			; IF IT WAS DYNAMIC...
	  ADDI	A2,(DB)			;  ...RELOCATE IT.
	MOVEI	A4,0
	CAML	A7,A10			; SHORTER THAN OLD/SPECIFIED ?
	  JRST	.+3			; NO
	IDPB	A4,A6			; YES - NULL FILL
	AOJA	A7,.-3			;  THE REST.
	TLO	A7,STRDYN
	PUSH	SP,A2
	MOVEI	A0,0
	SKIPE	A1,STR1(A2)		; UNLESS THERE WASN'T ONE,
	  PUSHJ	SP,GETOWN		; DELETE OLD STRING.
	POP	SP,A2
	POP	SP,A6
	MOVEM	A6,STR1(A2)		; SET
	MOVEM	A7,STR2(A2)		;  NEW STRING.

; Here we return unused space, if any. A3 is byte size, A7 is length.

	MOVEI	A4,^D36
	IDIVI	A4,(A3)			; GET # BYTES/WORD.
	TLZ	A7,-1			; CLEAR FLAGS.
	IDIVI	A7,(A4)			; GET # WORDS.
	SKIPE	A10			; ROUND
	  ADDI	A7,1			;  UP.
	ADDI	A7,1			; ALLOW FOR HEAP LINK WORD.
	HLRZ	A5,-1(A11)		; GET LENGTH OF CHUNK.
	HRLZM	A7,-1(A11)		; SET NEW LENGTH.
	SUBI	A5,(A7)			; GET LENGTH OF SPARE.
	JUMPE	A5,CPOPJ		; NONE
	MOVEI	A1,-1(A11)		; GET 
	ADDI	A1,1(A7)		;  ADDR OF SPARE PIECE (SKIP LINK WORD)
	HRLZM	A5,-1(A1)		; SET ITS LENGTH.
	MOVEI	A0,0			; TELL GETOWN TO DELETE.
	PJRST	GETOWN			;  DELETE SPARE & RETURN.
DDSST5:	; Quoted string.
	CAIE	A3,6			; SENSIBLE
	CAIN	A3,7			;  BYTE-SIZE ?
	  SKIPA				; YES
	DDTERR	^D39			; NO

DDSSTA:	PUSHJ	SP,DDGTCA		; GET CHAR
	CAIE	A4,.SQUOTE		; QUOTE
	CAIN	A4,.DQUOTE		;  ?
	  JRST	DDSST9			; YES

DDSSTB:	CAIN	A3,6			; SIXBIT ?
	  SUBI	A4,40			; YES
	CAILE	A12,1(A6)		; SAFE TO STORE ?
	  JRST	DDSSTR			; YES
	CCORE1	^D128			; NO - GET MORE
	HRLZI	A5,^D128
	ADDM	A5,-1(A11)
	ADDI	A12,^D128

DDSSTR:	IDPB	A4,A6
	AOJA	A7,DDSSTA		; COUNT & GET NEXT.

DDSST9:	PUSHJ	SP,DDGTCH		; QUOTE FOUND - WHAT'S NEXT CHAR ?
	CAIE	A4,.SQUOTE
	CAIN	A4,.DQUOTE		; ANOTHER QUOTE ?
	  JRST	DDSSTB			; YES - PUT 1 OF THEM IN.
	JRST	DDSSTC			; NO - DONE.
DDSET2:	; Not string.
	TLNN	A6,$TYPE-$B		; BOOLEAN ?
	  JRST	DDSET3			; YES
	; Integer, real or long-real. Let READ do it, but he gets his characters
	; from our input routine.

	LDB	A2,[
	POINT	2,A6,5]			; 0=INT, 1=REAL, 2=LONG REAL.
	TLNN	A6,$TYPE-$S		; STRING ?
	  MOVEI	A2,0			; YES - PRETEND INTEGER.
	PUSH	SP,A6			; SAVE
	PUSH	SP,FL			; ALL
	PUSH	SP,A11			; OUR
	PUSH	SP,A10			; WORLD.
	PUSHJ	SP,READ.		; READ NUMBER.
	POP	SP,A10			; RESTORE
	POP	SP,A11			; ALL
	POP	SP,FL			; OUR
	POP	SP,A6			; WORLD.

DDSET0:	PUSHJ	SP,DDPUT		; STORE VALUE
	  DDTERR ^D35			; SYSERR - DDPUT THINKS IT'S STRING!
	POPJ	SP,			; CLOBBERS ALL AC'S, EXCEPT A6,A10,FL.

DDSET3:	; Boolean.
	PUSHJ	SP,DDIGCH		; GET CHAR, IGNORE BLANKS.
	CAIE	A4,.PRCNT		; % ?
	CAIN	A4,.HASH		; # ?
	  JRST	DDSET4			; YES - OCTAL COMING.
	CAIE	A4,.T			; T
	CAIN	A4,.F			; /F
	  JRST	DDSET5			; YES - TRUE/FALSE COMING.
	 DDTERR	^D40			; [271] NO, ERROR - INVALID INPUT

DDSET4:	PUSHJ	SP,DDIGCH
	PUSHJ	SP,DDGTOC		; % OR $ SEEN - GET OCTAL VALUE.
	JRST	DDSET0

DDSET5:	; T(rue) / F(alse).
	MOVE	A3,[
	POINT	7,A7]			; USE EXISTING ROUTINE.
	PUSH	SP,A10			; NEEDED LATER BY DDPUT.
	SETZB	A7,A10
	IDPB	A4,A3

DDSETA:	PUSHJ	SP,DDGTCH
	CAIL	A4,.A
	CAILE	A4,.Z			; LETTER ?
	  JRST	DDSETB		; NO

DDSETC:	IDPB	A4,A3			; YES.
	TRNN	A7,376			; FULL ?
	  JRST	DDSETA			; NO

DDSETB:	MOVE	A1,[
	XWD	-2,[
	SIXBIT/TRUE/
	SIXBIT/FALSE/]]			; TABLE FOR UNIQUE TEST
	MOVEI	A2,A7
	PUSHJ	SP,UNIQUE
	  DDTERR ^D40			; NOT TRUE/FALSE
	  DDTERR ^D35			; NOT UNIQUE - V SILLY.
	POP	SP,A10			; NEEDED BY DDPUT (PTR TO [ IF ARRAY)
	HLRE	A0,A1			; -2 = TRUE, -1 = FALSE.
	AOJA	A0,DDSET0		; -1 = TRUE, 0 = FALSE !
DDGTVL:	; Get decimal value, from TTY: to A5; terminator in A4.
	; Clobbers A0-A3, A10, A11.
	PUSHJ	SP,DDIGCH		; GET CHAR, IGNORE BLANKS.
DDGTV1:	MOVEI	A5,0

DDGTV2:	CAIL	A4,.ZERO
	CAILE	A4,.NINE		; DIGIT ?
	  POPJ	SP,			; NO - DONE.
	IMULI	A5,^D10
	ADDI	A5,-.ZERO(A4)
	PUSHJ	SP,DDGTCH		; GET ANOTHER.
	JRST	DDGTV2


DDGTOC:	; Get value in octal from TTY: to A0. Clobbers A1,A3,A4,A10,A11
	; Terminator in A4. Expects first character already to be in A4 on entry.
	MOVEI	A3,^D12			; MAX LENGTH
	MOVEI	A0,0

DDGOC1:	CAIL	A4,.ZERO
	CAILE	A4,.SEVEN
	  POPJ	SP,			; EXIT IF NON-OCTAL DIGIT.
	SOJL	A3,DDGOC2		; IF TOO LONG, SKIP REST.
	MOVEI	A1,-.ZERO(A4)
	ROT	A1,-3			; GET TO L.H. END
	LSHC	A0,3			; ACCUMULATE.

DDGOC2:	PUSHJ	SP,DDGTCH
	JRST	DDGOC1			; LOOP
	SUBTTL	Debugging system - command routine - PAUSE

; Output is a breakpoint control block, whose format is:
;
; Word 0:	XWD addr of module's loader s.t. entry, addr of BLKIDX entry
; Word 1:	bit 0 (BP.PSH)	1=break is on a PUSHJ SP, instruction
;		bit 1 (BP.OCT)	1=octal address.
;		bit 2 (BP.SIL)	1=silent (no "Pause at line n" message)
;		bit 3 (BP.PRO)	1=procedure.
;		bit 4 (BP.LAB)	1=label, 0=line-number.
;		bit 5 (BP.PRI)	1="PRIVATE" (UN-NAMED) AUTOLIST.
;		bit 6-8 (BP.ACT)	Action on error processing autolist:
;			1 - IGNORE.
;			2 - CONTINUE (Type message)
;			3 - KILL (Reference to this a/l from this b/p)
;			4 - STOP (and return control to ALGDDT cmd level)
;		bit 9 (BP.NXT)	1=NEXT command (kill automatically).
;
;		bit 10-17 (BP.STN) Statement # within line.
;		bits 18 - 35: line number (if bit 4 = 0), or
;				ptr to SYM item for label (if bit 4 = 1).
; Word 2:	Proceed counter.
; Word 3:	Count-down to automatic "KILL"
; Word 4:	Left half  -  address of entry in b/p table.
;		Right half -  pointer to autolist, if "private", or
;				pointer to a/l list slot if "public"
; Word 5:	Displaced instruction.
; If BP.PSH is 0
; Word 6:	JRST	Breakpoint site + 1
; Word 7:	JRST	Breakpoint site + 2
; If BP.PSH is 1
; Word 6:	PUSH	SP,Word 8
; Word 7:	JRST	Called Routine
; Word 8:	Breakpoint site + 1
;
; The BREAK uuo is planted at the breakpoint site: its address-field
; points to the control block.
; Also, the address of the breakpoint and of the control block is
; put into a slot in the breakpoint list, a pointer to which is
; held in %DDTBK(DB) (AOBJN pointer).
PAUSE:	SETZB	A10,A11			; INIT PROCEED CNTR,LINE-#
	SETZB	A7,A12			; MODULE & AUTOLIST PTR

PAUSE0:	; Object command enters here with A12 -ve
	SKIPA				; NORMAL CASE
PAUS0A:	PUSHJ	SP,DDIGCH		; ALTERNATE LOOP - IGNORE CHARACTER
	CAIL	A4,.ZERO
	CAILE	A4,.NINE		; IF DIGIT..
	  SKIPA	
	JRST	PAUSE4			;  IT'S LINE #
	CAIN	A4,.HASH		; IF #...
	  JRST	PAUS33			; ..IT'S OCTAL ADDRESS.
	CAIN	A4,.SCOL		; IF SEMI-COLON...
	  JRST	SETBRK			;   END OF COMMAND.
	CAIN	A4,.LPAR		; IF LEFT-PARENTHESIS...
	  JRST	PAUSE1			;  PROCEED-COUNT.
	CAIN	A4,.DOT			; IF PERIOD...
	  JRST	PAUS0A			;  IGNORE (HERE IS DEFAULT)
	CAIL	A4,.A			; IF 
	CAILE	A4,.Z			;  NOT ALPHA
DDER42:	  DDTERR ^D42			;   THERE ARE NO MORE POSSIBILITIES.
	PUSH	SP,A10
	PUSHJ	SP,SCAN3		; READ WORD - CLOBBERS A10.
	POP	SP,A10
	CAIN	A4,.COLON		; IF DELIMITED BY A COLON...
	  JRST	PAUS21			;  IT'S A LABEL.
	SKIPA	A1,.+1
	  XWD	-PSMANY,PSWTAB
	MOVEI	A2,%DDTIB(DB)
	PUSHJ	SP,UNIQUE		; LOOK UP THE WORD.
	  DDTERR ^D42			; UNKNOWN
	  DDTERR ^D42			; NOT UNIQUE.
	MOVE	A1,PSWDSP-PSWTAB(A1)	; GET DISPATCH.
	JRST	(A1)

PSWTAB:	SIXBIT/BEGIN/
	SIXBIT/HERE/
	SIXBIT/AUTO/
	SIXBIT/MODES/
	SIXBIT/PROCED/ ; PROCEDURE.

	PSMANY=.-PSWTAB

PSWDSP:	EXP	PAUSE6
	EXP	PAUSE0
	EXP	PAUSE5
	EXP	PAUS28
	EXP	PAUS32
PAUS21:	; PAUSE <label>
	TLZE	FL,DD%FLG		; %IDENT ?
	  DDTERR ^D60			; YES - ERROR
EDIT(106) ; Make PAUSE Label: work correctly
	PUSHJ	SP,SEARCH		; [E106] LOOK UP LABEL
	 DDTERR	^D23			; [E106] CAN'T FIND IT
	;
	; A6 has lexeme. A11 clobbered.
	; A7 has pointer to BLKIDX entry.
	;
	TLNE	A6,$TYPE-$L		; LABEL ?
	 DDTERR	^D62 			; NO
	TLNN	A6,400			; FORMAL ?
	TLNE	A6,200000		; SWITCH ?
	 DDTERR	^D62			; YES
	MOVEI	A11,(A1)		; PTR TO SYM ITEM IN S.T.
	TLO	A11,BP.LAB		; MARK AS SUCH.
	PUSH	SP,A7			; SAVE BLKIDX POINTER
	SETZ	A7,			; [E106] Clear module name
	JRST	PAUS0A			; CONTINUE, SKIPPING ":"

PAUS32:	; Procedure.
	PUSH	SP,A10
	PUSHJ	SP,SCAN3		; GET NAME.
	POP	SP,A10
	TLZE	FL,DD%FLG		; %-IDENT ?
	 DDTERR	^D60			; YES - SILLY.
	PUSHJ	SP,SEARCH		; [E106] Look up procedure name
	 DDTERR	^D23			; [E106] Can't find it !
	TLNE	A6,200000		; IS IT
	TLNN	A6,100000		;  A PROCEDURE ?
	 DDTERR	^D84			; NO - COMPLAIN.
	PUSH	SP,A7			; SAVE BLKIDX PTR
	MOVEI	A11,(A1)		; SAVE STE ITEM ADDR.
	TLO	A11,BP.PRO		; MARK AS PROCEDURE.
	SETZ	A7,			; [E106] Clear module name
	JRST	PAUSE0			; CONTINUE.
PAUS28:	; MODES (OBJECT command). 1st char is in A4.
	JUMPGE	A12,DDER42		; ILLEGAL UNLESS OBJECT CMD.
	TLZ	A12,377777		; CLEAR DEFAULTS.

PAUS31:	MOVSI	A3,-PAUS29		; TABLE LENGTH.
	CAIE	A4,@PAUS30(A3)		; MATCH ?
	  AOBJN	A3,.-1			; NO - TRY NEXT.
	IOR	A12,PAUS30(A3)		; YES - SET FLAG.(R.H. DOESN'T MATTER)
	TLNE	A12,OBJERR		; ERROR CHAR ?
	 DDTERR	^D42			; YES.
	PUSHJ	SP,DDIGCH		; GET NEXT CHAR.
	CAIE	A4,.COMMA		; MORE MODES ?/
	  JRST	PAUSE0			; NO.
	PUSHJ	SP,DDIGCH		; YES - GET NEXT MODE.
	JRST	PAUS31

PAUS30:	; Table of mode chars. Bits 13 - 17 must be zero !!!
	XWD	OBJOCT,"O"		; OCTAL
	XWD	OBJASC,"7"		; ASCII
	XWD	OBJASC,"A"		;   "
	XWD	OBJSIX,"6"		; SIXBIT
	XWD	OBJSYM,"S"		; SYMBOLIC INSTRUCTION.
	XWD	OBJINT,"I"		; INTEGER
	XWD	OBJINT,"D"		;    "
	XWD	OBJREA,"R"		; REAL
	XWD	OBJREA,"F"		;  "
	XWD	OBJLR,"L"		; LONG REAL.
; add extra ones here.
	PAUS29==.-PAUS30
	XWD	OBJERR,0		; CATCH-ALL FOR OTHER CHARS.
PAUSE1:	; PROCEED-COUNT.
	PUSHJ	SP,DDGTVL		; GET DECIMAL NUMBER.
	MOVEI	A10,(A5)		; AND REMEMBER VALUE
	CAIN	A4,.RPAR		; CORRECT TERMINATOR ?
	JRST	PAUS0A			; YES - CARRY ON
	CAIN	A4,.COLON		; PAUSE (M:N) ?
	SKIPGE	A12			; AND NOT OBJECT COMMAND ?
	 DDTERR	^D38			; NO TO ONE OR THE OTHER
	PUSHJ	SP,DDGTVL		; READ UPPER BOUND
	CAILE	A10,(A5)		; VALID RANGE SPECIFICATION ?
	 DDTERR	^D96			; NO
	HRLI	A10,(A5)		; REMEMBER IT IN L.H.
	CAIE	A4,.RPAR		; CLOSING PARENTHESIS ?
	 DDTERR	^D38			; NO  - ERROR
	JRST	PAUS0A			; YES - CARRY ON


PAUSE4:	; LINE-#
	PUSHJ	SP,DDGTV1		; GET IT.
	MOVEI	A11,(A5)		; SAVE
	CAIE	A4,.COMMA		; STMNT # ?
	  JRST	PAUSE2			; NO.
	PUSHJ	SP,DDGTVL		; YES - GET IT.
	HRLI	A11,(A5)

PAUSE2:	PUSHJ	SP,DDGTMD
		; GET "IN MODULE-NAME" IF PRESENT - TO A7 IN RAD50
	CAIN	A4,.SPACE
	  PUSHJ	SP,DDIGCH		; GET A NON-SPACE.
	JRST	PAUSE0

PAUS33:	; Octal address.
	JUMPGE	A12,DDER42		; FOR NOW, ONLY ALLOWED IN 'OBJECT' CMD.
	PUSHJ	SP,DDGTCH
	PUSHJ	SP,DDGTOC		; GET OCTAL VALUE TO A0.
	HRRZ	A11,A0
	TLO	A11,BP.OCT		; MARK AS OCTAL ADDRESS.
	JRST	PAUSE2			; GET 'IN MODULE' IF PRESENT.

PAUSE6:	; BEGIN AUTOLIST.
	JUMPL	A12,DDER42		; NOT ALLOWED FOR OBJECT CMD.
	TRNE	FL,DDALST		; EXECUTING AN AUTOLIST ?
	 DDTERR	^D91			; YES - CAN'T HANDLE NESTING.
	PUSHJ	SP,PAUSE9		; PROCESS SWITCH IF ANY.
					; SETS BITS IN L.H. A12
	TLOE	A12,10			; REMEMBER IT'S "PRIVATE"
	 DDTERR	1,^D42			; DISSALLOW BAUSE 7 BEGIN BEGIN !
	MOVEI	A0,ALSIZE+1		; GET SIZE NEEDED
	PUSHJ	SP,GETOWN		; GET SPACE FOR A/L
	SETZM	ALSIZE(A1)		; AND CLEAR LINK
	HRRI	A12,(A1)		; SAVE ADDRESS.
	HRRZ	A1,%DDTAL(DB)		; IF NOT
	TRNN	A1,-1			;    ALREADY DONE,
	  PUSHJ	SP,PAUS10		; SET UP AUTOLIST TABLE, TO ALLOW NESTING.
	JRST	PAUSE0

PAUSE5:	; AUTO AUTOLIST-NAME
	JUMPL	A12,DDER42		; NOT ALLOWED FOR OBJECT CMD.
	PUSHJ	SP,PAUSE9		; PROCESS SWITCH.
	CAIN	A4,.SPACE
	  PUSHJ	SP,DDIGCH		; GET NAME (1 ALPHA CHAR)
	CAIL	A4,.A
	CAILE	A4,.Z			; ALPHA ?
	  DDTERR ^D44			; NO.
	HRRZ	A1,%DDTAL(DB)		; POINTER TO TABLE.
	TRNN	A1,-1			; IF SET UP
	  PUSHJ	SP,PAUS10		; NOT YET - DO SO.
	ADDI	A1,-.A(A4)
	HRRI	A12,(A1)		; GET ADDR OF TABLE-SLOT.
	JRST	PAUS0A

PAUS10:	; SET UP AUTO-LIST TABLES.
	MOVEI	A0,^D26+1+DDNEST	;
	PUSHJ	SP,GETCLR
	HRRM	A1,%DDTAL(DB)
	POPJ	SP,

PAUSE9:	; SCAN FOR AUTOLIST SWITCH.
	CAIE	A4,.SLASH		; SWITCH ?
	  POPJ	SP,			; NO.
	PUSH	SP,A10
	PUSHJ	SP,DDGTCH
	PUSHJ	SP,SCAN3		; GET WORD.
	POP	SP,A10			; SCAN3 CLOBBERS THIS.
PAUS12:	MOVEI	A2,%DDTIB(DB)		; GET ADDR OF SCAN3 O/P BUFFER.
	SKIPA	A1,.+1
	XWD	-5,PAUS13
	PUSHJ	SP,UNIQUE
	  DDTERR ^D45			; UNKNOWN
	  DDTERR ^D46			; NOT UNIQUE.
	SUBI	A1,PAUS13		; GET OFFSET.
	TRNN	A1,-1			; ZERO (=SILENT) ?
	  TLOA	A12,100			; YES: REMEMBER.
	DPB	A1,[
	POINT	3,A12,17]		; NO - SAVE OFFSET AS CODE.
	JRST	PAUSE9			; AND SEE IF MORE SWITCHES.

PAUS13:	<SIXBIT/SILENT/>		; 0(MUST BE) - NO MESSAGE.
	<SIXBIT/IGNORE/>		; 1
	<SIXBIT/CONTINUE/>		; 2
	<SIXBIT/KILL/>			; 3
	<SIXBIT/STOP/>			; 4

LIST7C:	; Table of ASCII switch-names, for LIST command. N.B. 2 words each !!
	ASCIZ/ignore/
	ASCIZ/continue/
	ASCIZ/kill/
	Z
	ASCIZ/stop/
	Z
SETBRK:	; All read. Here, A7 = module-name (RADIX-50) or 0
	; A10 = upper bound,,proceed-count.
	; A11 = Statement-#,,line-# or 0 (0=here)
	;	or label (R.H. = SYM item address).
	;	or octal address.
	; A12 = Autolist flags,,autolist address, or 0 (or -1 if OBJECT cmd.)
	JUMPN	A11,PAUS7A		; "HERE" ?
	SKIPL	%DDTST(DB)		; YES - DOES SYMBOL TABLE EXIST ?
	 DDTERR	1			; NO  - ERROR (OBJECT COMMAND)
	HRRZ	A11,%DDTPT(DB)		; YES - GET ADDR OF STN ITEM
	MOVE	A11,2(A11)		; GET LINE-# FROM IT.
PAUS7A:	TLNE	A11,BP.OCT!BP.PRO!BP.LAB ; PROCEDURE OR LABEL OR OCTAL ?
	  JRST	PAUS22			; YES.
	MOVE	A0,A11
	TLZ	A0,777777-BP.STN	; CLEAR FLAGS.
	MOVE	A1,A7			; GET MODULE-NAME.
	PUSHJ	SP,FNDLIN		; FIND ADDRESS.
	MOVE	A7,A1			; IN SOME CASES, A1 GETS SET UP.

PAUS26:	; here, A2 is address.
	JUMPL	A12,OBJEC0		; LEAVE THIS CODE IF OBJECT CMD.
	TRNE	A2,400000		; HI-SEG ?
	  DDTERR ^D47			; ILLEGAL.
	HLRZ	A5,(A2)			; GET L.H. OF INSTR.
	CAIN	A5,(<JRST 0>)		; JRST ?
	JRST	PAUS25			; YES - SEE IF LABEL
	CAIN	A5,(<JSP AX,>)		; [303] SPECIAL  CASE ?
	 JRST	PAUS15			; MAYBE.
	CAIN	A5,(PUSHJ SP,)		; PUSH-JUMP ?
	 JRST	PAUS67			; YES - CAREFUL !
	CAIN	A5,(<BREAK>)		; ALREADY BREAKPOINTED ?
	JRST	PAUS36			; YES - ILLEGAL UNLESS 'NEXT'

PAUS14:	MOVEI	A0,BP.INS+3		; GET LENGTH OF BLOCK

	MOVEI	A4,(A2)			; GET ADDRESS INTO A4
	PUSHJ	SP,GETCLR		; GET SPACE FROM HEAP
	MOVE	A5,(A4)			; GET DISPLACED INSTR.
	MOVEM	A5,BP.INS(A1)		; STORE IN BLOCK
	MOVSI	A5,(JRST)		; THEN GET ORDINARY RETURN
	HRRI	A5,1(A4)		; TO BREAK+1, AND STORE
	MOVEM	A5,BP.INS+1(A1)		; IN WORD AFTER INSTRUCTION
	ADDI	A5,1			; AND ALSO SET UP NEXT WORD
	MOVEM	A5,BP.INS+2(A1)		; IN CASE OF SKIPS
	JRST	PAUS16			; GO SET UP REST OF BLOCK.

PAUS36:	; IT'S A BREAK UUO.
	HRRZ	A1,(A2)			; GET R.H. OF BREAK UUO.
	TLNE	A11,BP.NXT		; IF THIS IS 'NEXT' COMMAND,
	  POPJ	SP,			;  FORGET THE WHOLE THING.
	MOVE	A5,BP.FLG(A1)		; GET FLAG WORD.
	TLNN	A5,BP.NXT		; IS IT A 'NEXT' ONE ?
	 DDTERR	^D48			; NO - PAUSE ALREADY EXISTS ERROR.
	JRST	PAUS37			; YES - USE SAME BLOCK.

PAUS22:	; It's a label or proc. A11 points to its SYM item in S.T.
	; or, it's an octal address, in A11.
	; A7 = module name or 0.
	TLNN	A11,BP.OCT		; UNLESS IT'S AN OCTAL ADDRESS,
	  POP	SP,A3			;  RETRIEVE BLKIDX PTR.
	JUMPN	A7,PAUS23		; THIS MODULE ?
	TLNE	A11,BP.OCT		; IS IT AN OCTAL ADDRESS ?
	  TDZA	A1,A1			; YES - NO DEFAULT RELOCATION.
	HLRZ	A1,%DDTPT(DB)		; NO - GET ITS RELOCATION.
EDIT(075); Set relocation correctly for "OBJECT #n in FOO"
	JRST	PAUS24

PAUS23:	; A7 has right-justified RADIX-50 module name.
	PUSH	SP,A10
	PUSHJ	SP,FNDMOD		; LOOK FOR NAME IN LINK S.T.
	 DDTERR	^D19			; NOT THERE.
	MOVE	A1,A10			; FOUND - GET POINTER.
	POP	SP,A10

; Here A1 points to LINK S.T. entry for the module, or else it holds zero.
; If A1 holds zero, 1(A1) will address A1, and hence set A2 to zero also.
; If A1 is a pointer, A2 will be set to the relocation offset for the module.
PAUS24:	HRRZ	A2,1(A1)		; [E075] GET RELOCATION
	TLNE	A11,BP.OCT		; OCTAL ADDRESS ?
	  SKIPA	A1,A11			; YES - GET IT.
	HRRZ	A1,1(A11)		; NO - GET VALUE FROM S.T.E.
	ADDI	A2,(A1)			; RELOCATE IT.
	MOVSI	A5,$EXT-$OWN		; [E106] Check for external procedures
	TLNE	A11,BP.PRO		; [E106] Pause on  Procedure ?
	TDNN	A5,1(A11)		; [E106] And External procedure ?
	JRST	PAUS26			; [E106] No
	MOVE	A2,(A2)			; [E106] Yes - get instruction
	TLC	A2,(<BREAK 0>)		; [E106] Check for BREAK UUO
	TLZN	A2,777777		; [E106] Was it BREAK ?
	HRRZ	A2,BP.INS(A2)		; [E106] Yes - get real address
	JRST	PAUS26			; DONE.

PAUS25:	HRRZ	A1,(A2)			; JRST - GET EFFECTIVE ADDRESS
	CAIL	A1,(A2)			; IF BACKWARD JUMP,
	CAILE	A1,20(A2)		; OR TOO FAR FORWARD
	JRST	PAUS14			; CAN'T POSSIBLY BE A PMB
	MOVE	A4,(A1)			; COULD BE - GET TARGET INSTRUCTION
	MOVE	A5,1(A1)		; AND FOLLOWING WORD
	CAMN	A4,[JSP AX,%ALGDR+52]	; [303] IF THIS IS NOT A CALL TO TRLAB,
	CAIE	A5,1(A2)		; OR PMB ADDRESS IS INCORRECT
	JRST	PAUS14			; THIS IS NOT A LABEL
	MOVEI	A2,(A1)			; OTHERWISE POINT A2 TO TRLAB
PAUS27:	ADDI	A2,2			; SKIP OVER CALL TO GOLAB/TRLAB
	JRST	PAUS26			; AND GO TRY AGAIN

PAUS35:	HRRZ	A5,3(A2)		; GET NUMBER OF FORMALS
	ADDI	A2,3(A5)		; STEP PAST BLOCK
	JRST	PAUS26			; AND GO TRY NEXT

PAUS15:	HRRZ	A4,(A2)			; GET ADDRESS
	CAIE	A4,%ALGDR+3		; GOLAB ?
	CAIN	A4,%ALGDR+52		; TRLAB ?
	JRST	PAUS27			; YES - SKIP THEM
	CAIE	A4,%ALGDR+1		; PARAM ?
	CAIN	A4,%ALGDR+2		; PAR0 ?
	JRST	PAUS35			; YES - SKIP THESE ALSO
	JRST	PAUS14			; OTHERWISE TREAT AS NORMAL

PAUS67:	MOVEI	A0,BP.INS+4		; SPECIAL CASE - PUSHJ SP,Routine
	MOVEI	A4,(A2)			; SAVE ADDRESS OF BREAK
	PUSHJ	SP,GETCLR		; GET SPACE FOR BLOCK
	MOVE	A5,(A4)			; GET DISPLACED INSTRUCTION
	MOVEM	A5,BP.INS(A1)		; AND STORE IN BLOCK
	HRLI	A5,(JRST 0)		; CHANGE "PUSHJ SP," TO "JRST"
	MOVEM	A5,BP.INS+2(A1)		; AND STORE AS SECOND INSTRUCTION
	MOVEI	A5,BP.INS+3(A1)		; THAT WILL BE EXECUTED. THIS
	HRLI	A5,(PUSH SP,)		; SIMULATES A PUSHJ SP,address
	MOVEM	A5,BP.INS+1(A1)		; BY PUSH SP,[.+1]; JRST address;
	MOVEI	A5,1(A4)		; FINALLY SET UP THE WORD
	MOVEM	A5,BP.INS+3(A1)		; THAT WILL BE PUSHED
	TLO	A11,BP.PSH		; REMEMBER THIS IS A SPECIAL !

PAUS16:	; displaced instruction(s) has been done.
	HRLI	A1,(<BREAK>)		; MAKE B/P UUO.
	MOVEM	A1,(A4)			; PUT IN OBJECT PROG.
	HRRZ	A5,%DDTPC(DB)		; GET CURRENT OBJECT PROGRAM ADDRESS
	CAIN	A5,(A4)			; IS THIS WHERE WE ARE SETTING B.P. ?
	HRLM	A1,%DDTAL(DB)		; YES - STORE CONTROL BLOCK ADDR

PAUS37:	MOVEM	A11,BP.LIN(A1)		; SAVE LINE-#
	HRRZM	A10,BP.CNT(A1)		;  & PROCEED COUNTER
	HRRM	A3,BP.PTR(A1)		;   & BLKIDX POINTER.
	SETOM	BP.LIM(A1)		; ASSUME NO UPPER BOUND
	TLNE	A10,-1			; WAS ONE SPECIFIED ?
	HLRZM	A10,BP.LIM(A1)		; YES - REMEMBER IT
	PUSHJ	SP,FNDMOD		;  GET LOADER S.T. PTR.
	 DDTERR	^D19			; CAN'T BE FOUND.
	HRLM	A10,BP.PTR(A1)		; SAVE POINTER TO MODULE'S LOADER S.T. ENTRY

	; CONTROL-BLOCK IS ALMOST COMPLETED. ITS ADDRESS IS IN A1.
	; THE ADDRESS OF THE B/P IS IN A4.
	; NOW, MAKE AN ENTRY IN THE B/P LIST, IN THE FORM:
	;  XWD ADDR-OF-B/P,ADDR-OF-CONTROL-BLOCK

	PUSH	SP,A1
	SKIPN	A3,%DDTBK(DB)		; PTR TO B/P LIST
	  JRST	PAUS17			; NOT SET UP YET - DO IT.

PAUS19:	SKIPE	A5,(A3)			; FIND A
	  AOBJN	A3,.-1			;  ZERO SLOT.
	JUMPE	A5,PAUS18		; FOUND ONE ?
	SKIPE	A3,(A3)			; NO. MORE TABLE ?
	  JRST	PAUS19			; YES - TRY THAT.

	; THE TABLE IS IN 10-WORD PIECES - THE LAST WORD OF EACH
	; PIECE IS EITHER 0 OR AN AOBJN PTR (-7,,ADDR) TO ANOTHER
	; PIECE.

	; NO FREE SLOT - GET A NEW PIECE OF TABLE AND CHAIN IT ON.

PAUS17:	MOVEI	A0,10			; LENGTH OF PIECE
	PUSHJ	SP,GETCLR		; GET IT, ZEROED.
	HRLI	A1,-7			; MAKE AOBJN PTR.
	MOVEI	A3,(A1)			; SAVE 1ST ADDR AS FREE SLOT.
	EXCH	A1,%DDTBK(DB)		; PUT NEW PIECE ON FRONT.
	MOVEM	A1,7(A3)		; OF OLD PIECE.

PAUS18:	; R.H. A3 IS ADDR OF FREE SLOT.
	POP	SP,A1			; GET ADDR OF CONTROL BLOCK.
	HRLI	A1,(A4)			; ADDR OF B/P
	MOVEM	A1,(A3)			; STORE IN TABLE.
	HRLZM	A3,BP.ALP(A1)		; BACKPOINTER TO BLOCK.

	; THE B/P IS NOW SET UP.
	HRRM	A12,BP.ALP(A1)		; SAVE AUTOLIST ADDR IF ANY.
	TLNE	A12,10			; PRIVATE ?
	  TRO	FL,DDALIP		; YES - REMEMBER.
	HLLZ	A2,A12
	LSH	A2,^D9			; SHIFT FLAGS TO L.H.
	TLZ	A2,BP.STN		; JUST FLAGS.
	IORM	A2,BP.FLG(A1)		; SAVE IN BLOCK.
	HRLI	A12,(A12)		;

	; WITH DDALIP SET, MAIN LOOP WILL READ COMMANDS INTO THE
	; AUTOLIST.  A12 IS KEPT AS PTR-TO-FREE-WORD,,ADDR-OF-ST.
	; COMMANDS ARE CHECKED FOR SYNTAX ONLY,  N O T  FOR SEMANTICS.
	; MAIN LOOP ROUTINES (DDGTLN, SCAN4, UNIQUE ETC) MUST
	; RESPECT A12 !!!

	HRRM	FL,%DDTFL(DB)		; ENSURE DDALIP GETS KEPT!
	POPJ	SP,			; DONE.
	SUBTTL	Debugging system - find module routine, and read module-name.

FNDMOD:	; Finds a module-name in the LINK symbol table.
	; Call with the name, in Radix50 (right-justified!) in A7.
	; Returns (skip) with pointer in A10.
	; Non-skip return if not found.
	; A7 is the only AC clobbered.
	;
	; N.B.:
	; 'IF' name is found in more than 1 title item 'THEN'
	; 'BEGIN'	'IF' one of them is main.program 'THEN'
	;		use that one 'ELSE'
	;		DDTERR ^D49 'FI'
	; 'END''FI';
	; We check for 'main.program' by comparing its relocation with
	;  %BEGIN.
	; The error-condition is most unlikely: the only feasible way
	;  of getting it is to have two (MACRO) procedures with the
	;   same TITLEs, but different ENTRY's !!!
	;
	; DDTERR ^D17  if no LINK symbol-table.

	JUMPN	A7,.+3			; IF NAME IS ZERO,
	HLRZ	A10,%DDTPT(DB)		; USE CURRENT
	JRST	CPOPJ1			;  AND GIVE GOOD RETURN.
	PUSH	SP,A2
	PUSH	SP,A3
	SKIPN	A2,.JBSYM		; GET POINTER TO LINK S.T.
	 DDTERR	^D17			; NONE
	TLZ	A7,740000
	SETZ	A10,
	MOVE	A3,@%SYS0(DB)		; GET VALUE

FNDMD1:	CAMN	A7,(A2)			; NAMES THE SAME ?
	  JRST	FNDMD2			; YES - CHECK UNIQUENESS ETC.

FNDMD3:	AOBJN	A2,.+1			; ADVANCE TO
	AOBJN	A2,FNDMD1		; NEXT ITEM.
	POP	SP,A3			; END - RESTORE
	POP	SP,A2			;  AC'S
	TLNN	A10,-1			; ANY FOUND ?
	  POPJ	SP,			; NO.
	TLNN	FL,DDTMP1		; YES - ONLY ONE ? (FLAG CLEAR)
	  MOVS	A10,A10			; YES - GET IT TO R.H. A10 FOR RETURN.
	TLNE	FL,DDTMP1		; 
	TRNE	A10,-1			; NOT UNIQUE - USE MAIN.PROGRAM ONE IF ANY.
	  JRST	CPOPJ1			; GOOD RETURN.
	DDTERR	^D49			; NOT UNIQUE, AND NONE HAS RELOC = %BEGIN.

FNDMD2:	; FOUND ONE.
	TLNE	A10,-1			; FIRST ONE ?
	  TLO	FL,DDTMP1		; NO - REMEMBER NOT UNIQUE.
	HRR	A10,1(A2)		; GET RELOCATION OF THIS ONE.
	CAIE	A3,(A10)		; = %BEGIN ?
	  TRZA	A10,-1			; NO - RESTORE ZERONESS OF POINTER TO %BEGIN ONE.
	HRR	A10,A2			; YES - SAVE POINTER TO IT.
	HRL	A10,A2			; IN ANY CASE, SAVE POINTER TO THIS ONE.
	JRST	FNDMD3			;  AND SEE IF ANY MORE.

DDGTMD:	; Read "IN module-name" if present. Return it in RAD50 in A7 , or 0
	; Clobbers A0-A4, A10.
	PUSH	SP,A11			;
	CAIN	A4,.SPACE
	PUSHJ	SP,DDIGCH		; IGNORE BLANKS
	MOVEI	A7,0			; DEFAULT THIS MODULE.
	CAIE	A4,"I"			; "IN <MODULE>" ?
	  JRST	DDGTM1			; exit
	PUSHJ	SP,DDGTCH
	CAIE	A4,"N"
	DDTERR	^D42
	PUSHJ	SP,DDIGCH		; GET CHAR OF NAME.

DDGTM0:	CAML	A7,[<377777,,-1>/50]	; [264] WILL IMULI OVERFLOW?
	  DDTERR ^D43			; [264] YES, TOO MUCH INPUT ALREADY
	IMULI	A7,50			; [264] ROTATE MODULE NAME OVER
	CAML	A7,[<RADIX50 0,000000>*50]  ; [264] TOO LONG?
	  DDTERR ^D43			; YES.
	CAIN	A4,.DOT			; DEAL
	  MOVEI	A4,.Z+1			;  WITH
	CAIN	A4,.DOLLR		;   THE
	  MOVEI	A4,.Z+2			;    THREE
	CAIN	A4,.PRCNT		;     SPECIAL
	  MOVEI	A4,.Z+3			;      CASES.
	CAIG	A4,.Z+3			; [264] INVALID CHR.?
	CAIGE	A4,.ZERO		; [264]
	  DDTERR ^D103			; [264] YES, ERROR
	CAIG	A4,"@"			; [264] NO, BUT CHECK AGAIN
	CAIGE	A4,":"			; [264]
	  SKIPA				; [264] NO, OK - SKIP
	DDTERR	^D103			; [264] YES, FAIL
	CAIL	A4,.A			; LETTER ?
	  SUBI	A4,7
	ADDI	A7,-57(A4)
	PUSHJ	SP,DDGTCH
	CAIE	A4,.SPACE		; END ?
	CAIN	A4,.SCOL		;
	  SKIPA				;
	  JRST	DDGTM0

DDGTM1:	POP	SP,A11			;
	POPJ	SP,			;
	SUBTTL	Debugging system Control-C  (Automatic 'NEXT')

DDT.CC::SKIPLE	%DDTST(DB)	; Have we tried to read S.T. ?
	POPJ	SP,		; Yes - can't do  a 'next' if no S.T.
	TLO	DB,INDDT	; Say we are in ALGDDT
	SETZM	%DDTBE(DB)	; Say no context (for FNDADR)
	SKIPL	%DDTST(DB)	; Have we tried to read S.T. before ?
	PUSHJ	SP,DDINIT	; No - try now.
	HRRZ	A4,.JBOPC##	; Then get User PC
	MOVEM	A4,%DDTPC(DB)	; Save it for later
	SKIPGE	%DDTST(DB)	; And unless S.T. not available
	PUSHJ	SP,FNDADR	; Convert address to line number
	TLZ	DB,INDDT	; Failure !
	TLNN	DB,INDDT	; Did we succeed ?
	POPJ	SP,		; No - return to ALGOTS
	POP	SP,A0		; Yes - tidy up the stack
	MOVE	A0,SP		; As DDCON% will update the
	SUBI	A0,(DB)		; stack from the value in
	MOVEM	A0,%ACCS+SP(DB)	; %ACCS+SP, which is delocated
	HRRI	A0,DDCONC	; [E1000] SET "ACTION ABANDONED"
	PUSHJ	SP,DDSETI	; [E1000] ^C trap
	SETO	A0,		; And force channel -1
	EXCH	A0,%CHAN(DB)	; for output, remembering
	MOVEM	A0,%DDTTY(DB)	; The original setting
	PUSHJ	SP,DDTTYC	; Set TTY characteristics
	TLO	DB,TMPFL3	; Set 'no typeout' flag
	PUSHJ	SP,HSTPR0	; And establish context
	HRROS	%DDTCC(DB)	; [E114] Flag 'automatic next'
; ****	JRST	DDNEXT		; Fall into 'NEXT' command
	SUBTTL	Debugging system - command routine - NEXT.

DDNEXT:	; 'NEXT' command.
	; Puts a breakpoint at the physically next statement;
	; sets bit BP.NXT in the control-block,
	; which causes the breakpoint to get killed automatically.

	SKIPL	%DDTST(DB)		; Any symbols ?
	 DDTERR	1			; No - can't be done.
	SKIPE	%DDTNL(DB)		; Already doing a 'next' ?
	PUSHJ	SP,NBKILL		; Yes - go delete old one
	HRRZ	A3,%DDTPT(DB)		; Get address of current 'STN' item
	JRST	DDNXT1			; And go read next S.T. entry

NEXT.6:	; 'else' - step to after 'fi'
	HLRZ	A3,1(A3)		; Get S.T. address of 'fi'
NEXT.7:	; 'fi' - ignore
DDNXT1:	PUSHJ	SP,SCANST		; Get next S.T. entry
	 DDTERR	^D92			; No more S.T. - error
	CAIN	A2,'STN'		; Statement item ?
	JRST	DDNXT2			; Yes - go set pause
	CAIE	A2,'MRK'		; Sentinel item ?
	  JRST	DDNXT1			; No - keep looking.
	HRRZ	A2,1(A3)		; Yes - get sub-type
	JRST	@DDNTAB(A2)		; And dispatch via table

DDNXT2:	PUSHJ	SP,SETNBP		; Go set a 'next' breakpoint
	JRST	CONTIN			; Restart his program.

DDNTAB:	EXP	NEXT.0	; Type 0	'exit'
	EXP	NEXT.1	; Type 1	'for'
	EXP	NEXT.2	; Type 2	'do'
	EXP	NEXT.3	; Type 3	'od'
	EXP	NEXT.4	; Type 4	'if'
	EXP	NEXT.5	; Type 5	'then'
	EXP	NEXT.6	; Type 6	'else'
	EXP	NEXT.7	; Type 7	'fi'
	EXP	NEXT.8	; Type 8	'go'
	EXP	NEXT.9	; Type 9	'to'

SETNBP:	SETZB	A7,A10			; this module, no proceed count
	SETZ	A12,			; No autolist.
	MOVE	A11,2(A3)		; Get statement,,line.
	TLO	A11,BP.NXT		; Say it's "next" (kill automatically).
	PUSHJ	SP,SETBRK		; Set up breakpoint.
; N.B. SETBRK returns the address of the breakpoint control block in A1.
	SKIPE	BP.LNK(A1)		; Is this B.P. already linked ?
	POPJ	SP,			; Yes - return
	SKIPN	A2,%DDTNL(DB)		; No  - get address of last B.P.
	SETO	A2,			; This is the first - flag it
	MOVEM	A2,BP.LNK(A1)		; Store value in link field
	HRL	A1,%DDTDL(DB)		; Then get top-level DL
	MOVEM	A1,%DDTNL(DB)		; store with B.P. address
	POPJ	SP,			; Return

NEXT.0:	; 'exit' - exit from procedure
	MOVEI	A4,@PRGLNK(DL)		; Get return address for procedure
	PUSHJ	SP,FNDADR		; And convert to line number
	 DDTERR	^D98			; Failure - say so