Google
 

Trailing-Edge - PDP-10 Archives - klad_sources - klad.sources/sysmac.dag
There are no other files named sysmac.dag in the archive.
.NLIST
.LIST	ME
.NLIST	MC,MD,CND
.ENABL	ABS

.REM	%

	THIS FILE CONTAINES HANDLERS USED BY DIAGNOSTIC
PROGRAMMING TO DO ALL I/O, SCOPE LOOPS, AND ERROR REPORTING.
TO USE, PUT THIS FILE ON YOUR DISK AREA AND IN YOUR PROGRAM
USE A ".MCALL" STATEMENT WITH THE MACRO NAMES TO BE USED.

THE MACRO'S ARE:

	MACRO			USE
	-----			---

	BITYPE		TYPES A LOCATION IN BINARY
	DECML		TYPES A LOCATION IN DECIMAL
	DUMP		TYPES A LOCATION IN OCTAL
	DUMP18		TYPES A LOCATION AS AN 18 BIT ADDRESS
	POP		POP'S A WORD OFF THE STACK
	PRINT		PRINTS A MESSAGE
	PUSH		PUSH'S A WORD ON THE STACK
	SDUMP		SAME AS DUMP EXCEPT SUPPRESSES LEADING ZERO'S
	SET		TRAP TABLE SETUP
	TRACE		TRACE FLOW WITH MESSAGE
	TYPEM		TYPES A CHARACTER
	$CATCH		TRAP CATCHER
	$CMTAG		LIST COMMON TAGS USED
	$DECML		CONVERT FROM BINARY TO DECIMAL AND PRINT
	$END		END CODE OF THE PROGRAM
	$EQUAT		DEFINES TRAP, EMT, REGISTERS, ETC.
	$HLT		ERROR HANDLER
	$KRAT		KERNAL REGISTER ASSIGNMENT TABLE
	$LOADR		ROUTINES TO GET AND RESTORE LOADER
	$OCTAL		OCTAL TYPEOUT HANDLER
	$POWER		POWER FAIL HANDLER
	$RAND		2 WORD RANDUM NUMBER GENERATOR
	$RAND4		4 WORD RANDOM NUMBER GERNRATOR
	$READ		TTY INPUT HANDLER
	$SCOPE		SCOPE LOOP
	$SETUP		BEGINNING OF THE PROGRAM CODE
	$SRAT		SUPERVISOR REGISTER ASSIGNMENT TABLE
	$SWDOC		LISTS THE SWITCH OPTIONS
	$TRAP		TRAP HANDLER
	$TYPE		TYPE HANDLER
	$URAT		USER REGISTER ASSIGNMENT TABLE
	.SCOPE		STRING OF STARS WITH TEST NO. AND COMMENT
	.SCOP		TEST NUMBER AND SCOPE
.NLIST				;TURN OFF THE LISTING
.LIST	ME			;LIST MACRO EXPANSIONS
.NLIST	MC,MD,CND		;NO LIST MACRO CALLS, DEFINATIONS, AND CONDITIONALS
.ENABL	ABS			;MAKE ABS FORMAT
.BIT=	177400			;DEFINE SWITCH OPTIONS TO BE USED
.MCALL	$SWDOC,$EQUAT,$CATCH,$END,$HLT,$OCTAL,$POWER,$SCOPE,$TYPE,.SCOPE,$CMTAG,$SETUP	;DEFINE MACROS
.LIST				;TURN THE LISTING BACK ON
.TITLE	MAINDEC-11-D****-A	********************************
;COPYRIGHT 1972, DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
;PROGRAM BY **************************

$SWDOC				;TABLE OF SWITCH OPTIONS

$EQUAT				;COMMONLY USED EQUATES
N=	1			;DEFINE N FOR .SCOPE


$CATCH				;TRAP CATCHER AND JMP BEGIN
.PAGE
$CMTAG				;WILL LIST COMMON TAGS USED

$SETUP	RTIADR			;COMMON TAGS AND SETUP OF VECTORS

.SCOPE	<STARTING TEST>
;***************   PUT CODE HERE  ****************

.PAGE
$END	BEGIN,SCOPE		;BELL, SCOPE, AND MONITOR LINKAGE
.PAGE
$TYPE				;TTY OUTPUT ROUTINE
.PAGE
$SCOPE				;SCOPE LOOP HANDLER
.PAGE
$HLT				;ERROR HLT HANDLER
.PAGE
$OCTAL				;OCTAL CONVERSION ROUTINE
.PAGE
$POWER				;POWER FAIL ROUTINE

RTIADR:	0			;RTI/RTT ADDRESS
.END				;END OF PROGRAM


%
;******************** $SWDOC ********************
;
;$SWDOC		LISTS THE SWITCH OPTIONS
;
;ARGUEMENTS:	COMMENTS FOR SW15 - SW8
;
;************************************************

.MACRO	$SWDOC	C15,C14,C13,C12,C11,C10,C9,C8

;    SWITCH			USE
;    ------		--------------------
.IIF NE 100000&.BIT,SW15=	100000		;HALT ON ERROR
.IIF EQ 100000&.BIT,SW15=	100000		;C15
.IIF NE 40000&.BIT,SW14=	40000		;LOOP ON TEST
.IIF EQ 40000&.BIT,SW14=	40000		;C14
.IIF NE 20000&.BIT,SW13=	20000		;INHIBIT ERROR TYPEOUTS
.IIF EQ 20000&.BIT,SW13=	20000		;C13
.IIF NE 10000&.BIT,SW12=	10000		;INHIBIT TRACE TRAP
.IIF EQ 10000&.BIT,SW12=	10000		;C12
.IIF NE 4000&.BIT,SW11=	4000		;INHIBIT ITERATIONS
.IIF EQ 4000&.BIT,SW11=	4000		;C11
.IIF NE 2000&.BIT,SW10=	2000		;0 - BELL ON PASS COMPLETE
.IIF NE 2000&.BIT,			;1 - BELL ON ERROR
.IIF EQ 2000&.BIT,SW10=	2000		;C10
.IIF NE 1000&.BIT,SW9=	1000		;LOOP ON ERROR
.IIF EQ 1000&.BIT,SW9=	1000		;C9
.IIF NE 400&.BIT,SW8=	400		;LOOP ON TEST IN SW<5:0>
.IIF EQ 400&.BIT,SW8=	400		;C8
.ENDM	$SWDOC
;******************** $KRAT ********************
;
;$KRAT		LIST THE KERNAL REGISTER ASSIGNMENT TABLE
;
;NO ARGUEMENTS
;
;************************************************

.MACRO	$KRAT
.NLIST
.SBTTL		KERNAL MEMORY MANAGEMENT REGISTER ASSIGNMENTS
.LIST
;MEMORY MANAGEMENT REGISTER ADDRESS ASSIGNMENTS - KERNAL

	SR0=177572		;ADDRESS OF MEM MGMT REGISTER SR0
	SR1=177574		;    "    "       "          "   SR1
	SR2=177576		;    "    "       "          "    SR2
	SR3=172516		;ADDRESS OF MEM MGMT REGISTER SR3

	KIPDR0=172300		;ADDRESS OF KERNEL 'I' PAGE
	KIPDR1=172302		;DESCRIPTOR REGISTERS
	KIPDR2=172304
	KIPDR3=172306
	KIPDR4=172310
	KIPDR5=172312
	KIPDR6=172314
	KIPDR7=172316

	KDPDR0=172320		;ADDRESSES OF KERNEL 'D' PAGE
	KDPDR1=172322		;DESCRIPTOR REGISTERS
	KDPDR2=172324
	KDPDR3=172326
	KDPDR4=172330
	KDPDR5=172332
	KDPDR6=172334
	KDPDR7=172336

	KIPAR0=172340		;ADDRESSES OF KERNEL 'I' PAGE
	KIPAR1=172342		;ADRESS REGISTERS
	KIPAR2=172344
	KIPAR3=172346
	KIPAR4=172350
	KIPAR5=172352
	KIPAR6=172354
	KIPAR7=172356

	KDPAR0=172360		;ADDRESSES OF KERNEL 'D' PAGE
	KDPAR1=172362		;ADDRESS REGISTERS
	KDPAR2=172364
	KDPAR3=172366
	KDPAR4=172370
	KDPAR5=172372
	KDPAR6=172374
	KDPAR7=172376

.ENDM	$KRAT
;******************** $SRAT ********************
;
;$SRAT		LISTS THE SWITCH OPTIONS
;
;NO ARGUEMENTS
;
;************************************************

.MACRO	$SRAT
.NLIST
.SBTTL		SUPERVISOR MEMORY MANAGEMENT REGISTER ASSIGNMENTS
.LIST
;MEMORY MANAGEMENT REGISTER ADDRESS ASSIGNMENTS -SUPERVISOR

	SIPDR0=172200		;ADDRESS OF SUPERVISOR 'I' PAGE
	SIPDR1=172202		;DESCRIPTOR REGISTERS
	SIPDR2=172204
	SIPDR3=172206
	SIPDR4=172210
	SIPDR5=172212
	SIPDR6=172214
	SIPDR7=172216

	SDPDR0=172220		;ADDRESS OF SUPERVISOR 'D' PAGE
	SDPDR1=172222		;DESCRIPTOR REGISTERS
	SDPDR2=172224
	SDPDR3=172226
	SDPDR4=172230
	SDPDR5=172232
	SDPDR6=172234
	SDPDR7=172236

	SIPAR0=172240		;address of supervisor 'i' page
	SIPAR1=172242		;address registers
	SIPAR2=172244
	SIPAR3=172246
	SIPAR4=172250
	SIPAR5=172252
	SIPAR6=172254
	SIPAR7=172256

	SDPAR0=172260		;address oF supervisor 'd' page
	SDPAR1=172262		;address registers
	SDPAR2=172264
	SDPAR3=172266
	SDPAR4=172270
	SDPAR5=172272
	SDPAR6=172274
	SDPAR7=172276
.ENDM	$SRAT
;******************** $URAT ********************
;
;$URAT		LISTS THE SWITCH OPTIONS
;
;NO ARGUEMENTS
;
;************************************************

.MACRO	$URAT
.NLIST
.SBTTL		USER MEMORY MANAGEMENT REGISTER ADDRESS ASSIGNMENTS
.LIST
;MEMORY MANAGEMENT REGISTER ADDRESS ASSIGNMENTS -USER

	UIPDR0=177600		;ADDRESS OF USER 'I' PAGE DESCRIPTOR
	UIPDR1=177602		;REGISTERS
	UIPDR2=177604
	UIPDR3=177606
	UIPDR4=177610
	UIPDR5=177612
	UIPDR6=177614
	UIPDR7=177616

	UDPDR0=177620		;ADDRESS OF USER 'D' PAGE DESCRIPTOR
	UDPDR1=177622		;REGISTERS
	UDPDR2=177624
	UDPDR3=177626
	UDPDR4=177630
	UDPDR5=177632
	UDPDR6=177634
	UDPDR7=177636

	UIPAR0=177640		;ADDRESS OF USER 'I' PAGE ADDRESS
	UIPAR1=177642		;REGISTERS
	UIPAR2=177644
	UIPAR3=177646
	UIPAR4=177650
	UIPAR5=177652
	UIPAR6=177654
	UIPAR7=177656

	UDPAR0=177660		;ADDRESS OF USER 'D' PAGE ADDRESS
	UDPAR1=177662		;REGISTERS
	UDPAR2=177664
	UDPAR3=177666
	UDPAR4=177670
	UDPAR5=177672
	UDPAR6=177674
	UDPAR7=177676
.ENDM	$URAT
;******************** $CMTAG ********************
;
;$CMTAG		COMMON TAGS LISTED
;
;NO ARGUEMENTS
;
;************************************************

.MACRO	$CMTAG
.=	1000

ICNT:	0			;LH = ITERATION COUNT  ;RH = TEST NO.
ERRORS:	0			;ERROR COUNT
PCNT:	0,0			;2 WORD PASS COUNT
LAD:	0			;LOOP ADDRESS FOR SCOPE
HLTADR:	0			;LAST HLT INSTRUCTION ADD. EXECUTED
.ENDM	$CMTAG

;******************** $SETUP ********************
;
;$SETUP		INITALIZES THE PROGRAM
;
;ARGUEMENT:		TAG FOR LOC. OF RTI OR RTT
;
;************************************************

.MACRO	$SETUP	Y
BEGIN:	MOV	#IOT$,@#20	;SET UP IOT VECTOR
	MOV	#340,@#22	;LOCK UP BUS REQUEST 7 (BR7)
	MOV	#PDOWN$,@#24	;SET UP PF VECTOR
	MOV	#340,@#26	;LOCK OUT THE WORLD
	MOV	#EMT$,@#30	;SET EMT VECTOR
	MOV	#340,@#32	;LOCK UP
	MOV	#TRAP$,@#34	;SET TRAP VECTOR
	MOV	#340,@#36	;LOCK UP
.IF NB	<Y>
.IF NE SW12&.BIT
	MOV	#Y,@#14 	;SET TRACE VECTOR TO Y
	MOV	#340,@#16	;BR7
	MOV	#RTI,Y  	;SET THE RTI
	MOV	#1$,@#10	;SET FOR TRAP
	SXT	R0		;CHECK FOR 11/40 - 11/45
	MOV	#RTT,Y  	;RESET TO RTT
	BR	2$		;SKIP IT ALL
1$:	CMP	(6)+,(6)+	;ZAP STACK
2$:	MOV	#12,@#10	;RESET 10
.ENDC
.ENDC
	CLR	ICNT		;INIT ICNT
	CLR	LAD		;INIT LAD
.ENDM	$SETUP
;******************** .SCOPE ********************
;
;.SCOPE		STRING OF STARS WITH TEST NUMBER AND COMMENT
;
;ARGUEMENT:	ASCII COMMENT
;
;************************************************

.MACRO	.SCOPE	ASCII
.NLIST
.MCALL	SCOPE.
QQ=	1
.LIST
	SCOPE.	\N,^*ASCII*
.ENDM	.SCOPE

.MACRO	SCOPE.	A,ASC			;USED WITH .SCOPE
.NLIST
.SBTTL	TST'A'	ASC
.LIST
;*************************************************************************
;*TEST A		ASC
;*************************************************************************
TST'A:	SCOPE
.NLIST
N=N+1
.LIST
.ENDM	SCOPE.

;******************** .SCOP ********************
;
;.SCOP		TEST NUMBER
;
;NO ARGUEMENT:
;
;************************************************

.MACRO	.SCOP
.NLIST
.MCALL	SCOP.
QQ=	1
.LIST
	SCOP.	\N
.ENDM	.SCOP

