;      *******************************************************
;      *                                                     *
;      *      THIS SOFTWARE WAS DEVELOPED WITH SUPPORT       *
;      *      FROM THE NATIONAL INSTITUTES OF HEALTH:        *
;      *         NIH CA06927                                 *
;      *         NIH CA22780                                 *
;      *                                                     *
;      *      DIRECT INQUIRIES TO:                           *
;      *            COMPUTER CENTER                          *
;      *            THE INSTITUTE FOR CANCER RESEARCH        *
;      *            7701 BURHOLME AVENUE                     *
;      *            PHILADELPHIA, PENNSYLVANIA   19111       *
;      *                                                     *
;      *      NO WARRANTY OR REPRESENTATION, EXPRESS OR      *
;      *      IMPLIED, IS MADE WITH RESPECT TO THE           *
;      *      CORRECTNESS, COMPLETENESS, OR USEFULNESS       *
;      *      OF THIS SOFTWARE, NOR THAT USE OF THIS         *
;      *      SOFTWARE MIGHT NOT INFRINGE PRIVATELY          *
;      *      OWNED RIGHTS.                                  *
;      *                                                     *
;      *      NO LIABILITY IS ASSUMED WITH RESPECT TO        *
;      *      THE USE OF, OR FOR DAMAGES RESULTING FROM      *
;      *      THE USE OF THIS SOFTWARE                       *
;      *                                                     *
;      *******************************************************
;      *                                                     *
;      *      THIS SOFTWARE WAS DESIGNED FOR USE ON A        *
;      *      PDP-11/70 OPERATING UNDER IAS V3.0 USING       *
;      *      THE IAS PDP-11 MACRO ASSEMBLER.                *
;      *                                                     *
;      *******************************************************
	.TITLE	FDT	-- FORTRAN DEBUGGER
	.MCALL	DIR$,CALLR
;
;	ICR001	ROBERT K. STODOLA	04-JUL-79	INITIAL VERSION
;	ICR002	ROBERT K. STODOLA	28-NOV-79	ADD OVERLAY SUPPORT
;	ICR003	ROBERT K. STODOLA	12-NOV-80	ADD SUPPORT FOR IAS
;							V3.1 CONTINUE/DEBUG
;							COMMAND.
;	ICR4XX	ROBERT K. STODOLA	14-NOV-80	ADD OPTIONAL SUPPORT
;							FOR VIRTUAL ARRAYS,
;							PREPARE FOR XFDT.
;
;	DOCUMENTATION IS EXTERNAL
;	NOTES ON THIS VERSION:
;		1.	BECAUSE THE DATA IS CURRENTLY NOT AVAILABLE IN THE
;			LIST FILE, VIRTUAL SUBROUTINE ARGUMENTS CANNOT
;			BE PROPERLY FLAGGED IN THE FDT BLOCK.  CODE IS
;			INCLUDED HERE TO SERVICE IT, SHOULD IT BECOME
;			AVAILABLE IN THE FUTURE.
;
.IIF NDF VFDT,VFDT = 0
.IIF NDF XFDT,XFDT = 0
.IF NE VFDT
  .IF NE XFDT
	.IDENT	"ICR4VX"
  .IFF
	.IDENT	"ICR4V"
  .ENDC
.IFF
  .IF NE XFDT
	.IDENT	"ICR4X"
  .IFF
	.IDENT	"ICR4"
  .ENDC
.ENDC
;RSX11M	= 0				;DEFINE RSX11M IF NOT IAS
;
	.IF	DF	RSX11M
T$RBLK	= 0				;OVERLAY DISK BLOCK
T$RUP	= 6				;TREE UP LINKAGE
T$RDWN	= 10				;TREE DOWN LINKAGE
T$RNXT	= 12				;TREE LATERAL LINKAGE
;
TR$DES	= 100000
TR$DSK	= 040000
TR$LOD	= 020000
TR$MEM	= 010000
	.IFF
	.MCALL	SEGDF$
	SEGDF$
	.ENDC
	.PAGE
	.SBTTL	MACRO DEFINITIONS
;
;	PSECT MACROS
;
	.MACRO	CODE
	.PSECT	CODE,RW,I,LCL,CON
	.ENDM	CODE
;
	.MACRO	PDATA
	.PSECT	PDATA,RW,D,LCL,CON
	.ENDM	PDATA
;
	.MACRO	IDATA
	.PSECT	IDATA,RW,D,LCL,CON
	.ENDM	IDATA
;
;	ROUTINE CALLING MACROS
;
	.MACRO	PREPVC	PROCS			;PREPARE SST VECTOR
	.MCALL	SVDB$
	PDATA
	.EVEN
SSTV:	.WORD	PROCS
	$TEMP = <.-SSTV>/2
SVDB:	SVDB$	SSTV,$TEMP
	CODE
	DIR$	#SVDB
	.ENDM	PREPVC
;
	.MACRO	OTSINI				;INIT FORTRAN OTS
	CALL	OTI$
	.GLOBL	$OTSVA
	.ENDM	OTSINI
;
	.MACRO	TYPES	BLO,STRING,EOL		;TYPE A CONSTANT STRING
	PDATA
	$TEMP = .
	.IF	NB	<BLO>
	.IF	DIF	<BLO>,<BOL>
	.REPT	BLO
	.BYTE	15,12
	.ENDR
	.IFF
	.BYTE	15,12
	.ENDC
	.ENDC
	.IF	NB	<STRING>
	.ASCII	STRING
	.ENDC
	.IIF	NB	<EOL>,	.BYTE	15,12
	.BYTE	0
	CODE
	MOV	#$TEMP,R1
	CALL	.TYPES
	.ENDM	TYPES
;
	.MACRO	LINPUT				;INPUT A LINE
	CALL	LINPT.
	.ENDM	LINPUT
;
	.MACRO	OPEN				;OPEN THE DISK FILE
	CALL	OPEN.
	.ENDM	OPEN
;
	.MACRO	MOVES	X,DEST,NULL,?A		;MOVE A CONSTANT STRING
	PDATA
	$TEMP = .
	.IF	B	<NULL>
	.ASCII	X
	.IFF
	.ASCIZ	X
	.ENDC
	$COUNT = .-$TEMP
	CODE
	.IIF	DIF	<DEST>,<R1>,	MOV	DEST,R1
	MOV	#$COUNT,R2
	MOV	#$TEMP,R0
A:
	MOVB	(R0)+,(R1)+
	SOB	R2,A
	.ENDM	MOVES
;
	.MACRO	LOCATE	X				;LOCATE ADDRESS
	.IIF	DIF	<X>,<R1>,	MOV	X,R1
	CALL	LOCAT.
	.ENDM	LOCATE
;
	.MACRO	CAIFEB	A1,A2,LOOP,ROUT,?OK			;CALL IF EQUAL
	CMPB	A1,A2
	BNE	OK
	CALL	ROUT
	BR	LOOP
OK:
	.ENDM	CAIFEB
;
	.MACRO	GET	X,Y
	.IIF	DIF	<X>,<R0>,	MOV	X,R0
	.IIF	DIF	<Y>,<R1>,	MOV	Y,R1
	CALL	GET.
	.ENDM	GET
;
	.MACRO	TYPNAM	X
	.IIF	DIF	<X>,<R1>,	MOV	X,R1
	CALL	TYPNM.
	.ENDM	TYPNAM
;
	.MACRO	GETVAR	LOC
	.IIF	DIF	<LOC>,<R1>,	MOV	LOC,R1
	CALL	GETVR.
	.ENDM	GETVAR
;
	.MACRO	MAPVRT
	.IIF	NE	VFDT,	CALL	VRTMAP
	.ENDM	MAPVRT
;
	.MACRO	SAVE	Y
	$SAVE$ = 0
	.IRP	X,<Y>
	.IIF	IDN	<X>,<R0>,$SAVE$=$SAVE$!1
	.IIF	IDN	<X>,<R1>,$SAVE$=$SAVE$!2
	.IIF	IDN	<X>,<R2>,$SAVE$=$SAVE$!4
	.IIF	IDN	<X>,<R3>,$SAVE$=$SAVE$!10
	.IIF	IDN	<X>,<R4>,$SAVE$=$SAVE$!20
	.IIF	IDN	<X>,<R5>,$SAVE$=$SAVE$!40
	.ENDM
	.IIF	NE	$SAVE$&1,	MOV	R0,-(SP)
	.IIF	NE	$SAVE$&2,	MOV	R1,-(SP)
	.IIF	NE	$SAVE$&4,	MOV	R2,-(SP)
	.IIF	NE	$SAVE$&10,	MOV	R3,-(SP)
	.IIF	NE	$SAVE$&20,	MOV	R4,-(SP)
	.IIF	NE	$SAVE$&40,	MOV	R5,-(SP)
	.ENDM	SAVE
	.MACRO	RESTOR
	.IIF	NE	$SAVE$&40,	MOV	(SP)+,R5
	.IIF	NE	$SAVE$&20,	MOV	(SP)+,R4
	.IIF	NE	$SAVE$&10,	MOV	(SP)+,R3
	.IIF	NE	$SAVE$&4,	MOV	(SP)+,R2
	.IIF	NE	$SAVE$&2,	MOV	(SP)+,R1
	.IIF	NE	$SAVE$&1,	MOV	(SP)+,R0
	.ENDM	RESTOR
;
	.MACRO	SAVALL			;SAVE ALL REGISTERS
	JSR	R5,$SAVAL
	.ENDM	SAVALL
;
	.MACRO	FORM	R,CODE,W,D,V	;CREATE FORMAT ELEMENT
	.IF	NDF	$FIN$
$FIN$=10.
$H$=26.
$A$=28.
$L$=30.
$O$=32.
$I$=34.
$G$=40.
$DA$=44.
$DL$=46.
$DO$=48.
$DI$=50.
$DG$=56.
	.ENDC
	.IF	DF	$'CODE'$
	$TEMP = $'CODE'$
	.IFF
	$TEMP = CODE
	.ENDC
	.IF	NB	<R>
	.IIF	DIF	<R>,<1>,	$TEMP = $TEMP!200
	.ENDC
	.IIF	NB	<V>,	$TEMP = $TEMP!100
	.BYTE	$TEMP
	.IIF	NE	$TEMP&200,	.BYTE	R
	.IIF	NB	<V>,	.BYTE	V
	.IIF	NB	<W>,	.BYTE	W
	.IIF	NB	<D>,	.BYTE	D
	.ENDM	FORM
	.PAGE
	.SBTTL	TABLE OFFSET DEFINITIONS
;
;  INITIAL TABLE
;
I.NAM = 0		;OFFSET TO NAME
I.ROTD = 10.		;OFFSET TO DIRECTORY POINTER
;
;  ROUTINE TABLE
;
R.NAM = 0		;OFFSET TO NAME
R.EPD = 6.		;ENTRY POINT DIRECTORY
R.VARD = 8.		;VARIABLE DIRECTORY
R.ARYD = 10.		;ARRAY DIRECTORY
R.LABD = 12.		;LABEL DIRECTORY
R.OVBN = 14.		;OVERLAY BLOCK NUMBER(0 IF NONE)
;
;  OTHER TABLES
;
T.NAM = 0		;NAME OF ITEM
T.ADR = 6.		;ADDRESS
T.TYP = 8.		;TYPE
T.FLG = 9.		;FLAGS:
T.FARG = 1		;	VARIABLE/ARRAY IS ARGUMENT
T.FREG = 2		;	ARGUMENT IS ADDRESSED THROUGH R5
T.FVIR = 4		;	VIRTUAL ARRAY
T.LEN = 10.		;LENGTH
T.DIMS = 12.		;DIMENSIONS
T.DIM1 = T.DIMS
T.DIM2 = T.DIMS+2
T.DIM3 = T.DIMS+4
T.DIMZ = 18.		;ZERO DIMENSIONS
T.DMZ1 = T.DIMZ
T.DMZ2 = T.DIMZ+2
T.DMZ3 = T.DIMZ+4
T.PSE = 24.		;PSECT OR ZERO IF NONE
;
T.LINK = 30.		;LINK TO NEXT TABLE
;
;	FORTRAN ARRAY DESCRIPTOR OFFSETS USED HERE
;
;	OTHER SYMBOL DEFINITIONS
;
BPTINS = 3				;BREAKPOINT DESCRIPTOR
;
;  BREAKPOINT TABLE (INTERNAL)
;
BRB.LO	= 0				;LOCATION OF BREAKPOINT
BRB.RA	= 2				;ROUTINE TABLE ADDRESS (DISK)
BRB.LA	= 4				;LINE/-ENTRY TABLE ADDRESS (DISK)
BRB.SI	= 6				;SAVED INSTRUCTION CODE
BRB.OS	= 10				;OVERLAY STATUS WORD
;
	.IF	NE	XFDT
BRBNUM	= 20.				;20 BREAKPOINTS IN XFDT
	.IFF
BRBLEN	= 12				;BREAKPOINT TABLE LENGTH
BRBNUM	= 10.				;10 BREAKPOINTS IN FDT
	.ENDC
.FDTFG == 23.				;DEFINE EVENT FLAG NUMBER FOR FDT
;
	.PSECT	$$SGD0	RW,D,LCL,OVR
BOV:
	.PSECT	$$SGD2	RW,D,LCL,OVR
EOV:
;
	.PAGE
	.SBTTL	MAIN CODE
	CODE
FDT.::
	ADD	#4.,R0			;SKIP OVER FORTRAN "CALL OTI$"
	MOV	R0,SAVPC		;SET FOR RETURN TO MAIN
	PREPVC	<0,0,BPTPRC>		;PREPARE SST VECTORS
	TST	#EOV-BOV		;IS OVERLAYED?
	BEQ	2$			;NO
	MOV	#BPTINS,$ALBP2		;YES.  SET BREAKPOINT IN $AUTO
2$:
	MOV	.ODTL1,OPQIO+Q.IOLU	;SAVE TI LU
	MOV	.ODTL1,IPQIOW+Q.IOLU
	.MCALL	ALUN$S
	ALUN$S	.ODTL1,#"TI		;ASSIGN LUN TO TI.
	BCC	4$			;IF ERROR, BEAT IT.
3$:
	JMP	RETRN.			;EXIT ON ASSIGN ERROR
4$:
	OTSINI				;INITIALIZE FORTRAN OTS
	CALL	FPSAVE			;SAVE FLOATING POINT REGS FOR FORTRAN
	TYPES	BOL,<'FDT - ICR003/RKS - 12-NOV-80'>,EOL
	TYPES	BOL,<'PROGRAM NAME? '>
	LINPUT				;GET NAME OF FDT FILE
	TST	R2			;EXIT IF NO PROG
	BNE	5$
	JMP	RETRN.
5$:
	ADD	#4,R2			;SAVE LENGTH OF FILENAME
	MOV	R2,DSPT+10		;  IN FILE DESCRIPTOR BLOCK
	MOVES	<'.FDT'>,R1		;ADD IN EXTENSION
	OPEN				;OPEN THE FDT FILE
	GET	#1,#INITAB		;GET THE INITIAL TABLE
	MOVES	<'.MAIN.:'>,#LINBUF,NULL;SET UP FOR LOCATION SEARCH
	LOCATE	#LINBUF			;LOCATE THE ADDRESS
	MOV	LOCROT,RETROT		;SET RETURN ROUTINE
	CLR	LOCSPT			;SET ROUTINE SPOT
	CLR	RETBRA			;CLEAR RETURN BREAKPOINT
	CLR	OPNADR			;CLEAR OPEN ADDRESS
	CLR	DEBUGT			;CLEAR CONTINUE/DEBUG FLAG
;
	.ENABL LSB
;
PCESS.:
	TST	OPNADR			;IS THERE AN OPEN LOCATION?
	BNE	10$			;YES, SO DON'T PRINT PROMPT
PCCLO.:
	CLR	OPNADR			;CLOSE ANY OPEN LOCATION
	TYPES	BOL,<'*'>		;NO, PRINT PROMPT
10$:
	LINPUT				;GET NEW LINE
	TST	DEBUGT			;IS CONTINUE/DEBUG?
	BNE	24$			;YES.  ALLOW ONLY B, G, C.
	CAIFEB	R3,#'/,PCESS.,OPENT	;OPEN BY TYPE
	CAIFEB	R3,#'A,PCESS.,OPENA	;OPEN FOR ASCII
	CAIFEB	R3,#'O,PCESS.,OPENO	;OPEN FOR OCTAL
	CAIFEB	R3,#'D,PCESS.,OPEND	;OPEN FOR DECIMAL
	TST	OPNADR			;IS LOCATION OPEN?
	BEQ	20$			;NO, SO SKIP NEXT/LAST/MODIFY.
	CAIFEB	R3,#'^,PCESS.,OPENL	;OPEN LAST LOCATION
	CAIFEB	R3,#12,PCESS.,OPENN	;OPEN NEXT LOCATION
	CAIFEB	R3,#15,PCCLO.,MODIF.	;CLOSE LOCATION