.MACRO	SCOP.	A
TST'A:	SCOPE			;TEST A
.NLIST
N=N+1
.LIST
.ENDM	SCOP.
;******************** $LOADR ********************
;
;$LOADR		ROUTINES TO GET AND RESTORE THE LOADER
;
;ARGUEMENT:	DEFINE IF MM EXISTS
;
;************************************************

.MACRO	$LOADR	ARG
.NLIST
.SBTTL		ROUTINES TO GET LOADER AND RESTORE IT
.LIST
;	$LOADR		GET AND RESTORE THE LOADER

;THESE ROUTINES FIRST FIND THE LOADER (TOP OF HIGHEST
;4K BANK IN 28K) AND SAVE IT AT TAG "ENDP:". ENTRY FOR
;THIS ROUTINE IS "JSR PC,LODGET".

;"JSR PC,LODRES" WILL RESTORE THE LOADER IN ITS ORIGONAL
;LOCATION. ".LOD:" CONTAINS THE ADDRESS OF THE LOADER.

.IF NB <ARG>
LODGET:	TST	OPTION		;WHICH OPTION?
	BLE	3$		;NO MEMORY MANAGEMENT
	CLR	@SR0		;TURN OFF MM
3$:	MOV	R0,R1		;GET THE BANK
.IFF
LODGET:	MOV	R0,R1		;GET THE BANK
.ENDC
	CMP	#6,R1		;IS IT > 6?
	BPL	1$		;SKIP IF LES THAN 6
	MOV	#6,R1		;IF > 7 MAKE 7
1$:	ROR	R1		;GET THE
	ROR	R1		;UPPER
	ROR	R1		;THREE
	ROR	R1		;BITS
	BIC	#17777,R1	;CLEAR JUNK
	MOV	#ENDP,R2	;GET SAVE ADDRESS
	ADD	R2,R1		;MAKE OTHER ONE
	MOV	R1,.LOD		;SAVE ADDRESS
2$:	MOV	(1)+,(2)+	;MOVE WORD
	CMP	#20000,R2	;END?
	BNE	2$		;NO!
	RTS	PC		;RETURN

.IF NB <ARG>
LODRES:	TST	OPTION		;WHICH OPTION?
	BLE	2$		;NO MEMORY MANAGEMENT
	CLR	@SR0		;TURN OFF MM
2$:	MOV	#ENDP,R2	;GET END OF PROGRAM
.IFF
LODRES:	MOV	#ENDP,R2	;GET END OF PROGRAM
.ENDC
	MOV	.LOD,R1		;GET SAVE ADDRESS
1$:	MOV	(2)+,(1)+	;RESTORE WORD
	CMP	#20000,R2	;END?
	BNE	1$		;LOOP
.IF NB <ARG>
	TST	OPTION		;WHICH OPTION?
	BLE	3$		;NO MEMORY MANAGEMENT
	INC	@SR0		;TURN ON MM
.ENDC
3$:	RTS	PC		;RETURN

.LOD:	0			;STARTING ADDRESS OF LOADER
.ENDM	$LOADR
;******************** $EQUAT ********************
;
;$EQUAT		DEFINES TRAP, EMT, REGISTERS, ETC.
;
;ARGUEMENT:	TURNS ON BIT DEFINITIONS IF DEFINED
;
;************************************************

.MACRO	$EQUAT	X
SCOPE=	TRAP
HLT=	EMT
TYPE=	IOT
PS=	177776
SWR=	177570
DISPLAY=SWR
BELL=	7
R0=	%0
R1=	%1
R2=	%2
R3=	%3
R4=	%4
R5=	%5
TTY=	%5
SP=	%6
PC=	%7
.IF NB	<X>
BIT0=	     1
BIT1=	     2
BIT2=	     4
BIT3=	    10
BIT4=	    20
BIT5=	    40
BIT6=	   100
BIT7=	   200
BIT8=	   400
BIT9=	  1000
BIT10=	  2000
BIT11=	  4000
BIT12=	 10000
BIT13=	 20000
BIT14=	 40000
BIT15=	100000
.ENDC
.NLIST
.MCALL	PRINT,PUSH,POP,DUMP,SDUMP,BITYPE,DECML
.LIST
.ENDM	$EQUAT
;****** BITYPE,DUMP,DUMP18,PRINT,SDUMP,TYPEM ******
;
;BITYPE		TYPE A LOCATION IN BINARY
;
;ARGUEMENT:	ADDRESS WITH MODE
;
;DUMP		TYPE A LOCATION IN OCTAL
;
;ARGUEMENT:	ADDRESS WITH MODE
;
;DUMP18		TYPE A LOCATION AS 18 BIT ADDRESS WITH MX
;
;ARGUEMENT:	ADDRESS WITH MODE
;
;PRINT		TYPE TEXT ON TTY
;
;ARGUEMENT:	ASCII STRING IN "<>"
;
;SDUMP		SAME AS "DUMP" EXCEPT SUPPRESS LEADING ZERO"S
;
;TYPEM		TYPES A CHARACTER
;
;ARGUEMENT:	CHARACTER TO BE TYPED
;
;**************************************************

.MACRO	DUMP	A
	MOV	A,TTY   	;TYPE A IN OCTAL
	JSR	PC,PRINTR	;TYPE LEADING ZERO'S
.ENDM	DUMP

.MACRO	SDUMP	A
	MOV	A,TTY   	;TYPE A IN OCTAL
	JSR	PC,PRINTS	;AND SUPRESS LEADING ZERO'S
.ENDM	SDUMP

.MACRO	BITYPE	NUM
	MOV	NUM,TTY   	;PUT NUM INTO TTY
	JSR	PC,BITYP$	;TYPE NUM IN BITS
.ENDM	BITYPE

.MACRO	PRINT	A
	TYPE	,.+2		;.ASCIZ A
.NLIST
.ASCIZ	A
.EVEN
.LIST
.ENDM	PRINT

.MACRO	DUMP18	A
	MOV	A,TTY   	;TYPE A WITH MX AS 18 BIT ADDRESS
	JSR	PC,PRINTA	;GO TO ADDRESS PRINTER
.ENDM	DUMP18

.MACRO	TYPEM	A
	TYPE	,A		;TYPE THE CHARACTER A
.ENDM	TYPEM
;**************** $CATCH,POP,PUSH ****************
;
;
;$CATCH		TRAP CATCHER
;
;ARGUEMENTS:	OPTIONAL ADDRESS FOR "JMP ADR" AT 200
;
;POP		POPS THE STACK INTO ARGUEMENT
;
;ARGUEMENT:	ADDRESSES FOR DATA (IN "<" AND ">")
;
;PUSH		PUSH DATA WORDS ON THE STACK
;
;ARGUEMENT:	ADDRESSES OF DATA IN "<>"
;
;*************************************************

.MACRO	PUSH	A
.IRP	B,<A>
	MOV	B,-(6)  	;PUSH B ON STACK
.ENDM
.ENDM	PUSH


.MACRO	POP	A
.IRP	B,<A>
	MOV	(6)+,B  	;POP STACK INTO B
.ENDM
.ENDM	POP


.MACRO	$CATCH
.=	0			;TRAP CATCHER FROM 0 - 776
.NLIST
0,0
.REPT	177
.+2
HALT
.ENDR
.LIST

.=	200

	JMP	@#BEGIN		;JUMP TO BEGINING ADDRESS OF PROGRAM
.ENDM	$CATCH
;********************* $END *********************
;
;$END		END CODE OF THE PROGRAM
;
;ARGUEMENTS:
;
;1) ADDRESS TO LOOP TO (DEFAULTS TO BEGIN)
;2) INSTRUCTION TO BE EXECUTED UPON ENTRY
;3) BELL RINGING COUNT (MASK; 37 = EVERY 40 PASSES)
;4) TYPES A FILLER FOR 11/05 IF DEFINED
;
;************************************************

.MACRO	$END	ADR,INSTR,C,D
.NLIST
.SBTTL		BELL AND SCOPE ROUTINE
.LIST
DONE:	INSTR
	ADD	#1,PCNT+2	;ADD 1 TO THE PASS COUNT
	ADC	PCNT		;MAKE IT DOUBLE PREC.
.IF NB	<C>
	BIT	#C,PCNT+2	;LOOP?
	BNE	3$		;GO BACK TO BEGINNING
.ENDC
.IF NE	SW10&.BIT
	BIT	#SW10,@#SWR	;RING THE BELL?
.IF NE	.BIT&SW12
	BNE	1$		;NO!
.IFF
	BNE	4$		;NO!
.ENDC
	TYPE	,BELL		;RING THE BELL
.IIF NB	<D>,	TYPE	,177		;TYPE A FILLER FOR 11/05
.ENDC
.IF NE	SW12&.BIT
1$:	CLR	-(6)		;CLEAR TRACE TRAP
	BIT	#SW12,@#SWR	;RUN WITH TRT?
	BNE	2$		;SKIP T BIT
	COM	.TBIT		;COMPLIMENT FLAG
	BPL	2$		;SKIP IF PLUS
	BIS	#20,(6)		;SET TRACE TRAP
	MOV	#3$,-(6)	;JUMP TO START OF TEST
	RTI			;RETURN
2$:	MOV	#4$,-(6)	;JUMP TO START OF TEST
	RTI			;RETURN
.ENDC
4$:	MOV	@#42,R0		;GET MONITOR ADDRESS
	BEQ	3$		;IF NONE
	JSR	7,(0)		;GO TO MONITOR
	NOP			;SAVE ROOM
	NOP			;FOR
	NOP			;ACT11
.IF B	<ADR>
3$:	JMP	@#BEGIN		;RETURN
.IFF
3$:	JMP	ADR		;RETURN
.ENDC

.IIF NDF PCNT,PCNT:
.IIF EQ	.-PCNT,PCNT:	0,0			;PASS COUNT
.TBIT:	0			;T BIT FLAG
.ENDM	$END
;******************** $SCOPE ******************
;
;$SCOPE		SCOPE LOOP HANDLER
;
;ARGUEMENTS:
;
;1) NUMBER OF PASSES (DEFAULTS TO 256.)
;2) TAG FOR TRAP SUBROUTINE
;3) TEST NUMBER TRACE IF DEFINED
;
;************************************************

.MACRO	$SCOPE	NUM,ADRS,X
.NLIST
.SBTTL		SCOPE LOOP HANDLER
.LIST
;	$SCOPE		SCOPE LOOP HANDLER

;THIS ROUTINE HANDLES THE ITERATIONS, LOOPING, ERROR
;LOOPING, AND THE DISPLAYING OF THE TEST NUMBER.

;"SCOPE" IS PLACED BETWEEN EACH SUBTEST IN THE TEST AND
;RECORDS THE STARTING ADDRESS OF THE SUBTEST IN "LAD:"

.IF NB	<ADRS>
TRAP$:	MOV	(6),TRPCT$	;GET RETURN ADDRESS
	SUB	#2,TRPCT$	;GET INSTRUCTION ADDRESS
	MOVB	TRPCT$,TRPCT$	;GET ARGUMENT
	BEQ	.+6		;SKIP IF ZERO
	JMP	ADRS		;GO TO HANDLER
.IF NE	.BIT&SW8
	BIT	#SW8,@#SWR	;LOOP ON SPEC. TEST?
	BEQ	1$		;NO LOOP ON SPEC. TEST
	MOVB	@#SWR,-(6)	;PUSH THE SW. REG. ON THE STACK
	BIC	#300,(6)	;MASK BITS 6 & 7
	CMPB	(6)+,ICNT	;ON RIGHT TEST?   *SW5-0*
	BEQ	OVER$		;NOT RIGHT TEST
1$:	BIT	#SW14,@#SWR	;LOOP ON TEST?
.IFF
	BIT	#SW14,@#SWR	;LOOP ON TEST?
.ENDC
.IFF
.IF NE	.BIT&SW8
TRAP$:	BIT	#SW8,@#SWR	;LOOP ON SPEC. TEST?
	BEQ	1$		;NO LOOP ON SPEC. TEST
	MOV	@#SWR,R5	;READ SWITCHES
	BIC	#300,R5		;MASK OUT BITS 7 & 6
	CMPB	R5,ICNT		;ON RIGHT TEST?   *SW5-0*
	BEQ	OVER$		;NOT RIGHT TEST
1$:	BIT	#SW14,@#SWR	;LOOP ON TEST?
.IFF
TRAP$:	BIT	#SW14,@#SWR	;LOOP ON TEST?
.ENDC
.ENDC
	BNE	KIT$		;LOOP ON TEST IS SET
	BR	3$		;SKIP - NOP FOR XOR TESTER
PUSH	@#4
	MOV	#4$,@#4		;SET FOR TIMEOUT
	TST	@#177060	;ERROR ON XOR?
POP	@#4
	BR	SVLAD$		;NO ERROR - GO TO NEXT TEST
4$:	CMP	(6)+,(6)+	;CLEAR STACK
POP	@#4
	BR	KIT$		;ERROR - LOOP ON TEST
3$:	BIT	#SW11,@#SWR	;KILL ITERATIONS
	BNE	SVLAD$		;YES - KILL ITERATIONS
	TSTB	ICNT+1		;FIRST ONE?
	BEQ	2$		;BRANCH IF FIRST
	CMPB	TIMES,ICNT+1	;DONE?
	BNE	KIT$		;BRANCH IF NOT 
2$:	MOVB	#1,ICNT+1	;FIRST ITERATION
SVLAD$:	INCB	ICNT		;COUNT TEST NUMBERS
	MOV	(6),LAD		;SAVE LOOP ADDRESS
	MOV	ICNT,@#DISPLAY	;DISPLAY TEST NO. AND ITERATION COUNT
.IIF NB	<X>,	JSR	PC,$TRACE
	RTI			;RETURN

KIT$:	INCB	ICNT+1		;INC THE ITERATION COUNT
OVER$:	MOV	ICNT,@#DISPLAY	;SET UP DISPLAY
.IIF NB	<X>,	JSR	PC,$TRACE
	TST	LAD		;FIRST ONE?
	BEQ	SVLAD$		;YES
	MOV	LAD,(6)		;FUDGE RETURN ADDRESS
	RTI			;FIXES PS
.IF NB	<X>

$TRACE:	BIT	#SW8,@#SWR	;CHECK BIT 8
	BNE	.+4		;SKIP IF TRACE
	RTS	PC		;RETURN
	PRINT	<<15><12>"_">
	MOVB	ICNT,TTY	;GET BYTE FOR TYPING
	BIC	#177400,TTY	;CLEAR JUNK
	JMP	PRINTS		;TYPE IT
.ENDC

.IIF NB	<ADRS>,TRPCT$:	0
.IIF NDF ICNT,ICNT:
.IIF EQ	.-ICNT,ICNT:	0			;LH = ITERATION COUNT  ;RH = TEST NO.
.IIF NDF LAD,LAD:
.IIF EQ	.-LAD,LAD:	0			;LOOP ADDRESS
.IIF B <NUM>,TIMES:	377			;RUN 377 TIMES
.IIF NB <NUM>,TIMES:	NUM			;RUN NUM TIMES
.ENDM	$SCOPE
;********************* $HLT *********************
;
;$HLT		ERROR TYPEOUT ROUTINE
;
;ARGUEMENT:	ADDRESS OF USER TYPEOUT (OPTIONAL)
;
;************************************************

.MACRO	$HLT	ADR
.NLIST
.SBTTL		HLT ROUTINE (ERROR TYPEOUT)
.LIST
;	$HLT		ERROR TYPEOUT HANDLER

;THIS ROUTINE PRINTS OUT ERROR MESSAGES STARTING WITH THE
;ADDRESS OF THE "HLT". IT ALSO COUNTS THE NUMBER OF ERRORS
;AND HAS THE CAPABILITY OF LOOPING ON ERROR, BELL ON ERROR,
;"HALT" ON ERROR, AND INHIBIT TYPEOUTS. AN OPTIONAL ARGUEMENT
;(HLT+3) WILL BE PLACED IN "HLTCT$:" FOR ADITIONAL TYPEOUTS.

.IF EQ	SW10&.BIT
EMT$:	INC	ERRORS		;INC THE ERROR COUNT
.IFF
EMT$:	BIT	#SW10,@#SWR	;BELL ON ERROR?
	BEQ	1$		;NO - SKIP
	TYPE	,BELL		;RING BELL
1$:	INC	ERRORS		;COUNT THE NUMBER OF ERRORS
.ENDC
.IF NE	SW13&.BIT
	BIT	#SW13,@#SWR	;SKIP TYPEOUT IF SET
	BNE	2$		;SKIP TYPEOUTS
.ENDC
	PRINT	<<15><12>>
	MOV	(6),HLTADR	;PUT ADDRESS OF INSTRUCTION ON STACK
	SUB	#2,HLTADR	;FUDGE ADDRESS
	MOVB	@HLTADR,HLTCT$	;GET HLT ARGUEMENT
	DUMP	HLTADR		;TYPE THE ADDRESS
	PRINT	<"  ">
.IF NB	ADR
	JSR	PC,ADR  	;GO TO USER ERROR ROUTINE
.ENDC
2$:	TST	@#SWR		;HALT ON ERROR
	BPL	.+4		;SKIP IF CONTINUE
	HALT			;HALT ON ERROR!
.IF EQ	SW9&.BIT
	RTI			;RETURN
.IFF
	BIT	#SW9,@#SWR	;CHECK FOR INHIBIT LOOP ON ERROR
	BNE	.+4		;SKIP IF LOOP ON ERROR
	RTI			;RETURN
	CLRB	ICNT+1		;CLEAR ITERATION COUNT
	JMP	KIT$		;LOOP ON TEST UNTIL NO ERRORS
.ENDC

.IIF NDF ERRORS,ERRORS:
.IIF EQ	.-ERRORS,ERRORS:	0			;ERROR COUNT
HLTCT$:	0			;HLT ARGUEMENT
.IIF NDF HLTADR,HLTADR:
.IIF EQ	.-HLTADR,HLTADR:	0			;LAST HLT INSTRUCTION EXECUTED
.ENDM	$HLT
;******************** $OCTAL ********************
;
;$OCTAL		OCTAL TYPEOUT ROUTINE
;
;ARGUEMENT:	IF PRESENT, CODES 18 BIT ADDRESS TYPER
;
;************************************************

.MACRO	$OCTAL	ANSW
.NLIST
.IF NB	<ANSW>
.SBTTL		OCTAL DUMP OF A WORD & 18 BIT ADDRESS TYPER
.IFF
.SBTTL		OCTAL DUMP OF A WORD
.ENDC
.LIST
;	$OCTAL		OCTAL TYPEOUT ROUTINE

;THIS ROUTINE IS USED TO TYPE AN OCTAL NUMBER ON THE TTY. IT WILL TYPE
;ALL 6 CHARACTERS, SUPPRESS LEADING ZEROES, TYPE AN 18 BIT ADDRESS, OR TYPE
;THE 16 BITS. IT IS CALLED VIA THE DUMP, SDUMP, DUMP18, OR BITYPE MACRO'S.

BITYP$:	MOV	#170101,.PR	;SET BIT FLAG ANS 16. CHARACTER COUNT
	BR	.PTIT		;NOW TYPE IT IN BIT FORM
PRINTR:	MOVB	#1,.PR		;SET ZERO FILL SWITCH
	BR	.+6		;SKIP
PRINTS:	CLR	.PR		;SUPRESS LEADING ZERO'S
	MOVB	#-6,.PR+1	;SET COUNT
.PTIT:	MOV	R4,-(6)		;SAVE R4
	MOV	#.PR+2,R4	;SET POINTER TO FIRST ASCII CHAR.
	CLRB	(4)		;CLEAR FIRST BYTE
	BR	.PRF		;ROTATE FIRST BIT
.IF NB	<ANSW>
PRINTA:	MOV	R4,-(6)		;SAVE R4
	MOV	#.PR+2,R4	;SET UP POINTER TO OUTPUT AREA
	MOVB	MX,(4)		;MX CONTAINS UPPER 5 BITS
	ASL	TTY		;GET RID
	ASL	TTY		;OF 3
	ASL	TTY		;JUNK BITS
	ASRB	(4)		;GET BIT13
	ROR	TTY		;PACK IT
	ASRB	(4)		;GET BIT14
	ROR	TTY		;PACK IT
	BISB	#'0,(4)+	;MAKE IT ASCII
	MOV	#175401,.PR	;-5,,1 - 5 BYTES AND FILL
.ENDC
.PRL:	CLRB	(4)		;CLEAR BYTE OF CHARACTER
	BIT	#100,.PR	;BIT TYPING MODE?
	BNE	.PRF		;YES - SKIP 2 ROTATES
	ROL	TTY		;ROTATE BIT INTO C
	ROLB	(4)		;PACK IT
	ROL	TTY		;ROTATE BIT INTO C
	ROLB	(4)		;PACK IT
.PRF:	ROL	TTY		;ROTATE BIT INTO C
	ROLB	(4)		;PACK IT
	TSTB	(4)		;IS IT ZERO?
	BEQ	.+6		;SKIP INC
	INCB	.PR		;SET FILL SWITCH
	TSTB	.PR		;CHECK FILL SWITCH
	BEQ	.+6		;SKIP BITSET
	BISB	#'0,(4)+	;MAKE INTO ASCII CHAR
	INCB	.PR+1		;INC COUNT
	BNE	.PRL		;REPEAT
	CMP	#.PR+2,R4	;EMPTY BUFFER?
	BNE	.+6		;SKIP IF NOT
	MOVB	#'0,(4)+	;LOAD 1 ZERO
	CLRB	(4)		;NULL TERMINATOR
	TYPE	,.PR+2		;TYPE IT
	MOV	(6)+,R4		;RESTORE R4
	RTS	PC		;RETURN
.PR:	.BLKW	12		;COUNT, SWITCH, AND OUTPUT BUFFER
.IF NB	<ANSW>
.IIF NDF MX,MX:
.IIF EQ	.-MX,MX:	0			;MEMORY EXTENSION BITS
.ENDC
.ENDM	$OCTAL
;***************** $DECML,DECML *****************
;
;$DECML		CONVERT BINARY TO DECIMAL AND TYPE ROUTINE
;NO ARGUEMENTS
;
;DECML		TYPES LOCATION IN DECIMAL
;
;ARGUEMENT	ADDRESS WITH MODE
;
;
;************************************************

.MACRO	DECML	NUM
	MOV	NUM,-(6)
	JSR	PC,.DECML
.ENDM	DECML

.MACRO	$DECML
.NLIST
.SBTTL		CONVERT BINARY TO DECIMAL AND TYPE ROUTINE
.LIST
.DECML:	PUSH	<R0,R1,R2,R3,R5>
	MOV	#100040,.DSIGN	;SET BLANK SWITCH AND SIGN
	MOV	14(6),R5	;GET DATA TO BE TYPED
	BPL	1$		;BR IF INPUT IS POS.
	NEG	R5		;MAKE THE BINARY NUMBER POS.
	MOVB	#'-,.DSIGN	;MAKE THE ASCII NUMBER NEG.
1$:	CLR	R0		;ZERO THE CONSTANTS INDEX
	MOV	#.DBLK,R3	;SETUP THE OUTPUT POINTER
	MOVB	#' ,(R3)+	;SET THE FIRST CHARACTER TO A BLANK
2$:	CLR	R2		;CLEAR THE BCD NUMBER
	MOV	.DTBL(R0),R1	;GET THE CONSTANT
3$:	SUB	R1,R5		;FORM THIS BCD DIGIT
	BLT	4$		;BR IF DONE
	INC	R2		;INCREASE THE BCD DIGIT BY 1
	BR	3$
4$:	ADD	R1,R5		;ADD BACK THE CONSTANT
	TST	R2		;CHECK IF BCD DIGIT=0
	BNE	5$		;FALL THROUGH IF 0
	TSTB	.DSIGN+1	;STILL DOING LEADING 0'S?
	BMI	7$		;BR IF YES
5$:	ASLB	.DSIGN+1	;MSD?
	BCC	6$		;BR IF NO
	MOVB	.DSIGN,-1(R3)	;YES--SET THE SIGN
6$:	BIS	#'0,R2		;MAKE THE BCD DIGIT ASCII
7$:	BIS	#' ,R2		;MAKE IT A SPACE IF NOT ALREADY A DIGIT
	MOVB	R2,(R3)+	;PUT THIS CHARACTER IN THE OUTPUT BUFFER
	TST	(R0)+		;JUST INCREMENTING
	CMP	R0,#10		;CHECK THE TABLE INDEX
	BLT	2$		;GO DO THE NEXT DIGIT
	BGT	8$		;GO TO EXIT
	MOV	R5,R2		;GET THE LSD
	BR	6$		;GO CHANGE TO ASCII
8$:	CLRB	(R3)		;SET THE TERMINATOR
	POP	<R5,R3,R2,R1,R0>
	MOV	(6)+,(6)	;FUDGE DATA OFF STACK
	TYPE	,.DBLK		;NOW TYPE THE NUMBER
	RTS	PC		;RETURN TO USER
.DTBL:	10000.
	1000.
	100.
	10.
.DBLK:	.BLKW	4
.DSIGN:	0
.ENDM	$DECML
;******************** $POWER ********************
;
;$POWER		POWER FAIL ROUTINE
;
;ARGUEMENTS:
;
;1) ADDRESSES TO BE SAVED (IN "<>")
;2) ADDRESSES TO BE RESTORED (REVERSE OF 1.)
;3) DEFINE IF "POWER" IS NOT WANTED
;4) ADDRESS TO RETURN TO IF NO RTI WANTED
;
;***********************************************

.MACRO	$POWER	A,R,C,ADR
.NLIST
.SBTTL		POWER DOWN AND UP ROUTINES
.LIST
PDOWN$:	MOV	#ILLUP,@PUVEC$	;SET FOR FAST UP
	MOV	#340,@PUVEC$+2	;PRIO:7
	PUSH	<R0,R1,R2,R3,R4,R5>
.IF NB	<A>
	PUSH	<A>
.ENDC
	MOV	SP,.SAVR6	;SAVE SP
	MOV	#PUP$,@PUVEC$	;SET UP VECTOR
	HALT			;WAIT FOR PF

PUP$:	MOV	.SAVR6,SP	;GET SP 
	CLR	R1		;WAIT LOOP FOR THE TTY
1$:	INC	R1		;WAIT FOR THE INC
	BNE	1$		;OF A WORD
.IF NB	<R>
	POP	<R>
.ENDC
	POP	<R5,R4,R3,R2,R1,R0>
	MOV	#PDOWN$,@#24	;SET UP THE POWER DOWN VECTOR
	MOV	#340,@#26	;PRIO:7
.IF B	<C>
	PRINT	<<15><12>"POWER">
.ENDC
.IF B	<ADR>
	RTI			;RETURN
.IFF
	JMP	ADR		;JMP TO USER ADDRESS
.ENDC

ILLUP:	HALT			;THE POWER UP SEQUENCE WAS STARTED
	BR	.-2		; BEFORE THE POWER DOWN WAS COMPLETE

.SAVR6:	0			;PUT THE SP HERE
PUVEC$:	24,26			;POWER UP VECTOR
.ENDM	$POWER
;********************* $TYPE *********************
;
;$TYPE		TTY TYPEOUT ROUTINE
;
;ARGUEMENT:	DEFINE IF A SHORT TYPE ROUTINE IS WANTED
;
;*************************************************

.MACRO	$TYPE	ANSW
.NLIST
.SBTTL		TYPE ROUTINE
.LIST
;	$TYPE		MESSAGE TYPEOUT ROUTINE

;THIS ROUTINE IS USE TO TYPE ASCII MESSAGES ON THE TTY. THE
;CALL CAN BE IN ONE OF 3 FORMS: 1) "TYPE ,ADR" - TYPES THE
;MESSAGE STARTING IN LOCATION "ADR:", 2) "TYPE ,CHAR" - TYPES
;THE ASCII "CHAR", AND 3) "PRINT <<15><12>"MESSAGE"> - TYPES
;THE MESSAGE WHICH IS INLINE ASCII.

IOT$:	MOV	TTY,-(6)	;SAVE TTY R5=TTY
	MOV	@2(6),TTY	;GET ADDRESS TO BE TYPED
.IF B	<ANSW>
	BIT	#177400,TTY	;IS IT A TYPEM?
	BNE	1$		;NO
	MOV	TTY,.TYPE	;GET THE CHARACTER
	MOV	#.TYPE,TTY	;FUDGE THE ADDRESS
.ENDC
1$:	TSTB	(TTY)		;TERMINATOR?
	BEQ	2$		;GET OUT IF SO
	MOVB	(TTY)+,@.TTYBF	;LOAD AND TYPE THE CHARACTER
	TSTB	@.TTYST		;IS THE PRINTER READY
	BPL	.-4		;WAIT UNTIL IT IS
	BR	1$		;GET THE NEXT CHARACTER