20$:
	CAIFEB	R3,#'X,PCCLO.,EXIT	;EXIT PROGRAM
24$:
	CAIFEB	R3,#'B,PCCLO.,BREAKP	;SET OR LIST BREAKPOINTS
	CAIFEB	R3,#'C,PCCLO.,CLEAR	;CLEAR BREAKPOINT(S)
	CMPB	R3,#'G			;IS RETURN TO PROGRAM REQUEST?
	BNE	30$			;NO.
	TST	R2			;YES.  IS JUMP?
	BEQ	RETRN.			;NO, SO SPLIT
	JMP	JUMP			;YES.
30$:
	CALL	ERROR.			;TYPE ERROR
	BR	PCESS.
	.DSABL	LSB
	.PAGE
	.SBTTL	BPT AND TRACE-TRAP SST PROCESSOR
TBIT=20
;
;	RETRN.  RETURN TO PROGRAM
;
	CODE
RETRN.:
	MOV	RETBRA,R0		;IS THERE A BREAKPOINT?
	BNE	10$			;YES.
	BIC	#TBIT,SAVPS		;NO.  CLEAR TRACE TRAP BIT...
	CLR	DEBUGT			;CLEAR DEBUG FLAG
	BR	20$			; AND RESTORE USER CONTEXT
10$:
	MOV	BRB.SI(R0),@(R0)	;TEMPORARILY RESTORE USERS INST.
	MOV	R0,RETBRP		;SAVE TABLE ADDRESS
	BIS	#TBIT,SAVPS
20$:
	SETD				;RESTORE FLOATING POINT PROCESSOR
	MOV	#ENDFPP,R0
	LDD	-(R0),0
	STD	0,R5
	LDD	-(R0),0
	STD	0,R4
	LDD	-(R0),3
	LDD	-(R0),2
	LDD	-(R0),1
	LDD	-(R0),0
	LDFPS	-(R0)
	MOV	#SAVPS,R0		;SET UP FOR RTT
	MOV	(R0),-(SP)
	MOV	-(R0),-(SP)
	MOV	-(R0),R5		;RESTORE REGISTERS
	MOV	-(R0),R4
	MOV	-(R0),R3
	MOV	-(R0),R2
	MOV	-(R0),R1
	MOV	-(R0),R0
	RTT				;RETURN TO PROGRAM
;
;	BPT AND TRACE TRAP INSTRUCTION PROCESSOR
;
	.ENABL	LSB
BPTPRC:
	MOV	R0,SAVR0		;SAVE REGISTER 0
	MOV	RETBRP,R0		;IS THIS T-BIT TO RESTORE BPT?
	BEQ	10$			;NO.
	MOV	#BPTINS,@(R0)		;RESTORE BPT INSTRUCTION
	BIC	#TBIT,2(SP)		;CLEAR TRACE TRAP BIT
	CLR	RETBRP			;CLEAR RESTORE REQUEST
	MOV	SAVR0,R0		;RESTORE REGISTER 0
	RTI				;RETURN TO USER
;
10$:
	MOV	#SAVR1,R0		;SAVE REMAINING REGISTERS AND PC/PS
	MOV	R1,(R0)+
	MOV	R2,(R0)+
	MOV	R3,(R0)+
	MOV	R4,(R0)+
	MOV	R5,(R0)+
	MOV	(SP)+,R1
	MOV	R1,(R0)+
	MOV	(SP)+,(R0)
	CALL	FPSAVE			;SAVE FLOATING POINT REGISTERS
	CLR	RETBRA			;CLEAR BREAKPOINT RETURN ADDRESS
	CLR	RETROT
	CLR	RETSPT
	CLR	OPNADR			;CLEAR OPEN ADDRESS
	BIT	#TBIT,(R0)		;WAS TBIT?
	BNE	TTRAP			;YES.  HANDLE TRACE TRAP
	MOV	#BREBUF,R2
	TST	-(R1)			;SEARCH FOR A BREAKPOINT HERE.
	CMP	R1,#$ALBP2		;IS BREAKPOINT FROM AUTOLOAD?
	BNE	20$			;NO
	MOV	(SP)+,SAVPC		;YES.  SAVE RETURN ADDRESS
	CALL	SETBRK			;SET ALL BREAKPOINTS
	BR	RETRN.			;RETURN
20$:
	CMP	R1,(R2)
	BEQ	30$			;FOUND THE BREAKPOINT
24$:
	ADD	#BRBLEN,R2
	CMP	R2,#BREEND
	BLO	20$
	TYPES	BOL,<'UNEXPECTED BREAKPOINT'>,EOL
	BR	RETRN.			;RETURN FROM BREAKPOINT
30$:
	MOV	BRB.OS(R2),R3		;GET SEGMENT STATUS WORD ADDRESS
	BEQ	34$			;NOT OVERLAYED
	BIT	#TR$DSK!TR$MEM,(R3)	;IS OVERLAY IN CORE?
	BNE	24$			;NO
34$:					;YES
	MOV	R2,RETBRA		;SAVE BREAKPOINT ADDRESS
	MOV	(R2)+,-(R0)		;SAVE AS RETURN ADDRESS
	MOV	(R2)+,RETROT		;SAVE ROUTINE BLOCK NUMBER
	MOV	(R2)+,R3		;SAVE ENTRY/LINE ADDRESS
	BGT	40$
	NEG	R3
40$:
	MOV	R3,RETSPT
	GET	R3,#TABL
	GET	RETROT,#ROTTAB
	TYPES	2,<'FDT BREAKPOINT FROM '>
	TYPNAM	#ROTTAB
	TYPES	,<' AT '>
	TYPNAM	#TABL
	TYPES	,,EOL
	JMP	PCESS.			;GO PROCESS USER COMMANDS
	.DSABL	LSB
;
TTRAP:
	TYPES	BOL,<'TBIT TRAP (CONTINUE/DEBUG).  PC = '>
	MOV	#'0,R0
	MOV	SAVPC,R1
	ROL	R1
	ADC	R0
	CALL	TYPE.
	MOV	#4,-(SP)
20$:
	MOV	#<'0>/10,R0		;PUT IN "0" AFTER SHIFT
	ROL	R1
	ROL	R0
	ROL	R1
	ROL	R0
	ROL	R1
	ROL	R0
	CALL	TYPE.
	DEC	(SP)
	BGE	20$
	MOV	(SP)+,DEBUGT		;SET DEBUG FLAG TO -1
	TYPES	,<.  B, G, AND C ALLOWED.>,EOL
	JMP	PCESS.			;GO PROCESS B, G, OR C.
;
;	FPSAVE:	SAVE FLOATING POINT REGISTERS
;
FPSAVE:
	SAVE	R0			;PRESERVE R0
	MOV	#SAVFPP,R0		;GET FLOATING POINT SAVE AREA
	STFPS	(R0)+			;SAVE STATUS
	SETD				;SET TO DOUBLE PRECISION MODE
	STD	0,(R0)+
	STD	1,(R0)+
	STD	2,(R0)+
	STD	3,(R0)+
	LDD	R4,0
	STD	0,(R0)+
	LDD	R5,0
	STD	0,(R0)+
	RESTOR				;RESTORE SAVED REGISTERS
	RETURN
;
	.PAGE
	.SBTTL	BREAKPOINT COMMAND PROCESSOR
	CODE
	.ENABL LSB
BREAKP:
	TST	R2			;IS ANY ARGUMENT?
	BNE	60$			;YES.
	MOV	#BREBUF,R2		;NO.  LIST ALL BREAKPOINTS
	CLR	R3
10$:
	TST	(R2)			;BREAK POINT HERE?
	BEQ	50$			;NO.
	TYPES	BOL,<'BREAK IN '>
	GET	BRB.RA(R2),#ROTTAB	;GET ROUTINE TABLE
	TYPNAM	#ROTTAB
	MOV	BRB.LA(R2),R3		;GET LINE/ENTRY ADDRESS
	BGT	20$
	TYPES	,<' AT ENTRY '>
	NEG	R3			;NEGATE
	BR	30$
20$:
	TYPES	,<' AT LINE '>
30$:
	GET	R3,#TABL		;GET TABLE ADDRESS
	TYPNAM	#TABL
50$:
	ADD	#BRBLEN,R2		;SPACE OVER TABLE
	CMP	R2,#BREEND		;AT END?
	BLO	10$			;NO, SO DO NEXT.
	TYPES	,,EOL
	RETURN				;RETURN TO MAIN LINE