.IF B	<ANSW>
2$:	MOV	@2(6),-(6)	;GET ADDRESS TO BE TYPED
	ADD	#2,4(6)		;ADD 2 TO THE ADDRESS
	CMP	(6)+,2(6)	;IS IT .+2?
	BNE	3$		;NO
	ADD	#2,TTY		;ADD 2 TO THE ADDRESS
	BIC	#1,TTY		;BACK UP TO AN EVEN BYTE
	MOV	TTY,2(6)	;RESTORE ADDRESS
3$:	MOV	(6)+,TTY	;RESTORE TTY
	RTI			;RETURN
.IFF
2$:	MOV	(6)+,TTY	;RESTORE TTY
	ADD	#2,(6)		;UPDATE RETURN ADDRESS
	RTI			;RETURN
.ENDC
.TTYBF:	177566			;TELETYPE BUFFER ADDRESS
.TTYST:	177564			;TELETYPE STATUS REG ADDRESS
.TYPE:	0			;CHARACTER TYPE LOCATION
.ENDM	$TYPE
;******************* $TRAP,SET *******************
;
;$TRAP		TRAP HANDLER (DEFINES SET)
;
;NO ARGUEMENTS
;
;SET		TRAP TABLE SETUP
;
;ARGUEMENTS:
;
;1) TRAP NAME TO BE DEFINED
;2) ADDRESS TO GO TO
;
;*************************************************

.MACRO	$TRAP
.PAGE
.MACRO	SET	A,B
	$SET	A,B,\<TRAP+N>,\N
.NLIST
N=N+2
.LIST
.ENDM	SET
.MACRO	$SET	A,B,C,D
.NLIST
A=	C
.LIST
	B		;A	 =  TRAP+D	 (C)
.ENDM	$SET
.NLIST
.SBTTL		TRAP HANDLER
.LIST
;	$TRAP		;TRAP HANDLER

;THIS ROUTINE DECODES A TRAP CALL AND JUMPS TO THE APROPRATE
;SUBROUTINE. THE CALL IS A "TRAP+N" WHERE N IS A MULTIPLE OF 2.
;THE "SET" MACRO WILL CREATE THE TABLE NEEDED. IT HAS TO
;FOLLOW THIS MACRO.

TRAP$:	MOV	(6),R5		;GET TRAP INSTRUCTION
	SUB	#2,R5		;BACK UP BY 2
	MOVB	(5),R5		;GET THE RIGHT BYTE OF TRAP
	ADD	#ADRTAB,R5	;INDEX TO TABLE
	CMP	#ENDTAB,R5	;CHECK FOR END OF TABLE
	BMI	.+4		;OUT OF BOUNDS
	JMP	@(5)		;GO TO ROUTINE
	HALT			;TRAP OUT OF BOUNDS
	BR	.-2		;HANG UP

ADRTAB:
.ENDM	$TRAP
;********************* $READ *********************
;
;$READ		TTY INPUT ROUTINE
;
;ARGUEMENT:	SIZE OF BUFFER (DEFAULTS TO 16. WORDS)
;
;*************************************************

.MACRO	$READ	SIZE
.NLIST
.SBTTL		TTY INPUT ROUTINE
.LIST
READ$:	MOV	R3,-(6)		;SAVE R3
1$:	MOV	#INPUT,R3	;GET ADDRESS
.IF B	<SIZE>
2$:	CMP	#INPUT+20,R3	;BUFFER FULL?
.IFF
2$:	CMP	#INPUT+SIZE,R3	;BUFFER FULL?
.ENDC
	BEQ	4$		;YES - TYPE "?"
	TSTB	@#177560	;WAIT FOR
	BPL	.-4		;A CHARACTER
	MOVB	@#177562,(3)	;GET CHARACTER
	BICB	#200,(3)	;GET RID OF JUNK
	CMPB	#177,(3)	;IS IT A RUBOUT
	BNE	3$		;SKIP IF NOT
4$:	PRINT	<"?"<15><12>>
	BR	1$		;ZAP THE BUFFER AND LOOP
3$:	MOVB	(3),.TYPE	;SET UP FOR TYPING
	TYPE	,.TYPE		;ECHO IT
	CMPB	#15,(3)+	;CHECK FOR RETURN
	BNE	2$		;LOOP IF NOT RETURN
	CLRB	-1(3)		;ZAP RETURN (THE 15)
	TYPE	,12		;TYPE A LINE FEED
	MOV	(6)+,R3		;RESTORE R3
	RTS	PC		;RETURN
.IIF NDF INPUT,INPUT:
.IF B	<SIZE>
.IIF EQ	.-INPUT,INPUT:	.BLKW	20		;TTY INPUT AREA
.IFF
.IIF EQ	.-INPUT,INPUT:	.BLKW	SIZE		;TTY INPUT AREA
.ENDC
.ENDM	$READ
;********************* $RAND ********************
;
;$RAND		RANDOM NUMBER GENERATOR
;
;NO ARGUEMENTS
;
;************************************************

.MACRO	$RAND
.NLIST
.SBTTL		RANDOM NUMBER GENERATOR
.LIST
RAND$:	PUSH	<R0,R1,R2,R3>
	MOV	LONUM,R0	;SET R0 WITH LOW
	MOV	HINUM,R1	;SET R1 WITH HIGH
	MOV	#-7,R3		;SET SHIFT COUNT
	CLR	R2		;ZERO R2
1$:	ASL	R0		;SHIFT R0 LEFT AND
	ROL	R1		;ROTATE CARRY INTO R1 AND
	ROL	R2		;ROTATE CARRY INTO R2
	INC	R3		;CHECK FOR DONE
	BNE	1$		;CONTINUE SHIFT LOOP
	ADD	LONUM,R2	;ADD NUMBER TO MAKE X 129
	ADC	R1		;PROPOGATE CARRY
	ADD	HINUM,R1	;ADD NUMBER TO MAKE X 129
	ADC	R2		;PROPOGATE CARRY
	ADD	#1057,R0	;ADD LOW CONSTANT
	ADC	R1		;PROPOGATE CARRY
	ADC	R2		;PROPOGATE CARRY
	ADD	#47401,R1	;ADD HIGH CONSTANT
	ADC	R2		;PROPOGATE CARRY
	ADD	#6,R2		;ADD HIGHEST CONSTANT
	ADD	R2,R0		;REPRIME R0 WITH HIGHEST DIGIT
	ADC	R1		;PROPOGATE CARRY
	MOV	R0,LONUM	;SAVE R0
	MOV	R1,HINUM	;SAVE R1
	POP	<R3,R2,R1,R0>
	RTS	PC		;RETURN

HINUM:	0			;HIGH ORDER WORD OF RANDOM NUMBER
LONUM:	0			;LOW ORDER WORD OF RANDOM NUMBER
.ENDM	$RAND
;******************** $RAND4 *******************
;
;$RAND4		4 WORD RANDOM NUMBER GENERATOR
;
;ARGUEMENT:	DEFINE TO TURN OFF RANDOM DATA AREA
;
;***********************************************

.MACRO	$RAND4	X
.NLIST
.SBTTL		FOUR WORD RANDOM NUMBER GENERATOR
.LIST
RAND4$:	ADD	RAND.B,RAND.A	;ADD THE SECOND TO THE FIRST
	ADC	RAND.D		;ADD THE CARRY TO THE FOURTH
	ADD	RAND.C,RAND.B	;ADD THE THIRD TO THE SECOND
	ADC	RAND.C		;ADD THE CARRY TO THE SECOND
	ADD	RAND.D,RAND.C	;ADD THE FOURTH TO THE THIRD
	ADC	RAND.B		;ADD THE CARRY TO THE SECOND
	ADD	RAND.A,RAND.D	;ADD THE FIRST TO THE FOURTH
	ADC	RAND.A		;ADD THE CARRY TO THE FIRST
	DECB	RAND.B+1	;TAKE CARE OF ALL ZERO
	RTS	PC		;RETURN
.IF B	<X>
.IIF NDF RAND.A,RAND.A:
.IF EQ	.-RAND.A

RAND.A:	0			;FIRST OF 4 WORD RANDOM NUMBER
RAND.B:	0			;SECOND
RAND.C:	0			;THIRD
RAND.D:	0			;FOURTH
.ENDC
.ENDC
.ENDM	$RAND4
;********************* TRACE *********************
;
;TRACE		TRACE FLOW WITH MESSAGE
;
;ARGUEMENTS
;
;1) MESSAGE
;2) SWITCH  USED
;
;************************************************

.MACRO	TRACE	MESG,SW
.NLIST
.IF NB	<SW>
	BIT	#SW,@#SWR	;IS BIT SW SET?
	BEQ	100$		;NO - SKIP
.ENDC
.LIST
PRINT	<<15><12>"% MESG">
.NLIST
.IIF NB	<SW>,100$:
.LIST
.ENDM
;************************************************
;
;MONITOR BUFFER AND CALL MACRO'S
;
;************************************************

.MACRO	LNKBLK	NAME,DEV,UNIT,DATSET,WORDS,ADR

	ADR+0			;ERROR RETURN ADDRESS
NAME:	0			;ENTRY
	.RAD50	"DATSET"
	.BYTE	WORDS,UNIT
	.RAD50	"DEV"		;DEVICE NAME
.ENDM	LNKBLK
.MACRO	FILBLK	NAME,NAMEXT,UIC,PROT,ADR,CODE

	ADR+0
	CODE+0
NAME:	.RAD50	"NAMEXT"
	UIC+0
	PROT+0
.ENDM	FILBLK
.MACRO	BUFHDR	NAME,BYCNT,MAXBYT,MODE,SIZE

NAME:	MAXBYT+0
	MODE+0
	BYCNT+0
.BLKW	SIZE+0
.ENDM	BUFHDR
.MACRO	BLKBLK	NAME,FUNCT,BLKNO

NAME:	FUNCT+0
	BLKNO+0
	0,0
.ENDM	BLKBLK
.MACRO	TRNBLK	NAME,FUNCT,ADR,BLOCK,WC

NAME:	BLOCK+0
	ADR+0
	WC+0
	FUNCT+0
	0
.ENDM	TRNBLK
.MACRO	WRITE	ASCII
	.TRAN	#TTYOUT,#1$	;.ASCIZ ASCII
	BR	2$
.NLIST
1$:	0
	3$
	2$-3$/2
	2,0
3$:	.ASCIZ	ASCII
.EVEN
2$:
.LIST
.ENDM	WRITE
.MACRO	ODT11
.NLIST
.SBTTL		ODT-11 -- V004A
.LIST
ST	=	177776		;STATUS REGISTER
O.TVEC	=	14		;TRT VECTOR LOCATION
O.STM	=	340		;PRIORITY MASK - STATUS REGISTER
O.TBT	=	20		;T-BIT MASK - STATUS REGISTER
TRT	=	000003		;TRT INSTRUCTION
;
; R5 IS USUALLY CONSIDERED SAFE, THE CURRENT ADDRESS WORD
; RESIDES IN IT.  AFTER A BREAKPOINT, IT IS SET TO ZERO, AND SEARCH
; OPERATIONS LEAVE IT RANDOMLY FILLED.  OTHERWISE, IT SHOULD NOT
; BE USED EXCEPT FOR JSR'S AND THE CURRENT ADDRESS POINTER (CAD).
;
O.RDB	=	177562	;R DATA BUFFER
O.RCSR	=	177560	;R C/SR
O.TDB	=	177566	;T DATA BUFFER
O.TCSR	=	177564	;T C/SR
;
;
; INITIALIZE ODT
;  USE O.ODT FOR A NORMAL ENTRY
;  USE O.ODT+2 TO RESTART ODT - WIPING OUT ALL BREAKPOINTS
;  USE O.ODT+4 TO RE-ENTER (I.E. - FAKE A BREAKPOINT)
;
O.ODT:	BR	O.STRT		;NORMAL ENTRY
	BR	O.RST		;RESTART
O.ENTR:	MOV	ST,O.UST	;RE-ENTER  --  SAVE STATUS
	MOV	O.TVEC+2,ST	;SET UP LOCAL STATUS
	MOV	#.+2,O.UPC	;FAKE THE PC
	JMP	O.BK1
;
O.STRT:	MOV	#O.UR0,SP	;SET UP STACK
	MOV	SP,O.USP	;FAKE THE SAVED STACK
	BR	O.RST1		;CLEAR BREAKPOINT TABLES
O.RST:	JSR	0,O.SVR		;SAVE REGISTERS
	MOV	O.UIN,@O.ADR1	;REMOVE THE BREAKPOINT
	MOVB	O.PRI,R4	;GET ODT PRIORITY
	RORB	R4		;SHIFT
	RORB	R4		; INTO
	RORB	R4		;  POSITION
	MOVB	R4,ST		;STORE IN STATUS
O.RST1:	CLRB	O.P		;DISALLOW PROCEED
	MOV	#O.STM,O.TVEC+2	;STATUS WORD TO TRT VECTOR + 2
	MOV	#O.BRK,O.TVEC	;PC TO TRT VECTOR
	BR	O.RALL		;CLEAR BREAKPOINT TABLES
;
; SPECIAL NAME HANDLER
;  DEPENDS UPON THE EXPLICIT ORDER OF THE TWO TABLES O.TL AND O.UR0
;
O.REGT:	JSR	5,O.GET		;SPECIAL NAME, GET ONE MORE CHARACTER
	MOV	#O.TL,R4	;TABLE START ADDRESS
O.RSP:	CMPB	R0,(R4)+	;IS THIS THE CORRECT CHARACTER?
	BEQ	O.SP		;JUMP IF YES
	CMP	#O.TL+O.LG,R4	;IS THE SEARCH DONE?
	BHI	O.RSP		;BRANCH IF NOT
	BIC	#177770,R0	;MASK OFF OCTAL
	MOV	R0,R4
O.SP1:	ASL	R4
	ADD	#O.UR0,R4	;GENERATE ADDRESS
	INC	R2		;SET FOUND FLAG
	BR	O.SCAN		;GO FIND NEXT CHARACTER
O.SP:	SUB	#O.TL-7,R4	;CORRECT CONSTANT
	BR	O.SP1
;
; _ HANDLER - OPEN INDEXED ON THE PC
;
O.ORPC:	JSR	PC,O.TCLS
	MOV	R5,R2		;CURRENT ADDRESS IN R2
	ADD	@R2,R2		;COMPUTE
	ASR	R2		;MOVE ONE BIT TO CARRY
	BCS	O.ERR		;ERROR IF ODD NUMBER
	ASL	R2		;RESTORE WORD
	TST	(R2)+		; AND INCREMENT BY TWO
	MOV	R2,R5		;UPDATE CAD
	JMP	O.OP2		;GO FINISH UP
;
; B HANDLER - SET AND REMOVE BREAKPOINTS
;
O.BKPT:	TST	R2		;IF NO NUMBER TYPED
	BEQ	O.RALL		;  REMOVE BREAKPOINT
	ASR	R4		;CHECK IF ODD
	BCS	O.ERR		;JUMP IF ODD
	ASL	R4		;RESTORE ONE BIT
	MOV	R4,O.ADR1	;SET A BREAKPOINT
	BR	O.DCD
O.RALL:	MOV	#O.TRTC,O.ADR1	;CLEAR BREAKPOINT
	BR	O.DCD
;
; COMMAND DECODER - ODT11
;
;   REGISTERS R0-R4 MAY BE USED,
;    REGISTER R5 WILL BE CONSIDERED SAFE
;
O.ERR:	BIS	#1,R5		;CLOSE EVERYTHING
	MOV	#'?,R0		;  ? TO BE TYPED
	JSR	5,O.FTYP	; OUTPUT ?
O.DCD:	JSR	5,O.CRLS	;TYPE  <CR><LF>*
O.DCD1:	CLR	R4		; R4 CONTAINS THE CONVERTED OCTAL
	CLR	R2		; R2 IS THE NUMBER FOUND FLAG
O.SCAN:	JSR	5,O.GET		;GET A CHAR, RETURN IN R0
	CMP	#'0,R0		;COMPARE WITH ASCII 0
	BHI	O.CLGL		;CHECK LEGALITY IF NON-NUMERIC
	CMP	#'7,R0		;COMPARE WITH ASCII 7
	BLO	O.CLGL		;CHECK LEGALITY IF NOT OCTAL
	BIC	#177770,R0	;CONVERT TO BCD
	ASL	R4		; MAKE ROOM
	ASL	R4		;  IN
	ASL	R4		;    R4
	ADD	R0,R4		;PACK THREE BITS IN R4
	INC	R2		;R2 HAS NUMERIC FLAG
	BR	O.SCAN		;   AND TRY AGAIN
O.CLGL:	CLR	R1		;CLEAR INDEX
O.LGL1:	CMPB	R0,O.LGCH(R1)	;DO THE CODES MATCH?
	BEQ	O.LGL2		;JUMP IF YES
	INC	R1		; SET INDEX FOR NEXT SEARCH
	CMP	R1,#O.CLGT	;IS THE SEARCH DONE?
	BHIS	O.ERR		;    OOPS!
	BR	O.LGL1		;RE-LOOP
O.LGL2:	ASL	R1		;MULTIPLY BY TWO
	JMP	@O.LGDR(R1)	;GO TO PROPER ROUTINE
;
O.LGDR:	O.WRD	;  /    OPEN WORD
	O.CRET	;  CARRIAGE RETURN    CLOSE
	O.REGT	;  $  REGISTER OPS
	O.GO	;  G  GO TO ADDRESS K
	O.OP1	;  <LF>  MODIFY, CLOSE, OPEN NEXT
	O.ORPC	;  _  OPEN RELATED, INDEX - PC
	O.BACK	;  ^  OPEN PREVIOUS
	O.OFST	;  O  OFFSET
	O.WSCH	;  W  SEARCH WORD
	O.EFF	;  E  SEARCH EFFECTIVE ADDRESS
	O.BKPT	;  B  BREAKPOINTS
	O.PROC	;  P  PROCEED
O.LGL	=	.-O.LGDR	;LGL MUST EQUAL 2X CHLGT ALWAYS
;
; PROCESS / - OPEN WORD
;
O.WRD:	TST	R2		;GET VALUE IF R2 IS NON-ZERO
	BEQ	O.WRDA		;SKIP OTHERWISE
	MOV	R4,R5		;   PUT VALUE IN CAD
O.WRD1:	ASR	R5		;MOVE ONE BIT TO CARRY
O.ERR2:	BCS	O.ERR		;JUMP IF ODD ADDRESS
	ASL	R5		;RESTORE THE CARRY BIT
	MOV	@R5,R0		;GET CONTENTS OF WORD
	JSR	5,O.CADV	;GO GET AND TYPE OUT @CAD
	BR	O.DCD1		;GO BACK TO DECODER
O.WRDA:	BIC	#1,R5		;CLEAR CLOSED BIT
	BR	O.WRD1		;GO BACK TO MAIN-LINE
;
; PROCESS CARRIAGE RETURN
;
O.CRET:	JSR	PC,O.TCLS	;CLOSE LOCATION
	BIS	#1,R5		;CLOSE EVERYTHING
	BR	O.DCD		;RETURN TO DECODER
;
; PROCESS <LF>, OPEN NEXT WORD
;
O.OP1:	JSR	PC,O.TCLS	;CLOSE PRESENT CELL
	TST	(R5)+		;GENERATE NEW ADDRESS
O.OP2:	JSR	5,O.CRLF	;<CR><LF>
	MOV	R5,R0		;NUMBER TO TYPE
	JSR	5,O.CADV	; TYPE OUT ADDRESS
	MOV	#'/,R0		;TYPE A /
	JSR	5,O.FTYP
	BR	O.WRD1		;GO PROCESS IT
;
; PROCESS ^, OPEN PREVIOUS WORD
;
O.BACK:	JSR	PC,O.TCLS
	TST	-(R5)		;GENERATE NEW ADDRESS
	BR	O.OP2		;GO DO THE REST
;
; PROCESS O, COMPUTE OFFSET
;
O.OFST:	ASR	R5		;GET LOW ORDER BIT
	BCS	O.ERR2		;ERROR IF CLOSED
	ASL	R5		;RESTORE WORD
	MOV	#' ,R0		;TYPE ONE BLANK
	JSR	5,O.FTYP	; AS A SEPARATOR
	SUB	R5,R4		;COMPUTE
	DEC	R4
	DEC	R4		;    16 BIT OFFSET
	MOV	R4,R0		;TYPE A
	MOV	R4,R2		;SAVE R4
	JSR	5,O.CADV	;NUMBER IN R0 - WORD MODE
	MOV	R2,R0
	ASR	R0		;DIVIDE BY TWO
	BCS	O.OF1		;BRANCH IF ODD
	JSR	5,O.CADV	;NUMBER IN R0 - BYTE MODE
O.OF1:	JMP	O.DCD1		;ALL DONE
;
; SEARCHES - $MSK   HAS THE MASK
;		$MSK+2 HAS THE FWA
;		$MSK+4 HAS THE LWA
;
O.EFF:	INC	R1		;SET EFFECTIVE SEARCH
	BR	O.WDS
O.WSCH:	CLR	R1		;SET WORD SEARCH
O.WDS:	TST	R2		;CHECK FOR OBJECT FOUND
O.ERR1:	BEQ	O.ERR		;ERROR IF NO OBJECT
	MOV	O.MSK+2,R2	;SET ORIGIN
	MOV	O.MSK,R5	;SET MASK
	COM	R5		;AND COMPLEMENT IT
O.WDS2:	CMP	R2,O.MSK+4	; IS THE SEARCH ALL DONE?
	BHI	O.DCD		;  YES
	MOV	@R2,R0		; GET OBJECT
	TST	R1		;NO
	BNE	O.EFF1		;BRANCH IF EFFECTIVE SEARCH
	MOV	R0,-(SP)
	MOV	R4,R3		;EXCLUSIVE OR
	BIC	R4,R0		; IS DONE
	BIC	(SP)+,R3		;  IN A VERY
	BIS	R0,R3		;    FANCY MANNER HERE
	BIC	R5,R3		;AND RESULT WITH MASK
O.WDS3:	BNE	O.WDS4		;RE-LOOP IF NO MATCH
	MOV	R4,-(SP)	;REGISTERS R2,R4, AND R5 ARE SAFE
	JSR	5,O.CRLF	;TYPE <CR,LF>
	MOV	R2,R0		;GET READY TO TYPE
	JSR	5,O.CADV	;  TYPE ADDRESS
	MOV	#'/,R0		;SLASH TO R0
	JSR	5,O.FTYP	;TYPE IT
	MOV	@R2,R0		;GET CONTENTS
	JSR	5,O.CADV	;TYPE CONTENTS
	MOV	(SP)+,R4	; RESTORE R4
O.WDS4:	TST	(R2)+		;INCREMENT TO NEXT CELL AND
	BR	O.WDS2		;    RETURN
O.EFF1:	CMP	R0,R4		; IS (X)=K?
	BEQ	O.WDS3		;TYPE IF EQUAL
	MOV	R0,R3		;(X) TO R3
	ADD	R2,R3		;(X)+X
	INC	R3
	INC	R3		;(X)+X+2
	CMP	R3,R4		;IS (X)+X+2=K?
	BEQ	O.WDS3		;BRANCH IF EQUAL
	BIC	#177400,R0	;WIPE OUT EXTRANEOUS BITS
	MOVB	R0,R0		;EXTEND SIGN
	CCC
	ASL	R0		;MULTIPLY BY TWO
	INC	R0		;ADD TWO
	INC	R0
	ADD	R2,R0		;ADD PC
	CMP	R0,R4		;IS THE RESULT A PROPER REL. BRANCH?
	BR	O.WDS3
;
; PROCESS G - GO
;
O.GO:	CLRB	O.P		;DISALLOW PROCEED
	ASR	R4		;CHECK LOW ORDER BIT
	BCS	O.ERR2		;ERROR IF ODD NUMBER
	ASL	R4		;RESTORE WORD
	MOV	R4,O.UPC	;SET UP NEW PC
	MOVB	#O.STM,ST	;SET HIGH PRIORITY
	JSR	5,O.RSTT	;RESTORE TELETYPE
O.TBIT:	CLRB	O.T		;CLEAR BOTH
	BIC	#O.TBT,O.UST	;  T-BIT FLAGS
	MOV	@O.ADR1,O.UIN	;SAVE INSTRUCTION
	MOV	O.TRTC,@O.ADR1	;REPLACE WITH TRAP
O.GO2:	MOV	(SP)+,R0	;RESTORE
	MOV	(SP)+,R1	; R0
	MOV	(SP)+,R2	;   THRU
	MOV	(SP)+,R3
	MOV	(SP)+,R4	;
	MOV	(SP)+,R5	;    R5
	MOV	(SP)+,SP	; AND SP
	MOV	O.UST,-(SP)	;    AND STATUS
	MOV	O.UPC,-(SP)	;    AND PC
	RTI
;
; PROCESS P - PROCEED
;   ONLY ALLOWED AFTER A BREAKPOINT
;
O.PROC:	TSTB	O.P		;CHECK LEGALITY OF PROCEED
	BEQ	O.ERR1		;NOT LEGAL
	CLRB	O.P		;CLEAR PROCEED FLAG
	TST	R2		;WAS COUNT SPECIFIED?
	BEQ	O.PR1		;NO
	MOV	R4,O.CT		;YES, PUT AWAY COUNT
O.PR1:	MOVB	#O.STM,ST	;FORCE HIGH PRIORITY
	JSR	5,O.RSTT	;RESTORE TTY
O.C1:	MOVB	#O.STM,ST	;SET HIGH PRIORITY
	INCB	O.T		;SET T-BIT FLAG
	BIS	#O.TBT,O.UST	;SET T-BIT
	BR	O.GO2
;
; BREAKPOINT HANDLER
;  A TRT BREAKPOINT CAUSES O.BRK TO BE ENTERED, WHICH SAVES
;  VARIOUS ODDS AND ENDS, FINDS OUT IF THE BREAKPOINT WAS LEGAL,
;  AND GIVES CONTROL TO THE COMMAND DECODER
;
O.BRK:	MOV	(SP)+,O.UPC	;PRIORITY IS 7 UPON ENTRY
	MOV	(SP)+,O.UST	;SAVE STATUS AND PC
O.BK1:	JSR	0,O.SVR		;SAVE VARIOUS REGISTERS
	TSTB	O.T		;CHECK FOR T-BIT SET
	BNE	O.TBIT		;JUMP IF SET
	MOV	O.UIN,@O.ADR1	;REMOVE BREAKPOINTS
	TSTB	O.PRI		;CHECK IF PRIORITY
	BPL	O.BK2		; IS AS SAME AS USER PGM
	MOVB	O.UST,R5	;PICK UP USER UST IF SO
	BR	O.BK3		;AND DON'T COMPUTE THE PRIORITY
O.BK2:	MOVB	O.PRI,R5	;OTHERWISE PICK UP ACTUAL PRIORITY
	CCC			;CLEAR CARRY
	RORB	R5		;SHIFT LOW ORDER BITS
	RORB	R5		;  INTO
	RORB	R5		;    HIGH ORDER
	RORB	R5		;      POSITION
O.BK3:	MOVB	R5,ST		;PUT THE STATUS AWAY WHERE IT BELONGS
	MOV	O.UPC,R5	;GET PC, IT POINTS TO THE TRT
	TST	-(R5)		;SUBTRACT TWO
	MOV	R5,O.UPC	;FROM THE USER'S PC
	CMP	R5,O.ADR1	;COMPARE WITH LIST
	BEQ	O.B2		;JUMP IF FOUND
	JSR	5,O.SVTT	;SAVE TELETYPE STATUS
	JSR	5,O.CRLF
	MOV	#O.BD,R4	;ERROR, NOTHING FOUND
	MOV	#O.BD+1,R3
	JSR	5,O.TYPE	;OUTPUT "BE" FOR BAD ENTRY
	MOV	R5,R0
	BIC	#O.TBT,O.UST	;CLEAR OUT ANY POSSIBLE FAKE T-BIT
	BR	O.B3		; AND CONTINUE
O.B2:	DEC	O.CT
	BGT	O.C1		;JUMP IF REPEAT
	MOV	#1,O.CT		;RESET COUNT TO 1
	INCB	O.P		;ALLOW PROCEED
	JSR	5,O.SVTT	;SAVE TELETYPE STATUS, R4 IS SAFE
	MOV	#'B,R0
	JSR	5,O.FTYP	;TYPE "B"
	MOV	O.ADR1,R0	;GET ADDRESS OF BREAK
O.B3:	JSR	5,O.CADV	;TYPE ADDRESS
	CLR	R5		;CLEAR CAD
	JMP	O.DCD		;GO TO DECODER
;
; SAVE REGISTERS R0-R6 IN INTERNAL STACK
;
O.SVR:	MOV	(SP)+,O.XXX	;PICK REGISTER FROM STACK AND SAVE
	MOV	SP,O.USP	;SAVE USER STACK ADDRESS
	MOV	#O.USP,SP	;SET TO INTERNAL STACK
	MOV	R5,-(SP)	;SAVE
	MOV	R4,-(SP)	; REGISTERS
	MOV	R3,-(SP)	;1
	MOV	R2,-(SP)	; THRU
	MOV	R1,-(SP)	;     5
	MOV	O.XXX,-(SP)	;PUT SAVED REGISTER ON STACK
	TST	-(SP)
	RTS	R0