60$:
	LOCATE	#LINBUF			;GET LOCATION FOR BREAKPOINT
	BCS	63$			;IF ERROR, NO ACTION
	MOV	LOCADR,R0		;GET ADDRESS OF LOCATIONS
	CALL	GBRK			;SEE IF ALREADY EXISTS
	BCC	62$			;SKIP, IF ALREADY THERE
	BVS	63$			;IF NO MORE ROOM, CALL ERROR
	CMP	R0,SAVPC		;IS THIS THE RETURN ADDRESS?
	BNE	61$			;NO
	MOV	R2,RETBRA		;YES.  SET RETURN BREAKPOINT
61$:
	MOV	R0,(R2)+		;SAVE ADDRESS FROM LOCATE
	MOV	ROTTAB-2,(R2)+		;SAVE ADDRESS OF TABLES
	MOV	TABL-2,(R2)+
	CMPB	TABL+T.NAM,#'A		;IS ENTRY POINT?
	BLT	6$			;NO.
	NEG	-2(R2)			;YES, SO NEGATE
6$:
	MOV	(R0),(R2)+
	MOV	#EOV-BOV,R5		;MAKE SURE IS OVERLAYED
	BEQ	7$			;NOT, SO STORE ZERO FOR STATUS WORD
	MOV	ROTTAB+R.OVBN,R5	;GET DISK ADDRESS
	CALL	GETOVL			;GET OVERLAY STATUS ADDRESS
7$:
	MOV	R5,(R2)+		;SAVE STATUS ADDRESS
	BEQ	8$			;IF ZERO, SET B.P.
	BIT	#TR$DSK!TR$MEM,(R5)	;IS RESIDENT?
	BNE	62$			;NO
8$:
	MOV	#BPTINS,(R0)		;SET BREAKPOINT
62$:
	RETURN
63$:
	JMP	ERROR.
	.DSABL	LSB
	.PAGE
	.SBTTL	CLEAR BREAKPOINT PROCESSOR
	CODE
CLEAR:
	TST	R2			;IS THIS A REQUEST FOR CLEAR ALL?
	BNE	20$			;NO.
	MOV	#BREBUF,R2		;YES.  PREPARE TO CLEAR ALL
10$:
	CALL	50$			;CLEAR THE BREAKPOINT
	CMP	#BREEND,R2
	BHI	10$			;MORE TO DO
	RETURN
20$:
	LOCATE	#LINBUF			;LOCATE BREAKPOINT
	BCS	40$			;ERROR
	MOV	LOCADR,R0
	CALL	GBRK			;GET THE BREAKPOINT
	BCS	30$			;BREAKPOINT DOES NOT EXIST
	CALL	50$			;CLEAR IT
30$:
	RETURN
40$:
	JMP	ERROR.
;
50$:					;CLEAR A BREAKPOINT
	CMP	R2,RETBRA		;IS THIS THE CURRENT BREAKPOINT?
	BNE	55$			;NO.
	CLR	RETBRA			;YES, SO CLEAR IT.
55$:
	TST	(R2)			;ALREADY CLEAR?
	BEQ	60$			;YES.
	MOV	10(R2),R1		;GET STATUS WORD
	BEQ	57$			;NONE, SO IN CORE
	BIT	#TR$DSK!TR$MEM,(R1)
	BNE	58$			;NOT RESIDENT
57$:
	MOV	6(R2),@(R2)		;RESTORE OLD INSTRUCTION
58$:
	CLR	(R2)			;CLEAR THE BREAKPOINT
60$:
	ADD	#BRBLEN,R2			;BUMP TO NEXT
	RETURN
	.PAGE
	.SBTTL	OPEN LOCATION PROCESSORS
	CODE
	.ENABL	LSB
OPENT:					;OPEN BY TYPE
	CLR	DSPTYP			;SET FOR DISPLAY BY TYPE
	BR	10$
OPENA:					;OPEN AS ASCII
	MOV	#2,DSPTYP		;SET FOR ASCII DISPLAY
	BR	10$
OPENO:					;OPEN AS OCTAL
	MOV	#4,DSPTYP		;SET FOR OCTAL DISPLAY
	BR	10$
OPEND:
	MOV	#6,DSPTYP		;OPEN AS DECIMAL
10$:
	GETVAR	#LINBUF			;GET THE VARIABLE BLOCK
	BCS	20$			;BRANCH IF GOT ONE
	MOV	LOCADR,OPNADR		;SAVE OPENED ADDRESS
	BR	24$
20$:
	JMP	ERROR.			;RETURN ERROR
OPENN:					;OPEN NEXT ARRAY LOCATION
	TST	OPNELN			;IS ARRAY?
	BLT	20$			;NO.
	CALL	MODIF.			;MODIFY IF REQUESTED
	MOV	OPNADR,R0		;GET OPEN ADDRESS
	ADD	TABL+T.LEN,R0		;ADVANCE TO NEXT
	INC	OPNELN
	MAPVRT				;DO VIRTUAL MAPPING
	MOV	R0,OPNADR		;SAVE NEW OPEN ADDRESS
	MOVB	#15,R0			;TYPE CARRAIGE RETURN
	CALL	TYPE.
	BR	30$
OPENL:					;OPEN LAST ARRAY LOCATION
	TST	OPNELN			;IS ARRAY?
	BLE	20$			;NO, OR AT BOTTOM
	CALL	MODIF.			;YES.  MODIFY LAST ELEMENT.
	MOV	OPNADR,R0		;GET OPEN ADDRESS
	SUB	TABL+T.LEN,R0		;RETREAT TO LAST LOCATION
	DEC	OPNELN
	MAPVRT				;DO VIRTUAL MAPPING
	MOV	R0,OPNADR		;SAVE NEW OPEN ADDRESS
24$:
	TYPES	BOL
30$:
	TYPNAM	#ROTTAB			;TYPE ROUTINE NAME
	MOVB	#':,R0			;TYPE COLON
	CALL	TYPE.
	TYPNAM	#TABL			;TYPE VARIABLE OR ARRAY NAME
	MOV	OPNELN,R2		;GET ELEMENT NUMBER
	BLT	40$			;NOT ARRAY
	CALL	DSPAEL			;DISPLAY ARRAY ELEMENT NUMBER.
40$:
	TYPES	,<' = '>
	MOV	OPNADR,R0		;GET ADDRESS
	CALL	DSPVAR			;DISPLAY VARIABLE.
	TYPES	,<'  '>
	RETURN
	.DSABL	LSB
;
	.PAGE
	.SBTTL	JUMP COMMAND PROCESSOR
	CODE
JUMP:
	.ENABL	LSB
	TST	DEBUGT			;DON'T ALLOW JUMP FROM T-TRAP
	BNE	10$
	LOCATE	#LINBUF			;GET LOCATION
	BCS	10$
	CMP	RETROT,LOCROT		;MAKE SURE IT IS IN ROUTINE
	BNE	10$
	CLR	RETBRA			;CLEAR RETURN BREAKPOINT
	MOV	LOCADR,SAVPC		;SAVE FOR RETURN
	JMP	RETRN.
10$:
	JMP	ERROR.
	.DSABL	LSB
	.PAGE
	.SBTTL	GENERAL UTILITY ROUTINES
;
;	REGISTER CONVENTIONS:
;
;	EXCEPT WHERE NOTED, R0 AND R1 ARE DESTROYED, AND ALL OTHERS ARE
;	PRESERVED.
;
;
;	$SAVAL -- SAVE ALL REGISTERS (COROUTINE RETURN)
;
;	CALL BY JSR R5,$SAVAL
;
	CODE
$SAVAL:
	MOV	R4,-(SP)
	MOV	R3,-(SP)
	MOV	R2,-(SP)
	MOV	R1,-(SP)
	MOV	R0,-(SP)
	MOV	#$RESTR,-(SP)	;SAVE FOR USER RETURN
	MOV	R5,-(SP)	;SAVE FOR MY RETURN
	MOV	16(SP),R5	;RESTORE ORIGINAL R5
	RETURN
$RESTR:
	MOV	(SP)+,R0
	MOV	(SP)+,R1
	MOV	(SP)+,R2
	MOV	(SP)+,R3
	MOV	(SP)+,R4
	MOV	(SP)+,R5
	RETURN
;
;	OPEN.  OPEN THE DISK FILE FOR INPUT.
;
;	ALL REGISTERS ARE PRESERVED.  FILE IN INPUT BUFFER IS OPENED.
;
	CODE
	.MCALL	FDBDF$,FDAT$A,FDRC$A,FDOP$A,FDBF$A,FDOP$R
	.MCALL	OPEN$,CLOSE$,GET$
OPEN.:
	SAVALL
	FDOP$R	#FDTFDB,.ODTL2		;SET LUN IN FDB
	OPEN$	#FDTFDB			;OPEN THE FILE
	BCS	FILERR			;ERROR OPENING FILE
	RETURN