;
; SAVE TELETYPE STATUS
;
O.SVTT:	MOVB	O.RCSR,O.CSR1	;SAVE R C/SR
	MOVB	O.TCSR,O.CSR2	;SAVE T C/SR
	CLRB	O.RCSR		;CLEAR ENABLE AND MAINTENANCE
	CLRB	O.TCSR		;  BITS IN BOTH C/SR
	JSR	5,O.CRLF	;TYPE <CR,LF>
	RTS	R5
;
; RESTORE TELETYPE STATUS
;
O.RSTT:	JSR	5,O.CRLF		;<CR,LF> BEFORE RESTORING
	TSTB	O.TCSR		;WAIT READY ON PRINTER
	BPL	.-4
	BIT	#4000,O.RCSR	;CHECK BUSY FLAG ON READER
	BEQ	O.RSE1		;SKIP READY LOOP IF NOT BUSY
	TSTB	O.RCSR		;WAIT READY
	BPL	.-4		;    ON READER
O.RSE1:	MOVB	O.CSR1,O.RCSR	;RESTORE
	MOVB	O.CSR2,O.TCSR	;  THE STATUS REGISTERS
	RTS	R5
;
; TYPE OUT CONTENTS OF WORD OR BYTE WITH ONE TRAILING SPACE
; WORD IS IN R0
;
O.CADV:	MOV	R2,-(SP)	;SAVE R2
	MOV	#O.BUF+6,R4	;BUFFER START ADDRESS
	MOV	#'0,-(SP)		;CONSTANT ASCII 0
O.SPC:	MOV	R0,R2		; GET
	BIC	#177770,R2	;    OCTAL CHARACTER
	ADD	@SP,R2		;CONVERT TO ASCII
	MOVB	R2,-(R4)	;STORE IN BUFFER
	ASR	R0		;SHIFT THIS MESS
	ASR	R0		; RIGHT
	ASR	R0		;   THREE WHOLE PLACES
	CMP	R4,#O.BUF+1	;DONE?
	BHI	O.SPC		;    NO
	BIC	#177776,R0	;GET LAST BIT
	ADD	(SP)+,R0		;CONVERT TO ASCII
	MOVB	R0,-(R4)	;AND PUT IT AWAY
	MOV	#O.BUF,R4	;FWA FOR WORD MODE
	MOV	#O.BUF+6,R3	;LWA
	JSR	5,O.TYPE	;TYPE WHOLE STRING OF CHARACTERS
	MOV	(SP)+,R2	;RESTORE R2
	RTS	R5
;
; GENERAL CHARACTER INPUT ROUTINE
; CHARACTER INPUT GOES TO R0
;
O.GET:	TSTB	O.RCSR		;WAIT FOR
	BPL	.-4		;   INPUT FROM KEYBOARD
	MOVB	O.RDB,R0	;GET A CHARACTER
	JSR	5,O.FTYP	;ECHO CHARACTER
	BIC	#177600,R0	;STRIP OFF PARITY FROM CHARACTER
	BEQ	O.GET		;IGNORE NULLS
	CMPB	#40,R0		;CHECK FOR SPACES
	BEQ	O.GET		;IGNORE NULLS
	CMPB	#';,R0		;CHECK FOR SEMI-COLON
	BEQ	O.GET		;IGNORE THEM IF FOUND
	RTS	R5
;
; GENERAL CHARACTER OUTPUT ROUTINE
;  ADDRESS OF FIRST BYTE IN R4,
;  ADDRESS OF LAST BYTE IN R3, (R3)>(R4)
;
O.TYPE:	CMP	R3,R4		;CHECK FOR COMPLETION
	BLO	O.TYP1		; EXIT WHEN DONE
	MOVB	(R4)+,R0	;GET A CHARACTER
	JSR	5,O.FTYP	;TYPE ONE CHARACTER
	BR	O.TYPE		;LOOP UNTIL DONE
;
; TYPE ONLY ONE CHARACTER (CONTAINED IN R0)
;
O.FTYP:	TSTB	O.TCSR		;CHECK STATUS
	BPL	.-4		;WAIT UNTIL READY
	MOVB	R0,O.TDB	;TYPE ONE CHARACTER
O.TYP1:	RTS	R5
;
; CLOSE WORD OR BYTE AND EXIT,
; UPON ENTERING, R2 HAS NUMERIC FLAG, R4 HAS CONTENTS
;
O.TCLS:	ASR	R5		;GET LOW ORDER BIT
	BCS	O.TC		;JUMP IF ALREADY CLOSED
	ASL	R5
	TST	R2		;IF NO NUMBER WAS TYPED THERE IS
	BEQ	O.CLS1		;NO CHANGE TO THE OPEN CELL
	MOV	R4,@R5		;STORE WORD
O.CLS1:	RTS	PC
O.TC:	TST	-(SP)		;POP EXTRA CELL FROM STACK
	JMP	O.ERR		;AND SCREAM BLOODY MURDER
;
; O.CRLF - TYPE <CR,LF>
; O.CRLS - TYPE <CR,LF>*
;
O.CRLF:	MOV	#O.CR+1,R3	;LWA <CR,LF>
	BR	O.CRS
O.CRLS:	MOV	#O.CR+2,R3	;LWA <CR,LF>*
O.CRS:	MOV	#O.CR,R4	;FWA
	JSR	5,O.TYPE	;TYPE SOMETHING
	RTS	R5
;
O.XXX:	.WORD	0		;TEMPORARY STORAGE
O.T:	.BYTE	0		;  T-BIT FLAG
O.P:	.BYTE	0		;PROCEED FLAG = 0 IF PROCEED NOT ALLOWED
				;	      = 1 IF PROCEED ALLOWED
O.CSR1:	.BYTE	0		;SAVE CELL - R C/SR
O.CSR2:	.BYTE	0		;SAVE CELL - T C/SR
;
	.EVEN
O.BD:	.WORD	"BE
;
O.CR:	.BYTE	015	;  <CR>
	.BYTE	012	;  <LF>
	.BYTE	'*	;  *
;
O.LGCH:	.BYTE	'/	;  /
	.BYTE	015	;  CARRIAGE RETURN
	.BYTE	'$	;  $
	.BYTE	'G	;  G
	.BYTE	012	;  <LF>
	.BYTE	'_	;  _
	.BYTE	'^	;  ^
	.BYTE	'O	;  O
	.BYTE	'W	;  W
	.BYTE	'E	;  E
	.BYTE	'B	;  B
	.BYTE	'P	;  P
O.CLGT	=	.-O.LGCH		;TABLE LENGTH
;
O.TL:	.BYTE	'S	;DO	  1
	.BYTE	'P	;NOT	  2
	.BYTE	'M	;CHANGE	  3
	.BYTE	0	;THE	  4
	.BYTE	0	;ORDER	  5
	.BYTE	'B	;HERE	  6
O.LG	=	.-O.TL
;
O.BUF:				;6 CHAR. BUFFER WITH
.	=	.+6
	.BYTE	' 		;TRAILING BLANK
	.EVEN
;
O.TRTC:	TRT			;TRACE TRAP PROTOTYPE
;
;THE ORDER OF THE FOLLOWING ENTRIES IS CRITICAL
;
.	=	O.ODT-40
O.UR0:	0	;USER R0
	0	;     R1
	0	;     R2
	0	;     R3
	0	;     R4
	0	;     R5
O.USP:	0	;USER SP
O.UPC:	0	;USER PC
O.UST:	0	;USER ST
O.PRI:	7	;ODT PRIORITY
O.MSK:	0	;MASK
	0	;LOW LIMIT
	0	;HIGH LIMIT
;
; BREAK POINT LISTS, ADR1 = ADDRESS OF BREAKPOINT,CT = COUNT,
;   UIN = CONTENTS
;
O.ADR1:	0
O.CT:	0
O.UIN:	0
.ENDM	ODT11
.MACRO	ODT11X
.NLIST
.SBTTL		ODT-11X -- V006A
.LIST
.=.+200
ST	=	177776		;STATUS REGISTER

O.BKP	=	16		;NUMBER OF BREAKPOINTS-1 MULT. BY 2
O.TVEC	=	14		;TRT VECTOR LOCATION
O.STM	=	340		;PRIORITY MASK - STATUS REGISTER
O.TBT	=	20		;T-BIT MASK - STATUS REGISTER
TRT	=	000003		;TRT INSTRUCTION


O.RDB	=	177562	;R DATA BUFFER
O.RCSR	=	177560	;R C/SR
O.TDB	=	177566	;T DATA BUFFER
O.TCSR	=	177564	;T C/SR


; INITIALIZE ODT
;  USE O.ODT FOR A NORMAL ENTRY
;  USE O.ODT+2 TO RESTART ODT - WIPING OUT ALL BREAKPOINTS
;  USE O.ODT+4 TO RE-ENTER (I.E. - FAKE A BREAKPOINT)

O.ODT:	BR	O.STRT		;NORMAL ENTRY
	BR	O.RST		;RESTART
O.ENTR:	MOV	ST,O.UST	;RE-ENTER -- SAVE STATUS
	MOV	O.TVEC+2,ST	;SET UP LOCAL STATUS
	MOV	#.+2,O.UPC	;FAKE THE PC
	MOVB	#-1,O.P		;DISALLOW PROCEED
	CLRB	O.S
	JMP	O.BK1

O.STRT:	MOV	#O.UR0,SP	;SET UP STACK
	MOV	SP,O.USP	;FAKE THE SAVED STACK
	BR	O.RST1
O.RST:	JSR	0,O.SVR		;SAVE REGISTERS
	JSR	5,O.REM		;REMOVE ALL BREAKPOINTS
	MOVB	O.PRI,R4	;GET ODT PRIORITY
	RORB	R4		;SHIFT
	RORB	R4		; INTO
	RORB	R4		;  POSITION
	MOVB	R4,ST		;STORE IN STATUS
O.RST1:	CLRB	O.S		;DISABLE SINGLE INSTRUCTION FOR NOW
	MOV	@#10,-(6)	;SAVE IT
	MOV	#O.1120,@#10	;RESERVED INST
	SXT	R0		;IS IT AN 11/40-45?
	MOV	#RTT,O.RTI	;YES
	BR	.+4		;SKIP CLEAR
O.1120:	CMP	(6)+,(6)+	;CLEAR STACK
	MOV	(6)+,@#10	;RESTORE 10
	MOVB	#-1,O.P		;DISALLOW PROCEED
	MOV	#O.STM,O.TVEC+2	;STATUS WORD TO TRT VECTOR+2
	MOV	#O.BRK,O.TVEC	;PC TO TRT VECTOR
	JMP	O.RALL		;CLEAR BREAKPOINT TABLES
; SPECIAL NAME HANDLER
;  DEPENDS UPON THE EXPLICIT ORDER OF THE TWO TABLES O.TL AND O.UR0

O.REGT:	JSR	5,O.GET		;SPECIAL NAME, GET ONE MORE CHARACTER
	MOV	#O.TL,R4	;TABLE START ADDRESS
O.RSP:	CMPB	R0,(R4)+	;IS THIS THE CORRECT CHARACTER?
	BEQ	O.SP		;JUMP IF YES
	CMP	#O.TL+O.LG,R4	;IS THE SEARCH DONE?
	BHI	O.RSP		;BRANCH IF NOT
	BIC	#177770,R0	;MASK OFF OCTAL
	MOV	R0,R4
O.SP1:	ASL	R4
	ADD	#O.UR0,R4	;GENERATE ADDRESS
	INC	R2		;SET FOUND FLAG
	BR	O.SCAN		;GO FIND NEXT CHARACTER
O.SP:	SUB	#O.TL-7,R4	;GO FIND NEXT CHARACTER
	BR	O.SP1

; _ HANDLER - OPEN INDEXED ON THE PC

O.ORPC:	JSR	5,O.TCLS	;TEST WORD MODE AND CLOSE
	ADD	@R2,R2		;COMPUTE
	INC	R2
	INC	R2		;   NEW ADDRESS
O.PCS:	MOV	R2,O.CAD	;UPDATE CAD
	JMP	O.OP2A		;GO FINISH UP
O.ORAB:	JSR	5,O.TCLS		;TEST WORD MODE AND CLOSE
	MOV	@R2,R2		;GET ABSOLUTE ADDRESS
	BR	O.PCS
O.ORRB:	JSR	5,O.TCLS	;TEST AND CLOSE
	MOV	@R2,R1		;COMPUTE NEW ADDRESS
	MOVB	R1,R1		;EXTEND THE SIGN
	ASL	R1		;R2=2(@R2)
	INC	R1		;   +2
	INC	R1
	ADD	R1,R2		;   +PC
	BR	O.PCS
O.TCLS:	JSR	PC,O.CLSE	;CLOSE CURRENT CELL
	CMP	#2,O.BW		;ONLY WORD MODE ALLOWED
	BNE	O.TCL1		;BRANCH IF ERROR
	MOV	O.CAD,R2	;CURRENT ADDRESS IN R2
	RTS	R5
O.TCL1:	TST	(SP)+
	BR	O.ERR		;POP A WORD AND SHOW THE ERROR

;	PROCESS S - SINGLE INSTRUCTION MODE

O.SNGL:	TST	R2		;SEE IF TURN ON OR TURN OFF
	BNE	O.SI1		;BRANCH IF TURNING IT ON
	CLRB	O.S		;CLEAR THE FLAG
	BR	O.DCD		;CONTINUE THE SCAN
O.SI1:	MOVB	#-1,O.S	;SET THE FLAG
	BR	O.DCD
; COMMAND DECODER - ODT11X

;  ALL REGISTERS MAY BE USED (R0-R5),

O.ERR:	MOV	#'?,R0		;  ? TO BE TYPED
	JSR	5,O.FTYP	; OUTPUT ?
O.DCD:	CLR	O.BW		;CLOSE ALL
	JSR	5,O.CRLS	;TYPE  <CR><LF>*
O.DCD2:	CLR	R3		;R3 IS A SAVE REGISTER FOR R2
	CLR	R5		;R5 IS A SAVE REGISTER FOR R4
O.DCD1:	CLR	R4		; R4 CONTAINS THE CONVERTED OCTAL
	CLR	R2		; R2 IS THE NUMBER FOUND FLAG