FILERR:
	TYPES	BOL,<'ERROR WITH SYMBOL FILE'>,EOL
EXIT:
	CALL FLUSH.
	CLOSE$	#FDTFDB
	CALL	EXIT$
;
	PDATA
	.EVEN
.ODTL2:: .WORD	0			;***** TASK BUILDER DEFINES THIS
;
	IDATA
	.EVEN
FDTFDB:	FDBDF$				; FDT FILE FDB
	FDAT$A	R.FIX,,32.
	FDRC$A	FD.RAN,,32.
	FDOP$A	,DSPT,,FO.RD!FA.SHR
	FDBF$A	,,1
;
DSPT:					; DEFAULT DATASET
	.WORD	DEVSZ,DEVPT
	.WORD	0,0
	.WORD	0,LINBUF
DEVPT:	.ASCII	'SY0:'
	DEVSZ=.-DEVPT
	.EVEN
;
;	GET.  GET A BLOCK.
;
;	INPUTS:
;		R0	BLOCK NUMBER TO FETCH
;		R1	ADDRESS IN WHICH TO PUT BLOCK (R1-2 WILL GET
;			BLOCK NUMBER ALREADY THERE).
;
;	NOTES:
;		ALL REGISTERS PRESERVED.
;
	CODE
GET.:
	SAVALL				;SAVE THE REGISTERS
	CMP	-(R1),R0		;DO WE ALREADY HAVE BLOCK?
	BEQ	50$			;YES, SO RETURN.
	MOV	R0,(R1)+		;SAVE RECORD NUMBER
	MOV	R0,FDTFDB+F.RCNM+2	;SAVE IN FDB FOR GET$
	GET$	#FDTFDB,R1
	BCS	REDERR
50$:
	RETURN
REDERR:
	TYPES	BOL,<'ERROR READING FILE'>,EOL
	JMP	EXIT
;
;
;	DSPVAR -- DISPLAY VARIABLE ON TERMINAL.
;
;	INPUTS:
;		R0	ADDRESS OF VARIABLE TO BE TYPED
;		DSPTYP	DISPLAY TYPE (0 FOR TYPED I/O)
;		TABL	TABLE DESCRIBING VARIABLE
;
;	NOTES:
;		ALL REGISTERS ARE PRESERVED
;
	CODE
DSPVAR:
	SAVALL				;SAVE ALL REGISTERS
	MOV	R0,DSPADR		;SAVE DISPLAY ADDRESS
	CALL	GFTYP.
	MOV	#DSPLN,-(SP)		;OUTPUT BUFFER COUNT
	MOV	IOFORM,-(SP)		;FORMAT STATEMENT
	MOV	#DSPBUF,-(SP)		;DISPLAY BUFFER ADDRESS.
	MOV	#INTERN,-(SP)		;SAVE ERROR ADDRESS
	MOV	(SP),-(SP)
	CALL	ENFE$			;PREPARE TO ENCODE
	MOV	DSPADR,-(SP)		;GET VARIABLE ADDRESS
	CALL	@IOCALL			;DO I/O
	CALL	EOLST$			;END I/O
	MOV	#DSPBUF,R1
	MOV	#DSPLN,R2
	CMP	#2,DSPTYP
	BNE	10$
	MOV	TABL+T.LEN,R2
10$:
	MOVB	(R1)+,R0		;GET CHARACTER
	BEQ	20$
	CMPB	R0,#40			;SKIP BLANKS
	BNE	13$
	CMP	#2,DSPTYP		;IF ASCII DISPLAY, INCLUDE BLANKS
	BNE	15$
13$:
	CALL	TYPE.
15$:
	SOB	R2,10$
20$:
	RETURN
;
	IDATA
	.EVEN
DSPTYP:	.WORD	0
DSPADR:	.WORD	0
DSPLN=48.
DSPBUF:	.BLKB	DSPLN
;
;	MODIF.  MODIFY THE OPEN LOCATION.
;
;	INPUTS:
;		DSPTYP	DISPLAY/REPLACE TYPE CODE
;		TABL	DESCRIPTOR OF VARIABLE
;		OPNADR	ADDRESS OF THE OPEN ELEMENT
;
;	NOTES:
;		ALL REGISTERS SAVED
;
	CODE
MODIF.:
	TSTB	(R0)		;REPLACE?
	BEQ	30$		;NO.
	SAVALL			;YES, SO SAVE REGISTERS
	MOV	#DSPBUF,R2	;MOVE INPUT TO DISPLAY BUFFER
	CLR	R1		;SET CHARACTER COUNT
10$:
	MOVB	(R0)+,(R2)+
	BEQ	20$
	INC	R1
	CMP	#DSPLN,R1
	BGT	10$
20$:
	CALL	GFTYP.		;SET UP FOR I/O
	MOV	R1,-(SP)
	MOV	IOFORM,-(SP)
	CMP	#FORMC8,(SP)	;INSURE CORRECT INPUT FORMAT FOR COMPLEX.
	BNE	25$
	MOV	#FORMIC,(SP)
25$:
	MOV	#DSPBUF,-(SP)
	MOV	#ERROR.,-(SP)
	MOV	(SP),-(SP)
	CALL	DEFE$
	MOV	OPNADR,-(SP)
	CALL	@IOCALL
	CALL	EOLST$
30$:
	RETURN
;
;	ARRAY ELEMENT CONVERSIONS
;
;	GETAEL:  SET UP ARRAY ELEMENT NUMBER AND ADJUST ADDRESS
;
;	INPUTS:
;		R4	ADDRESS OF BUFFER CONTAINING DIMENSIONS
;
;	OUTPUTS:
;		OPNELN	ELEMENT NUMBER IN ARRAY
;		C-BIT
;
;	NOTES:
;		ALL REGISTERS ARE PRESERVED
;
	CODE
GETAEL:
	SAVALL			;SAVE ALL REGISTERS
	CLR	OPNELN		;INITIALIZE ELEMENT NUMBER
10$:
	TSTB	(R4)		;TEST FOR END OF STRING
	BEQ	30$		;IF END OF STRING, USE ELEMENT ZERO.
	MOV	#1,R5		;INITIALIZE MULTIPLIER
	MOV	#TABL+T.DIMS,R2	;POINT TO DIMENSIONS
20$:
	CMP	R2,#TABL+T.DIM3	;IS LAST?
	BHI	30$		;YES.
	TST	(R2)
	BLE	30$		;YES
	CLR	R3		;GET NEXT DIMENSION
22$:
	MOVB	(R4)+,R0
	CMPB	R0,#40		;IGNORE BLANKS
	BEQ	22$
	SUB	#'0,R0
	BLT	25$
	CMP	#9.,R0
	BLT	25$
	MUL	#10.,R3
	ADD	R0,R3
	BR	22$
25$:
	SUB	T.DIMZ-T.DIMS(R2),R3	;GET ACTUAL OFFSET
	BLT	40$
	CMP	R3,(R2)		;INSURE AGAINST OVERFLOW
	BLT	26$		;NO OVERFLOW.
	CMP	R2,#TABL+T.DIM3	;IS LAST?
	BHIS	26$		;YES.
	TST	2(R2)
	BGT	40$		;NO, SO ERROR
26$:
	MUL	R5,R3		;MULTIPLY
	ADD	R3,OPNELN	;ADD TO ELEMENT NUMBER
	MUL	(R2)+,R5	;CORRECT MULTIPLIER FOR NEXT DIMENSION
	BR	20$
30$:
	CLC			;NO ERROR
	RETURN
40$:
	SEC			;ERROR
	RETURN
;
;	DSPAEL:  DISPLAY AN ELEMENT NUMBER.
;
;	INPUTS:
;		R2	ELEMENT NUMBER TO BE DISPLAYED
;
;	NOTES:
;		ALL REGISTERS SAVED
;
	.ENABL	LSB
DSPAEL:
	SAVALL
	MOVB	#'(,R0
	CALL	TYPE.			;TYPE A PARENTHESIS
	MOV	#TABL+T.DIM2,R4		;SCAN THROUGH DIMENSIONS
10$:
	CMP	R4,#TABL+T.DIM3		;AT THE END?
	BHI	20$
	TST	(R4)			;
	BLE	20$
	MOV	R2,R3
	CLR	R2
	DIV	-2(R4),R2
	TST	(R4)+
	ADD	T.DIMZ-T.DIMS-4(R4),R3
	MOVB	#',,R5
	CALL	30$
	BR	10$
20$:
	MOV	R2,R3
	ADD	T.DIMZ-T.DIMS-2(R4),R3
	MOVB	#'),R5
TYPEDC:
30$:
	CLRB	-(SP)
	MOV	R3,R1
40$:
	CLR	R0
	DIV	#10.,R0
	ADD	#'0,R1
	MOVB	R1,-(SP)
	MOV	R0,R1
	BNE	40$
50$:
	MOVB	(SP)+,R0
	BEQ	60$
	CALL	TYPE.
	BR	50$
60$:
	MOV	R5,R0
	CALL	TYPE.
	RETURN
	.DSABL	LSB
;
;	GFTYP.  GET FORMAT TYPE.
;
;	INPUTS:
;		TABL	TABLE DESCRIBING VARIABLE OR ARRAY
;
;	OUTPUTS:
;		IOCALL	ADDRESS OF FORMAT ELEMENT CALL
;		IOFORM	ADDRESS OF FORMAT STATEMENT
;
;	NOTES:
;		ALL REGISTERS SAVED
;
	CODE
GFTYP.:
	SAVE	<R0,R1,R2>
	MOV	TABL+T.LEN,R1
	CLR	R0
	MOVB	TABL+T.TYP,R2
	DIV	R2,R0
	ASL	R2
	ASL	R2
	ADD	R0,R2
	ASL	R2
	MOV	TYPTAB-12(R2),R1	;GET ADDRESS OF TABLE
	BEQ	INTERN			;ERROR
	MOV	(R1)+,IOCALL		;GET I/O ROUTINE ADDRESS
	ADD	DSPTYP,R1		;OFFSET FOR DISPLAY TYPE
	MOV	(R1),IOFORM		;GET FORMAT STATEMENT ADDRESS
	RESTOR
	RETURN
;
INTERN:
	TYPES	BOL,<'*** FDT INTERNAL ERROR ***'>,EOL
	JMP	EXIT
;
	IDATA
	.EVEN
IOCALL:	.WORD	0
IOFORM:	.WORD	0
;
	PDATA
	.EVEN
TYPTAB:					;DISPLAY BY TYPE TABLE
	.WORD	TABL1			;LOGICAL*1
	.WORD	TABL2			;LOGICAL*2
	.WORD	0
	.WORD	TABL4			;LOGICAL*4
	.WORD	TABI2			;INTEGER*2
	.WORD	TABI4			;INTEGER*4
	.WORD	0
	.WORD	0
	.WORD	TABR4			;REAL*4
	.WORD	TABR8			;REAL*8
	.WORD	0
	.WORD	0
	.WORD	0
	.WORD	TABC8			;COMPLEX*8
;
TABL1:	.WORD	IOAB$,FORML1,FORMA,FORMO,FORMI
TABL2:	.WORD	IOAL$,FORML2,FORMA,FORMO,FORMI
TABL4:	.WORD	IOAM$,FORML4,FORMA,FORMO,FORMI
TABI2:	.WORD	IOAI$,FORMI2,FORMA,FORMO,FORMI
TABI4:	.WORD	IOAJ$,FORMI4,FORMA,FORMO,FORMI
TABR4:	.WORD	IOAR$,FORMR4,FORMA,FORMR4,FORMR4
TABR8:	.WORD	IOAD$,FORMR8,FORMA,FORMR8,FORMR8
TABC8:	.WORD	IOAC$,FORMC8,FORMA,FORMC8,FORMC8
;
	.GLOBL	LCI$
FORML1:
FORML2:
FORML4:
	FORM	1,DL
	FORM	,FIN
	.GLOBL	ICI$
FORMI:
FORMI2:
FORMI4:
	FORM	1,DI
	FORM	,FIN
	.GLOBL	RCI$
FORMR4:
FORMR8:
	FORM	1,DG
	FORM	,FIN
FORMIC:				;INPUT FORMAT FOR COMPLEX
	FORM	2,DG
	FORM	,FIN
FORMC8:
	FORM	1,H,<'(>
	FORM	1,DG
	FORM	1,H,<',>
	FORM	1,DG
	FORM	1,H,<')>
	FORM	,FIN
FORMO:
	FORM	1,DO
	FORM	,FIN
FORMA:
	FORM	2,DA
	FORM	,FIN
;
;	ERROR.	TYPE "\\" TO THE USER TO INDICATE ERROR.
;
;	NO INPUTS.
;
	CODE
ERROR.:
	CLR	OPNADR			;CLOSE ANY OPEN ADDRESS
	TYPES	BOL,'\\',EOL		;TYPE ERROR
	RETURN
;
;	TYPNM.  TYPE A NAME TO THE TERMINAL
;
;	INPUTS:
;		R1	ADDRESS OF NAME
;
	CODE
TYPNM.:
	SAVE	R2			;SAVE REGISTER 2
	MOV	#6,R2			;NUMBER OF CHARACTERS IN NAME
10$:
	MOVB	(R1)+,R0
	CMPB	R0,#40			;IS CHARACTER A SPACE?
	BEQ	20$			;YES.
	CALL	TYPE.			;NO, SO TYPE IT.
	SOB	R2,10$
20$:
	RESTOR				;RESTORE SAVED REGISTER
	RETURN
;
;	.TYPES -- TYPE A STRING UNTIL NULL.
;
;	INPUTS:
;		R1	ADDRESS OF STRING TO BE TYPED.
;
	.ENABLE	LSB
	CODE
.TYPES:
	MOVB	(R1)+,R0		;GET NEXT CHAR
	BEQ	30$			;DONE IF NULL
	MOV	#.TYPES,-(SP)		;SET FOR RETURN TO .TYPES
					;** FALL THROUGH TO TYPE. **
;
;	TYPE.  TYPE A CHARACTER FROM R0
;
;	INPUTS:
;		R0	CHARACTER TO BE TYPED
;
;	NOTES:
;		R1 IS PRESERVED.
;
TYPE.:
	MOVB	R0,@CUROUT		;CURRENT OUTPUT CHARACTER
	INC	CUROUT			;BUMP BUFFER POINTER
	CMP	CUROUT,#EBUFF		;END OF BUFFER?
	BLO	30$			;NO, SO RETURN
					;** FALL THROUGH TO FLUSH. **
;
;	FLUSH.  TYPE OUT ANY CHARACTERS IN OUTPUT BUFFER
;
;	NO INPUTS
;
;	NOTES:
;		R0 AND R1 PRESERVED
;
FLUSH.:
	CMP	CUROUT,#BUFF		;ANYTHING IN BUFFER?
	BLOS	30$			;NO.
	SUB	#BUFF,CUROUT		;GET NUMBER OF CHARS.
	MOV	CUROUT,OPQIO+Q.IOPL+2	;SAVE OUTPUT COUNT
	DIR$	#OPQIO
	MOV	#BUFF,CUROUT		;RE-INIT BUFFER
30$:
	RETURN
	.DSABL	LSB
;
;	LINPT. -- ACCEPT A LINE UNTIL A TERMINATOR IS TYPED
;
;	RETURNS WITH BOL IN R0, EOL+1 IN R1, LENGTH IN R2, TERM IN R3
;	LINES ARE ALWAYS ENDED WITH A NUL.  TERMINATING CHARACTERS ARE
;	OMITTED.
;
	CODE
	.ENABL	LSB
LINPT.:
	MOV	#LINBUF,R1		;START AT BOL
10$:
	CALL	INCHR			;GET A CHARACTER
	CALL	TYPE.			;OUTPUT THE CHARACTER
	CMPB	R0,#12			;CHECK FOR TERMINATORS
	BEQ	50$
	CMPB	R0,#15
	BEQ	50$
	CMPB	R0,#'/
	BEQ	50$
	CMPB	R0,#'^
	BEQ	50$
	CMPB	R0,#';			;IS GENERAL TERMINATOR?
	BEQ	40$
	CMPB	#25,R0			;CHECK FOR CONTROL-U
	BNE	15$
	TYPES	,<' ^U'>,EOL
	BR	LINPT.
15$:
	CMPB	#40,R0			;IS IT A VALID CHAR?
	BHI	20$			;NO
	CMPB	#177,R0
	BHI	30$
	CMP	#LINBUF,R1
	BEQ	LINPT.
	MOVB	-(R1),R0
	CALL	TYPE.
	BR	10$
20$:
	CALL	ERROR.			;NO.
	BR	LINPT.
30$:
	MOVB	R0,(R1)+		;YES.  SAVE IT IN BUFFER
	CMP	#LINEND,R1		;END OF LINE?
	BLOS	20$			;YES.
	BR	10$			;NO.  GET NEW CHAR
40$:
	CALL	INCHR			;GET GENERAL TERMINATOR
	CALL	TYPE.