O.SCAN:	JSR	5,O.GET		;GET A CHAR, RETURN IN R0
	CMP	#'0,R0		;COMPARE WITH ASCII 0
	BHI	O.CLGL		;CHECK LEGALITY IF NON-NUMERIC
	CMP	#'7,R0		;COMPARE WITH ASCII 7
	BLO	O.CLGL		;CHECK LEGALITY IF NOT OCTAL
	BIC	#177770,R0	;CONVERT TO BCD
	ASL	R4		; MAKE ROOM
	ASL	R4		;  IN
	ASL	R4		;    R4
	ADD	R0,R4		;PACK THREE BITS IN R4
	INC	R2		;R2 HAS NUMERIC FLAG
	BR	O.SCAN		;   AND TRY AGAIN
O.CLGL:	CLR	R1		;CLEAR INDEX
O.LGL1:	CMPB	R0,O.LGCH(R1)	;DO THE CODES MATCH?
	BEQ	O.LGL2		;JUMP IF YES
	INC	R1		; SET INDEX FOR NEXT SEARCH
	CMP	R1,#O.CLGT	;IS THE SEARCH DONE?
	BHIS	O.ERR		;    OOPS!
	BR	O.LGL1		;RE-LOOP
O.LGL2:	ASL	R1		;MULTIPLY BY TWO
	JMP	@O.LGDR(R1)	;GO TO PROPER ROUTINE

O.LGDR:	O.SEMI	;  
	O.WRD	;  /    OPEN WORD
	O.BYT	;  \    OPEN BYTE
	O.CRET	;  CARRIAGE RETURN    CLOSE
	O.REGT	;  $  REGISTER OPS
	O.GO	;  G  GO TO ADDRESS K
	O.OP1	;  <LF>  MODIFY, CLOSE, OPEN NEXT
	O.ORPC	;  _  OPEN RELATED, INDEX - PC
	O.OLD	;  <  RETURN TO OLD SEQUENCE AND OPEN
	O.BACK	;  ^  OPEN PREVIOUS
	O.OFST	;  O  OFFSET
	O.WSCH	;  W  SEARCH WORD
	O.EFF	;  E  SEARCH EFFECTIVE ADDRESS
	O.BKPT	;  B  BREAKPOINTS
	O.PROC	;  P  PROCEED
	O.ORAB	;  @  OPEN RELATED, ABSOLUTE
	O.ORRB	;  >  OPEN RELATED, REL. BRANCH
	O.SNGL	;  S  SINGLE INSTRUCTION MODE
O.LGL	=	.-O.LGDR	;LGL MUST EQUAL 2X CHLGT ALWAYS

; SEMI-COLON PROCESSOR

O.SEMI:	MOV	R2,R3	;A SEMI-COLON HAS BEEN RECEIVED
	MOV	R4,R5	;NUMERIC FLAG TO R3, CONTENTS TO R5
	BR	O.DCD1		;GO BACK FOR MORE

; PROCESS / AND \ - OPEN WORD OR BYTE

O.WRD:	MOV	#2,O.BW		;OPEN WORD
	BR	O.WB1
O.BYT1:	ROL	R4		;GET THE ADDRESS BACK
O.BYT:	MOV	#1,O.BW		;OPEN BYTE
O.WB1:	TST	R2		;GET VALUE IF R2 IS NON-ZERO
	BEQ	O.WRD1		;SKIP OTHERWISE
	MOV	R4,O.DOT	;PUT VALUE IN DOT
	MOV	R4,O.CAD	;    ALSO IN CAD
O.WRD1:	CMP	#1,O.BW		;CHECK BYTE MODE
	BEQ	O.WRD2		;JUMP IF BYTE
	MOV	O.CAD,R4
	ASR	R4		;MOVE ONE BIT TO CARRY
	BCS	O.BYT1		;JUMP IF ODD ADDRESS
	MOV	@O.CAD,R0	;GET CONTENTS OF WORD
	BR	O.WRD3
O.WRD2:	MOVB	@O.CAD,R0	;GET CONTENTS OF BYTE
O.WRD3:	JSR	5,O.CADV	;GO GET AND TYPE OUT @CAD
	BR	O.DCD2		;GO BACK TO DECODER

; PROCESS CARRIAGE RETURN

O.CRET:	JSR	PC,O.CLSE	;CLOSE LOCATION
O.DCDA:	BR	O.DCD		;RETURN TO DECODER

; PROCESS <LF>, OPEN NEXT WORD

O.OLD:	INCB	O.SEQ		;SET NEED O.DOT TO O.CAD MOVE
O.OP1:	TST	O.BW		;<LF> RECEIVED
O.ERR2:	BEQ	O.ERR		;ERROR IF NOTHING IS OPEN
	JSR	PC,O.CLSE	;CLOSE PRESENT CELL
	TSTB	O.SEQ		;SEE IF < COMMAND
	BEQ	O.OP5		;BRANCH IF NOT
	MOV	O.DOT,O.CAD	;GO TO THE FORRMER STREAM
O.OP5:	CLRB	O.SEQ		;CLEAR THE FLAG
	ADD	O.BW,O.CAD	;GENERATE NEW ADDRESS
O.OP2:	MOV	O.CAD,O.DOT	;INITIALIZE DOT
O.OP2A:	JSR	5,O.CRLF	;<CR><LF>
	MOV	O.BW,-(SP)	;SAVE BW
	MOV	#2,O.BW		;SET TO TYPE FULL WORD ADDRESS
	MOV	O.CAD,R0	;NUMBER TO TYPE
	JSR	5,O.CADV	; TYPE OUT ADDRESS
	MOV	@SP,O.BW	;RESTORE BW
	CMP	#1,(SP)+	;IS IT BYTE MODE?
	BEQ	O.OP3		;JUMP IF YES
	MOV	#'/,R0		;TYPE A /
O.OP4:	JSR	5,O.FTYP
	BR	O.WRD1		;GO PROCESS IT
O.OP3:	MOV	#'\,R0		;TYPE A \
	BR	O.OP4

; PROCESS ^, OPEN PREVIOUS WORD

O.BACK:	TST	O.BW		;  ^ RECEIVED
	BEQ	O.ERR2		;ERROR IF NOTHING OPEN
	JSR	PC,O.CLSE
	SUB	O.BW,O.CAD	;GENERATE NEW ADDRESS
	BR	O.OP2		;GO DO THE REST

; B HANDLER - SET AND REMOVE BREAKPOINTS

O.BKPT:	MOV	#O.TRTC,R0
	ASL	R4		;MULTIPLY NUMBER BY TWO
	TST	R3
	BEQ	O.REMB		;IF R3 IS ZERO GO REMOVE BREAKPOINT
	ASR	R5		;GET ONE BIT TO CARRY
	BCS	O.ERR1		;BADNESS IF ODD ADDRESS
	ASL	R5		;RESTORE ONE BIT
	ADD	#O.ADR1,R4
	TST	R2
	BNE	O.SET1		;JUMP IF SPECIFIC CELL
O.SET:	CMP	R0,@R4		;IS THIS CELL FREE?
	BEQ	O.SET1		;JUMP IF YES
	CMP	R4,#O.BKP+O.ADR1	;ARE WE AT THE END OF OUR ROPE
	BHIS	O.ERR1		;YES, THERE IS NOTHING FREE
	TST	(R4)+		;INCREMENT BY TWO
	BR	O.SET
O.SET1:	CMP	R4,#O.BKP+O.ADR1
	BHI	O.ERR1		;ERROR IF TOO LARGE
	MOV	R5,@R4		;SET BREAKPOINT
	BR	O.DCDA		;RETURN
O.REMB:	TST	R2
	BEQ	O.RALL		;GO REMOVE ALL
	CMP	R4,#O.BKP
	BHI	O.ERR1		;JUMP IF NUMBER TOO LARGE
	MOV	R0,O.ADR1(R4)	;CLEAR BREAKPOINT
	CLR	O.CT(R4)	;CLEAR COUNT ALSO
O.DCDB:	BR	O.DCDA
O.RALL:	CLR	R4
	MOV	#O.TRTC,R0
O.RM1:	CMP	R4,#O.BKP+2	;ALL DONE?
	BHI	O.DCDA		;JUMP IF YES
	MOV	R0,O.ADR1(R4)	;RESET BKPT
	MOV	#TRT,O.UIN(R4)	;RESET CONTENTS OF TABLE
	CLR	O.CT(R4)	;CLEAR COUNT
	TST	(R4)+		;INCREMENT BY TWO
	BR	O.RM1

; PROCESS O, COMPUTE OFFSET

O.OFST:	CMP	#2,O.BW		;CHECK WORD MODE
	BNE	O.ERR1		;ERROR IF NOT CORRECT MODE
	MOV	#' ,R0		;TYPE ONE BLANK
	JSR	5,O.FTYP	;  AS A SEPARATOR
	TST	R3		;WAS SEMI-COLON TYPED?
	BEQ	O.ERR1		;NO, CALL IT AN ERROR
O.OF2:	SUB	O.CAD,R5	;COMPUTE
	DEC	R5
	DEC	R5		;    16 BIT OFFSET
	MOV	R5,R0
	JSR	5,O.CADV	;NUMBER IN R0 - WORD MODE
	MOV	R5,R0
	ASR	R0		;DIVIDE BY TWO
	BCS	O.OF1		;ERROR IF ODD
	CMP	#-200,R0	;COMPARE WITH -200
	BGT	O.OF1		;DO NOT TYPE IF OUT OF RANGE
	CMP	#177,R0		;COMPARE WITH +177
	BLT	O.OF1		;DO NOT TYPE IF OUT OF RANGE
	DEC	O.BW		;SET TEMPORARY BYTE MODE
	JSR	5,O.CADV	;NUMBER IN R0 - BYTE MODE
	INC	O.BW		;RESTORE WORD MODE
O.OF1:	JMP	O.DCD2		;ALL DONE

O.ERR1:	JMP	O.ERR		;INTERMEDIATE HELP

; SEARCHES - $MSK   HAS THE MASK
;		$MSK+2 HAS THE FWA
;		$MSK+4 HAS THE LWA

O.EFF:	INC	R1		;SET EFFECTIVE SEARCH
	BR	O.WDS
O.WSCH:	CLR	R1		;SET WORD SEARCH
O.WDS:	TST	R3		;CHECK FOR OBJECT FOUND
	BEQ	O.ERR1		;ERROR IF NO OBJECT
	MOV	#2,O.BW		;SET WORD MODE
	MOV	O.MSK+2,R2	;SET ORIGIN
	MOV	O.MSK,R4	;SET MASK
	COM	R4
O.WDS2:	CMP	R2,O.MSK+4	; IS THE SEARCH ALL DONE?
	BHI	O.DCDB		;  YES
	MOV	@R2,R0		; GET OBJECT
	TST	R1		;NO
	BNE	O.EFF1		;BRANCH IF EFFECTIVE SEARCH
	MOV	R0,-(SP)
	MOV	R5,R3		;EXCLUSIVE OR
	BIC	R5,R0		; IS DONE
	BIC	(SP)+,R3		;  IN A VERY
	BIS	R0,R3		;    FANCY MANNER HERE
	BIC	R4,R3		;AND RESULT WITH MASK
O.WDS3:	BNE	O.WDS4		;RE-LOOP IF NO MATCH
	MOV	R4,-(SP)	;REGISTERS R2,R4, AND R5 ARE SAFE
	JSR	5,O.CRLF
	MOV	R2,R0		;GET READY TO TYPE
	JSR	5,O.CADV	;  TYPE ADDRESS
	MOV	#'/,R0		;SLASH TO R0
	JSR	5,O.FTYP	;TYPE IT
	MOV	@R2,R0		;GET CONTENTS
	JSR	5,O.CADV	;TYPE CONTENTS
	MOV	(SP)+,R4	; RESTORE R4
O.WDS4:	TST	(R2)+		;INCREMENT TO NEXT CELL AND
	BR	O.WDS2		;    RETURN
O.EFF1:	CMP	R0,R5		; IS (X)=K?
	BEQ	O.WDS3		;TYPE IF EQUAL
	MOV	R0,R3		;(X) TO R3
	ADD	R2,R3		;(X)+X
	INC	R3
	INC	R3		;(X)+X+2
	CMP	R3,R5		;IS (X)+X+2=K?
	BEQ	O.WDS3		;BRANCH IF EQUAL
	BIC	#177400,R0	;WIPE OUT EXTRANEOUS BITS
	MOVB	R0,R0
	CCC
	ASL	R0		;MULTIPLY BY TWO
	INC	R0
	INC	R0
	ADD	R2,R0		;ADD PC
	CMP	R0,R5		;IS THE RESULT A PROPER REL. BRANCH?
	BR	O.WDS3

; PROCESS G - GO

O.GO:	TST	R3		;WAS K; TYPED?
	BEQ	O.ERR1		; TYPE ?<CR,LF> IF NOT
	MOVB	#O.BKP+3,O.P	;CLEAR PROCEED
	ASR	R5		;CHECK LOW ORDER BIT
	BCS	O.ERR1		;ERROR IF ODD NUMBER
	ASL	R5		;RESTORE WORD
	MOV	R5,O.UPC	;SET UP NEW PC
	MOVB	#O.STM,ST		;SET HIGH PRIORITY
	JSR	5,O.RSTT	;RESTORE TELETYPE
O.TBIT:	CLRB	O.T		;CLEAR
	BIS	#O.TBT,O.UST	;    BOTH T-BIT FLAGS
	TSTB	O.S		;SEE IF WE NEED A T BIT
	BNE	O.GO2		;IF NOT GO NOW
	BIC	#O.TBT,O.UST	;SET TH T BIT
O.GO1:	JSR	5,O.RSB		;RESTORE BREAKPOINTS
O.GO2:	JSR	0,O.RSR		;RESTORE REGISTERS
	MOV	O.UST,-(SP)	;    AND STATUS
	MOV	O.UPC,-(SP)	;    AND PC
O.RTI:	RTI

; PROCESS P - PROCEED 
;   ONLY ALLOWED AFTER A BREAKPOINT

O.PROC:	MOVB	O.P,R0
	TSTB	R0		;CHECK LEGALITY OF PROCEED
	BLT	O.ERR1		;NOT LEGAL
	TST	R2		;CHECK FOR ILLEGAL COUNT
	BNE	O.ERR1		;JUMP IF ILLEGAL
	TST	R3		;WAS COUNT SPECIFIED?
	BEQ	O.PR1		;NO
	MOV	R5,O.CT(R0)	;YES, PUT AWAY COUNT
O.PR1:	MOVB	#O.STM,ST	;FORCE HIGH PRIORITY
	JSR	5,O.RSTT	;RESTORE TTY
O.C1:	CMPB	O.P,#O.BKP	;SEE IF A REAL ONE OR A FAKE
	BGT	O.TBIT		;BRANCH IF FAKE
	TSTB	O.S		;SEE IF SINGLE INSTRUCTION MODE
	BNE	O.TBIT		;IF SO EXIT NOW
	MOVB	#O.STM,ST	;SET HIGH PRIORITY
	INCB	O.T		;SET T-BIT FLAG
	BIS	#O.TBT,O.UST	;SET T-BIT
	BR	O.GO2