50$:
	MOV	R0,R3			;SAVE TERMINATOR
	MOV	#LINBUF,R0		;GET BOL
	MOV	R1,R2			;GET NUMBER OF CHARS
	CLRB	(R1)			;MAKE LAST CHAR NULL.
	SUB	R0,R2
	CALL	FLUSH.			;FLUSH ANY CHARACTERS TO BE OUTPUT
	RETURN
	.DSABL	LSB
;
;	INCHR -- GET A CHARACTER
;
;	NO INPUTS.
;
;	NOTES:
;		CHARACTER RETURNED IN R0.
;
	CODE
INCHR:
	CALL	FLUSH.			;FLUSH ANY CHARACTERS TO BE OUTPUT
	DIR$	#IPQIOW
	MOV	TEMP,R0			;GET CHAR
	BIC	#^C177,R0		;CLEAR BITS
	CMPB	#140,R0			;SHIFT TO UPPER CASE
	BGT	10$
	CMPB	#177,R0
	BEQ	10$
	BICB	#40,R0
10$:
	RETURN
;
;	TERMINAL I/O BUFFERS
;
	IDATA
	.MCALL	QIOW$			;WRITE WITH WAIT
OPQIO:	QIOW$	IO.WLB!TF.CCO,,.FDTFG,,,,<BUFF,0,0>
IPQIOW:	QIOW$	IO.RAL!TF.RNE,,.FDTFG,,,,<TEMP,1,0>
.ODTL1:: .WORD	0			;***** TASK BUILDER DEFINES THIS 
CUROUT:	.WORD	BUFF
TEMP:	.WORD	0
LINBUF:	.BLKB	80.
LINEND:
BUFF:	.BLKB	80.
EBUFF:
	.EVEN
;
;	GBRK -- GET A BREAK POINT FROM TABLE.
;	ON ENTRY R0 CONTAINS PROGRAM ADDRESS, AND ROTTAB-2
;	HAS THE ROUTINE BLOCK #.  ON EXIT:
;	BREAKPOINT FOUND:
;		R2 HAS BREAKPOINT TABLE ADDRESS, C-BIT CLEAR
;	BREAKPOINT NOT FOUND, EMPTY SLOT AVAILABLE:
;		R2 HAS EMPTY SLOT, C-BIT SET, V-BIT CLEAR
;	BREAKPOINT NOT FOUND, TABLE FULL:
;		C-BIT SET, V-BIT SET
;
	CODE
GBRK:
	MOV	#BREBUF,R2		;GET BEGINNING OF TABLE
	CLR	-(SP)			;SAVE SPACE FOR FREE SLOT
10$:
	TST	(R2)			;IS SLOT EMPTY?
	BNE	20$			;NO.
	MOV	R2,(SP)			;YES, SO SAVE IT
20$:
	CMP	R0,(R2)			;IS THIS THE BREAKPOINT?
	BNE	30$			;NO.
	CMP	ROTTAB-2,2(R2)
	BNE	30$
	TST	(SP)+			;YES.  CLEAR OFF STACK.
	CLC				;RETURN WITH C-BIT CLEAR
	RETURN
30$:
	ADD	#BRBLEN,R2		;BUMP TO NEXT SLOT
	CMP	R2,#BREEND		;END OF BUFFER?
	BLO	10$			;NO, SO CONTINUE SEARCH
	MOV	(SP)+,R2		;YES.  GET FREE SLOT
	BEQ	40$			;NONE, SO TABLE FULL
	CLV
	BR	50$
40$:
	SEV
50$:
	SEC
	RETURN
;
	IDATA
	.EVEN
BREBUF:	.BLKB	BRBLEN*BRBNUM
BREEND:
;
;	LOCAT.  LOCATE A ENTRY OR STATEMENT ADDRESS INDICATED
;		IN BUFFER BEGINNING AT R1.
;
;	INPUTS:
;		R1	ADDRESS OF BUFFER
;
;	NOTES:
;		ALL REGISTERS ARE PRESERVED.
;
	CODE
LOCAT.:
	SAVALL				;SAVE ALL REGISTERS
	MOV	R1,R4			;SAVE BUFFER ADDRESS IN R4
	CALL	GETRT.			;GET ROUTINE ADDRESS
	BCS	10$			;ERROR
	MOV	ROTTAB-2,LOCROT		;SAVE ROUTINE BLOCK NUMBER
	MOV	#TABL,R3
	CMPB	#'A,(R4)
	BLE	20$
	MOV	ROTTAB+R.LABD,R2
	CALL	GETNM.			;GET ROUTINE NAME
	BCC	30$
10$:
	RETURN				;RETURN.  CARRY BIT SET PROPERLY
20$:
	MOV	ROTTAB+R.EPD,R2
	CALL	GETNM.
	BCS	10$
30$:
	MOV	TABL+T.ADR,LOCADR
	MOV	TABL-2,LOCSPT		;SAVE SPOT BLOCK NUMBER
	CLC	
	RETURN
;
;	GETRT.  GET ROUTINE INDICATED IN BUFFER OR DEFAULT.
;
;	INPUTS:
;		R4	ADDRESS OF BUFFER
;
;	NOTES:
;		ALL REGISTERS SAVED
;
	CODE
GETRT.:
	SAVE	<R0,R1,R2,R3>
	MOV	R4,R0
10$:
	TSTB	(R0)			;SCAN BUFFER FOR A COLON
	BEQ	20$
	CMPB	#':,(R0)+
	BNE	10$
	MOV	#ROTTAB,R3
	MOV	INITAB+I.ROTD,R2
	CALL	GETNM.
	BR	30$
20$:
	MOV	RETROT,R0		;GET DEFAULT ROUTINE BLOCK
	BNE	25$			;OK.  DEFAULT EXISTS.
	SEC				;NO DEFAULT, SO ERROR.
	BR	30$			;FINISH UP
25$:
	GET	R0,#ROTTAB		;GET DEFAULT ROUTINE
	CLC
30$:
	RESTOR
	RETURN
;
;	GETNM.  GET A TABLE WITH NAME SPECIFIED.
;
;	INPUTS:
;		R2	BLOCK NUMBER OF FIRST BLOCK TO CHECK
;		R3	BLOCK BUFFER ADDRESS
;		R4	NAME TO FIND
;
;	NOTES:
;		R0,R1,R3, AND R5 ARE SAVED.
;		R2 CONTAINS BLOCK NUMBER ON SUCCESS
;		R4 CONTAINS NEXT BUFFER ADDRESS ON SUCCESS
;
	CODE
GETNM.:
	SAVE	<R0,R1,R5>
5$:
	MOV	R2,R0			;GET BLOCK NUMBER FOR GET.
	BEQ	40$			;NOT FOUND IF ZIP.
	GET	R0,R3
	MOV	R3,R1
	MOV	#6.,R5
	MOV	R4,R0
10$:
	CMPB	(R0),#'(
	BEQ	15$
	CMPB	(R0),#':
	BEQ	15$
	CMPB	(R0),#',
	BEQ	15$
	TSTB	(R0)
	BEQ	20$
	DEC	R5
	BLT	40$
	CMPB	(R0)+,(R1)+
	BNE	30$
	BR	10$
15$:
	INC	R0
20$:
	TST	R5
	BLE	50$
	CMPB	(R1),#40
	BEQ	50$
30$:
	MOV	T.LINK(R3),R2
	BNE	5$
40$:
	SEC
	BR	60$
50$:
	CLC
	MOV	R0,R4
60$:
	RESTOR
	RETURN
;
;	GETVR.  GET A VARIABLE BLOCK.
;
;	INPUTS:
;		R1	POINTER TO VARIABLE BUFFER
;
;	NOTES:
;		ALL REGISTERS SAVED
;
	CODE
GETVR.:
	SAVALL
	MOV	R1,R4
	CALL	GETRT.
	BCS	30$
	TST	#EOV-BOV		;IS OVERLAYED?
	BEQ	5$			;NO.
	MOV	ROTTAB+R.OVBN,R5	;GET OVERLAY STATUS WORD ADDRESS
	CALL	GETOVL
	BIT	#TR$DSK!TR$MEM,(R5)	;IS RESIDENT?
	BNE	30$			;NO, SO ERROR.
5$:
	MOV	ROTTAB+R.VARD,R2
	MOV	#TABL,R3
	MOV	#-1,OPNELN
	CALL	GETNM.
	BCC	10$
	MOV	ROTTAB+R.ARYD,R2
	CALL	GETNM.
	BCS	30$
.IF	EQ	VFDT
	BITB	#T.FVIR,TABL+T.FLG	;NO VIRTUAL ALLOWED FOR NON-VFDT
	BNE	24$