; BREAKPOINT HANDLER
O.BRK:	MOV	(SP)+,O.UPC	;PRIORITY IS 7 UPON ENTRY
	MOV	(SP)+,O.UST	;SAVE STATUS AND PC
	MOVB	#O.BKP+3,O.P	;TELL ;P THAT WE CAN CONTINUE
O.BK1:	JSR	0,O.SVR		;SAVE VARIOUS REGISTERS
	TSTB	O.T		;CHECK FOR T-BIT SET
	BNE	O.TBIT		;JUMP IF SET
	JSR	5,O.REM		;REMOVE BREAKPOINTS
	TSTB	O.PRI		;CHECK IF PRIORITY
	BPL	O.BK2		; IS AS SAME AS USER PGM
	MOVB	O.UST,R5	;PICK UP USER UST IF SO
	BR	O.BK3
O.BK2:	MOVB	O.PRI,R5	;OTHERWISE PICK UP ACTUAL PRIORITY
	CCC			;CLEAR CARRY
	RORB	R5		;SHIFT LOW ORDER BITS
	RORB	R5		;  INTO
	RORB	R5		;    HIGH ORDER
	RORB	R5		;      POSITION
O.BK3:	MOVB	R5,ST		;PUT THE STATUS AWAY WHERE IT BELONGS
	MOV	O.UPC,R5	;GET PC, IT POINTS TO THE TRT
	TSTB	O.S		;SEE IF IT WAS SINGLE INSTRUCTION FUN
	BMI	O.B4		;IF SO HANDLE THERE
	TST	-(R5)
	MOV	R5,O.UPC
	MOV	#O.BKP,R4	;GET A COUNTER
O.B1:	CMP	R5,O.ADR1(R4)	;COMPARE WITH LIST
	BEQ	O.B2		;JUMP IF FOUND
	DEC	R4
	DEC	R4
	BGE	O.B1		;RE-LOOP UNTIL FOUND
	JSR	5,O.SVTT	;SAVE TELETYPE STATUS
	JSR	5,O.CRLF
	MOV	#O.BD,R4	;ERROR, NOTHING FOUND
	MOV	#O.BD+1,R3
	JSR	5,O.TYPE	;OUTPUT "BE" FOR BAD ENTRY
	MOV	R5,R0
	ADD	#2,O.UPC	;POP OVER THE ADJUSTMENT ABOVE
	BR	O.B3		; OR CONTINUE
O.B4:	MOVB	#O.BKP+2,R4	;SET BREAK POINT HIGH + 1
	MOV	R5,O.ADR1(R4)	;STORE NEXT PC VALUE FOR TYPE OUT
	BR	O.B2
O.B2:	MOVB	R4,O.P		;ALLOW PROCEED
	DEC	O.CT(R4)
	BGT	O.C1		;JUMP IF REPEAT
	MOV	#1,O.CT(R4)	;RESET COUNT TO 1
	JSR	5,O.SVTT	;SAVE TELETYPE STATUS, R4 IS SAFE
	MOV	#'B,R0
	JSR	5,O.FTYP	;TYPE "B"
	MOVB	O.P,R0		;CONVERT BREAKPOINT NUMBER TO ASCII
	ADD	#140,R0
	ASR	R0
	JSR	5,O.FTYP
	MOV	#';,R0
	JSR	5,O.FTYP	; TYPE 
	MOV	#2,O.BW		; SET WORD MODE
	MOVB	O.P,R4
	MOV	O.ADR1(R4),R0	;GET ADDRESS OF BREAK
O.B3:	JSR	5,O.CADV	;TYPE ADDRESS
	JMP	O.DCD		;GO TO DECODER
; SAVE REGISTERS R0-R6
;   INTERNAL STACK

O.SVR:	MOV	(SP)+,O.XXX	;PICK REGISTER FROM STACK AND SAVE
	MOV	SP,O.USP	;SAVE USER STACK ADDRESS
	MOV	#O.USP,SP	;SET TO INTERNAL STACK
	MOV	R5,-(SP)	;SAVE
	L	R4,-(SP)	; REGISTERS
	MOV	R3,-(SP)	;1
	MOV	R2,-(SP)	; THRU
	MOV	R1,-(SP)	;     5
	MOV	O.XXX,-(SP)	;PUT SAVED REGISTER ON STACK
	TST	-(SP)
	RTS	R0

; RESTORE REGISTERS R0-R6

O.RSR:	TST	(SP)+		;POP THE EXTRA CELL
	MOV	(SP)+,O.XXX	;GET R0 FROM STACK
	MOV	(SP)+,R1	;RESTORE
	MOV	(SP)+,R2	; REGISTERS
	MOV	(SP)+,R3	;  1
	MOV	(SP)+,R4	;  THRU
	MOV	(SP)+,R5	;    5
	MOV	O.USP,SP	;RESTORE USER STACK
	MOV	O.XXX,-(SP)	;PUT R0 ON USER STACK
	RTS	R0

; RESTORE BREAKPOINTS 0-7

O.RSB:	MOV	#O.BKP,R4	;RESTORE ALL BREAKPOINTS
O.RS1:	MOV	@O.ADR1(R4),O.UIN(R4)	;SAVE CONTENTS
	MOV	O.TRTC,@O.ADR1(R4)	;REPLACE WITH TRAP
	DEC	R4
	DEC	R4
	BGE	O.RS1		;RE-LOOP UNTIL DONE
	RTS	R5		;  THEN QUIT

; SAVE TELETYPE STATUS

O.SVTT:	MOVB	O.RCSR,O.CSR1	;SAVE R C/SR
	MOVB	O.TCSR,O.CSR2	;SAVE T C/SR
	CLRB	O.RCSR		;CLEAR ENABLE AND MAINTENANCE
	CLRB	O.TCSR		;  BITS IN BOTH C/SR
	RTS	R5

; RESTORE TELETYPE STATUS

O.RSTT:	JSR	5,O.CRLF
	TSTB	O.TCSR		;WAIT READY
	BPL	.-4		;  ON PRINTER
	BIT	#4000,O.RCSR	;CHECK BUSY FLAG
	BEQ	O.RSE1		;SKIP READY LOOP IF NOT BUSY
	TSTB	O.RCSR		;WAIT READY
	BPL	.-4		;    ON READER
O.RSE1:	MOVB	O.CSR1,O.RCSR	;RESTORE
	MOVB	O.CSR2,O.TCSR	;  THE STATUS REGISTERS
	RTS	R5

; REMOVE BREAKPOINTS 0-7
;   IN THE OPPOSITE ORDER OF SETTING

O.REM:	TSTB	O.S		;SEE IF SINGLE INSTRUCTION IS GOING
	BNE	O.R2		;EXIT IF SO
	CLR	R4		;REMOVE ALL BREAKPOINTS
O.R1:	MOV	O.UIN(R4),@O.ADR1(R4)	;CLEAR BREAKPOINT
	INC	R4
	INC	R4
	CMP	R4,#O.BKP
	BLE	O.R1		;RE-LOOP UNTIL DONE
O.R2:	RTS	R5		;THEN QUIT

; TYPE OUT CONTENTS OF WORD OR BYTE WITH ONE TRAILING SPACE
; WORD IS IN R0

O.CADV:	MOV	#6,R3		;# OF DIGITS
	MOV	#-2,R4		;# OF BITS FIRST-3
	CMP	#1,O.BW		;SEE IF WORD MODE
	BNE	O.SPC		;BRANCH IF SO
	SUB	#3,R3		;ONLY DO 3 DIGITS
	INC	R4		;DO 2 BITS FIRST
	SWAB	R0		;AND TURN R0 AROUND
O.SPC:	MOV	R0,-(SP)	;SAVE R0
O.V0:	ADD	#3,R4		;COMPUTE THE NUMBER OF BITS TO DO
	CLR	R0
O.V1:	ROL	(SP)		;GET A BIT
	ROL	R0		;STORE IT AWAY
	DEC	R4		;DECREMENT COUNTER
	BGT	O.V1		;LOOP IF MORE BITS NEEDED
	ADD	#'0,R0		;CONVERT TO ASCII
	JSR	R5,O.FTYP	;TYPE IT
	DEC	R3		;SEE IF MORE DIGITS TO DO
	BGT	O.V0		;LOOP IF SO
	MOVB	#' ,R0		;SET UP FOR TRAILING SPACE
	TST	(SP)+		;GET RID OF JUNK AND FALL THRU TO FTYP
; TYPE ONLY ONE CHARACTER (CONTAINED IN R0)

O.FTYP:	TSTB	O.TCSR
	BPL	.-4
	MOVB	R0,O.TDB
O.TYP1:	RTS	R5
; GENERAL CHARACTER INPUT ROUTINE -- ODT11X
; CHARACTER INPUT GOES TO R0

O.GET:	TSTB	O.RCSR		;WAIT FOR
	BPL	.-4		;  INPUT FROM KBD
	MOVB	O.RDB,R0	;GET CHARACTER - STRIP OFF PARITY
	BIC	#177600,R0	;STRIP OFF PARITY FROM CHARACTER
	CMPB	R0,#012		;SEE IF A <LF>
	BEQ	O.GET1		;IF SO SAVE THE PAPER
	JSR	5,O.FTYP	;ECHO CHARACTER
	BEQ	O.GET		;IGNORE NULLS
	CMPB	#40,R0		;CHECK FOR SPACES
	BEQ	O.GET		;IGNORE SPACES
O.GET1:	RTS	R5

; GENERAL CHARACTER OUTPUT ROUTINE - ODT11X
;  ADDRESS OF FIRST BYTE IN R4,
;  ADDRESS OF LAST BYTE IN R3, (R3)>(R4)

O.TYPE:	CMP	R3,R4		;CHECK FOR COMPLETION
	BLO	O.TYP1		; EXIT WHEN DONE
	MOVB	(R4)+,R0	;GET A CHARACTER
	JSR	5,O.FTYP	;TYPE ONE CHARACTER
	BR	O.TYPE		;LOOP UNTIL DONE

; CLOSE WORD OR BYTE AND EXIT,
; UPON ENTERING, R2 HAS NUMERIC FLAG, R4 HAS CONTENTS

O.CLSE:	TST	R2		;IF NO NUMBER WAS TYPED THERE IS
	BEQ	O.CLS1		;NO CHANGE TO THE OPEN CELL
	CMP	#1,O.BW
	BEQ	O.CLS2		;JUMP IF BYTE MODE
	BHI	O.CLS1		;JUMP IF ALREADY CLOSED
	MOV	R4,@O.CAD	;STORE WORD
	BR	O.CLS1
O.CLS2:	MOVB	R4,@O.CAD	;STORE BYTE
O.CLS1:	RTS	PC

O.CRLF:	MOV	#O.CR+1,R3	;LWA <CR,LF>
	BR	O.CRS
O.CRLS:	MOV	#O.CR+2,R3	;LWA <CR,LF>*
O.CRS:	MOV	#O.CR,R4	;FWA
	JSR	5,O.TYPE	;TYPE SOMETHING
	RTS	R5

O.BW:	0			; =0 - ALL CLOSED,
				; =1 - BYTE OPEN,
				; =2 - WORD OPEN
O.CAD:	0			; CURRENT ADDRESS
O.DOT:	0			; ORIGIN ADDRESS
O.XXX:	.WORD	0		;TEMPORARY STORAGE
O.WDFG:	.BYTE	0		;SEARCH FLAG = 1 - EFFECTIVE
				;            = 0 - WORD
O.S:	.BYTE	0		;SINGLE INSTRUCTION FLAG
				;0 IF NOT ACTIVE
				;-1 IF ACTIVE
				;NO BREAK BOINTS MAY BE SET WHILE IN 
				;SINGLE INSTRUCTION MODE
O.T:	.BYTE	0		;  T-BIT FLAG
O.P:	.BYTE	0		;PROCEED FLAG = -2 IF MANUAL ENTRY
				;		-1 IF NO PROCEED ALLOWED
				;		0-7 IF PCEED ALLOWED
O.CSR1:	.BYTE	0		;SAVE CELL - R C/SR
O.CSR2:	.BYTE	0		;SAVE CELL - T C/SR
O.SEQ:	.BYTE	0		;FLAG FOR < COMMAND

	.EVEN
O.BD:	.WORD	"BE

O.CR:	.BYTE	015	;  <CR>
	.BYTE	012	;  <LF>
	.BYTE	'*	;  *

O.LGCH:	.BYTE	';	;  
	.BYTE	'/	;  /
	.BYTE	'\	;  \
	.BYTE	015	;  CARRIAGE RETURN
	.BYTE	'$	;  $
	.BYTE	'G	;  G
	.BYTE	012	;  <LF>
	.BYTE	'_	;  _
	.BYTE	'<	;  <
	.BYTE	'^	;  ^
	.BYTE	'O	;  O
	.BYTE	'W	;  W
	.BYTE	'E	;  E
	.BYTE	'B	;  B
	.BYTE	'P	;  P
	.BYTE	'@	;  @
	.BYTE	'>	;  >
	.BYTE	'S	;  S
O.CLGT	=	.-O.LGCH		;TABLE LENGTH

O.TL:	.BYTE	'S	;DO	  1
	.BYTE	'P	;NOT	  2
	.BYTE	'M	;CHANGE	  3
	.BYTE	0	;THE	  4
	.BYTE	0	;ORDER	  5
	.BYTE	'B	;HERE	  6
O.LG	=	.-O.TL
	.EVEN
O.TRTC:	TRT			;TRACE TRAP PROTOTYPE

;THE ORDER OF THE FOLLOWING ENTRIES IS CRITICAL

.	=	O.ODT-120	;ODT'S STACK IMMEDIATELY PRECEDES ODT

O.UR0:	0	;USER R0
	0	;     R1
	0	;     R2
	0	;     R3
	0	;     R4
	0	;     R5
O.USP:	0	;USER SP
O.UPC:	0	;USER PC
O.UST:	0	;USER ST
O.PRI:	7	;ODT PRIORITY
O.MSK:	0	;MASK
	0	;LOW LIMIT
	0	;HIGH LIMIT

; BREAK POINT LISTS, ADR1 = ADDRESS OF BREAKPOINT,CT = COUNT,
;   UIN = CONTENTS

O.ADR1:	
.	=	.+O.BKP+4
O.CT:	
.	=	.+O.BKP+4
O.UIN:	
.	=	.+O.BKP+4
.	=	O.TRTC+2
.ENDM	ODT11X

.LIST