.ENDC
	CALL	GETAEL			;GET ARRAY ELEMENT NUMBER
	BCS	30$
10$:
	MOV	ROTTAB-2,LOCROT
	MOV	TABL-2,LOCSPT
	MOV	TABL+T.ADR,R0
	BITB	#T.FARG,TABL+T.FLG	;IS THIS A SUBROUTINE ARGUMENT?
	BEQ	15$			;NO.
	CMP	LOCROT,RETROT		;YES.  ARE WE IN THIS MODULE?
	BNE	24$			;NO, SO BAD VARIABLE.
	BITB	#T.FREG,TABL+T.FLG	;YES.  IS ADDRESSED THOURHG R5?
	BEQ	13$			;NO
	ADD	SAVR5,R0
13$:
	TST	R0			;INSURE NOT BAD ARG.
	BEQ	24$
	MOV	(R0),R0
15$:
	MOV	R0,LOCADR
	MOV	OPNELN,R1
	BLT	20$
.IF	NE	VFDT
	BITB	#T.FVIR,TABL+T.FLG	;IS THIS A VIRTUAL ARRAY?
	BEQ	16$			;NO.
	CALL	VRTMAP			;INSURE ELEMENT IS MAPPED
	MOV	R0,LOCADR
	BR	20$
16$:
.ENDC
	MUL	TABL+T.LEN,R1
	ADD	R1,LOCADR
20$:
	CLC
	BR	30$
24$:
	SEC
30$:
	RETURN
;
;	VRTMAP	-- MAP OVER DESIRED VARIABLE AND ADJUST OPEN ADDRESS
;
;	ON EXIT:
;		R0	- ACTUAL ADDRESS OF VIRTUAL ARRAY, OR SAME AS ENTRY
;
.IF	NE	VFDT
	CODE
VRTMAP:
	BITB	#T.FVIR,TABL+T.FLG	;IS VIRTUAL ARRAY?
	BEQ	30$			;NO, SO SPLIT
	MOV	TABL+T.LEN,R0		;GET LENGTH
	MOVB	VCT-1(R0),R0		;GET ADB ADDRESS OFFSET
	ADD	#VADB,R0		;GET ADB ADDRESS
	MOV	R0,-(SP)		;PUT ADB ON STACK
	MOV	TABL+T.ADR,(R0)		;PUT OFFSET IN ADB
	MOV	-4(R0),-(SP)		;GET CALL ROUTINE ADDRESS
	MOV	OPNELN,R0		;GET ELEMENT NUMBER
	CALL	@(SP)+			;CALL THE APPROPRIATE ROUTINE
30$:
	RETURN
;
	IDATA
VCT:	.BYTE	4,16,4,30,4,4,4,42
	.EVEN
VADB:
	.WORD	VRTB$,1,0,0,4401
	.WORD	VRTI$,2,0,0,20402
	.WORD	VRTJ$,4,0,0,24404
	.WORD	VRTD$,10,0,0,34410
.ENDC
;
;	SETBRK -- THIS ROUTINE GOES THROUGH ALL DEFINED BREAKPOINTS
;		  AND SETS ANY BREAKPOINTS WHICH ARE RESIDENT
;
;	ALL REGISTERS MAY BE DESTROYED
;
	CODE
SETBRK:
	MOV	#BREBUF,R1		;GET BREAKPOINT BUFFER
10$:
	CMP	R1,#BREEND		;END OF BREAKS?
	BHIS	30$			;YES.
	MOV	(R1),R0			;IS BREAK DEFINED?
	BEQ	20$			;NO
	MOV	BRB.OS(R1),R2		;IS IN AN OVERLAYED PROGRAM?
	BEQ	15$			;NO, SO SET BREAK UNCONDITIONALLY
	BIT	#TR$DSK!TR$MEM,(R2)	;IS OVERLAY IN CORE?
	BNE	20$			;NO.
15$:
	CMP	#BPTINS,(R0)		;IS BREAKPOINT ALREADY SET?
	BEQ	20$			;YES, SO DON'T BOTHER
	MOV	(R0),BRB.SI(R1)		;NO.  SAVE INST. IN CASE OVERLAID
	MOV	#BPTINS,(R0)		;SET BREAKPOINT
20$:
	ADD	#BRBLEN,R1		;SET TO NEXT ENTRY
	BR	10$			;GO LOOK FOR IT
30$:
	RETURN
;
;	GETOVL -- GET OVERLAY STATUS WORD ADDRESS
;
;	INPUTS:
;		R5	DISK BLOCK NUMBER OF DESIRED SEGMENT
;
;	OUTPUT:
;		R5	ADDRESS OF SEGMENT DESCRIPTOR (STATUS WORD IS FIRST)
;
;	NOTES:
;		ALL OTHER REGISTERS ARE PRESERVED
;
	CODE
GETOVL:
	SAVE	<R2,R3,R4>		;SAVE REGISTERS 3 AND 4
	MOV	#BOV,R3			;BOTTOM OF SEGMENT LIST
10$:
	MOV	R3,R4			;SAVE THIS SEGMENT ADDRESS
	MOV	T$RBLK(R4),R3		;GET DISK BLOCK
	BIC	#TR$DES!TR$DSK!TR$LOD!TR$MEM,R3	;MASK OUT STATUS BITS
	CMP	R3,R5			;THIS IS THE BLOCK?
	BEQ	40$			;YES
20$:					;NO, SO FOLLOW TREE
	MOV	T$RUP(R4),R3		;TRY TO GO UP
	BNE	10$			;GOT NEXT ONE UP
30$:
	MOV	T$RNXT(R4),R3		;NO MORE UP, TRY TO GO OVER.
	MOV	T$RDWN(R3),R2		;MAKE SURE WE HAVE NOT CIRCLED ROUND.
	BNE	32$			;IF NE, NOT A ROOT OR COTREE
	CMP	R3,#BOV			;MUST BE ROOT OR COTREE.  IS ROOT?
	BEQ	OVERR			;YES.  OVERLAY NOT FOUND
	BR	10$			;COTREE, SO CHECK IT
32$:
	CMP	R3,T$RUP(R2)		;BACK AT BEGINNING OF "NEXT" CIRCLE?
	BNE	10$			;NO.
	MOV	R2,R4			;MOVE DOWN AND TRY AGAIN
	BR	30$
40$:
	MOV	R4,R5			;SAVE ADDRESS AS OUTPUT
	RESTOR				;RESTORE SAVED REGISTERS
	RETURN
;
OVERR:
	TYPES	BOL,<'OVERLAY ERROR'>,EOL	;ERROR!
	JMP	EXIT
;
	.PAGE
	.SBTTL	IMPORTANT GLOBAL VARIABLES
;
	.MACRO	TAB	X			;GENERATE A TABLE BUFFER
	.WORD	0
X:	.BLKW	16.
	.ENDM	TAB
;
	IDATA
	TAB	INITAB
	TAB	ROTTAB
	TAB	TABL
LOCADR:	.WORD	0			;CODE LOCATION ADDRESS
LOCROT:	.WORD	0			;ROUTINE BLOCK NUMBER OF CODE LOC
LOCSPT:	.WORD	0			;ENTRY/LINE BLOCK OF CODE LOCATION
;
OPNADR:	.WORD	0			;OPEN LOCATION ADDRESS
OPNROT:	.WORD	0			;OPEN LOCATION ROUTINE
OPNSPT:	.WORD	0			;OPEN LOCATION ARRAY/VARIABLE BLOCK
OPNELN:	.WORD	0			;OPEN LOCATION ARRAY ELEMENT
;
RETBRA:	.WORD	0			;BREAKPOINT TABLE ENTRY OF RETURN OR 0
RETROT:	.WORD	0			;ROUTINE OF RETURN POINT
RETSPT:	.WORD	0			;LINE/ENTRY POINT OF RETURN
RETBRP:	.WORD	0			;RETURN FROM BREAKPOINT BPT ADDRESS
DEBUGT:	.WORD	0			;FLAG TO INDICATE CONTINUE/DEBUG
;
SAVR0:	.WORD	0,0,0,0,0,0,0,174000	;REGISTER SAVE BUFFER
SAVR1 = SAVR0 + 2
SAVR2 = SAVR0 + 4
SAVR3 = SAVR0 + 6
SAVR4 = SAVR0 + 10
SAVR5 = SAVR0 + 12
SAVPC = SAVR0 + 14
SAVPS = SAVR0 + 16
;
SAVFPP:	.BLKW	6*4+1			;FLOATING POINT SAVE AREA
ENDFPP:
	.END	FDT.